2014-01-22 77 views
2

我想设置一个装满游戏字母的“麻袋”,并随机发送一些字母并将其删除。我有几个问题: 问题Nr.1 现在我做了一个无尽长的列表,其中包含每一个字母都在麻袋里,在循环函数中必须有一个更简单的方法。在R中设置拼字游戏

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

问题NR 2 与功能样品(a,7)我可以打印出从列表7个随机字母。所以现在我需要做的就是从列表a中减去这些字母,但是我查过的所有东西似乎都会删除所有字母(所以如果我拔出一个“A”,它会从所有字母中删除所有“A”第一个列表)。

红利问题(不需要回答): 设置电路板(应该是一个很好的可打印图形)可能会通过矩阵完成。空白空间可以用O标记,双点DP,双字值DW等。我已经知道这远远超出了我的理解,但是会不会有一种方法可以自动计算一个人在某个特定位置放下一个字所能获得的收益。

回答

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

董事会代表作为基体是完全理智的,虽然你可能要问一个问题,指定用于计数点的精确规则。

+0

从来就用我的信息来更新它和它完美的作品。一个问题:样本函数中的replace = FALSE,意味着在创建每个数字后,其他人有更高的可能性来? – Euchale

+0

'?sample'将有助于:'replace = F'代表没有替换的抽样,即'sample(sack,3,replace = F)'可能不包含3个JOkers,而'sample(sack,3,replace = T) '可以。 – tonytonov

10

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

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

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

enter image description here

############################## 
# 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)