在R中设置一个拼字游戏

Question

我想设置一个充满游戏字母的“麻袋”，随后发出随机字母并将其删除。我有几个问题： 问题Nr.1 现在我制作了一个无休止的长列表，其中包含了解决方案中的每一个字母，必须有一个更简单的方法来执行循环函数。

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

问题Nr.2 使用函数Sample（a，7），我可以从列表中打印7个随机字母。所以现在我需要做的就是从列表a中减去这些字母，但是我查找的所有内容似乎都删除了所有字母（所以如果我拉出一个“A”，它会删除所有的“A”。第一个清单）。

奖金问题（无需回答）： 设置电路板（应该是一个很好的可打印图形）可能会在Matrix上完成。其中空格可以用O标记，双点DP，双字值DW等等。我已经知道这远远超出了我的理解，但是有没有办法自动计算一个人在某个地方放下一个字的数量。

Answer 1

我读了你的问题，并有兴趣看看我是否可以做类似的事情。这是我的实现（有点混乱，可以提高效率）。我没有实现所有内容（即只有多个分数，而不是字母倍数）并且它只对行中的单词进行计数（即不对侧行进行评分）。

它还具有部分单词和字典的功能。

希望它会给你一些想法 - 这是一个动画：

##############################
# 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,t.w=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,d.w=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(t.w*d.w)),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){
  n.t<-min(n,nrow(sack))
  draw<-sack[0:n.t,1]
  sack<<-data.frame(letter=sack[-(0:n.t),])
  c(as.character(draw),rep(NA,(n-n.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
  c.x<-LETTERS[(min(match(unique(word.grid$c),LETTERS))-1):(max(match(unique(word.grid$c),LETTERS))+1)]
  r.x<-(min(as.integer(unique(word.grid$r)))-1):(max(as.integer(unique(word.grid$r)))+1)
  pad<-expand.grid(c=c.x,r=r.x)
  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's 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,t.w=1,d.w=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("t.w","d.w")]))
  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)

Answer 2

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, ...

作为矩阵的董事会代表是完全理智的，尽管你可能想问另一个问题，指明计算点数的确切规则。