Game setup with scratches in R

Question

I want to set up a "bag" full of letters in the game, and give out random letters and delete them later. I have a few questions: Question No. 1 Right now I have made an infinitely long list that contains every letter that is in the bag, there should be an easier way to do this over the loop function.

a<-c("Joker","Joker", "A","A","A","A","A","A","A","A","A","B","B",..."W","W","X","Y","Y","Z") 

Question No. 2 with the Sample function (a, 7) I can print 7 random letters from the list. So, now I just need to subtract these letters from the list a, but everything I was looking for seems to delete all the letters (so if I pulled out one “A”, it will delete all “A” from the first list).

Bonus question (you don’t need to answer it): The setup of the board (it should be a good printed schedule) is likely to be performed on the matrix. Where empty spaces can be marked with O, Double points DP, Double word value DW, etc. I already know that this is far from my understanding, but whether there will be a way to automatically calculate how much a person receives for breaking a word in a certain place.

Answer 1

 set.seed(3222955) # set up game avail_pieces <- c("Joker", LETTERS[1:3]) count_pieces <- c(2, 7, 3, 4) sack <- rep(avail_pieces, count_pieces) sack #[1] "Joker" "Joker" "A" "A" "A" "A" "A" "A" "A" "B" "B" "B" "C" #[14] "C" "C" "C" # start game ind1 <- sample(seq_len(length(sack)), 5, replace=FALSE) hand1 <- sack[ind1] # update sack sack <- sack[-ind1] hand1 #[1] "A" "C" "B" "Joker" "A" sack #[1] "Joker" "A" "A" "A" "A" "A" "B" "B" "C" "C" "C" # repeat for hand2, ... 

The representative matrix representation is perfectly normal, although you can ask another question by specifying the exact rule for scoring.

Answer 2

I read your question and was interested to see if I could do something like this. Here's my implementation (which is a bit messy and might be more efficient). I have not implemented everything (i.e. only a few words, not the multiplicity of letters), and it only considers a word in a line (i.e. Does not evaluate side lines).

It also has features for partial words and a dictionary.

