Problem 93

R Project Euler

遅い(170秒)上にその場しのぎだらけで汚いしパッケージの力を借りた．気分転換のつもりがすっきりしない感が増大している．なんかいろいろひどい．また調べてやり直そう．

library(combinat)
cand <- combn(1:9, 4)

oper <- c("+", "-", "*", "/")
ope1 <- rep(oper, rep(16, 4))
ope2 <- rep(rep(oper, rep(4, 4)), 4)
ope3 <- rep(oper, 16)
oprs <- matrix(c(ope1, ope2, ope3), byrow=T, nrow=3)

brac <- function(a, b, c, d, o1, o2, o3){
  return(c(
           eval(parse(text=paste("(", a, o1, "(", b,  o2, "(", c,  o3, d, ")))"))),
           eval(parse(text=paste(a, o1, "(", b, o2, c, ")", o3, d))),
           eval(parse(text=paste("(", a, o1, b, ")", o2, "(", c, o3, d, ")"))),
           eval(parse(text=paste(a, o1, "((", b, o2, c,")", o3, d, ")" ))),
           eval(parse(text=paste("(((", a, o1, b, ")", o2, c, ")", o3, d, ")")))
           ))
}
brac2 <- function(nums, oprs) brac(nums[1], nums[2], nums[3], nums[4], oprs[1], oprs[2], oprs[3])

ret.length <- function(nums){
  ans <- numeric(7680)
  per <- permn(nums)
  for(i in 1:64){
    ans[(120*i):(120*i-119)] <- unlist(lapply(per, brac2, oprs[,i]))
  }
  ans <- unique(ans)
  ans <- ans[ans %% 1 == 0]
  ans <- sort(ans[ans > 0])
  if(min(ans) > 1) return(0)
  sum(ans == 1:length(ans))
}

max.len <- 0
answer <- numeric(4)
for(i in 1:126){
  if((temp <- ret.length(cand[, i])) > max.len){
    max.len <- temp
    answer <- cand[, i]
  }
}
answer