Task: Zebra puzzle








VB: Option Base 1
Public Enum attr
    Colour = 1
    Nationality
    Beverage
    Smoke
    Pet
End Enum
Public Enum Drinks_
    Beer = 1
    Coffee
    Milk
    Tea
    Water
End Enum
Public Enum nations
    Danish = 1
    English
    German
    Norwegian
    Swedish
End Enum
Public Enum colors
    Blue = 1
    Green
    Red
    White
    Yellow
End Enum
Public Enum tobaccos
    Blend = 1
    BlueMaster
    Dunhill
    PallMall
    Prince
End Enum
Public Enum animals
    Bird = 1
    Cat
    Dog
    Horse
    Zebra
End Enum
Public permutation As New Collection
Public perm(5) As Variant
Const factorial5 = 120
Public Colours As Variant, Nationalities As Variant, Drinks As Variant, Smokes As Variant, Pets As Variant

Private Sub generate(n As Integer, A As Variant)
    If n = 1 Then
        permutation.Add A
    Else
        For i = 1 To n
            generate n - 1, A
            If n Mod 2 = 0 Then
                tmp = A(i)
                A(i) = A(n)
                A(n) = tmp
            Else
                tmp = A(1)
                A(1) = A(n)
                A(n) = tmp
            End If
        Next i
    End If
End Sub

Function house(i As Integer, name As Variant) As Integer
    Dim x As Integer
    For x = 1 To 5
        If perm(i)(x) = name Then
            house = x
            Exit For
        End If
    Next x
End Function
 
Function left_of(h1 As Integer, h2 As Integer) As Boolean
    left_of = (h1 - h2) = -1
End Function
 
Function next_to(h1 As Integer, h2 As Integer) As Boolean
    next_to = Abs(h1 - h2) = 1
End Function
 
Private Sub print_house(i As Integer)
    Debug.Print i & ": "; Colours(perm(Colour)(i)), Nationalities(perm(Nationality)(i)), _
        Drinks(perm(Beverage)(i)), Smokes(perm(Smoke)(i)), Pets(perm(Pet)(i))
End Sub
Public Sub Zebra_puzzle()
    Colours = [{"blue","green","red","white","yellow"}]
    Nationalities = [{"Dane","English","German","Norwegian","Swede"}]
    Drinks = [{"beer","coffee","milk","tea","water"}]
    Smokes = [{"Blend","Blue Master","Dunhill","Pall Mall","Prince"}]
    Pets = [{"birds","cats","dog","horse","zebra"}]
    Dim solperms As New Collection
    Dim solutions As Integer
    Dim b(5) As Integer, i As Integer
    For i = 1 To 5: b(i) = i: Next i
    
    generate 5, b
    For c = 1 To factorial5
        perm(Colour) = permutation(c)
        
        If left_of(house(Colour, Green), house(Colour, White)) Then
            For n = 1 To factorial5
                perm(Nationality) = permutation(n)
                
                
                
                If house(Nationality, Norwegian) = 1 _
                    And house(Nationality, English) = house(Colour, Red) _
                    And next_to(house(Nationality, Norwegian), house(Colour, Blue)) Then
                    For d = 1 To factorial5
                        perm(Beverage) = permutation(d)
                        
                        
                        
                        If house(Nationality, Danish) = house(Beverage, Tea) _
                            And house(Beverage, Coffee) = house(Colour, Green) _
                            And house(Beverage, Milk) = 3 Then
                            For s = 1 To factorial5
                                perm(Smoke) = permutation(s)
                                
                                
                                
                                
                                If house(Colour, Yellow) = house(Smoke, Dunhill) _
                                    And house(Nationality, German) = house(Smoke, Prince) _
                                    And house(Smoke, BlueMaster) = house(Beverage, Beer) _
                                    And next_to(house(Beverage, Water), house(Smoke, Blend)) Then
                                    For p = 1 To factorial5
                                        perm(Pet) = permutation(p)
                                        
                                        
                                        
                                        
                                        If house(Nationality, Swedish) = house(Pet, Dog) _
                                            And house(Smoke, PallMall) = house(Pet, Bird) _
                                            And next_to(house(Smoke, Blend), house(Pet, Cat)) _
                                            And next_to(house(Pet, Horse), house(Smoke, Dunhill)) Then
                                            For i = 1 To 5
                                                print_house i
                                            Next i
                                            Debug.Print
                                            solutions = solutions + 1
                                            solperms.Add perm
                                        End If
                                    Next p
                                End If
                            Next s
                        End If
                    Next d
                End If
            Next n
        End If
    Next c
    Debug.Print Format(solutions, "@"); " solution" & IIf(solutions > 1, "s", "") & " found"
    For i = 1 To solperms.Count
        For j = 1 To 5
            perm(j) = solperms(i)(j)
        Next j
        Debug.Print "The " & Nationalities(perm(Nationality)(house(Pet, Zebra))) & " owns the Zebra"
    Next i
