〓〓β

ベルク・カッツェ

数字を入れてみて当てはまるものが4通り。
色を当てはめてみたら、3通りは不可能。
残る1通りについての色の当てはめ方が2通り。
答えは2通りになりました。
今日も寝不足なのでもう寝ます。

　　 8月25日（木） 0:43:50　　　　51776

「数学」小旅行

描いてみるしか手はないのか。
往生しました。

たぶん、最も下手なプログラムです。
a=[]
a[1]=[[1,1],[2,2],[3,3],[4,4]]
a[2]=(1..4).to_a.permutation(2).to_a.permutation(4).to_a.select{|x|x[0][0]==2&&[x[0][0],x[1][0],x[2][0],x[3][0]].uniq.count==4&&[x[0][1],x[1][1],x[2][1],x[3][1]].uniq.count==4}.to_a
a[3]=(1..4).to_a.permutation(2).to_a.permutation(4).to_a.select{|x|x[0][0]==3&&[x[0][0],x[1][0],x[2][0],x[3][0]].uniq.count==4&&[x[0][1],x[1][1],x[2][1],x[3][1]].uniq.count==4}.to_a
a[4]=(1..4).to_a.permutation(2).to_a.permutation(4).to_a.select{|x|x[0][0]==4&&[x[0][0],x[1][0],x[2][0],x[3][0]].uniq.count==4&&[x[0][1],x[1][1],x[2][1],x[3][1]].uniq.count==4}.to_a

for i in (0..a[2].count-1)
for j in (0..a[3].count-1)
for k in (0..a[4].count-1)

if [a[1][0][1],a[2][i][0][1],a[3][j][0][1],a[4][k][0][1]].uniq.count==4 &&
[a[1][1][0],a[2][i][1][0],a[3][j][1][0],a[4][k][1][0]].uniq.count==4 &&
[a[1][1][1],a[2][i][1][1],a[3][j][1][1],a[4][k][1][1]].uniq.count==4 &&
[a[1][2][0],a[2][i][2][0],a[3][j][2][0],a[4][k][2][0]].uniq.count==4 &&
[a[1][2][1],a[2][i][2][1],a[3][j][2][1],a[4][k][2][1]].uniq.count==4 &&
[a[1][3][0],a[2][i][3][0],a[3][j][3][0],a[4][k][3][0]].uniq.count==4 &&
[a[1][3][1],a[2][i][3][1],a[3][j][3][1],a[4][k][3][1]].uniq.count==4 &&
(a[1]+a[2][i]+a[3][j]+a[4][k]).uniq.count==16
then
p ''
p a[1]
p a[2][i]
p a[3][j]
p a[4][k]
end
end
end
end

このなかで、(a[1]+a[2][i]+a[3][j]+a[4][k]).uniq.count==16
を失念していて、8通りだと盲信していました。

　　 8月25日（木） 13:34:00　　　　51777

「数学」小旅行

　　 8月25日（木） 13:34:00　　　　51778

「数学」小旅行

　　 8月25日（木） 13:34:01　　　　51779

「数学」小旅行

このごろマウスの調子が変で、ワンクリックがスリークリックになったみたいです。大変お見苦しくいことになりました。申し訳ございません。

　　 8月25日（木） 14:29:14　　　　51780

まるケン

トランプのＡ、２，３，４を並べて試行錯誤、、、と思ったけどトランプが見つからず。
小さな紙片に４色のペンで数字を書いて試行錯誤。
もっとありそうなのに２通りしかないのって、ちょっとした驚きでした。

興味本位で一般化。
１色１枚の場合はそれを置くだけなので１通り。
２色だと解なし。
３色だと１通り。
で今回の４色は２通り。
rubyで検算しのを改造して、さらに大きな数で。
５色は１８通り。
６色は解なし。
７色は解、、、あるのですが、まだ数え切れていません。

マサルさんの数値設定、相変わらず絶妙ですね。
５色２５枚だったらお手上げでした。

　　 8月26日（金） 19:09:57　　 MAIL:take4310@mobile.email.ne.jp 　　51781

まるケン

しらみつぶしなアルゴリズムだと、一晩かけても数え切れていませんでした。
とりあえず1000通り以上はあることだけご報告いたします。

　　 8月27日（土） 7:42:48　　 MAIL:take4310@mobile.email.ne.jp 　　51782

いちごみるく

何回考えても6912になると思ったら条件５，６がありました。。

　　 9月1日（木） 0:29:33　　　　51783

まるケン

