○になったー


4 桁の数字から四則演算で 10 を作るという懐かしい遊びをやった記憶がある人も多いと思います。最近 Twitter 界隈で「○になったー」 (○に数が入る) というのが流行っていますが,ものぐさな私はプログラムでやれば良いとか思ってしまうわけです。

で,できたのがこんなの (http://ideone.com/u0dLS)。 R って便利ですねと思えるでしょう。任意の 2 項演算子 (もしくは 2 つ引数をとる関数) と任意の数で利用できます。

リンクからソースコードが取得できますが,再掲。

permutation <- function(v, n = length(v), replace = FALSE) {
   if (n == 0 || length(v) == 0) {
      return(list(NULL))
   }
   v <- sort(v)
   u <- unique(v)
   result <- lapply(u, function(x) {
      s <- NULL
      if (replace) {
         s <- u
      } else {
         s <- v[-match(x, v)]
      }
      lapply(permutation(s, n - 1, replace), function(y) c(x, y))
   })
   return(unlist(result, recursive = FALSE))
}

順列を生成します。 v[-match(x, v)] の部分はベクトルから要素を 1 つだけ取り除く作業です (v[v != x] だとすべて取り除かれる)。ちなみに再起で呼び出されるたびに sortunique やっているのは無駄です。引数にするのが正しいやり方です。

tree <- function(operator, operand) {
   operand <- as.list(operand)
   if (length(operator) == 0) {
      return(operand)
   }
   result <- lapply(lapply(0 : (length(operand) - 2), function(i) append(operand[-c(1, 2)], call(operator[1], operand[[1]], operand[[2]]), i)), function(o) tree(operator[-1], o))
   return(unlist(result, recursive = FALSE))
}

式木を生成します。 R には call という関数があり,演算子・関数にオペランド・引数を与えるという操作が容易に行えます。今思えば変数名の operatoroperand というのは正確ではないですね。

makeNumber <- function(number, result, operator = c("+", "-", "*", "/")) {
   operator <- permutation(operator, length(number) - 1, TRUE)
   operand <- permutation(number)
   for (i in 1 : length(operand)) {
      for (j in 1 : length(operator)) {
         lapply(tree(operator[[j]], operand[[i]]), function(t) {
            e <- eval(t)
            # NaN == numerical は NA なので e == result だと 0/0 になったとき失敗する。
            if (!is.na(e) && e == result) {
               print(t)
            }
         })
      }
   }
}

メインの関数です。 number に使用する数のベクトル, result に結果を与えます。 operator は使用する演算子で,デフォルトでは四則演算子 (+, -, *, /) です。もちろん atan2 のような関数や,自作関数も使えます。

> makeNumber(c(3, 4, 7, 8), 10)
(3 - 7/4) * 8
8 * (3 - 7/4)

> makeNumber(c(1, 1, 2.5, pi), 10, c("+", "/", "atan2"))
3.14159265358979/(atan2(1, 1)/2.5)
2.5/(atan2(1, 1)/3.14159265358979)

> f <- function(x, y) x * y - x + y
> makeNumber(c(1, 2, 3, 4), 10, c("*", "f"))
f(3, 1) * f(2, 4)
f(2, 4) * f(3, 1)
f(f(3, 1) * 2, 4)
f(2 * f(3, 1), 4)
f(2, 4) * f(3, 1)
f(3, 1) * f(2, 4)
f(2, f(3, 1) * 4)
f(2, 4 * f(3, 1))
f(f(4, 1), 3) * 2
2 * f(f(4, 1), 3)