[ここをクリックすると内容が表示されます]
解くことが可能かどうかの判定はしているつもりなんですが、なぜかいつも僕には解けません。（難しくて。）コード: 全て選択
#N88BASIC
Dim A(8,8) As Byte,A$ As String,B(141) As Byte
Dim i As Long,j As Long,k As Long,i2 As Long,j2 As Long,i3 As Long,j3 As Long
Print "計算中..."
Print "Step 1"
randomize
For i2=0 To 2
For j2=0 To 2
For i=i2*3 To i2*3+2
For j=j2*3 To j2*3+2
k=Int(Rnd()*9)+1
If IfCan(i,j,k) then
A(i,j)=k
Else
If IfnCan(i,j) then
For i=0 To 8
For j=0 To 8
A(i,j)=0
Next
Next
i=0
j=0
i2=0
j2=0
End If
j-=1
End If
Next
Next
Next
Next
i3=0
Print "Step 2"
Do
i=Int(Rnd()*9)
j=Int(Rnd()*9)
If A(i,j)>10 then continue
If IfCanThink(i,j) then
A(i,j)=20
Else
A(i,j)+=10
End If
i3+=1
If i3=81 then Exit Do
Loop
i3=0
For i=0 To 8
For j=0 To 8
A(i,j)-=10
If A(i,j)<=9 then
B(i3)=A(i,j)+48
i3++
Else
B(i3)=63
i3++
End If
If j=2 or j=5 then
B(i3)=124
i3++
End If
Next
B(i3)=13
B(i3+1)=10
i3+=2
If i=2 or i=5 then
For i2=0 To 10
B(i3)=61
i3++
Next
B(i3)=13
B(i3+1)=10
i3+=2
End If
Next
A$=MakeStr(B)
Cls 3
Print A$
Open Str$(Int(Rnd()*100000))+".txt" For Output As #1'かぶらなそうな名前にする。
Print #1,A$
Close #1
Function IfCan(i As Long,j As Long,k As Long) As Long
Dim li As Long,lj As Long,c As Long
For li=0 To 8
If A(li,j)=k then c=-1
Next
For lj=0 To 8
If A(i,lj)=k then c=-1
Next
For li=i\3*3 To i\3*3+2
For lj=j\3*3 To j\3*3+2
If A(li,lj)=k then c=-1
Next
Next
If c=-1 then IfCan=FALSE else IfCan=TRUE
End Function
Function IfnCan(i As Long,j As Long) As Long
Dim k As Long,c As Long
c=0
For k=1 To 9
If IfCan(i,j,k) then
c=-1
End If
Next
If c=-1 then IfnCan=FALSE else IfnCan=TRUE
End Function
Function IfCanThink(i As Long,j As Long) As Long
Dim k As Long,c As Long,a As Long
a=A(i,j)
A(i,j)=0
c=IfCan2(i,j)
A(i,j)=a
If c=1 then IfCanThink=TRUE else IfCanThink=FALSE
End Function
Function IfCan2(i As Long,j As Long) As Long
Dim a(8) As Byte,li As Long,lj As Long
For li=0 To 8
If A(li,j)<>20 then
If A(li,j)>=10 then
a(A(li,j)-10)=1
Else
a(A(li,j))=1
End If
End If
Next
For lj=0 To 8
If A(i,lj)<>20 then
If A(i,lj)>=10 then
a(A(i,lj)-10)=1
Else
a(A(i,lj))=1
End If
End If
Next
For li=i\3*3 To i\3*3+2
For lj=j\3*3 To j\3*3+2
If A(li,lj)<>20 then
If A(li,lj)>=10 then
a(A(li,lj)-10)=1
Else
a(A(li,lj))=1
End If
End If
Next
Next
lj=0
For li=0 To 8
lj=lj+a(li)
Next
If lj>=8 then IfCan2=TRUE else IfCan2=FALSE
End Function頭の体操にはもってこいだと思いますが。
解答出力機能付き [ここをクリックすると内容が表示されます]
コード: 全て選択
#N88BASIC
Dim A(8,8) As Byte,A$ As String,B(141) As Byte,Ans(8,8) As Byte
Dim i As Long,j As Long,k As Long,i2 As Long,j2 As Long,i3 As Long,j3 As Long
Print "計算中..."
Print "Step 1"
randomize
For i2=0 To 2
For j2=0 To 2
For i=i2*3 To i2*3+2
For j=j2*3 To j2*3+2
k=Int(Rnd()*9)+1
If IfCan(i,j,k) then
A(i,j)=k
Else
If IfnCan(i,j) then
For i=0 To 8
For j=0 To 8
A(i,j)=0
Next
Next
i=0
j=0
i2=0
j2=0
End If
j-=1
End If
Next
Next
Next
Next
memcpy(Ans,A,81)
i3=0
Print "Step 2"
Do
i=Int(Rnd()*9)
j=Int(Rnd()*9)
If A(i,j)>10 then continue
If IfCanThink(i,j) then
A(i,j)=20
Else
A(i,j)+=10
End If
i3+=1
If i3=81 then Exit Do
Loop
i3=0
For i=0 To 8
For j=0 To 8
A(i,j)-=10
If A(i,j)<=9 then
B(i3)=A(i,j)+48
i3++
Else
B(i3)=63
i3++
End If
If j=2 or j=5 then
B(i3)=124
i3++
End If
Next
B(i3)=13
B(i3+1)=10
i3+=2
If i=2 or i=5 then
For i2=0 To 10
B(i3)=61
i3++
Next
B(i3)=13
B(i3+1)=10
i3+=2
End If
Next
A$=Str$(Int(Rnd()*100000))
Open A$+".txt" As #1
Open A$+"_ans.txt" As #2
A$=MakeStr(B)
Cls 3
Print A$
Print #1,A$
Close #1
i3=0
For i=0 To 8
For j=0 To 8
B(i3)=Ans(i,j)+48
i3++
If j=2 or j=5 then
B(i3)=124
i3++
End If
Next
B(i3)=13
B(i3+1)=10
i3+=2
If i=2 or i=5 then
For i2=0 To 10
B(i3)=61
i3++
Next
B(i3)=13
B(i3+1)=10
i3+=2
End If
Next
A$=MakeStr(B)
Print #2,A$
Close #2
Function IfCan(i As Long,j As Long,k As Long) As Long
Dim li As Long,lj As Long,c As Long
For li=0 To 8
If A(li,j)=k then c=-1
Next
For lj=0 To 8
If A(i,lj)=k then c=-1
Next
For li=i\3*3 To i\3*3+2
For lj=j\3*3 To j\3*3+2
If A(li,lj)=k then c=-1
Next
Next
If c=-1 then IfCan=FALSE else IfCan=TRUE
End Function
Function IfnCan(i As Long,j As Long) As Long
Dim k As Long,c As Long
c=0
For k=1 To 9
If IfCan(i,j,k) then
c=-1
End If
Next
If c=-1 then IfnCan=FALSE else IfnCan=TRUE
End Function
Function IfCanThink(i As Long,j As Long) As Long
Dim k As Long,c As Long,a As Long
a=A(i,j)
A(i,j)=0
c=IfCan2(i,j)
A(i,j)=a
If c=1 then IfCanThink=TRUE else IfCanThink=FALSE
End Function
Function IfCan2(i As Long,j As Long) As Long
Dim a(8) As Byte,li As Long,lj As Long
For li=0 To 8
If A(li,j)<>20 then
If A(li,j)>=10 then
a(A(li,j)-10)=1
Else
a(A(li,j))=1
End If
End If
Next
For lj=0 To 8
If A(i,lj)<>20 then
If A(i,lj)>=10 then
a(A(i,lj)-10)=1
Else
a(A(i,lj))=1
End If
End If
Next
For li=i\3*3 To i\3*3+2
For lj=j\3*3 To j\3*3+2
If A(li,lj)<>20 then
If A(li,lj)>=10 then
a(A(li,lj)-10)=1
Else
a(A(li,lj))=1
End If
End If
Next
Next
lj=0
For li=0 To 8
lj=lj+a(li)
Next
If lj>=8 then IfCan2=TRUE else IfCan2=FALSE
End Function