aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

210
Task/Bulls-and-cows-Player/Ada/bulls-and-cows-player.ada
View file

@ -1,210 +0,0 @@
with Ada.Text_IO;
with Ada.Containers.Vectors;
with Ada.Numerics.Discrete_Random;
procedure Bulls_Player is
-- package for In-/Output of natural numbers
package Nat_IO is new Ada.Text_IO.Integer_IO (Natural);
-- for comparing length of the vectors
use type Ada.Containers.Count_Type;
-- number of digits
Guessing_Length : constant := 4;
-- digit has to be from 1 to 9
type Digit is range 1 .. 9;
-- a sequence has specified length of digits
type Sequence is array (1 .. Guessing_Length) of Digit;
-- data structure to store the possible answers
package Sequence_Vectors is new Ada.Containers.Vectors
(Element_Type => Sequence,
Index_Type => Positive);
-- check if sequence contains each digit only once
function Is_Valid (S : Sequence) return Boolean is
Appeared : array (Digit) of Boolean := (others => False);
begin
for I in S'Range loop
if Appeared (S (I)) then
return False;
end if;
Appeared (S (I)) := True;
end loop;
return True;
end Is_Valid;
-- calculate all possible sequences and store them in the vector
procedure Fill_Pool (Pool : in out Sequence_Vectors.Vector) is
Finished : exception;
-- count the sequence up by one
function Next (S : Sequence) return Sequence is
Result : Sequence := S;
Index : Positive := S'Last;
begin
loop
-- overflow at a position causes next position to increase
if Result (Index) = Digit'Last then
Result (Index) := Digit'First;
-- overflow at maximum position
-- we have processed all possible values
if Index = Result'First then
raise Finished;
end if;
Index := Index - 1;
else
Result (Index) := Result (Index) + 1;
return Result;
end if;
end loop;
end Next;
X : Sequence := (others => 1);
begin
loop
-- append all valid values
if Is_Valid (X) then
Pool.Append (X);
end if;
X := Next (X);
end loop;
exception
when Finished =>
-- the exception tells us that we have added all possible values
-- simply return and do nothing.
null;
end Fill_Pool;
-- generate a random index from the pool
function Random_Index (Pool : Sequence_Vectors.Vector) return Positive is
subtype Possible_Indexes is Positive range
Pool.First_Index .. Pool.Last_Index;
package Index_Random is new Ada.Numerics.Discrete_Random
(Possible_Indexes);
Index_Gen : Index_Random.Generator;
begin
Index_Random.Reset (Index_Gen);
return Index_Random.Random (Index_Gen);
end Random_Index;
-- get the answer from the player, simple validity tests
procedure Get_Answer (S : Sequence; Bulls, Cows : out Natural) is
Valid : Boolean := False;
begin
Bulls := 0;
Cows := 0;
while not Valid loop
-- output the sequence
Ada.Text_IO.Put ("How is the score for:");
for I in S'Range loop
Ada.Text_IO.Put (Digit'Image (S (I)));
end loop;
Ada.Text_IO.New_Line;
begin
Ada.Text_IO.Put ("Bulls:");
Nat_IO.Get (Bulls);
Ada.Text_IO.Put ("Cows:");
Nat_IO.Get (Cows);
if Bulls + Cows <= Guessing_Length then
Valid := True;
else
Ada.Text_IO.Put_Line ("Invalid answer, try again.");
end if;
exception
when others =>
null;
end;
end loop;
end Get_Answer;
-- remove all sequences that wouldn't give an equivalent score
procedure Strip
(V : in out Sequence_Vectors.Vector;
S : Sequence;
Bulls, Cows : Natural)
is
function Has_To_Be_Removed (Position : Positive) return Boolean is
Testant : constant Sequence := V.Element (Position);
Bull_Score : Natural := 0;
Cow_Score : Natural := 0;
begin
for I in Testant'Range loop
for J in S'Range loop
if Testant (I) = S (J) then
-- same digit at same position: Bull!
if I = J then
Bull_Score := Bull_Score + 1;
else
Cow_Score := Cow_Score + 1;
end if;
end if;
end loop;
end loop;
return Cow_Score /= Cows or else Bull_Score /= Bulls;
end Has_To_Be_Removed;
begin
for Index in reverse V.First_Index .. V.Last_Index loop
if Has_To_Be_Removed (Index) then
V.Delete (Index);
end if;
end loop;
end Strip;
-- main routine
procedure Solve is
All_Sequences : Sequence_Vectors.Vector;
Test_Index : Positive;
Test_Sequence : Sequence;
Bulls, Cows : Natural;
begin
-- generate all possible sequences
Fill_Pool (All_Sequences);
loop
-- pick at random
Test_Index := Random_Index (All_Sequences);
Test_Sequence := All_Sequences.Element (Test_Index);
-- ask player
Get_Answer (Test_Sequence, Bulls, Cows);
-- hooray, we have it!
exit when Bulls = 4;
All_Sequences.Delete (Test_Index);
Strip (All_Sequences, Test_Sequence, Bulls, Cows);
exit when All_Sequences.Length <= 1;
end loop;
if All_Sequences.Length = 0 then
-- oops, shouldn't happen
Ada.Text_IO.Put_Line
("I give up, there has to be a bug in" &
"your scoring or in my algorithm.");
else
if All_Sequences.Length = 1 then
Ada.Text_IO.Put ("The sequence you thought has to be:");
Test_Sequence := All_Sequences.First_Element;
else
Ada.Text_IO.Put ("The sequence you thought of was:");
end if;
for I in Test_Sequence'Range loop
Ada.Text_IO.Put (Digit'Image (Test_Sequence (I)));
end loop;
end if;
end Solve;
begin
-- output blah blah
Ada.Text_IO.Put_Line ("Bulls and Cows, Your turn!");
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line
("Think of a sequence of" &
Integer'Image (Guessing_Length) &
" different digits.");
Ada.Text_IO.Put_Line ("I will try to guess it. For each correctly placed");
Ada.Text_IO.Put_Line ("digit I score 1 Bull. For each digit that is on");
Ada.Text_IO.Put_Line ("the wrong place I score 1 Cow. After each guess");
Ada.Text_IO.Put_Line ("you tell me my score.");
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("Let's start.");
Ada.Text_IO.New_Line;
-- solve the puzzle
Solve;
end Bulls_Player;

158
Task/Bulls-and-cows-Player/AutoHotkey/bulls-and-cows-player.ahk
View file

@ -11,97 +11,97 @@ Gui, Show
Return
ButtonStart:
If Default = Restart
Reload
Gui, Submit, NoHide
GuiControl, Focus, Bulls
If (Bulls = length)
{
GuiControl, , Info, Guessed in %i% tries!
GuiControl, , Default, Restart
Default = Restart
}
Else
{
If i = 0
{
GuiControl, , Default, Submit
GuiControl, , History
}
Else
{
If (StrLen(Bulls) != 1 || StrLen(Cows) != 1)
Return
If Bulls is not digit
Return
If Cows is not digit
Return
GuiControl, , History, % History .= ": " Bulls " Bulls " Cows " Cows`n"
GuiControl, , Bulls
GuiControl, , Cows
S:=Remove(S, Guess, Bulls, Cows)
}
If !S
{
GuiControl, , Info, Invalid response.
GuiControl, , Default, Restart
Default = Restart
}
Else
{
Guess := SubStr(S,1,length)
GuiControl, , History, % History . Guess
GuiControl, , Info, Enter a single digit number of bulls and cows.
i++
}
}
If Default = Restart
Reload
Gui, Submit, NoHide
GuiControl, Focus, Bulls
If (Bulls = length)
{
GuiControl, , Info, Guessed in %i% tries!
GuiControl, , Default, Restart
Default = Restart
}
Else
{
If i = 0
{
GuiControl, , Default, Submit
GuiControl, , History
}
Else
{
If (StrLen(Bulls) != 1 || StrLen(Cows) != 1)
Return
If Bulls is not digit
Return
If Cows is not digit
Return
GuiControl, , History, % History .= ": " Bulls " Bulls " Cows " Cows`n"
GuiControl, , Bulls
GuiControl, , Cows
S:=Remove(S, Guess, Bulls, Cows)
}
If !S
{
GuiControl, , Info, Invalid response.
GuiControl, , Default, Restart
Default = Restart
}
Else
{
Guess := SubStr(S,1,length)
GuiControl, , History, % History . Guess
GuiControl, , Info, Enter a single digit number of bulls and cows.
i++
}
}
Return
GuiEscape:
GuiClose:
ExitApp
ExitApp
Remove(S, Guess, Bulls, Cows) {
Loop, Parse, S, `n
If (Bulls "," Cows = Response(Guess, A_LoopField))
S2 .= A_LoopField . "`n"
Return SubStr(S2,1,-1)
Loop, Parse, S, `n
If (Bulls "," Cows = Response(Guess, A_LoopField))
S2 .= A_LoopField . "`n"
Return SubStr(S2,1,-1)
}
; from http://rosettacode.org/wiki/Bulls and Cows#AutoHotkey
Response(Guess,Code) {
Bulls := 0, Cows := 0
Loop, % StrLen(Code)
If (SubStr(Guess, A_Index, 1) = SubStr(Code, A_Index, 1))
Bulls++
Else If (InStr(Code, SubStr(Guess, A_Index, 1)))
Cows++
Return Bulls "," Cows
Bulls := 0, Cows := 0
Loop, % StrLen(Code)
If (SubStr(Guess, A_Index, 1) = SubStr(Code, A_Index, 1))
Bulls++
Else If (InStr(Code, SubStr(Guess, A_Index, 1)))
Cows++
Return Bulls "," Cows
}
; from http://rosettacode.org/wiki/Permutations#Alternate_Version
P(n,k="",opt=0,delim="",str="") {
i:=0
If !InStr(n,"`n")
If n in 2,3,4,5,6,7,8,9
Loop, %n%
n := A_Index = 1 ? A_Index : n "`n" A_Index
Else
Loop, Parse, n, %delim%
n := A_Index = 1 ? A_LoopField : n "`n" A_LoopField
If (k = "")
RegExReplace(n,"`n","",k), k++
If k is not Digit
Return "k must be a digit."
If opt not in 0,1,2,3
Return "opt invalid."
If k = 0
Return str
Else
Loop, Parse, n, `n
If (!InStr(str,A_LoopField) || opt & 1)
s .= (!i++ ? (opt & 2 ? str "`n" : "") : "`n" )
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
i:=0
If !InStr(n,"`n")
If n in 2,3,4,5,6,7,8,9
Loop, %n%
n := A_Index = 1 ? A_Index : n "`n" A_Index
Else
Loop, Parse, n, %delim%
n := A_Index = 1 ? A_LoopField : n "`n" A_LoopField
If (k = "")
RegExReplace(n,"`n","",k), k++
If k is not Digit
Return "k must be a digit."
If opt not in 0,1,2,3
Return "opt invalid."
If k = 0
Return str
Else
Loop, Parse, n, `n
If (!InStr(str,A_LoopField) || opt & 1)
s .= (!i++ ? (opt & 2 ? str "`n" : "") : "`n" )
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
}

100
Task/Bulls-and-cows-Player/C++/bulls-and-cows-player.cpp
View file

@ -21,89 +21,89 @@ public:
private:
void guess()
{
pair<int, int> res; int cc = 1;
cout << endl << " SECRET: " << secret << endl << "==============" << endl;
cout << "+-----------+---------+--------+\n| GUESS | BULLS | COWS |\n+-----------+---------+--------+\n";
while( true )
{
string gs = gimmeANumber();
if( gs.empty() ) { cout << endl << "Something went wrong with the scoring..." << endl << "Cannot find an answer!" << endl; return; }
if( scoreIt( gs, res ) ) { cout << endl << "I found the secret number!" << endl << "It is: " << gs << endl; return; }
cout << "| " << gs << " | " << setw( 3 ) << res.first << " | " << setw( 3 ) << res.second << " |\n+-----------+---------+--------+\n";
clearPool( gs, res );
pair<int, int> res; int cc = 1;
cout << endl << " SECRET: " << secret << endl << "==============" << endl;
cout << "+-----------+---------+--------+\n| GUESS | BULLS | COWS |\n+-----------+---------+--------+\n";
while( true )
{
string gs = gimmeANumber();
if( gs.empty() ) { cout << endl << "Something went wrong with the scoring..." << endl << "Cannot find an answer!" << endl; return; }
if( scoreIt( gs, res ) ) { cout << endl << "I found the secret number!" << endl << "It is: " << gs << endl; return; }
cout << "| " << gs << " | " << setw( 3 ) << res.first << " | " << setw( 3 ) << res.second << " |\n+-----------+---------+--------+\n";
clearPool( gs, res );
}
}
void clearPool( string gs, pair<int, int>& r )
{
vector<string>::iterator pi = pool.begin();
while( pi != pool.end() )
{
if( removeIt( gs, ( *pi ), r ) ) pi = pool.erase( pi );
else pi++;
}
vector<string>::iterator pi = pool.begin();
while( pi != pool.end() )
{
if( removeIt( gs, ( *pi ), r ) ) pi = pool.erase( pi );
else pi++;
}
}
string gimmeANumber()
{
if( pool.empty() ) return "";
return pool[rand() % pool.size()];
if( pool.empty() ) return "";
return pool[rand() % pool.size()];
}
void fillPool()
{
for( int x = 1234; x < 9877; x++ )
{
ostringstream oss; oss << x;
if( check( oss.str() ) ) pool.push_back( oss.str() );
}
for( int x = 1234; x < 9877; x++ )
{
ostringstream oss; oss << x;
if( check( oss.str() ) ) pool.push_back( oss.str() );
}
}
bool check( string s )
{
for( string::iterator si = s.begin(); si != s.end(); si++ )
{
if( ( *si ) == '0' ) return false;
if( count( s.begin(), s.end(), ( *si ) ) > 1 ) return false;
}
return true;
for( string::iterator si = s.begin(); si != s.end(); si++ )
{
if( ( *si ) == '0' ) return false;
if( count( s.begin(), s.end(), ( *si ) ) > 1 ) return false;
}
return true;
}
bool removeIt( string gs, string ts, pair<int, int>& res )
{
pair<int, int> tp; getScore( gs, ts, tp );
return tp != res;
pair<int, int> tp; getScore( gs, ts, tp );
return tp != res;
}
bool scoreIt( string gs, pair<int, int>& res )
{
getScore( gs, secret, res );
return res.first == LEN;
getScore( gs, secret, res );
return res.first == LEN;
}
void getScore( string gs, string st, pair<int, int>& pr )
{
pr.first = pr.second = 0;
for( unsigned int ui = 0; ui < LEN; ui++ )
{
if( gs[ui] == st[ui] ) pr.first++;
else
{
for( unsigned int vi = 0; vi < LEN; vi++ )
if( gs[ui] == st[vi] ) pr.second++;
}
}
pr.first = pr.second = 0;
for( unsigned int ui = 0; ui < LEN; ui++ )
{
if( gs[ui] == st[ui] ) pr.first++;
else
{
for( unsigned int vi = 0; vi < LEN; vi++ )
if( gs[ui] == st[vi] ) pr.second++;
}
}
}
string createSecret()
{
string n = "123456789", rs = "";
while( rs.length() < LEN )
{
int r = rand() % n.length();
rs += n[r]; n.erase( r, 1 );
}
return rs;
string n = "123456789", rs = "";
while( rs.length() < LEN )
{
int r = rand() % n.length();
rs += n[r]; n.erase( r, 1 );
}
return rs;
}
string secret;

106
Task/Bulls-and-cows-Player/C/bulls-and-cows-player-1.c
View file

@ -9,94 +9,94 @@ int len = 0;
int irand(int n)
{
int r, rand_max = RAND_MAX - (RAND_MAX % n);
do { r = rand(); } while(r >= rand_max);
return r / (rand_max / n);
int r, rand_max = RAND_MAX - (RAND_MAX % n);
do { r = rand(); } while(r >= rand_max);
return r / (rand_max / n);
}
char* get_digits(int n, char *ret)
{
int i, j;
char d[] = "123456789";
int i, j;
char d[] = "123456789";
for (i = 0; i < n; i++) {
j = irand(9 - i);
ret[i] = d[i + j];
if (j) d[i + j] = d[i], d[i] = ret[i];
}
return ret;
for (i = 0; i < n; i++) {
j = irand(9 - i);
ret[i] = d[i + j];
if (j) d[i + j] = d[i], d[i] = ret[i];
}
return ret;
}
#define MASK(x) (1 << (x - '1'))
int score(const char *digits, const char *guess, int *cow)
{
int i, bits = 0, bull = *cow = 0;
int i, bits = 0, bull = *cow = 0;
for (i = 0; guess[i] != '\0'; i++)
if (guess[i] != digits[i])
bits |= MASK(digits[i]);
else ++bull;
for (i = 0; guess[i] != '\0'; i++)
if (guess[i] != digits[i])
bits |= MASK(digits[i]);
else ++bull;
while (i--) *cow += ((bits & MASK(guess[i])) != 0);
while (i--) *cow += ((bits & MASK(guess[i])) != 0);
return bull;
return bull;
}
void pick(int n, int got, int marker, char *buf)
{
int i, bits = 1;
if (got >= n)
strcpy(list + (n + 1) * len++, buf);
else
for (i = 0; i < 9; i++, bits *= 2) {
if ((marker & bits)) continue;
buf[got] = i + '1';
pick(n, got + 1, marker | bits, buf);
}
int i, bits = 1;
if (got >= n)
strcpy(list + (n + 1) * len++, buf);
else
for (i = 0; i < 9; i++, bits *= 2) {
if ((marker & bits)) continue;
buf[got] = i + '1';
pick(n, got + 1, marker | bits, buf);
}
}
void filter(const char *buf, int n, int bull, int cow)
{
int i = 0, c;
char *ptr = list;
int i = 0, c;
char *ptr = list;
while (i < len) {
if (score(ptr, buf, &c) != bull || c != cow)
strcpy(ptr, list + --len * (n + 1));
else
ptr += n + 1, i++;
}
while (i < len) {
if (score(ptr, buf, &c) != bull || c != cow)
strcpy(ptr, list + --len * (n + 1));
else
ptr += n + 1, i++;
}
}
void game(const char *tgt, char *buf)
{
int i, p, bull, cow, n = strlen(tgt);
int i, p, bull, cow, n = strlen(tgt);
for (i = 0, p = 1; i < n && (p *= 9 - i); i++);
list = malloc(p * (n + 1));
for (i = 0, p = 1; i < n && (p *= 9 - i); i++);
list = malloc(p * (n + 1));
pick(n, 0, 0, buf);
for (p = 1, bull = 0; n - bull; p++) {
strcpy(buf, list + (n + 1) * irand(len));
bull = score(tgt, buf, &cow);
pick(n, 0, 0, buf);
for (p = 1, bull = 0; n - bull; p++) {
strcpy(buf, list + (n + 1) * irand(len));
bull = score(tgt, buf, &cow);
printf("Guess %2d| %s (from: %d)\n"
"Score | %d bull, %d cow\n%s",
p, buf, len, bull, cow, line);
printf("Guess %2d| %s (from: %d)\n"
"Score | %d bull, %d cow\n%s",
p, buf, len, bull, cow, line);
filter(buf, n, bull, cow);
}
filter(buf, n, bull, cow);
}
}
int main(int c, char **v)
{
int n = c > 1 ? atoi(v[1]) : 4;
int n = c > 1 ? atoi(v[1]) : 4;
char secret[10] = "", answer[10] = "";
srand(time(0));
char secret[10] = "", answer[10] = "";
srand(time(0));
printf("%sSecret | %s\n%s", line, get_digits(n, secret), line);
game(secret, answer);
printf("%sSecret | %s\n%s", line, get_digits(n, secret), line);
game(secret, answer);
return 0;
return 0;
}

6
Task/Bulls-and-cows-Player/Common-Lisp/bulls-and-cows-player.lisp
View file

@ -35,9 +35,9 @@
(if (= b 4)
(return-from solve (format t "Solution found!")))
(setq possible-guesses (mapcan #'(lambda (x) (if (and (= b (bulls x guess))
(= c (- (bulls+cows x guess) b)))
(list x)))
(remove guess possible-guesses)))
(= c (- (bulls+cows x guess) b)))
(list x)))
(remove guess possible-guesses)))
(setq guess (nth (random (length possible-guesses)) possible-guesses))
(setq b (bulls number guess))
(setq c (- (bulls+cows number guess) b)))))

84
Task/Bulls-and-cows-Player/Euphoria/bulls-and-cows-player.ex
View file

@ -1,84 +0,0 @@
include std/sequence.e
constant line = "--------+--------------------\n"
constant digits = "123456789"
sequence list = {}
function get_digits(integer n)
integer j
sequence d = digits, ret = ""
for i=1 to n do
j = rand(length(digits)-i)
ret &= d[i+j]
if j then
d[i+j] = d[i]
d[i] = ret[i]
end if
end for
return ret
end function
function MASK(integer x)
return power(2,x-digits[1])
end function
function score(sequence pattern, sequence guess)
integer bits = 0, bull = 0, cow = 0
for i = 1 to length(guess) do
if guess[i] != pattern[i] then
bits += MASK(pattern[i])
else
bull += 1
end if
end for
for i = 1 to length(guess) do
cow += and_bits(bits,MASK(guess[i])) != 0
end for
return {bull, cow}
end function
procedure pick(integer n, integer got, integer marker, sequence buf)
integer bits = 1
if got >= n then
list = append(list,buf)
else
for i = 0 to length(digits)-1 do
if not and_bits(marker,bits) then
buf[got+1] = i+digits[1]
pick(n, got+1, or_bits(marker,bits), buf)
end if
bits *= 2
end for
end if
end procedure
function tester(sequence item, sequence data)
return equal(score(item,data[1]),data[2])
end function
constant tester_id = routine_id("tester")
procedure game(sequence tgt)
integer p, n = length(tgt)
sequence buf = repeat(0,n), bc
list = {}
pick(n,0,0,buf)
p = 1
bc = {0,0}
while bc[1]<n do
buf = list[rand($)]
bc = score(tgt,buf)
printf(1,"Guess %2d| %s (from: %d)\nScore | %d bull, %d cow\n%s",
{p, buf, length(list)} & bc & {line})
list = filter(list, tester_id, {buf, bc})
p+=1
end while
end procedure
constant n = 4
sequence secret = get_digits(n)
printf(1,"%sSecret | %s\n%s", {line, secret, line})
game(secret)

20
Task/Bulls-and-cows-Player/Haskell/bulls-and-cows-player-1.hs
View file

@ -13,21 +13,21 @@ player = do
play ps =
if null ps then
putStrLn "Unable to find a solution"
putStrLn "Unable to find a solution"
else do i <- randomRIO(0,length ps - 1)
let p = ps!!i :: String
putStrLn ("My guess is " ++ p) >> putStrLn "How many bulls and cows?"
input <- takeInput
let bc = input ::[Int]
ps' = filter((==sum bc).length. filter id. map (flip elem p))
$ filter((==head bc).length. filter id. zipWith (==) p) ps
if length ps' == 1 then putStrLn $ "The answer is " ++ head ps'
else play ps'
putStrLn ("My guess is " ++ p) >> putStrLn "How many bulls and cows?"
input <- takeInput
let bc = input ::[Int]
ps' = filter((==sum bc).length. filter id. map (flip elem p))
$ filter((==head bc).length. filter id. zipWith (==) p) ps
if length ps' == 1 then putStrLn $ "The answer is " ++ head ps'
else play ps'
takeInput = do
inp <- getLine
let ui = map digitToInt $ take 2 $ filter(`elem` ['0'..'4']) inp
if sum ui > 4 || length ui /= 2 then
do putStrLn "Wrong input. Try again"
takeInput
else return ui
takeInput
else return ui

152
Task/Bulls-and-cows-Player/Lua/bulls-and-cows-player.lua
View file

@ -2,110 +2,110 @@ local line = "---------+----------------------------------+-------+-------+"
local digits = {1,2,3,4,5,6,7,8,9}
function and_bits (a, b)
-- print (a, b)
return a & b -- Lua 5.3
-- print (a, b)
return a & b -- Lua 5.3
end
function or_bits (a, b)
return a | b -- Lua 5.3
return a | b -- Lua 5.3
end
function get_digits (n)
local tDigits = {}
for i = 1, #digits do tDigits[i] = digits[i] end
local ret = {}
math.randomseed(os.time())
for i = 1, n do
local d = table.remove (tDigits, math.random(#tDigits))
table.insert (ret, d)
end
return ret
local tDigits = {}
for i = 1, #digits do tDigits[i] = digits[i] end
local ret = {}
math.randomseed(os.time())
for i = 1, n do
local d = table.remove (tDigits, math.random(#tDigits))
table.insert (ret, d)
end
return ret
end
function mask (x)
return 3*x-1 -- any function
return 3*x-1 -- any function
end
function score (guess, goal)
local bits, bulls, cows = 0, 0, 0
for i = 1, #guess do
if (guess[i] == goal[i]) then
bulls = bulls + 1
else
bits = bits + mask (goal[i])
end
end
for i = 1, #guess do
if not (guess[i] == goal[i]) then
local nCow = (and_bits (bits, mask(guess[i])) == 0) and 0 or 1
cows = cows + nCow
end
end
return bulls, cows
local bits, bulls, cows = 0, 0, 0
for i = 1, #guess do
if (guess[i] == goal[i]) then
bulls = bulls + 1
else
bits = bits + mask (goal[i])
end
end
for i = 1, #guess do
if not (guess[i] == goal[i]) then
local nCow = (and_bits (bits, mask(guess[i])) == 0) and 0 or 1
cows = cows + nCow
end
end
return bulls, cows
end
function iCopy (list)
local nList = {}
for i = 1, #list do nList[i] = list[i] end
return nList
local nList = {}
for i = 1, #list do nList[i] = list[i] end
return nList
end
function pick (list, n, got, marker, buf)
-- print ('pick', #list, n)
local bits = 1
if got >= n then
table.insert (list, buf)
else
local bits = 1
for i = 1, #digits do
if and_bits(marker,bits) == 0 then
buf[got+1] = i
pick (list, n, got+1, or_bits (marker, bits), iCopy(buf))
end
bits = bits * 2
end
end
-- print ('pick', #list, n)
local bits = 1
if got >= n then
table.insert (list, buf)
else
local bits = 1
for i = 1, #digits do
if and_bits(marker,bits) == 0 then
buf[got+1] = i
pick (list, n, got+1, or_bits (marker, bits), iCopy(buf))
end
bits = bits * 2
end
end
end
function filter_list (list, guess, bulls, cows)
local index = 1
for i = 1, #list do
-- print ('filter_list i: ' .. i)
local scoreBulls, scoreCows = score (guess, list[i])
if bulls == scoreBulls and cows == scoreCows then
list[index] = list[i]
index = index + 1
end
end
for i = #list, index+1, -1 do
table.remove (list, i)
end
local index = 1
for i = 1, #list do
-- print ('filter_list i: ' .. i)
local scoreBulls, scoreCows = score (guess, list[i])
if bulls == scoreBulls and cows == scoreCows then
list[index] = list[i]
index = index + 1
end
end
for i = #list, index+1, -1 do
table.remove (list, i)
end
end
function game (goal)
local n = #goal
local attempt = 1
local guess = {} -- n-length guess numbers array
for i = 1, n do table.insert (guess, 0) end -- empty buffer
local list = {}
pick (list, n, 0, 0, guess)
local bulls, cows = 0, 0
while true do
guess = list[1]
bulls, cows = score (guess, goal)
print (' Guess ' .. attempt .. ' | ' ..table.concat(guess), '('..#list..' variants) ', bulls, cows)
if bulls == n then return end
filter_list (list, guess, bulls, cows)
attempt = attempt + 1
end
local n = #goal
local attempt = 1
local guess = {} -- n-length guess numbers array
for i = 1, n do table.insert (guess, 0) end -- empty buffer
local list = {}
pick (list, n, 0, 0, guess)
local bulls, cows = 0, 0
while true do
guess = list[1]
bulls, cows = score (guess, goal)
print (' Guess ' .. attempt .. ' | ' ..table.concat(guess), '('..#list..' variants) ', bulls, cows)
if bulls == n then return end
filter_list (list, guess, bulls, cows)
attempt = attempt + 1
end
end
local n = 4
local secret = get_digits (n)
print (line..'\nSecret '.. #secret.. ' | '..table.concat(secret) .. ' | Bulls | Cows |' .. '\n' .. line)
print (line..'\nSecret '.. #secret.. ' | '..table.concat(secret) .. ' | Bulls | Cows |' .. '\n' .. line)
game (secret)

22
Task/Bulls-and-cows-Player/Mathematica/bulls-and-cows-player.math
View file

@ -1,14 +1,14 @@
bullCow={Count[#1-#2,0],Length[#1\[Intersection]#2]-Count[#1-#2,0]}&;
Module[{r,input,candidates=Permutations[Range[9],{4}]},
While[True,
r=InputString[];
If[r===$Canceled,Break[],
input=ToExpression/@StringSplit@r;
If[Length@input!=3,Print["Input the guess, number of bulls, number of cows, delimited by space."],
candidates=Select[candidates,bullCow[ToCharacterCode@StringJoin[ToString/@#],ToCharacterCode@ToString@input[[1]]]==input[[2;;3]]&];
candidates=SortBy[candidates,{-3,-1}.bullCow[ToCharacterCode@StringJoin[ToString/@#],ToCharacterCode@ToString@input[[1]]]&];
If[candidates==={},Print["No more candidates."];Break[]];
If[Length@candidates==1,Print["Must be: "<>StringJoin[ToString/@candidates[[1]]]];Break[]];
Print[ToString@Length@candidates<>" candidates remaining."];
Print["Can try "<>StringJoin[ToString/@First@candidates]<>"."];
]]]]
r=InputString[];
If[r===$Canceled,Break[],
input=ToExpression/@StringSplit@r;
If[Length@input!=3,Print["Input the guess, number of bulls, number of cows, delimited by space."],
candidates=Select[candidates,bullCow[ToCharacterCode@StringJoin[ToString/@#],ToCharacterCode@ToString@input[[1]]]==input[[2;;3]]&];
candidates=SortBy[candidates,{-3,-1}.bullCow[ToCharacterCode@StringJoin[ToString/@#],ToCharacterCode@ToString@input[[1]]]&];
If[candidates==={},Print["No more candidates."];Break[]];
If[Length@candidates==1,Print["Must be: "<>StringJoin[ToString/@candidates[[1]]]];Break[]];
Print[ToString@Length@candidates<>" candidates remaining."];
Print["Can try "<>StringJoin[ToString/@First@candidates]<>"."];
]]]]

84
Task/Bulls-and-cows-Player/Prolog/bulls-and-cows-player-1.pro
View file

@ -16,49 +16,49 @@ digits(8).
% tirage(-)
tirage(Ms) :-
% are there previous guesses ?
( bagof([P, R], guess(P,R), Propositions)
-> tirage(Propositions, Ms)
; % First try
tirage_1(Ms)),
!.
% are there previous guesses ?
( bagof([P, R], guess(P,R), Propositions)
-> tirage(Propositions, Ms)
; % First try
tirage_1(Ms)),
!.
% tirage_1(-)
% We choose the first Len numbers
tirage_1(L):-
proposition(Len),
Max is Len-1,
numlist(0, Max, L).
proposition(Len),
Max is Len-1,
numlist(0, Max, L).
% tirage(+,-)
tirage(L, Ms) :-
proposition(Len),
proposition(Len),
length(Ms, Len),
digits(Digits),
digits(Digits),
% The guess contains only this numbers
% The guess contains only this numbers
Ms ins 0..Digits,
all_different(Ms),
all_different(Ms),
% post the constraints
% post the constraints
maplist(placees(Ms), L),
% compute a possible solution
label(Ms).
% compute a possible solution
label(Ms).
% placees(+, +])
placees(Sol, [Prop, [BP, MP]]) :-
V #= 0,
V #= 0,
% compute the numbers of digits in good places
compte_bien_placees(Sol, Prop, V, BP1),
BP1 #= BP,
% compute the numbers of digits in good places
compte_bien_placees(Sol, Prop, V, BP1),
BP1 #= BP,
% compute the numbers of digits inbad places
compte_mal_placees(Sol, Prop, 0, V, MP1),
MP1 #= MP.
% compute the numbers of digits inbad places
compte_mal_placees(Sol, Prop, 0, V, MP1),
MP1 #= MP.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
@ -73,10 +73,10 @@ placees(Sol, [Prop, [BP, MP]]) :-
compte_mal_placees(_, [], _, MP, MP).
compte_mal_placees(Sol, [H | T], N, MPC, MPF) :-
compte_une_mal_placee(H, N, Sol, 0, 0, VF),
MPC1 #= MPC + VF,
N1 is N+1,
compte_mal_placees(Sol, T, N1, MPC1, MPF).
compte_une_mal_placee(H, N, Sol, 0, 0, VF),
MPC1 #= MPC + VF,
N1 is N+1,
compte_mal_placees(Sol, T, N1, MPC1, MPF).
% Here we check one digit of an already done guess
@ -93,22 +93,22 @@ compte_une_mal_placee(_H, _N, [], _, TT, TT).
% digit in the same range, continue
compte_une_mal_placee(H, NH, [_H1 | T], NH, TTC, TTF) :-
NH1 is NH + 1, !,
compte_une_mal_placee(H, NH, T, NH1, TTC, TTF).
NH1 is NH + 1, !,
compte_une_mal_placee(H, NH, T, NH1, TTC, TTF).
% same digit in different places
% increment the counter and continue continue
compte_une_mal_placee(H, NH, [H1 | T], NH1, TTC, TTF) :-
H #= H1,
NH \= NH1,
NH2 is NH1 + 1,
TTC1 #= TTC + 1,
compte_une_mal_placee(H, NH, T, NH2, TTC1, TTF).
H #= H1,
NH \= NH1,
NH2 is NH1 + 1,
TTC1 #= TTC + 1,
compte_une_mal_placee(H, NH, T, NH2, TTC1, TTF).
compte_une_mal_placee(H, NH, [H1 | T], NH1, TTC, TTF) :-
H #\= H1,
NH2 is NH1 + 1,
compte_une_mal_placee(H, NH, T, NH2, TTC, TTF).
H #\= H1,
NH2 is NH1 + 1,
compte_une_mal_placee(H, NH, T, NH2, TTC, TTF).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@ -123,10 +123,10 @@ compte_une_mal_placee(H, NH, [H1 | T], NH1, TTC, TTF) :-
compte_bien_placees([], [], MP, MP).
compte_bien_placees([H | T], [H1 | T1], MPC, MPF) :-
H #= H1,
MPC1 #= MPC + 1,
compte_bien_placees(T, T1, MPC1, MPF).
H #= H1,
MPC1 #= MPC + 1,
compte_bien_placees(T, T1, MPC1, MPF).
compte_bien_placees([H | T], [H1 | T1], MPC, MPF) :-
H #\= H1,
compte_bien_placees(T, T1, MPC, MPF).
H #\= H1,
compte_bien_placees(T, T1, MPC, MPF).

34
Task/Bulls-and-cows-Player/Prolog/bulls-and-cows-player-2.pro
View file

@ -1,21 +1,21 @@
bulls_and_cows :-
retractall('ia.pl':guess(_,_)),
retractall(coups(_)),
assert(coups(1)),
retractall('ia.pl':guess(_,_)),
retractall(coups(_)),
assert(coups(1)),
repeat,
( tirage(Ms)
-> maplist(add_1, Ms, Ms1),
atomic_list_concat(Ms1, Guess),
retract(coups(Coup)),
Coup_1 is Coup + 1,
assert(coups(Coup_1)),
format('~w My guess ~w~n', [Coup, Guess]),
write('Bulls : '), read(Bulls),
write('Cows : '), read(Cows), nl,
assert('ia.pl':guess(Ms, [Bulls, Cows])),
Bulls = 4
; writeln('Sorry, I can''t find a solution !'), true).
repeat,
( tirage(Ms)
-> maplist(add_1, Ms, Ms1),
atomic_list_concat(Ms1, Guess),
retract(coups(Coup)),
Coup_1 is Coup + 1,
assert(coups(Coup_1)),
format('~w My guess ~w~n', [Coup, Guess]),
write('Bulls : '), read(Bulls),
write('Cows : '), read(Cows), nl,
assert('ia.pl':guess(Ms, [Bulls, Cows])),
Bulls = 4
; writeln('Sorry, I can''t find a solution !'), true).
add_1(X, Y) :-
Y is X + 1.
Y is X + 1.

48
Task/Bulls-and-cows-Player/Raku/bulls-and-cows-player.raku
View file

@ -4,36 +4,36 @@
my @candidates = ([X] [1..9] xx 4).grep: *.unique == 4;
repeat {
my $guess = @candidates.pick;
my ($bulls, $cows) = read-score;
@candidates .= grep: &score-correct;
my $guess = @candidates.pick;
my ($bulls, $cows) = read-score;
@candidates .= grep: &score-correct;
# note how we declare our two subroutines within the repeat block. This
# limits the scope in which the routines are known to the scope in which
# they are needed and saves us a lot of arguments to our two routines.
sub score-correct($a) {
my $exact = [+] $a >>==<< $guess;
# note how we declare our two subroutines within the repeat block. This
# limits the scope in which the routines are known to the scope in which
# they are needed and saves us a lot of arguments to our two routines.
sub score-correct($a) {
my $exact = [+] $a >>==<< $guess;
# number of elements of $a that match any element of $b
my $loose = +$a.grep: any @$guess;
# number of elements of $a that match any element of $b
my $loose = +$a.grep: any @$guess;
return $bulls == $exact && $cows == $loose - $exact;
}
return $bulls == $exact && $cows == $loose - $exact;
}
sub read-score() {
loop {
my $score = prompt "My guess: {$guess.join}.\n";
sub read-score() {
loop {
my $score = prompt "My guess: {$guess.join}.\n";
if $score ~~ m:s/^ $<bulls>=(\d) $<cows>=(\d) $/
and $<bulls> + $<cows> <= 4 {
return +$<bulls>, +$<cows>;
}
if $score ~~ m:s/^ $<bulls>=(\d) $<cows>=(\d) $/
and $<bulls> + $<cows> <= 4 {
return +$<bulls>, +$<cows>;
}
say "Please specify the number of bulls and cows";
}
}
say "Please specify the number of bulls and cows";
}
}
} while @candidates > 1;
say @candidates
?? "Your secret number is {@candidates[0].join}!"
!! "I think you made a mistake with your scoring.";
?? "Your secret number is {@candidates[0].join}!"
!! "I think you made a mistake with your scoring.";

6
Task/Bulls-and-cows-Player/Red/bulls-and-cows-player.red
View file

@ -13,15 +13,15 @@ valid: function [ i] [ all [ parse i [4 digits] "," 4 = length? unique i ] ]
possible: collect [ repeat i 9876 [ if valid s: to-string i [ keep s ] ] ] ;; should start at 1234, but for sake of brevity...
forever [ ;; read valid secret number from keyboard...
while [ not valid secret: ask "^/Enter Number with 4 uniq digits (1 - 9 only, q-quit ) " ] [ ;; "^/" is character for newline
either secret = "q" [print "Bye" halt ] [ print [ secret "invalid, Try again !" ] ]
while [ not valid secret: ask "^/Enter Number with 4 uniq digits (1 - 9 only, q-quit ) " ] [ ;; "^/" is character for newline
either secret = "q" [print "Bye" halt ] [ print [ secret "invalid, Try again !" ] ]
]
results: copy #() ;; map (key-value ) to store each guess and its result
foreach guess possible [
foreach [k v] body-of results [ ;; check guess against previous results
if v <> check guess k [ guess: copy "" break ]
if v <> check guess k [ guess: copy "" break ]
]
if empty? guess [ continue ] ;; check against previous results failed ?
put results guess res: check guess secret ;; store current guess and result in map

236
Task/Bulls-and-cows-Player/SenseTalk/bulls-and-cows-player.sensetalk
View file

@ -1,121 +1,121 @@
set the remoteWorkInterval to .001 -- optional
repeat forever
repeat forever
set description to "Enter a 4 digit number" & newline & "- zero's excluded" & newline & "- each digit should be unique" & newline
Ask "Enter a Number" title "Bulls & Cows (Player)" message description
put it into num
if num is ""
Answer "" with "Play" or "Quit" title "Quit Bulls & Cows (Player)?"
if it is "Quit"
exit all
end if
end if
set startTime to now
if number of characters in num is 4
if character 1 of num is not equal to character 2 of num
if character 1 of num is not equal to character 3 of num
if character 1 of num is not equal to character 4 of num
if character 2 of num is not equal to character 3 of num
if character 2 of num is not equal to character 4 of num
if character 3 of num is not equal to character 4 of num
if num does not contain 0
exit repeat
end if
end if
end if
end if
end if
end if
end if
end if
end repeat
set guess to 1111
set lastBullQty to 0
set digitLocation to 1
set cowVals to empty
repeat forever
set score to {
bulls: {
qty: 0,
values: {}
},
cows: {
qty: 0,
values: {}
}
}
repeat the number of characters in num times
if character the counter of guess is equal to character the counter of num
add 1 to score.bulls.qty
insert character the counter of guess into score.bulls.values
else
if num contains character the counter of guess
if character the counter of guess is not equal to character the counter of num
if score.bulls.values does not contain character the counter of guess and score.cows.values does not contain character the counter of guess
add 1 to score.cows.qty
if cowVals.(character the counter of guess) is empty
set cowVals.(character the counter of guess) to false
end if
end if
end if
end if
end if
end repeat
if guess is equal to num
put now - startTime into elapsedTime
set displayMessage to "Your Number:" && num & newline & "Guessed Number:" && guess & newline & newline & "Time Elapsed:" && elapsedTime.seconds && seconds
Answer displayMessage with "Play Again" or "Quit" title "Done!"
if it is "Quit"
exit all
end if
exit repeat
else
if the counter is greater than 1
if score.bulls.qty is not lastBullQty
if score.bulls.qty is greater than lastBullQty
if digitLocation is not 4 -- move on to the next digit
add 1 to digitLocation
else
set digitLocation to 1
end if
repeat for each (key,value) in cowVals
if score.bulls.values contains key
set cowVals.(key) to "bull"
else
set cowVals.(key) to false
end if
end repeat
else
subtract 1 from character digitLocation of guess -- stay on current digit
end if
set lastBullQty to score.bulls.qty -- save bull qty
else -- score.bulls.qty = lastBullQty
set cow_guessed to false
if cowVals is not empty
repeat for each (key,value) in cowVals
if value is false
set cow_guessed to true
set cowVals.(key) to true
if digitLocation is not 1
set character digitLocation of guess to key
exit repeat
else
add 1 to character digitLocation of guess
exit repeat
end if
end if
end repeat
if cow_guessed is false
if character digitLocation of guess is greater than 9
set character digitLocation of guess to 0 -- reset the current digit
end if
add 1 to character digitLocation of guess -- increment the current digit
end if
else
add 1 to character digitLocation of guess -- increment the current digit
end if
end if
end if
end if
end repeat
repeat forever
set description to "Enter a 4 digit number" & newline & "- zero's excluded" & newline & "- each digit should be unique" & newline
Ask "Enter a Number" title "Bulls & Cows (Player)" message description
put it into num
if num is ""
Answer "" with "Play" or "Quit" title "Quit Bulls & Cows (Player)?"
if it is "Quit"
exit all
end if
end if
set startTime to now
if number of characters in num is 4
if character 1 of num is not equal to character 2 of num
if character 1 of num is not equal to character 3 of num
if character 1 of num is not equal to character 4 of num
if character 2 of num is not equal to character 3 of num
if character 2 of num is not equal to character 4 of num
if character 3 of num is not equal to character 4 of num
if num does not contain 0
exit repeat
end if
end if
end if
end if
end if
end if
end if
end if
end repeat
set guess to 1111
set lastBullQty to 0
set digitLocation to 1
set cowVals to empty
repeat forever
set score to {
bulls: {
qty: 0,
values: {}
},
cows: {
qty: 0,
values: {}
}
}
repeat the number of characters in num times
if character the counter of guess is equal to character the counter of num
add 1 to score.bulls.qty
insert character the counter of guess into score.bulls.values
else
if num contains character the counter of guess
if character the counter of guess is not equal to character the counter of num
if score.bulls.values does not contain character the counter of guess and score.cows.values does not contain character the counter of guess
add 1 to score.cows.qty
if cowVals.(character the counter of guess) is empty
set cowVals.(character the counter of guess) to false
end if
end if
end if
end if
end if
end repeat
if guess is equal to num
put now - startTime into elapsedTime
set displayMessage to "Your Number:" && num & newline & "Guessed Number:" && guess & newline & newline & "Time Elapsed:" && elapsedTime.seconds && seconds
Answer displayMessage with "Play Again" or "Quit" title "Done!"
if it is "Quit"
exit all
end if
exit repeat
else
if the counter is greater than 1
if score.bulls.qty is not lastBullQty
if score.bulls.qty is greater than lastBullQty
if digitLocation is not 4 -- move on to the next digit
add 1 to digitLocation
else
set digitLocation to 1
end if
repeat for each (key,value) in cowVals
if score.bulls.values contains key
set cowVals.(key) to "bull"
else
set cowVals.(key) to false
end if
end repeat
else
subtract 1 from character digitLocation of guess -- stay on current digit
end if
set lastBullQty to score.bulls.qty -- save bull qty
else -- score.bulls.qty = lastBullQty
set cow_guessed to false
if cowVals is not empty
repeat for each (key,value) in cowVals
if value is false
set cow_guessed to true
set cowVals.(key) to true
if digitLocation is not 1
set character digitLocation of guess to key
exit repeat
else
add 1 to character digitLocation of guess
exit repeat
end if
end if
end repeat
if cow_guessed is false
if character digitLocation of guess is greater than 9
set character digitLocation of guess to 0 -- reset the current digit
end if
add 1 to character digitLocation of guess -- increment the current digit
end if
else
add 1 to character digitLocation of guess -- increment the current digit
end if
end if
end if
end if
end repeat
end repeat

32
Task/Bulls-and-cows-Player/Tcl/bulls-and-cows-player.tcl
View file

@ -5,11 +5,11 @@ proc scorecalc {guess chosen} {
set bulls 0
set cows 0
foreach g $guess c $chosen {
if {$g eq $c} {
incr bulls
} elseif {$g in $chosen} {
incr cows
}
if {$g eq $c} {
incr bulls
} elseif {$g in $chosen} {
incr cows
}
}
return [list $bulls $cows]
}
@ -30,23 +30,23 @@ while 1 {
set ans [lindex $choices [expr {int(rand()*[llength $choices])}]]
lappend answers $ans
puts -nonewline \
"Guess [llength $answers] is [join $ans {}]. Answer (Bulls, cows)? "
"Guess [llength $answers] is [join $ans {}]. Answer (Bulls, cows)? "
set score [scan [gets stdin] %d,%d]
lappend scores $score
if {$score eq {$size 0}} {
puts "Ye-haw!"
break
puts "Ye-haw!"
break
}
foreach c $choices[set choices {}] {
if {[scorecalc $c $ans] eq $score} {
lappend choices $c
}
if {[scorecalc $c $ans] eq $score} {
lappend choices $c
}
}
if {![llength $choices]} {
puts "Bad scoring? nothing fits those scores you gave:"
foreach a $answers s $scores {
puts " [join $a {}] -> ([lindex $s 0], [lindex $s 1])"
}
break
puts "Bad scoring? nothing fits those scores you gave:"
foreach a $answers s $scores {
puts " [join $a {}] -> ([lindex $s 0], [lindex $s 1])"
}
break
}
}

10
Task/Bulls-and-cows-Player/Yabasic/bulls-and-cows-player.basic
View file

@ -14,8 +14,8 @@ print " I can however be given a score for my guesses."
for i = 1234 to 9876
if check(str$(i)) = 0 then
available$ = available$ + " " + str$(i)
k = k +1
available$ = available$ + " " + str$(i)
k = k +1
end if
next i
@ -71,7 +71,7 @@ wend
sub score$(a$, b$) // return as a csv string the number of bulls & cows.
local i, c$, bulls, cows
bulls = 0 : cows = 0
for i = 1 to 4
c$ = mid$(a$, i, 1)
@ -86,7 +86,7 @@ end sub
sub check(i$)
local t, i, j
t = 0 // zero flags available: 1 means not available
for i = 1 to 3
for j = i + 1 to 4
@ -99,7 +99,7 @@ end sub
sub word$(l$, i, d$)
local c$(1), n
n = token(l$, c$(), d$)
return c$(i)
end sub