四字熟語パズルの作成
Posted feedbacks - R
重複なしの8312単語，utf-8 でソートしたもの 9080個の解が見つかったというのだが（少ない?） 1.33GH PowerPC G4 > system.time(foo()) 1 1 180 一上一下 一期四相 相利共生 下化衆生 2 1 300 一上一下 一貧一富 富貴利達 下学上達 3 2 175 一世一度 一朝之忿 忿忿之心 度衆生心 4 2 245 一世一度 一筆啓上 上下一心 度衆生心 5 2 268 一世一度 一草一木 木人石心 度衆生心 6 4 21 一世之雄 一入再入 入室升堂 雄気堂堂 途中省略 071 8153 8158 鬼手仏心 鬼面仏心 心煩意乱 心狂意乱 9072 8153 8158 鬼手仏心 鬼面仏心 心融神会 心領意会 9073 8153 8158 鬼手仏心 鬼面仏心 心融神会 心領神会 9074 8153 8158 鬼手仏心 鬼面仏心 心領意会 心領神会 9075 8153 8159 鬼手仏心 鬼面嚇人 人人具足 心満意足 9076 8157 8158 鬼臉嚇人 鬼面仏心 心満意足 人給家足 9077 8157 8159 鬼臉嚇人 鬼面嚇人 人人具足 人給家足 9078 8158 8159 鬼面仏心 鬼面嚇人 人人具足 心満意足 9079 8185 8186 魯魚帝虎 魯魚烏焉 焉馬之誤 虎虚之誤 9080 8223 8225 鴻門玉斗 鴻鵠之志 志士仁人 斗南一人 m = 9080 ユーザ システム 経過 1676.849 582.988 2544.118
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | foo <- function() {
x <- read.table("yojijukugo.txt", header=FALSE, as.is=TRUE)
y <- unique(sort(x[,2]))
n <- length(y)
w <- sapply(y, function(i) unlist(strsplit(i, "")))
h <- w[1,]
t <- w[4,]
head <- unique(h)
nh <- length(head)
m <- 0
for (i0 in 1:nh) { # for (i0 in 1:nh)
h12 <- which(h == head[i0])
lh12 <- length(h12)
if (lh12 == 1) next
a <- combn(lh12, 2)
for (ia in 1:ncol(a)) {
i1 <- h12[a[1,ia]]
i2 <- h12[a[2,ia]]
ki3 <- which(h == t[i2])
ki4 <- which(h == t[i1])
x <- outer(t[ki3], t[ki4], "==")
x[lower.tri(x, diag=TRUE)] <- FALSE
x <- which(x, arr.ind=TRUE)
if (nrow(x) == 0) next
for (ib in 1:nrow(x)) {
i3 <- ki3[x[ib, 1]]
i4 <- ki4[x[ib, 2]]
m <- m+1
cat(m, i1, i2, y[c(i1, i2, i3, i4)], "\n")
}
}
}
cat("m =",m,"\n")
}
|
重複防止が間違えていました 16864件でした 12118件とする解と比較してみると，1文字目と4文字目が同じでも別の熟語を拾えているようです。 愛屋及烏 及 合 屋 之 烏集之衆
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | foo <- function() {
x <- read.table("yojijukugo.txt", header=FALSE, as.is=TRUE)
y <- unique(sort(x[,2]))
n <- length(y)
w <- sapply(y, function(i) unlist(strsplit(i, "")))
h <- w[1,]
t <- w[4,]
head <- unique(h)
nh <- length(head)
m <- 0
for (i0 in 1:nh) { # for (i0 in 1:nh)
h12 <- which(h == head[i0])
lh12 <- length(h12)
if (lh12 == 1) next
a <- combn(lh12, 2)
for (ia in 1:ncol(a)) {
i1 <- h12[a[1,ia]]
i2 <- h12[a[2,ia]]
ki3 <- which(h == t[i2])
ki4 <- which(h == t[i1])
x <- outer(t[ki3], t[ki4], "==")
x <- which(x, arr.ind=TRUE)
if (nrow(x)==0) next
for (ib in 1:nrow(x)) {
i3 <- ki3[x[ib, 1]]
i4 <- ki4[x[ib, 2]]
if (i3 != i4) {
m <- m+1
cat(m, y[c(i1, i2, i3, i4)], "\n")
}
}
}
}
cat("m =",m,"\n")
}
|
結果の総数は 12118 件でした． 実行時間は Power PC 1.5GHz で 10 秒程度． 元データは CP932 で取り込んで重複を除いた 8312 件で、変数 word に格納済み．
1 2 3 4 5 6 7 | w <- data.frame(idx = seq(along=word), body=word,
head = substr(word, 1, 1), tail = substr(word, 4, 4))
w13 <- merge(w, w, by.x="tail", by.y="head")
w13$head.tail <- paste(w13$head, w13$tail.1)
w1234 <- merge(w13, w13, by="head.tail", sort=FALSE)
w1234 <- subset(w1234, tail.x != tail.y & idx.x.x < idx.x.y,
select=grep('body', names(w1234), value=TRUE))
|
にしお
#3644()
Rating-1/1=-1.00
与えられた四字熟語のリストから下のように四角く配置することのできる熟語の組み合わせを探すプログラムを作成してください。
出力例:
四字熟語は左から右、上から下へ読むものとします。また右上隅の漢字と左下隅の漢字は異なるものでなければいけません。
四字熟語のデータは扱いやすい形(たとえばユニコード文字列のリスト)で与えられていると仮定して構いません。サンプルデータが必要であれば FOR Microsoft IME The四字熟語辞典(データ / 文書作成) にテキスト形式のデータが入っているのでそれを使えると思います。
問題の規模の参考までに、40行程度のPythonスクリプトでこのデータ(重複をのぞいて8312件)を処理してみたところ2.4GHzのCPUで13秒程度かかりました。結果は8133件出力されました。
[ reply ]