R/CanadianSalad.R

In guiboucher/Games.GB: Games in R

#' Canadian Salad
#'
#' Jeux de la salade canadienne. De 2 à 6 joueurs.\cr
#' Règles : \url{https://www.pagat.com/compendium/canadian_salad.html}
#'
#' @import shiny
#' @import data.table
#' @import stringr
#' @export
CanadianSalad <- function(data = "Partie1-CS.rds", type = "text"){


# Variables ---------------------------------------------------------------------------------------------

  data <- paste0("data-games/", data)
  player_hand_order <- c(  # ordre des cartes visible par le joueur
    paste(c(2:10,"J","Q","K","A"), rep(c("Pique", "Coeur", "Trèfle", "Carreau"), each = 13))
  )

# Fonctions ---------------------------------------------------------------------------------------------

  # Ajustement du deck selon le nombre de joueurs
  .deck_players <- function(nPlayers, type){
    deck <- deck52[[type]]
    if(nPlayers == 3){
      deck <- deck[!deck %in% paste(2,club(type))]
    } else if(nPlayers == 5){
      deck <- deck[!deck %in% paste(2, c(club(type), diamond(type)))]
    } else if(nPlayers %in% c(6, 8)){
      deck <- deck[!deck %in% paste(rep(2:3, each = 2), c(club(type), diamond(type)))]
    } else if(nPlayers == 7){
      deck <- deck[!deck %in% c(paste(2, club(type)), paste(2, diamond(type)), paste(3, club(type)))]
    }
    return(deck)
  }
  # Importance des cartes selon la première carte joué - permet de savoir qui gagnera la main
  .hand_order <- function(card, type){
    if(str_detect(card, spade(type))){
      return(c(
        paste(c("A", "K", "Q", "J", 10:2), spade(type)),
        paste(rep(c("A", "K", "Q", "J", 10:2), each = 3), c(heart(type), diamond(type), club(type))),
        ""  # joueur qui n'ont pas placé de carte encore
      ))
    } else if(str_detect(card, heart(type))){
      return(c(
        paste(c("A", "K", "Q", "J", 10:2), heart(type)),
        paste(rep(c("A", "K", "Q", "J", 10:2), each = 3), c(spade(type), diamond(type), club(type))),
        ""  # joueur qui n'ont pas placé de carte encore
      ))
    } else if(str_detect(card, diamond(type))){
      return(c(
        paste(c("A", "K", "Q", "J", 10:2), diamond(type)),
        paste(rep(c("A", "K", "Q", "J", 10:2), each = 3), c(spade(type), heart(type), club(type))),
        ""  # joueur qui n'ont pas placé de carte encore
      ))
    } else if(str_detect(card, club(type))){
      return(c(
        paste(c("A", "K", "Q", "J", 10:2), club(type)),
        paste(rep(c("A", "K", "Q", "J", 10:2), each = 3), c(spade(type), heart(type), diamond(type))),
        ""  # joueur qui n'ont pas placé de carte encore
      ))
    }
  }
  # Compter les points selon le tour
  .ptsTour <- function(dt, tour){
    if(tour == 1L){
      return(.pts_T1())
    } else if(tour == 2L){
      return(.pts_T2(dt))
    } else if(tour == 3L){
      return(.pts_T3(dt))
    } else if(tour == 4L){
      return(.pts_T4(dt))
    } else if(tour == 5L){
      return(.pts_T5(dt))
    } else if(tour == 6L){
      return(.pts_T6(dt))
    }
  }
  .pts_T1 <- function() return(10L)
  .pts_T2 <- function(dt){
    pts <- sum(str_detect(dt$actualHand$Carte, heart(type))) * 10
    return(as.integer(pts))
  }
  .pts_T3 <- function(dt){
    cartes <- copy(dt$actualHand$Carte)
    pts <- sum(str_detect(str_sub(cartes, 1, 1), "Q")) * 25
    return(as.integer(pts))
  }
  .pts_T4 <- function(dt){
    cartes <- copy(dt$actualHand$Carte)
    pts <- sum(str_detect(cartes, paste("K", spade()))) * 100
    return(as.integer(pts))
  }
  .pts_T5 <- function(dt){
    dt <- copy(dt)
    if(unique(sapply(dt$PlayerCards, length)) == 0){
      return(100L)
    } else {
      return(0L)
    }
  }
  .pts_T6 <- function(dt){
    return(.pts_T1() + .pts_T2(dt) + .pts_T3(dt) + .pts_T4(dt) + .pts_T5(dt))
  }


# User interface ----------------------------------------------------------------------------------------

  ui <- shinyUI(fluidPage(

    titlePanel("La Salade Canadienne"),

    sidebarLayout(

      sidebarPanel(
        textInput("playerName", "Joueur :", ""),  # où on indique son nom en tant que joueur - NE PAS EFFACER
        actionButton("addPlayer", "Ajouter Joueur"), hr(),  # Ajouter son nom s'il n'apparaît pas dans le tableau en haut de la page
        actionButton("startGame", "ON JOUE!"),  # commencer la partie si tous les joueurs sont présents
        actionButton("newGame", "Nouvelle Partie"), hr(),  # recommencer une nouvelle partie
        textOutput("Tour"),
        textOutput("playerTurn"), hr(),  # indiquer c'est à qui le tour
        textOutput("title_last_play"),
        tableOutput("lastPlay"), hr()
      ),

      mainPanel(
        tableOutput("Score"), hr(),  # indiquer le score des joueurs
        tableOutput("actualHand"), hr(),
        textOutput("playerDeck"), hr(),
        textInput("card2play", "Carte à jouer :", ""),
        actionButton("playCard", "Placer carte")
      )

    )

  ))

# Server -------------------------------------------------------------------------------------------------

  server <- shinyServer(function(input, output, session){

    output$test <- renderPrint({ gameData()$show_last_hand })

    # Importation du data : Vérification à chaque 0.1 seconde si le data a été modifié. Si c'est le cas
    # le data est importé, donnant accès aux dernières modifications/informations.
    gameData <- reactiveFileReader(intervalMillis = 0.1,
                                   filePath = data, readFunc = readRDS,
                                   session = NULL)

    # Nom du joueur - le joueur inscrit son nom en haut à gauche, clique sur Ajouter Joueur, puis laisse
    # son nom inscrit dans la case pour que le programme sache c'est qui.
    me_player <- reactive({ input$playerName })
    # Afficher le deck du joueur
    output$playerDeck <- renderText({paste(gameData()$PlayerCards[[me_player()]], collapse = " // ")})
    # Titre au-dessus du tableau de la dernière main
    output$title_last_play <- renderText({
      if(gameData()$show_last_hand){
        return("Dernière main :")
      } else {
        return("")
      }
    })


    # Indiquer les joueurs actifs ainsi que leur score
    output$Score <- renderTable({ gameData()$Score })
    # Ajout d'un joueur lorsque celui-ci le demande -> clique sur 'Ajouter Joueur'
    observeEvent(input$addPlayer, {
      DT <- gameData()
      if(DT$newGame){
        DT$Score <- rbind(DT$Score, data.table(Joueur = input$playerName,
                                               T1 = 0L, T2 = 0L, T3 = 0L,
                                               T4 = 0L, T5 = 0L, T6 = 0L,
                                               Tot = 0L))
        saveRDS(DT, data)
      }
    })
    # Si nouveau joueur -> on ajuste le deck
    deck <- reactive(.deck_players(length(gameData()$Score$Joueur), type))
    # Indiquer c'est à qui de jouer le tour
    output$playerTurn <- reactive({
      if(is.null(gameData()$playerTurn)){
        return("")
      } else if(gameData()$Tour > 6){
        DT <- gameData()$Score
        setorder(DT, Tot)
        return(paste0("Le gagnant est ",DT[[1,1]]," <3"))
      } else {
        return(paste0("À ",gameData()$playerTurn," de jouer."))
      }
    })
    # Indiquer le tour
    output$Tour <- renderText({
      if(is.null(gameData()$Tour)){
        return("")
      } else if(gameData()$Tour == 1){
        return("Tour 1 : Main = 10 pts.")
      } else if(gameData()$Tour == 2){
        return("Tour 2 : Coeur = 10 pts.")
      } else if(gameData()$Tour == 3){
        return("Tour 3 : Reine = 25 pts.")
      } else if(gameData()$Tour == 4){
        return("Tour 4 : Roi de Pique = 100 pts.")
      } else if(gameData()$Tour == 5){
        return("Tour 5 : Dernière main = 100 pts.")
      } else if(gameData()$Tour == 6){
        return("Tour 6 : Toutes les règles.")
      }
    })
    # Afficher les cartes que les joueurs ont placés
    output$actualHand <- renderTable({ gameData()$actualHand })
    # Afficher le dernier jeu
    output$lastPlay <- renderTable({ gameData()$lastPlay})




    # Nouvelle partie - Supprimer les joueurs et refaire inscription
    observeEvent(input$newGame, {
      DT <- list(  # remettre les infos à zéro
        Score = data.table(Joueur = as.character(),
                           T1 = as.integer(), T2 = as.integer(), T3 = as.integer(),
                           T4 = as.integer(), T5 = as.integer(), T6 = as.integer(),
                           Tot = as.integer()),
        Hand = 0L,  # numéro de la main
        newGame = TRUE,  # est-ce une nouvelle game?
        show_last_hand = FALSE  # afficher la dernière main?
      )
      saveRDS(DT, data)
    })



    # ON JOUE! - Préparer le jeu
    observeEvent(
      input$startGame, {
        DT <- copy(gameData())
        if(DT$newGame){
          DT$newGame <- FALSE
          # Mélanger les joueurs pour déterminer l'ordre des joueurs
          DT$Score <- DT$Score[sample(1:nrow(DT$Score))]  # new order
          # Distribuer les cartes pour tout le monde
          allcards <- as.character(deck())
          i <- 1L
          DT$PlayerCards <- list()  # liste contenant les cartes de chaque joueur
          while(length(allcards)){
            card <- sample(allcards, 1)  # sélectionner une carte
            allcards <- allcards[!allcards %in% card]  # supprimer la carte pour ne pas la resélectionner
            DT$PlayerCards[[paste0(DT$Score$Joueur[[i]])]] <-  # sauvegarder carte dans le deck du joueur
              c(DT$PlayerCards[[paste0(DT$Score$Joueur[[i]])]], as.character(card))
            i <- i + 1L  # prochain joueur
            if(i > nrow(DT$Score)) i <- 1L  # recommencer à 1 si on a donné des cartes à tout le monde
          }
          for(i in names(DT$PlayerCards))
            DT$PlayerCards[[i]] <- as.character(sort(
              factor(DT$PlayerCards[[i]], levels = player_hand_order)
            ))
          # Indiquer c'est à qui de jouer
          DT$playerTurn <- DT$Score$Joueur[1]
          DT$playerTurn_idx <- 1L
          # Créer tableau qui contiendra la carte de tous les joueurs
          DT$actualHand <- data.table(Joueur = DT$Score$Joueur, Carte = "")
          # Indiquer le type de main
          DT$Tour <- 1L
          # Type de la carte de la main
          DT$TypeCard <- ""

          # Save new data
          saveRDS(DT, data)  # save new infos
        }

      }
    )
    # ON JOUE! - Placer une carte

    card2play <- reactive({  # raccourci permi pour jouer les cartes
      card <- input$card2play
      for(letter in c("j", "q", "k", "a"))
        if(str_detect(str_sub(card, 1, 1), letter))
          str_sub(card, 1, 1) <- toupper(str_sub(card, 1, 1))
      card <- str_replace(card, "pi", "Pique")
      card <- str_replace(card, "co", "Coeur")
      card <- str_replace(card, "tr", "Trèfle")
      card <- str_replace(card, "ca", "Carreau")
      return(card)
    })

    observeEvent(  # Placer la carte dans le jeu, puis la supprimer du deck du joueur
      input$playCard, {

        DT <- copy(gameData())
        if(DT$playerTurn == input$playerName && DT$Tour <= 6){  # si c'est le tour du joueur
          if(any(str_detect(DT$PlayerCards[[DT$playerTurn]], card2play()))){  # si la carte qu'il a inscrit est dans son jeu

            if(all(DT$actualHand$Carte == "")) DT$TypeCard <- card2play()  # déterminer quel est le type de carte à jouer
            # Placer la carte du joueur
            DT$actualHand[Joueur == input$playerName, Carte := card2play()]  # inscrire la valeur de la carte dans le tableau
            DT$PlayerCards[[DT$playerTurn]] <-  # supprimer la carte du jeu
              DT$PlayerCards[[DT$playerTurn]][!DT$PlayerCards[[DT$playerTurn]] %in% card2play()]
            # Trier le tableau
            DT$actualHand[, Carte := factor(Carte, levels = .hand_order(DT$TypeCard, type))]  # permet de trier du texte
            setorder(DT$actualHand, Carte)  # nouvel ordre des cartes selon importance
            DT$actualHand[, Carte := as.character(Carte)]  # remettre en texte normal
            # Modifier joueur
            if(all(DT$actualHand$Carte != "")){  # si tout le monde a joué
              DT$Score[Joueur == DT$actualHand$Joueur[1],  # ajouter les points au joueur qui a remporté la main
                       paste0("T",DT$Tour) := get(paste0("T",DT$Tour)) + .ptsTour(DT, DT$Tour)]
              DT$Score[, Tot := T1 + T2 + T3 + T4 + T5 + T6]
              DT$playerTurn <- DT$actualHand$Joueur[1]  # prochain joueur à jouer
              DT$playerTurn_idx <- match(DT$playerTurn, DT$Score$Joueur)  # index du joueur pour prochain tour
              DT$lastPlay <- copy(DT$actualHand)  # sauvegarder la dernière main
              DT$actualHand <- DT$actualHand <- data.table(Joueur = DT$Score$Joueur, Carte = "")  # remettre table vide pour prochain tour
              if(DT$show_last_hand == FALSE) DT$show_last_hand <- TRUE  # Afficher lasthand dès la fin de la 1ere main
              DT$TypeCard <- ""  # initialiser le type de la carte pour le prochain tour
              if(  # si personne n'a de carte, c'est la fin du tour
                unique(sapply(DT$PlayerCards, length)) == 0  # s'il n'y a plus de carte
                | (DT$Tour == 3L && sum(DT$Score$T3) == 100L)  # si toutes les reines sont sortis
                | (DT$Tour == 4L && sum(DT$Score$T4) == 100L)  # si le roi de pique est sorti
              ){
                DT$Tour <- DT$Tour + 1L  # prochain tour
                # Prochain tour implique qu'on doit redonner les cartes
                # Distribuer les cartes pour tout le monde
                allcards <- as.character(deck())
                i <- 1L
                DT$PlayerCards <- list()  # liste contenant les cartes de chaque joueur
                while(length(allcards)){
                  card <- sample(allcards, 1)  # sélectionner une carte
                  allcards <- allcards[!allcards %in% card]  # supprimer la carte pour ne pas la resélectionner
                  DT$PlayerCards[[paste0(DT$Score$Joueur[[i]])]] <-  # sauvegarder carte dans le deck du joueur
                    c(DT$PlayerCards[[paste0(DT$Score$Joueur[[i]])]], as.character(card))
                  i <- i + 1L  # prochain joueur
                  if(i > nrow(DT$Score)) i <- 1L  # recommencer à 1 si on a donné des cartes à tout le monde
                }
                if(DT$Tour > 6){  # ne pas afficher les carte si c'est terminé
                  for(i in names(DT$PlayerCards))
                    DT$PlayerCards[[i]] <- ""
                } else {
                  for(i in names(DT$PlayerCards))
                    DT$PlayerCards[[i]] <- as.character(sort(
                      factor(DT$PlayerCards[[i]], levels = player_hand_order)
                    ))
                }
              }
            } else {
              DT$playerTurn_idx <- DT$playerTurn_idx + 1L  # prochain joueur
              if(DT$playerTurn_idx > nrow(DT$Score)) DT$playerTurn_idx <- 1L  # recommencer au premier si besoin
              DT$playerTurn <- DT$Score$Joueur[DT$playerTurn_idx]  # nom du joueur que c'est son tour
            }

            # Save new data
            saveRDS(DT, data)  # save new infos

            # Supprimer le texte dans le textbox contenant le nom de la carte
            updateTextInput(session, "card2play", value = "")

          }

        }

      }
    )


  })

  return(shinyApp(ui, server))

}