#51783
出題期間が延長したので、ルール５、ルール６を外した問題を考えていました。
今回の正解をベースに逆算すると、
ルール５のうち、色の条件を外すと２４倍、
数字の並びの条件も外すとさらに２４倍、
ルール６、縦の１列目の数字（１行目を除いた３つ）の順番を変えてさらに６倍。
２×２４×２４×６で同じ答えが出ました。

　　 9月2日（金） 18:00:43　　 MAIL:take4310@mobile.email.ne.jp 　　51784

うろん

4進法表示で00～33を使って魔方陣をつくる

ルールより、各行、列には一の位と四の位に
0～3までの数字が丁度1つずつ入る

00 11 22 33
x1
x2
x3
まで確定

左の列は2通りしかないことはすぐにわかるので、
それぞれの場合を考える

00 11 22 33
21 Ａ
32
13

Ａを含む行について考える

一の位が3である数は13と33が使われているので、
03と23しかなく、同じ行に21を含むので、03しかない

同様に、一の位が2である数は02と12しかなく、
同じ行に03を含むことから、12と決まる

よって、残りの1つは30である

次に、Ａを含む列についても同様に考えると、
02、23、30を含むことがわかる

これより、Ａが30と決まり、
ここから1通りに定まることは難しくない

00 11 22 33
31
12
23
についても同様

以上より、2通り

などと考えてみたものの、
特に簡単になっているわけでもなく。。。

　　 9月4日（日） 19:52:48　　　　51785

「数学」小旅行

以前にも、ナンプレの解を求めるプログラムを作ったのですが、再考しました。

$n=9
$n2=$n**2
$a=[0,2,0,0,0,0,0,7,0,
　　1,9,0,5,0,7,0,3,8,
　　3,0,0,0,6,0,0,0,1,
　　0,8,0,3,0,9,0,2,0,
　　0,0,0,0,0,0,0,0,0,
　　0,4,0,0,0,0,0,6,0,
　　0,5,0,1,8,3,0,9,0,
　　0,0,0,0,0,0,0,0,0,
　　7,0,8,0,0,0,4,0,5]　#問題で、数字が入っていないところは０にします。

def s(k)
　r=(k/3%3)*3+(k/9/3)*27
　if k<$n2 then
　　if $a[k]==0 then
　　　for m in 1..$n
　　　　t=false
　　　　t=t||(m==$a[r])||(m==$a[r+1])||(m==$a[r+2])||(m==$a[r+9])||(m==$a[r+10])||
　　　　(m==$a[r+11])||(m==$a[r+18])||(m==$a[r+19])||(m==$a[r+20])
　　　　if !t then
　　　　　for i in (0..$n-1)
　　　　　　t=t||(m==$a[k/$n*$n+i])||(m==$a[i*$n+k%$n])
　　　　　end
　　　　end
　　　　if !t then
　　　　　$a[k]=m;s(k+1);$a[k]=0
　　　　end
　　　end
　　else
　　　s(k+1)
　　end
　else
　　p $a
　end
end

#再帰呼び出しで解が見つかったら出力します。
s(0)

　　 9月5日（月） 9:51:16　　　　51786

「数学」小旅行

ルール５，６がなかったら、で、
29行目のアドレス渡し対策が肝でした。

$n=4
$n2=$n**2
a=Array.new($n**2,0)
b=Array.new($n**2,0)#初期条件をなしにしたもの
as=Array.new()
bs=Array.new()

def e(h,k,m) #k番目にmを入れられるか。True or False
t=false
for i in (0..$n-1)
t=t||(m==h[k/$n*$n+i])
t=t||(m==h[i*$n+k%$n])
end
t
end

def s(h,k,l)
if k<$n2 then
if h[k]==0 then
for m in 1..$n
if !e(h,k,m) then
h[k]=m;s(h,k+1,l);h[k]=0
end
end
else
s(h,k+1,l)
end
else
buf=h.map{|x|x}#アドレス渡し対策
l.push(buf)
$c+=1
end
end

ti=Time.now
$c=0#数の入れ方すべてをasに保存
s(a,0,as)
ac=$c

$c=0#色の付け方すべてをbsに保存
s(b,0,bs)
bc=$c

$c=0
for i in 0..ac-1#色と番号のセットがすべて異なるものを数える
for j in 0..bc-1
if [as[i],bs[j]].transpose.uniq.count==$n2 then
$c+=1
end
end
end

p $c
p Time.now-ti

　　 9月5日（月） 16:08:38　　　　51787