RosettaCodeData/Task/Bulls-and-cows-Player/FreeBASIC/bulls-and-cows-player.basic
2024-10-16 18:07:41 -07:00

98 lines
2.7 KiB
Text

Function countBullsAndCows(guess() As Integer, answer() As Integer) As String
Dim As Integer bulls = 0, cows = 0
Dim As Integer i, j
For i = 0 To Ubound(guess)
If answer(i) = guess(i) Then
bulls += 1
Else
For j = 0 To Ubound(answer)
If answer(j) = guess(i) Then
cows += 1
Exit For
End If
Next
End If
Next
Return Str(bulls) & "," & Str(cows)
End Function
'--- Programa Principal ---
Randomize Timer
Dim As Integer choices(5040, 3)
Dim As Integer index = 0
Dim As Integer i, j, k, l
' generate all possible distinct 4 digit (1 to 9) integer arrays
For i = 1 To 9
For j = 1 To 9
If j = i Then Continue For
For k = 1 To 9
If k = i Or k = j Then Continue For
For l = 1 To 9
If l = i Or l = j Or l = k Then Continue For
choices(index, 0) = i
choices(index, 1) = j
choices(index, 2) = k
choices(index, 3) = l
index += 1
Next
Next
Next
Next
' pick one at random as the answer
Dim As Integer answer(3)
Dim As Integer randIndex = Int(Rnd * index)
For i = 0 To 3
answer(i) = choices(randIndex, i)
Next
' keep guessing, pruning the list as we go based on the score, until answer found
Do
randIndex = Int(Rnd * index)
Dim As Integer guess(3)
For i = 0 To 3
guess(i) = choices(randIndex, i)
Next
Dim As String result = countBullsAndCows(guess(), answer())
Dim As Integer bulls = Val(Left(result, Instr(result, ",") - 1))
Dim As Integer cows = Val(Mid(result, Instr(result, ",") + 1))
Print "Guess = ";
For i = 0 To 3
Print guess(i);
Next
Print " Bulls = "; bulls; " Cows = "; cows
If bulls = 4 Then
Print "You've just found the answer!"
Exit Do
End If
For i = index - 1 To 0 Step -1
Dim As Integer possible(3)
For j = 0 To 3
possible(j) = choices(i, j)
Next
Dim As String result2 = countBullsAndCows(possible(), answer())
Dim As Integer bulls2 = Val(Left(result2, Instr(result2, ",") - 1))
Dim As Integer cows2 = Val(Mid(result2, Instr(result2, ",") + 1))
' if score is no better remove it from the list of choices
If bulls2 <= bulls And cows2 <= cows Then
For j = i To index - 2
For k = 0 To 3
choices(j, k) = choices(j + 1, k)
Next
Next
index -= 1
End If
Next
If index = 0 Then
Print "Something went wrong as no choices left! Aborting program"
Exit Do
End If
Loop
Sleep