library(fun) mine_sweeper()
gomoku()
playedlist <- NULL i <- 0 repeat { for (j in 1:2) { repeat { l <- locator(1) l$x <- min(n, max(1, round(l$x))) l$y <- min(n, max(1, round(l$y))) xy <- paste(l, collapse = ":") if (!is.element(xy, playedlist)) break } playedlist <- c(playedlist, xy) points(l, cex = 3, pch = c(19, 21)[j], bg = c("black", "white")[j]) i <- i + 1 if (i >= n^2) break } if (i >= n^2) break }
tower_of_hanoi(4)
move.hanoi <- function(k, from, to, via) { if (k > 1) { move.hanoi(k - 1, from, via, to) move.hanoi(1, from, to, via) move.hanoi(k - 1, via, to, from) } else { cat("Move ", tower[[from]][1], " from ", LETTERS[from], " to ", LETTERS[to], "\n") tower[[to]] <<- c(tower[[from]][1], tower[[to]]) tower[[from]] <<- tower[[from]][-1] draw.hanoi() Sys.sleep(0.5) } }
Other Games
library(hangman) hangman()
library(gamer) entangler()
library(ompr) library(dplyr) n <- 9 # 9 cells per square, row and column model <- MIPModel() %>% # The number k stored in position i,j add_variable(x[i, j, k], i=1:n, j=1:n, k=1:n, type="binary") %>% # no objective set_objective(0) %>% # only one number can be assigned per cell add_constraint(sum_expr(x[i, j, k], k=1:n) == 1, i=1:n, j=1:n) %>% # each number is exactly once in a row add_constraint(sum_expr(x[i, j, k], j=1:n) == 1, i=1:n, k=1:n) %>% # each number is exactly once in a column add_constraint(sum_expr(x[i, j, k], i=1:n) == 1, j=1:n, k=1:n) %>% # each 3x3 square must have all numbers add_constraint(sum_expr(x[i, j, k], i=1:3 + sx, j=1:3 + sy) == 1, sx=seq(0, n - 3, 3), sy=seq(0, n - 3, 3), k=1:n)
model
Mixed linear integer optimization problem Variables: Continuous: 0 Integer: 0 Binary: 729 Model sense: maximize Constraints: 324
modelFixed <- model %>% add_constraint(x[1, 2, 3] == 1) %>% add_constraint(x[1, 4, 6] == 1) %>% add_constraint(x[1, 5, 2] == 1) %>% add_constraint(x[1, 8, 7] == 1) %>% add_constraint(x[1, 9, 9] == 1) %>% add_constraint(x[2, 1, 6] == 1) %>% add_constraint(x[2, 6, 5] == 1) %>% add_constraint(x[3, 5, 3] == 1) %>% add_constraint(x[3, 7, 5] == 1) %>% add_constraint(x[4, 2, 6] == 1) %>% add_constraint(x[4, 3, 3] == 1) %>% add_constraint(x[4, 8, 9] == 1) %>% add_constraint(x[4, 9, 2] == 1) %>% add_constraint(x[5, 4, 8] == 1) %>% add_constraint(x[5, 6, 6] == 1) %>% add_constraint(x[6, 1, 7] == 1) %>% add_constraint(x[6, 2, 4] == 1) %>% add_constraint(x[6, 7, 8] == 1) %>% add_constraint(x[6, 8, 5] == 1) %>% add_constraint(x[7, 3, 7] == 1) %>% add_constraint(x[7, 5, 8] == 1) %>% add_constraint(x[8, 4, 1] == 1) %>% add_constraint(x[8, 9, 3] == 1) %>% add_constraint(x[9, 1, 3] == 1) %>% add_constraint(x[9, 2, 9] == 1) %>% add_constraint(x[9, 5, 6] == 1) %>% add_constraint(x[9, 6, 4] == 1) %>% add_constraint(x[9, 8, 2] == 1)
modelFixed
Mixed linear integer optimization problem Variables: Continuous: 0 Integer: 0 Binary: 729 Model sense: maximize Constraints: 352
library(ompr.roi) library(ROI.plugin.glpk) result <- solve_model(modelFixed, with_ROI(solver="glpk", verbose=TRUE))
<SOLVER MSG> ---- GLPK Simplex Optimizer, v4.47 352 rows, 729 columns, 2944 non-zeros 0: obj = 0.000000000e+000 infeas = 3.520e+002 (352) 500: obj = 0.000000000e+000 infeas = 2.222e+000 (104) * 681: obj = 0.000000000e+000 infeas = 1.572e-012 (89) OPTIMAL SOLUTION FOUND GLPK Integer Optimizer, v4.47 352 rows, 729 columns, 2944 non-zeros 729 integer variables, all of which are binary Integer optimization begins... + 681: mip = not found yet <= +inf (1; 0) + 692: >>>>> 0.000000000e+000 <= 0.000000000e+000 0.0% (1; 0) + 692: mip = 0.000000000e+000 <= tree is empty 0.0% (0; 1) INTEGER OPTIMAL SOLUTION FOUND <!SOLVER MSG> ----
result
Status: optimal Objective value: 0
solution <- result %>% get_solution(x[i,j,k]) %>% filter(value > 0) %>% select(i, j, k) head(solution, 8)
i j k 1 3 1 1 2 7 2 1 3 6 3 1 4 8 4 1 5 2 5 1 6 4 6 1 7 1 7 1 8 5 8 1
RXKCD::getXKCD('653')
plot(1:10, type="b", bty="l", col="paleturquoise3", lty=2, lwd=2)
library(htmltools) library(SVGAnnotation) library(XML) library(comicR) comic <- tagList( tags$div( id = "simplePlot" ,HTML( saveXML( svgPlot({plot(1:10, type="b", bty="l", col="paleturquoise3", family="Permanent Marker", lty=2, lwd=2)}, height=4, width = 6) ) ) ) ,comicR( "#simplePlot" ) )
comic
plays <- readxl::read_excel(file.path(dataDir, 'football', '2016 NFL Play-by-Play Data.xlsx')) topPassers <- plays %>% filter(`Play Type` == "Pass") %>% group_by(Passer) %>% summarize(n.obs=length(`Play Type`)) %>% arrange(desc(n.obs)) %>% slice(1:10) %>% magrittr::extract2('Passer') passType <- plays %>% filter(`Play Type` == "Pass" & Passer %in% topPassers) %>% mutate(PassDistance=factor(`Pass Distance`, levels=c("Short", "Deep"))) %>% mutate(Passer=factor(Passer, levels=topPassers)) %>% dplyr::rename(PassLocation=`Pass Location`, PassResult=`Pass Result`) %>% group_by(Passer, PassLocation, PassDistance) %>% summarize(share=(sum(PassResult == "Complete") / length(PassResult)), n.obs=length(PassResult)) %>% filter(n.obs > 5)
ggplot(passType, aes(PassLocation, PassDistance)) + geom_tile(aes(fill=share), color="white") + facet_wrap(~Passer, nrow=2) + scale_color_brewer()
library(crosstalk) all_shared <- SharedData$new(data=talks, key=~ShareKey, group=groupMeetup) details_shared <- SharedData$new(data=eventDetails, key=~ShareKey, group=groupMeetup) # custom filter topicFilter <- filter_select_multikey(id='TopicSelector', label='Choose a Topic', sharedData1=all_shared, sharedData2=details_shared, col1='PresentationTopics', key1='ShareKey', col2='EventMeetupTopics', key2='ShareKey') # custom datatable funcion makeDatatable(talks_shared, colsToHide=c('ShareKey'), scrollX=FALSE, width='100%', scrollY=200, height=200, order=list(list(1, 'desc')), elementID='PresentationsTable', scrollCollapse=FALSE )