Task: Bulls and cows_Player








VB: Option Explicit
 
Sub Main_Bulls_And_Cows_Player()
Dim collSoluces As New Collection, Elem As Variant, Soluce As String
Dim strNumber As String, cpt As Byte, p As Byte
Dim i As Byte, Bulls() As Boolean, NbBulls As Byte, Cows As Byte, Poss As Long
Const NUMBER_OF_DIGITS As Byte = 4
        
        strNumber = CreateNb(NUMBER_OF_DIGITS)
        Debug.Print "TOSS : " & StrConv(strNumber, vbUnicode)
        Debug.Print "---------- START ------------"
        Set collSoluces = CollOfPossibleNumbers
        Poss = collSoluces.Count
        For Each Elem In collSoluces
            
            Debug.Print "Attempt : " & StrConv(Elem, vbUnicode)
            NbBulls = 0: Soluce = Elem
            ReDim Bulls(NUMBER_OF_DIGITS - 1)
            For i = 1 To NUMBER_OF_DIGITS
                If IsBull(strNumber, Mid(Elem, i, 1), i) Then
                    Bulls(i - 1) = True: NbBulls = NbBulls + 1
                    RemoveIfNotBull collSoluces, Mid(Elem, i, 1), i
                End If
            Next i
            Cows = 0
            For i = 1 To NUMBER_OF_DIGITS
                If Not Bulls(i - 1) Then
                    If IsCow(collSoluces, strNumber, Mid(Elem, i, 1), p) Then
                        If Not Bulls(p - 1) Then Cows = Cows + 1
                    End If
                End If
            Next i
            Poss = collSoluces.Count
            Debug.Print "Bulls : " & NbBulls & ", Cows : " & Cows
            If Poss = 1 Then Exit For
        Next
                Debug.Print "---------- THE END ------------"
        Debug.Print "TOSS WAS : " & StrConv(strNumber, vbUnicode) & " We found : " & StrConv(Soluce, vbUnicode)
End Sub
 
Function CreateNb(NbDigits As Byte) As String
Dim myColl As New Collection
Dim strTemp As String
Dim bytAlea As Byte
 
    Randomize
    Do
        bytAlea = Int((Rnd * 9) + 1)
        On Error Resume Next
        myColl.Add CStr(bytAlea), CStr(bytAlea)
        If Err <> 0 Then
            On Error GoTo 0
        Else
            strTemp = strTemp & CStr(bytAlea)
        End If
    Loop While Len(strTemp) < NbDigits
    CreateNb = strTemp
End Function
 
Function CollOfPossibleNumbers() As Collection
Dim TempColl As New Collection
Dim x As String
Dim i As Long
Dim Flag As Boolean
Dim b As Byte
 
    For i = 1234 To 9876
        Flag = False
        For b = 1 To 4
            x = CStr(i)
            If Len(Replace(x, Mid(x, b, 1), "")) < 3 Then
                Flag = True: Exit For
            End If
        Next
        If Not Flag Then TempColl.Add x, x
    Next i
    Set CollOfPossibleNumbers = TempColl
End Function
 
Function IsBull(strgNb As String, Digit As String, place As Byte) As Boolean
    IsBull = (Mid(strgNb, place, 1) = Digit)
End Function

Function IsCow(C As Collection, strgNb As String, Digit As String, place As Byte) As Boolean
    If (InStr(strgNb, Digit) > 0) Then
        IsCow = True: place = InStr(strgNb, Digit)
        RemoveIfNotCow C, Digit
    End If
End Function
 
Sub RemoveIfNotBull(C As Collection, Digit As String, place As Byte)
Dim E As Variant
 
    For Each E In C
        If Mid(E, place, 1) <> Digit Then C.Remove E
    Next
End Sub
 
Sub RemoveIfNotCow(C As Collection, Digit As String)
Dim E As Variant
 
    For Each E In C
        If (InStr(E, Digit) = 0) Then C.Remove E
    Next
End Sub




Ada: with Ada.Text_IO;
with Ada.Containers.Vectors;
with Ada.Numerics.Discrete_Random;

procedure Bulls_Player is

   
   package Nat_IO is new Ada.Text_IO.Integer_IO (Natural);

   
   use type Ada.Containers.Count_Type;

   
   Guessing_Length : constant := 4;

   
   type Digit is range 1 .. 9;
   
   type Sequence is array (1 .. Guessing_Length) of Digit;

   
   package Sequence_Vectors is new Ada.Containers.Vectors
     (Element_Type => Sequence,
      Index_Type   => Positive);

   
   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;

   
   procedure Fill_Pool (Pool : in out Sequence_Vectors.Vector) is
      Finished : exception;
      
      function Next (S : Sequence) return Sequence is
         Result : Sequence := S;
         Index  : Positive := S'Last;
      begin
         loop
         
            if Result (Index) = Digit'Last then
               Result (Index) := Digit'First;
               
               
               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
      
         if Is_Valid (X) then
            Pool.Append (X);
         end if;
         X := Next (X);
      end loop;
   exception
      when Finished =>
         
         
         null;
   end Fill_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;

   
   procedure Get_Answer (S : Sequence; Bulls, Cows : out Natural) is
      Valid : Boolean := False;
   begin
      Bulls := 0;
      Cows  := 0;
      while not Valid loop
         
         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;

   
   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;
         Cows_Score : Natural := 0;
      begin
         for I in Testant'Range loop
            for J in S'Range loop
               if Testant (I) = S (J) then
                  
                  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;

   
   procedure Solve is
      All_Sequences : Sequence_Vectors.Vector;
      Test_Index    : Positive;
      Test_Sequence : Sequence;
      Bulls, Cows   : Natural;
   begin
      
      Fill_Pool (All_Sequences);
      loop
      
         Test_Index    := Random_Index (All_Sequences);
         Test_Sequence := All_Sequences.Element (Test_Index);
         
         Get_Answer (Test_Sequence, Bulls, Cows);
         
         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
         
         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
   
   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;
end Bulls_Player;