Hope this gives you some ideas - here's the animation:

 ############################## # PREREQUISITES # ############################## require(ggplot2) # for the plot require(gridExtra) # to arrange the board and panels require(data.table) # for fast dictionary lookup require(dplyr) # for data manipulation require(grid) # for gpar ############################## # UTILITY FUNCTIONS # ############################## tb <- theme(axis.line=element_blank(), axis.text.x=element_blank(), axis.text.y=element_blank(), axis.ticks=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(), legend.position="none", panel.background=element_blank(), panel.border=element_blank(), panel.grid.major=element_blank(), panel.grid.minor=element_blank(), plot.background=element_blank()) strip.word<-function(subword,word,returnExact=F){ temp.word<<-word lapply(1:nchar(subword),function(x)temp.word<<-sub(substr(subword,x,x),"",temp.word)) ifelse(returnExact,nchar(temp.word)==(nchar(word)-nchar(subword)),return(temp.word)) } char.vec<-function(s){ unlist(lapply(1:nchar(s),function(x)substr(s,x,x))) } ############################## # LOAD SCRABBLE DICTIONARY # # AND INDEX # ############################## # NB remove hashes to run once! #scrabble.dictionary<-data.table(read.table(file="https://raw.github.com/jmlewis/valett/master/scrabble/sowpods.txt",header=F,col.names="words")) #setkey(scrabble.dictionary,words) ############################## # LOAD RULES # # LETTERS (DIST & SCORES) # ############################## rules<-read.csv(text="letter,score,num A,1,8 B,3,2 C,3,2 D,2,4 E,1,12 F,4,2 G,2,3 H,4,2 I,1,9 J,8,1 K,5,1 L,1,4 M,3,2 N,1,6 O,1,8 P,3,2 Q,10,1 R,1,6 S,1,4 T,1,6 U,1,4 V,4,2 W,4,2 X,8,1 Y,4,2 Z,10,1 0,0,2",header=T) # INDEX RULES BY LETTER rownames(rules)<-rules$letter ############################## # MAKE EMPTY BOARD # ############################## board<-expand.grid(c=LETTERS[1:15],r=15:1,stringsAsFactors=FALSE) triple.word<-data.frame(c=c("A","H","O","A","O","A","H","O"),r=c(1,1,1,8,8,15,15,15),stringsAsFactors=F,tw=3) double.word<-data.frame(c=c("B","C","D","E","K","L","M","N","B","C","D","E","K","L","M","N","H"),r=c(2,3,4,5,5,4,3,2,14,13,12,11,11,12,13,14,8),stringsAsFactors=F,dw=2) board.filled<-merge(merge(board,triple.word,all.x=T),double.word,all.x=T) board.filled[is.na(board.filled)]<-1 valids<-unique(c(board$r,as.character(board$c))) # used for checking bounds of words within board ############################## # INITIALISE # # BOARD, SACK & TRAYS # ############################## init.game<-function(seed=1){words<<-data.frame(r=c(),c=c(),lab=c(),stringsAsFactors=F) tray<<-data.frame(player=c(rep(1,7),rep(2,7)),tiles=c(NA),stringsAsFactors=F) # FILL THE SACK sack<<-data.frame(letter=unlist(apply(rules,1,function(x)rep(x[1],x[3])))) # SHUFFLE THE SACK set.seed(seed) #>>>>>>>>>>>> REMOVE THIS FOR A REAL GAME sack$letter<<-sample(sack$letter,nrow(sack)) scorecard<<-data.frame(player=c(),word=c(),score=c()) player<<-1 # START PLAYER 1 } switch.player<-function()player<<-ifelse(player==1,2,1) # SWWITCH FUNCTION ############################## # FUNCTION TO # # PLOT BOARD (WITH WORDS) # # AND TO FILL EACH TRAY # ############################## fill.board<-function(){ g<-ggplot(board.filled) + geom_tile(aes(c,r,fill=factor(tw*dw)),color="red") + scale_fill_brewer(palette="YlOrRd", name="SQUARE\n", labels=c("","2x WORD","3x WORD")) + theme_bw() + coord_fixed(ratio=1,xlim=c(0.5:15.5),ylim=c(0.5:15.5)) + scale_y_continuous(breaks=c(1:15)) + theme(axis.title.x=element_blank(), axis.title.y=element_blank()) ifelse(nrow(words)==0, return(g), return(g + geom_point(aes(x=c,y=as.integer(r)),color="black",data=words,size=14,shape=22,fill="yellow",alpha=0.7) + geom_text(aes(x=c,y=as.integer(r),label=gsub("0"," ",lab)),data=words,size=9) )) } fill.tray<-function(letters,p=1){ n<-length(letters) g<-qplot(1:7,1)+geom_tile(color="white",size=1,fill="lightblue") + theme_bw() + coord_fixed(ratio=1,xlim=c(0.25:10),ylim=c(0.25,1.75)) + tb + geom_point(aes(8,1),alpha=0.8,fill=ifelse(p==player,"red","grey"),size=13,shape=22) + geom_text(aes(8,1,label=paste0("P",p)),size=5,color="white") + geom_text(aes(9,1,label=sum(scorecard[scorecard$player==p,"score"])),size=5,color="blue") ifelse(n==0, return(g), return(g+geom_point(aes(x=1:n,y=rep(1,n)),size=14,shape=22,fill="yellow",alpha=0.7) + geom_text(aes(x=1:n,y=rep(1,n),label=gsub("0"," ",letters)),size=9)) ) } ############################## # FUNCTION TO # # DRAW THE BOARD # # AND TRAYS FOR EACH PLAYER # ############################## draw.game<-function(){ ifelse(nrow(scorecard)==0,grb<-rectGrob(),grb<-tableGrob(scorecard %.% arrange(player),gp=gpar(cex=0.6))) grid.arrange(arrangeGrob(fill.tray(tray[tray$player==1 & !is.na(tray$tiles),2],1), fill.board(), fill.tray(tray[tray$player==2 & !is.na(tray$tiles),2],2), ncol=1,heights=c(0.15,0.7,0.15)),grb,ncol=2,widths=c(0.8,0.2)) } draw.tiles<-function(n=7){ nt<-min(n,nrow(sack)) draw<-sack[0:nt,1] sack<<-data.frame(letter=sack[-(0:nt),]) c(as.character(draw),rep(NA,(nn.t))) } ############################## # FUNCTION TO # # ADD EACH WORD # # TO THE BOARD # ############################## add.word<-function(word,c="H",r=8,d=1){ word<-gsub(" ","0",word) c.ix<-match(c,LETTERS) word.len<-nchar(word) word.start<-c(c,r) word.col<-match(word.start[1],LETTERS) ifelse(d==1, word.grid<-data.frame(LETTERS[word.col:(word.col+word.len-1)],word.start[2],c(strsplit(word,"")),stringsAsFactors=F), word.grid<-data.frame(word.start[1],as.numeric(word.start[2]):(as.numeric(word.start[2])-word.len+1),c(strsplit(word,"")),stringsAsFactors=F)) colnames(word.grid)<-c("c","r","lab") # work out which letters are already on the board, and which are needed existing.letters<-merge(word.grid,words)[,"lab"] tray.letters<-strip.word(paste0(unlist(existing.letters),collapse=""),word) tray.contents<-paste0(unlist(tray[tray$player==player,"tiles"]),collapse="") # pad out the surrounding cells to determine if the word is adjacent / overlaying cx<-LETTERS[(min(match(unique(word.grid$c),LETTERS))-1):(max(match(unique(word.grid$c),LETTERS))+1)] rx<-(min(as.integer(unique(word.grid$r)))-1):(max(as.integer(unique(word.grid$r)))+1) pad<-expand.grid(c=cx,r=rx) touch.x<-pad[!((pad$r==max(pad$r)|pad$r==min(pad$r))&(pad$c==pad$c[1]|pad$c==pad$c[nrow(pad)])),] # get the entire word if it an add-on ifelse(d==1, {#find the whole row #start with the start point (that we know is in the word) #and go forward and backward full.row<-merge(board[board$r==r,],unique(rbind(words[words$r==r,],word.grid[word.grid$r==r,])),all.x=T) word.shift<-sum(cumprod(!is.na(full.row$lab)[c.ix:1]))-1 word.len<-sum(cumprod(!is.na(full.row$lab)[c.ix:15])) word.entire<-paste0(full.row$lab[(c.ix-word.shift):(c.ix+word.len-1)],collapse="")}, {#find the whole column #start with the start point (that we know is in the word) #and go forward and backward full.row<-merge(board[board$c==c,],unique(rbind(words[words$c==c,],word.grid[word.grid$c==c,])),all.x=T) word.shift<-sum(cumprod(!is.na(full.row$lab)[r:1]))-1 word.len<-sum(cumprod(!is.na(full.row$lab)[r:15])) word.entire<-paste0(full.row$lab[(r+word.len-1):(r-word.shift)],collapse="")} # backwards because top >> bottom ) # error handling if(is.na(sum(match(unlist(word.grid[,1:2]),valids)))) stop("ERROR, WORD OFF BOARD") # test for on board if(is.na(scrabble.dictionary[grep(paste0("^",gsub("0",".{1,1}",word.entire),"$"),scrabble.dictionary[,words])][1])) stop("ERROR, NOT IN DICTIONARY") # test spelling if(strip.word(word,paste0(existing.letters,tray.contents,collapse=""),T)==F) stop(paste0("MISSING LETTERS IN YOUR TRAY",player)) # check tray if(nrow(merge(touch.x,words))==0 & nrow(words)>0) stop("ERROR, YOU MUST TOUCH AN EXISTING LETTER") # position score.base<-sum(sapply(char.vec(gsub(" ","0",word.entire)),function(x)rules[rules$letter==x,"score"])) ifelse(nrow(words)>0, word.specials<-merge(merge(words,word.grid,by=c("c","r"),all.y=T),board.filled), word.specials<-data.frame(c="H",r=8,lab.x=NA,lab.y=NA,tw=1,dw=2,stringsAsFactors=F)) #update the filled board words<<-unique(rbind(words,word.grid)) # clean up excess entries with unique new.tray<<-paste0(tray[tray$player==player&!is.na(tray$tiles),"tiles"],collapse="") lapply(1:nchar(word),function(x)new.tray<<-sub(substr(word,x,x),"",new.tray)) tray[tray$player==player,]<<-data.frame(player=player,tiles=unlist(c(lapply(1:nchar(new.tray),function(x)substr(new.tray,x,x)),draw.tiles(n=7-nchar(new.tray)))),stringsAsFactors=F) #update the scorecard score.upd<<-score.base*prod(as.matrix(word.specials[is.na(word.specials$lab.x),c("tw","dw")])) scorecard<<-rbind(scorecard,data.frame(player=player,word=word.entire,score=score.upd)) # toggle players and draw the board switch.player() draw.game() } ############################## # # # PLAY SCRABBLE! # # # # PRE-RUN WITH SEED VALUE # # FOR CONSISTENT RESULTS # # # ############################## init.game(6) #LEAVE SEED PARAM BLANK FOR RANDOM GAME draw.game() tray[tray$player==1,"tiles"]<-draw.tiles(7) tray[tray$player==2,"tiles"]<-draw.tiles(7) draw.game() add.word("WIVES",c="H",8,1) add.word("SLANT",c="L",8,2) add.word("ONCE",c="K",5,1) add.word("BONE",c="K",11,2) add.word("BEET",c="K",11,1) add.word("GREET",c="M",14,2) add.word("EROS",c="L",13,1) add.word("BOSS",c="O",15,2) add.word("WAVY",c="H",8,2) add.word("MOVE",c="F",6,1) add.word("MIN ",c="F",6,2) add.word("FIZ ",c="C",3,1) add.word("WILD",c="D",4,2) add.word("PATE",c="N",8,2) add.word("J IL",c="A",2,1) add.word("PINE",c="I",9,2) add.word("SUPINE",c="I",11,2) add.word("HUGS",c="F",11,1) add.word("DEATH",c="F",15,2) add.word("RACK",c="E",13,1) add.word("DUAL",c="F",15,1) add.word("REMOVE",c="D",6,1) add.word("ROOFER",c="D",11,2) add.word("DOXY",c="C",9,1) add.word("HAIR",c="A",11,1) add.word("HEARD",c="A",11,2) add.word("QAT",c="B",12,2) add.word("ANNUL",c="H",7,1) add.word("WIN",c="D",4,1)