# # This is a Shiny web application. You can run the application by clicking # the 'Run App' button above. # # Find out more about building applications with Shiny here: # # http://shiny.rstudio.com/ # # Author: Michael HÃ¶hle # Date: 05 Jan 2019 # License: GNU General Public License (GPL v3 - https://www.gnu.org/licenses/gpl.html) library(purrr) library(shiny) library(dplyr) library(combinat) library(magrittr) library(ggplot2) library(plotly) ##Global variable containing the hashmap to store the computed binary trees. trees <- list() trees[["0"]] <- NULL trees[["1"]] <- list(list(val="node", left=NULL, right=NULL)) trees[["2"]] <- list(list(val=NULL, left=trees[["1"]][[1]], right=trees[["1"]][[1]])) allBinTrees <- function(n) { ##Character version of n, which is used as hash key n_char <- as.character(n) ##Only compute something if n is not already in the tree list if (is.null(pluck(trees, n_char))) { trees[[n_char]] <<- list() for (i in 1:(n-1)) { j = n - i for (left_tree in allBinTrees(i)) { for (right_tree in allBinTrees(j)) { trees[[n_char]][[length(trees[[n_char]]) + 1]] <<- list(val=NULL, left=left_tree, right=right_tree) } } } } #end if not already in tree list ##Return result from our hashmap return(pluck(trees, n_char)) } ##Helper function to print a tree tree2String <- function(tree) { ##If tree only consists of a leave if (is.character(tree\$val)) return(tree\$val) ##Make the string paste0("(", tree2String(tree\$left), " op " , tree2String(tree\$right), ")") } ##Convention: Number the operators from left to right. We do the search ##and replace recursively. Any clever way to do this as a regexp? addOpNumbers <- function(str, i=1) { if (!grepl(" op ", str)) return(str) ##Replace one "op" addOpNumbers( str=sub(" op ", paste0(" op",i," "), str), i=i+1) } ##Convert the "node" placeholders into the variables a, b, c, ... ##Convention: Name the numbers from left to right by "a", "b", "c", ... replaceNodes <- function(str, i=1) { if (!grepl("node", str)) return(str) ##Replace one "node" replaceNodes( str=sub("node", letters[i], str), i=i+1) } ##Even more general helper function for numbers as well as operators replace <- function(str, what) { if (length(what) == 0) return(str) replace( str=gsub(names(what)[1], what[1], str), what=what[-1]) } solve <- function(base_numbers, expr_result, operatorList) { ##Variables k <- length(base_numbers) ##Permuations of the base numbers perm <- combinat::permn(base_numbers) %>% map(setNames, nm=letters[seq_len(k)]) ##Slim it? perm <- perm[!duplicated(map(perm, paste0, collapse=""))] ##Make all combinations of the operators opsList <- map( seq_len(k-1), function(.x) operatorList) operators <- cross(opsList) %>% map( setNames, nm=paste0("op",seq_len(k-1))) ##Make all possible brackets bracketing <- map_chr( allBinTrees(n=k), ~ tree2String(.x) %>% addOpNumbers %>% replaceNodes) ##All combinations of the numbers, the order and the bracketing. ##Depending on the combinations this might take a while... combos <- cross3( perm, map( operators, unlist), bracketing) %>% map(setNames, c("numbers", "operators", "bracket")) ##Compute value of all combinations (with progress bar) res <- withProgress( message = 'Evaluating all combinations', detail = 'This might take a while...', value = 0, { res <- map(combos, .f=function(l) { incProgress(1/length(combos)) l[["expr"]] <- l[["bracket"]] %>% replace(l[["numbers"]]) %>% replace(l[["operators"]]) l[["value"]] <- eval(parse(text=l[["expr"]])) return(l) }) }) ##Convert results to a data.frame df <- withProgress( message = 'Converting result to a data.frame', detail = 'This might take a while...', value = 0, { map_df(res, ~ { incProgress(1/length(res)) data.frame(expr=.x\$expr, value=.x\$value) }) }) ##Match 24 is_zero <- function(x) isTRUE(all.equal(x, 0)) ##Only those with nice integers results df_int <- df %>% mutate(rounded = round(value, digits=0), diff=value - rounded) %>% rowwise %>% filter(is_zero(diff)) res <- list(combos=df_int %>% select(expr, value), expr=df_int %>% filter(rounded==expr_result) %\$% expr) return(res) } # Define UI for application that draws a histogram ui <- fluidPage( # Application title titlePanel("Solving Math Puzzles"), #"A small app to brute force solve a particular type of math puzzle. See this ", a(href="", em("blog post")), "for details.", p(), # # Show a plot of the generated distribution tabsetPanel( tabPanel("Main", h1(""), fluidRow( column(1,textInput("no1", "Expression:", "8")), column(1,h3("op1")), column(1,textInput("no2", " ", "8")), column(1,h3("op2")), column(1,textInput("no3", " ", "3")), column(1,h3("op3")), column(1,textInput("no4", " ", "3")), column(1,h3("=")), column(1,textInput("res", "", "24")) ), fluidRow( column(4,selectInput("operators","Operators:",choices=c("+","-","*","/"), multiple=TRUE, selected=c("+","-","*","/"))) ), fluidRow( column(8, ""), column(1, actionButton("goButton", "Solve!")) ), hr(), htmlOutput("result") ),# end tabPanel tabPanel("Detailed Table", dataTableOutput("allCombosDF")), tabPanel("Histogram", plotlyOutput("allCombosHistogram")) ) #end tabSetPanel ) # Define server logic required to draw a histogram server <- function(input, output) { tags\$head(tags\$style(HTML(' .skin-blue .container-fluid { background-color: #f4b943; }'))) getBaseNumbers <- eventReactive(input\$goButton, { as.numeric(c(input\$no1, input\$no2, input\$no3, input\$no4)) }) getResult <- eventReactive(input\$goButton, { as.numeric(input\$res) }) getOperatorList <- eventReactive(input\$operators, { input\$operators }) output\$result <- renderUI({ input\$goButton ##Extract base numbers base_numbers <- getBaseNumbers() expr_result <- getResult() operatorList <- getOperatorList() print(expr_result) print(base_numbers) print(operatorList) ##Solve the math puzzle solution <- suppressWarnings(solve(base_numbers = base_numbers, expr_result = expr_result, operatorList = operatorList)) output\$allCombosDF <- renderDataTable(solution\$combos) output\$allCombosHistogram <- renderPlotly({ ##p <- ggplot(solution\$combos, aes(x=value)) + geom_histogram(bins=50) + ylab("Number of combinations") + xlab("Value of expression") p <- ggplot(solution\$combos, aes(x=value)) + geom_histogram(breaks=seq(floor(min(solution\$combos\$value))-0.5,ceiling(max(solution\$combos\$value))+0.5,by=1)) + ylab("Number of combinations") + xlab("Value of expression") plotly::ggplotly(p) })#,width=800, height=400, res=100) print(solution) HTML(paste0("

### Solution:

", if (length(solution\$expr)>0) {paste0(solution\$expr, " = ", expr_result, collapse="
")} else {"No solution found!"}, "
")) }) #renderUI } # Run the application shinyApp(ui = ui, server = server)