End Sub




Ada: with Ada.Text_IO; use Ada.Text_IO;
procedure Zebra is
   type Content is (Beer, Coffee, Milk, Tea, Water,
      Danish, English, German, Norwegian, Swedish,
      Blue, Green, Red, White, Yellow,
      Blend, BlueMaster, Dunhill, PallMall, Prince,
      Bird, Cat, Dog, Horse, Zebra);
   type Test is (Drink, Person, Color, Smoke, Pet);
   type House is (One, Two, Three, Four, Five);
   type Street is array (Test'Range, House'Range) of Content;
   type Alley is access all Street;

   procedure Print (mat : Alley) is begin
      for H in House'Range loop
         Put(H'Img&": ");
         for T in Test'Range loop
            Put(T'Img&"="&mat(T,H)'Img&" ");
      end loop; New_Line; end loop;
   end Print;

   function FinalChecks (mat : Alley) return Boolean is
      function Diff (A, B : Content; CA , CB : Test) return Integer is begin
         for H1 in House'Range loop for H2 in House'Range loop
               if mat(CA,H1) = A and mat(CB,H2) = B then
                  return House'Pos(H1) - House'Pos(H2);
               end if;
         end loop; end loop;
      end Diff;
   begin
      if abs(Diff(Norwegian, Blue, Person, Color)) = 1
        and Diff(Green, White, Color, Color) = -1
        and abs(Diff(Horse, Dunhill, Pet, Smoke)) = 1
        and abs(Diff(Water, Blend, Drink, Smoke)) = 1
        and abs(Diff(Blend, Cat, Smoke, Pet)) = 1
      then return True;
      end if;
      return False;
   end FinalChecks;

   function Constrained (mat : Alley; atest : Natural) return Boolean is begin
      
      
      case Test'Val (atest) is
         when Drink => 
            if mat (Drink, Three) /= Milk then return False; end if;
            return True;
         when Person => 
            for H in House'Range loop
               if (mat(Person,H) = Norwegian and H /= One)
               or (mat(Person,H) = Danish and mat(Drink,H) /= Tea)
               then return False; end if;
            end loop;
            return True;
         when Color => 
            for H in House'Range loop
               if (mat(Person,H) = English and mat(Color,H) /= Red)
               or (mat(Drink,H) = Coffee and mat(Color,H) /= Green)
               then return False; end if;
            end loop;
            return True;
         when Smoke => 
            for H in House'Range loop
               if (mat(Color,H) = Yellow and mat(Smoke,H) /= Dunhill)
               or (mat(Smoke,H) = BlueMaster and mat(Drink,H) /= Beer)
               or (mat(Person,H) = German and mat(Smoke,H) /= Prince)
               then return False; end if;
            end loop;
            return True;
         when Pet => 
            for H in House'Range loop
               if (mat(Person,H) = Swedish and mat(Pet,H) /= Dog)
               or (mat(Smoke,H) = PallMall and mat(Pet,H) /= Bird)
               then return False; end if;
            end loop;
            return FinalChecks(mat); 
      end case;
   end Constrained;

   procedure Solve (mat : Alley; t, n : Natural) is
      procedure Swap (I, J : Natural) is
         temp : constant Content := mat (Test'Val (t), House'Val (J));
      begin
         mat (Test'Val (t), House'Val (J)) := mat (Test'Val (t), House'Val (I));
         mat (Test'Val (t), House'Val (I)) := temp;
      end Swap;
   begin
      if n = 1 and Constrained (mat, t) then 
         if t < 4 then Solve (mat, t + 1, 5); 
         else Print (mat); return; 
         end if;
      end if;
      for i in 0 .. n - 1 loop 
         Solve (mat, t, n - 1);
         if n mod 2 = 1 then Swap (0, n - 1);
         else Swap (i, n - 1); end if;
      end loop;
   end Solve;

   myStreet : aliased Street;
   myAlley : constant Alley := myStreet'Access;
begin
   for i in Test'Range loop for j in House'Range loop 
      myStreet (i,j) := Content'Val(Test'Pos(i)*5 + House'Pos(j));
   end loop; end loop;
   Solve (myAlley, 0, 5); 
end Zebra;