子供がやってた算数問題(図だけ改)

子供がやってた算数問題(改)

スキルのある諸先輩方は、きれいな図を書いている。 以前やった算数問題は、テキストだけでむりやり書いたが、イマイチわかりにくい。そこで、分かりやすくRで図を書いて再掲する。早い話Rで図を書く練習である。しかし、余白のコントロールがうまくいかなかった。markdownのout.width/heightを設定したりpar()をいじったりしたがどうも狙ったとおりにならない。余白が多すぎる感じになったが今日はこれでよしとしよう。

 ＃以下図以外は再掲記事

子供が面白い算数の問題をやっていた。

library(diagram)

## Loading required package: shape

par(xpd = T)

names <- c(1, 7, 5, 2, 6, 2, 3, 4, 1, 3)
a <- 0.8
M <- matrix(nrow = 10, ncol = 10, byrow = TRUE, data = 0)
M[5, 1:2] <- M[6, 2:3] <- M[7, 3:4] <- M[8, 5:6] <- M[9, 6:7] <- M[10, 8:9] <- "diff."
ichi <- matrix(c(seq(0, a, length = 4), seq(a * 1/6, a * 5/6, length = 3), a * 
    2/6, a * 4/6, a * 0.5, rep(1, 4), rep(0.75, 3), rep(0.5, 2), 0.25), nrow = 10, 
    byrow = FALSE) #表示する位置を決めてやる
plotmat(M, pos = ichi, curve = 0, name = names, lwd = 1, box.lwd = 2, cex.txt = 1, 
    box.type = "circle", box.prop = 1, relsize = 0.7) #最後のsizeを１にするとはみ出す

こんな感じで、上2つの差の絶対値が下の数になるというルール。

names <- LETTERS[1:10]
names[5] <- "E=6"
a <- 0.8
M <- matrix(nrow = 10, ncol = 10, byrow = TRUE, data = 0)
M[5, 1:2] <- M[6, 2:3] <- M[7, 3:4] <- M[8, 5:6] <- M[9, 6:7] <- M[10, 8:9] <- "diff."
ichi <- matrix(c(seq(0, a, length = 4), seq(a * 1/6, a * 5/6, length = 3), a * 
    2/6, a * 4/6, a * 0.5, rep(1, 4), rep(0.75, 3), rep(0.5, 2), 0.25), nrow = 10, 
    byrow = FALSE)
plotmat(M, pos = ichi, curve = 0, name = names, lwd = 1, box.lwd = 2, cex.txt = 1, 
    box.type = "circle", box.prop = 1, relsize = 0.7)

このルールで、１～１０の整数を使ってA～Jの表を完成する。

問題はE=6の場合であった。

とりあえず算数だけでサクッと解いて、父親の面目は保ったが なんか、虫食い算の時もそうだったけど、Rでも解きたく なるんだよね。R病かな。

今回は以前速いのに感心したe1071を使用する。

# 算数問題

f1 <- function() {
    library(e1071)
    s <- permutations(10)

    a <- b <- c <- d <- e <- f <- g <- numeric(36288000)

    a <- abs(s[, 1] - s[, 2]) == s[, 5]
    b <- abs(s[, 2] - s[, 3]) == s[, 6]
    c <- abs(s[, 3] - s[, 4]) == s[, 7]
    d <- abs(s[, 5] - s[, 6]) == s[, 8]
    e <- abs(s[, 6] - s[, 7]) == s[, 9]
    f <- abs(s[, 8] - s[, 9]) == s[, 10]

    g <- a * b * c * d * e * f

    return(s[g == 1, ])
}

system.time(f1())

## Loading required package: class

##    user  system elapsed 
##    2.95    0.41    3.37

res1 <- f1()
res1

##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,]    9    3   10    8    6    7    2    1    5     4
## [2,]    6    1   10    8    5    9    2    4    7     3
## [3,]    8    1   10    6    7    9    4    2    5     3
## [4,]    8    3   10    9    5    7    1    2    6     4
## [5,]    9   10    3    8    1    7    5    6    2     4
## [6,]    6   10    1    8    4    9    7    5    2     3
## [7,]    8   10    1    6    2    9    5    7    4     3
## [8,]    8   10    3    9    2    7    6    5    1     4

ということで、そもそも８種類の解答しか無いことが分かる。 上の書き方で言うと、ｆ＝1,4,6,7の場合、答えがひとつしかないようだ。

肝心の答えは

names <- c(9, 3, 10, 8, 6, 7, 2, 1, 5, 4)
a <- 0.8
M <- matrix(nrow = 10, ncol = 10, byrow = TRUE, data = 0)
M[5, 1:2] <- M[6, 2:3] <- M[7, 3:4] <- M[8, 5:6] <- M[9, 6:7] <- M[10, 8:9] <- "diff."
ichi <- matrix(c(seq(0, a, length = 4), seq(a * 1/6, a * 5/6, length = 3), a * 
    2/6, a * 4/6, a * 0.5, rep(1, 4), rep(0.75, 3), rep(0.5, 2), 0.25), nrow = 10, 
    byrow = FALSE)
plotmat(M, pos = ichi, curve = 0, name = names, lwd = 1, box.lwd = 2, cex.txt = 1, 
    box.type = "circle", box.prop = 1, relsize = 0.7)

ということになる。

しかし、sが277Mbもあってワロタ。

ちなみに以前使用したgtoolsのpermutationsを使うと 死ぬほど時間がかかる。

detach("package:e1071", unload = TRUE)

f2 <- function() {
    library(gtools)
    s <- permutations(10, 10, set = TRUE, repeats.allowed = FALSE)
    a <- b <- c <- d <- e <- f <- g <- numeric(36288000)

    a <- abs(s[, 1] - s[, 2]) == s[, 5]
    b <- abs(s[, 2] - s[, 3]) == s[, 6]
    c <- abs(s[, 3] - s[, 4]) == s[, 7]
    d <- abs(s[, 5] - s[, 6]) == s[, 8]
    e <- abs(s[, 6] - s[, 7]) == s[, 9]
    f <- abs(s[, 8] - s[, 9]) == s[, 10]

    g <- a * b * c * d * e * f

    return(s[g == 1, ])
}
system.time(f2())

##    user  system elapsed 
##   69.97    0.59   70.95

３秒と７０秒の差は大きい