Task: Bulls and cows








VB: Option Explicit

Sub Main_Bulls_and_cows()
Dim strNumber As String, strInput As String, strMsg As String, strTemp As String
Dim boolEnd As Boolean
Dim lngCpt As Long
Dim i As Byte, bytCow As Byte, bytBull As Byte
Const NUMBER_OF_DIGITS As Byte = 4
Const MAX_LOOPS As Byte = 25 

    strNumber = Create_Number(NUMBER_OF_DIGITS)
    Do
        bytBull = 0: bytCow = 0: lngCpt = lngCpt + 1
        If lngCpt > MAX_LOOPS Then strMsg = "Max of loops... Sorry you loose!": Exit Do
        strInput = AskToUser(NUMBER_OF_DIGITS)
        If strInput = "Exit Game" Then strMsg = "User abort": Exit Do
        For i = 1 To Len(strNumber)
            If Mid(strNumber, i, 1) = Mid(strInput, i, 1) Then
                bytBull = bytBull + 1
            ElseIf InStr(strNumber, Mid(strInput, i, 1)) > 0 Then
                bytCow = bytCow + 1
            End If
        Next i
        If bytBull = Len(strNumber) Then
            boolEnd = True: strMsg = "You win in " & lngCpt & " loops!"
        Else
            strTemp = strTemp & vbCrLf & "With : " & strInput & " ,you have : " & bytBull & " bulls," & bytCow & " cows."
            MsgBox strTemp
        End If
    Loop While Not boolEnd
    MsgBox strMsg
End Sub

Function Create_Number(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
    Create_Number = strTemp
End Function

Function AskToUser(NbDigits As Byte) As String
Dim boolGood As Boolean, strIn As String, i As Byte, NbDiff As Byte

    Do While Not boolGood
        strIn = InputBox("Enter your number (" & NbDigits & " digits)", "Number")
        If StrPtr(strIn) = 0 Then strIn = "Exit Game": Exit Do
        If strIn <> "" Then
            If Len(strIn) = NbDigits Then
                NbDiff = 0
                For i = 1 To Len(strIn)
                    If Len(Replace(strIn, Mid(strIn, i, 1), "")) < NbDigits - 1 Then
                        NbDiff = 1
                        Exit For
                    End If
                Next i
                If NbDiff = 0 Then boolGood = True
            End If
        End If
    Loop
    AskToUser = strIn
End Function




Ada: with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;

procedure Bulls_And_Cows is
   package Random_Natural is new Ada.Numerics.Discrete_Random (Natural);
   Number : String (1..4);
begin
   declare 
      use Random_Natural;
      Digit    : String   := "123456789";
      Size     : Positive := 9;
      Dice     : Generator;
      Position : Natural;
   begin
      Reset (Dice);
      for I in Number'Range loop
         Position := Random (Dice) mod Size + 1;
         Number (I) := Digit (Position);
         Digit (Position..Size - 1) := Digit (Position + 1..Size);
         Size := Size - 1;
      end loop;
   end;
   loop 
      Put ("Enter four digits:");
      declare
         Guess : String  := Get_Line;
         Bulls : Natural := 0;
         Cows  : Natural := 0;
      begin
         if Guess'Length /= 4 then
            raise Data_Error;
         end if;
         for I in Guess'Range loop
            for J in Number'Range loop                  
               if Guess (I) not in '1'..'9' or else (I < J and then Guess (I) = Guess (J)) then
                  raise Data_Error;
               end if;
               if Number (I) = Guess (J) then
                  if I = J then
                     Bulls := Bulls + 1;
                  else
                     Cows := Cows + 1;
                  end if;
               end if;
            end loop;
         end loop;
         exit when Bulls = 4;
         Put_Line (Integer'Image (Bulls) & " bulls," & Integer'Image (Cows) & " cows");
      exception
         when Data_Error => Put_Line ("You should enter four different digits 1..9");
      end;
   end loop;
end Bulls_And_Cows;