Data update
This commit is contained in:
Ingy döt Net
parent
4bb20c9b71
commit
cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
106
Task/Zebra-puzzle/Ada/zebra-puzzle.adb
Normal file
106
Task/Zebra-puzzle/Ada/zebra-puzzle.adb
Normal file
|
|
@ -0,0 +1,106 @@
|
|||
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
|
||||
-- Tests seperated into levels for speed, not strictly necessary
|
||||
-- As such, the program finishes in around ~0.02s
|
||||
case Test'Val (atest) is
|
||||
when Drink => -- Drink
|
||||
if mat (Drink, Three) /= Milk then return False; end if;
|
||||
return True;
|
||||
when Person => -- Drink+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 => -- Drink+People+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 => -- Drink+People+Color+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 => -- Drink+People+Color+Smoke+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); -- Do the next-to checks
|
||||
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 -- test t passed
|
||||
if t < 4 then Solve (mat, t + 1, 5); -- Onto next test
|
||||
else Print (mat); return; -- Passed and t=4 means a solution
|
||||
end if;
|
||||
end if;
|
||||
for i in 0 .. n - 1 loop -- The permutations part
|
||||
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 -- Init Matrix
|
||||
myStreet (i,j) := Content'Val(Test'Pos(i)*5 + House'Pos(j));
|
||||
end loop; end loop;
|
||||
Solve (myAlley, 0, 5); -- start at test 0 with 5 options
|
||||
end Zebra;
|
||||
290
Task/Zebra-puzzle/Fortran/zebra-puzzle.f
Normal file
290
Task/Zebra-puzzle/Fortran/zebra-puzzle.f
Normal file
|
|
@ -0,0 +1,290 @@
|
|||
program zebra_clean
|
||||
implicit none
|
||||
|
||||
integer, parameter :: RED=1, GREEN=2, WHITE=3, BLUE=4, YELLOW=5
|
||||
integer, parameter :: ENGLISH=1, SWEDE=2, DANE=3, NORWEGIAN=4, GERMAN=5
|
||||
integer, parameter :: DOG=1, CAT=2, BIRD=3, HORSE=4, ZEBRA=5
|
||||
integer, parameter :: TEA=1, COFFEE=2, MILK=3, BEER=4, WATER=5
|
||||
integer, parameter :: PALLMALL=1, DUNHILL=2, BLEND=3, BLUEMASTER=4, PRINCE=5
|
||||
|
||||
integer :: solution(5,5) ! (house, attribute): color, nation, pet, drink, smoke
|
||||
integer(kind=8) :: count
|
||||
integer :: num_solutions
|
||||
|
||||
count = 0
|
||||
num_solutions = 0
|
||||
|
||||
print *, "Solving Einstein's Zebra Puzzle..."
|
||||
print *
|
||||
|
||||
call solve(1, 1, solution, count, num_solutions)
|
||||
|
||||
print *
|
||||
print '(A,I0)', "Total permutations tried: ", count
|
||||
print '(A,I0)', "Solutions found: ", num_solutions
|
||||
if (num_solutions == 1) print *, "Solution is UNIQUE!"
|
||||
|
||||
contains
|
||||
|
||||
recursive subroutine solve(house, attr, sol, cnt, nsol)
|
||||
integer, intent(in) :: house, attr
|
||||
integer, intent(inout) :: sol(5,5)
|
||||
integer(kind=8), intent(inout) :: cnt
|
||||
integer, intent(inout) :: nsol
|
||||
integer :: val
|
||||
|
||||
! If all houses and attributes filled, check solution
|
||||
if (house > 5) then
|
||||
cnt = cnt + 1
|
||||
if (is_valid_solution(sol)) then
|
||||
nsol = nsol + 1
|
||||
call print_sol(sol, nsol)
|
||||
end if
|
||||
return
|
||||
end if
|
||||
|
||||
! Move to next position
|
||||
if (attr > 5) then
|
||||
call solve(house+1, 1, sol, cnt, nsol)
|
||||
return
|
||||
end if
|
||||
|
||||
! Try each possible value for this attribute
|
||||
do val = 1, 5
|
||||
if (can_place(sol, house, attr, val)) then
|
||||
sol(house, attr) = val
|
||||
if (satisfies_constraints(sol, house, attr)) then
|
||||
call solve(house, attr+1, sol, cnt, nsol)
|
||||
end if
|
||||
sol(house, attr) = 0
|
||||
end if
|
||||
end do
|
||||
end subroutine
|
||||
|
||||
function can_place(sol, house, attr, val) result(ok)
|
||||
integer, intent(in) :: sol(5,5), house, attr, val
|
||||
logical :: ok
|
||||
integer :: h
|
||||
|
||||
! Check if value already used in this attribute
|
||||
ok = .true.
|
||||
do h = 1, house-1
|
||||
if (sol(h, attr) == val) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
end do
|
||||
|
||||
! Handle fixed constraints
|
||||
! Constraint 9: Middle house drinks milk
|
||||
if (attr == 4 .and. house == 3 .and. val /= MILK) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
if (attr == 4 .and. house /= 3 .and. val == MILK) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 10: Norwegian in first house
|
||||
if (attr == 2 .and. house == 1 .and. val /= NORWEGIAN) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
if (attr == 2 .and. house /= 1 .and. val == NORWEGIAN) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
end function
|
||||
|
||||
function satisfies_constraints(sol, house, attr) result(ok)
|
||||
integer, intent(in) :: sol(5,5), house, attr
|
||||
logical :: ok
|
||||
integer :: i
|
||||
|
||||
ok = .true.
|
||||
|
||||
! Only check constraints for completed houses
|
||||
do i = 1, house
|
||||
if (any(sol(i,:) == 0)) cycle ! House not complete
|
||||
|
||||
! Constraint 2: English in red
|
||||
if ((sol(i,2) == ENGLISH .and. sol(i,1) /= RED) .or. &
|
||||
(sol(i,1) == RED .and. sol(i,2) /= ENGLISH)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 3: Swede has dog
|
||||
if ((sol(i,2) == SWEDE .and. sol(i,3) /= DOG) .or. &
|
||||
(sol(i,3) == DOG .and. sol(i,2) /= SWEDE)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 4: Dane drinks tea
|
||||
if ((sol(i,2) == DANE .and. sol(i,4) /= TEA) .or. &
|
||||
(sol(i,4) == TEA .and. sol(i,2) /= DANE)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 6: Coffee in green
|
||||
if ((sol(i,1) == GREEN .and. sol(i,4) /= COFFEE) .or. &
|
||||
(sol(i,4) == COFFEE .and. sol(i,1) /= GREEN)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 7: Pall Mall has bird
|
||||
if ((sol(i,5) == PALLMALL .and. sol(i,3) /= BIRD) .or. &
|
||||
(sol(i,3) == BIRD .and. sol(i,5) /= PALLMALL)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 8: Yellow smokes Dunhill
|
||||
if ((sol(i,1) == YELLOW .and. sol(i,5) /= DUNHILL) .or. &
|
||||
(sol(i,5) == DUNHILL .and. sol(i,1) /= YELLOW)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 13: Blue Master drinks beer
|
||||
if ((sol(i,5) == BLUEMASTER .and. sol(i,4) /= BEER) .or. &
|
||||
(sol(i,4) == BEER .and. sol(i,5) /= BLUEMASTER)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 14: German smokes Prince
|
||||
if ((sol(i,2) == GERMAN .and. sol(i,5) /= PRINCE) .or. &
|
||||
(sol(i,5) == PRINCE .and. sol(i,2) /= GERMAN)) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
|
||||
! Constraint 5: Green immediately left of white
|
||||
if (i < 5) then
|
||||
if (sol(i,1) == GREEN .and. sol(i+1,1) /= 0 .and. sol(i+1,1) /= WHITE) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
end if
|
||||
if (i > 1) then
|
||||
if (sol(i,1) == WHITE .and. sol(i-1,1) /= GREEN) then
|
||||
ok = .false.
|
||||
return
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
end function
|
||||
|
||||
function is_valid_solution(sol) result(valid)
|
||||
integer, intent(in) :: sol(5,5)
|
||||
logical :: valid
|
||||
|
||||
valid = .false.
|
||||
|
||||
! Check all constraints on complete solution
|
||||
if (.not. check_pair(sol, 2, ENGLISH, 1, RED)) return
|
||||
if (.not. check_pair(sol, 2, SWEDE, 3, DOG)) return
|
||||
if (.not. check_pair(sol, 2, DANE, 4, TEA)) return
|
||||
if (.not. check_adjacent_left(sol, 1, GREEN, 1, WHITE)) return
|
||||
if (.not. check_pair(sol, 1, GREEN, 4, COFFEE)) return
|
||||
if (.not. check_pair(sol, 5, PALLMALL, 3, BIRD)) return
|
||||
if (.not. check_pair(sol, 1, YELLOW, 5, DUNHILL)) return
|
||||
if (sol(3,4) /= MILK) return
|
||||
if (sol(1,2) /= NORWEGIAN) return
|
||||
if (.not. check_adjacent(sol, 5, BLEND, 3, CAT)) return
|
||||
if (.not. check_adjacent(sol, 3, HORSE, 5, DUNHILL)) return
|
||||
if (.not. check_pair(sol, 5, BLUEMASTER, 4, BEER)) return
|
||||
if (.not. check_pair(sol, 2, GERMAN, 5, PRINCE)) return
|
||||
if (.not. check_adjacent(sol, 2, NORWEGIAN, 1, BLUE)) return
|
||||
if (.not. check_adjacent(sol, 4, WATER, 5, BLEND)) return
|
||||
|
||||
valid = .true.
|
||||
end function
|
||||
|
||||
function check_pair(sol, attr1, val1, attr2, val2) result(ok)
|
||||
integer, intent(in) :: sol(5,5), attr1, val1, attr2, val2
|
||||
logical :: ok
|
||||
integer :: i
|
||||
ok = .false.
|
||||
do i = 1, 5
|
||||
if (sol(i, attr1) == val1 .and. sol(i, attr2) == val2) then
|
||||
ok = .true.
|
||||
return
|
||||
end if
|
||||
end do
|
||||
end function
|
||||
|
||||
function check_adjacent_left(sol, attr1, val1, attr2, val2) result(ok)
|
||||
integer, intent(in) :: sol(5,5), attr1, val1, attr2, val2
|
||||
logical :: ok
|
||||
integer :: i
|
||||
ok = .false.
|
||||
do i = 1, 4
|
||||
if (sol(i, attr1) == val1 .and. sol(i+1, attr2) == val2) then
|
||||
ok = .true.
|
||||
return
|
||||
end if
|
||||
end do
|
||||
end function
|
||||
|
||||
function check_adjacent(sol, attr1, val1, attr2, val2) result(ok)
|
||||
integer, intent(in) :: sol(5,5), attr1, val1, attr2, val2
|
||||
logical :: ok
|
||||
integer :: i, pos1, pos2
|
||||
pos1 = 0
|
||||
pos2 = 0
|
||||
do i = 1, 5
|
||||
if (sol(i, attr1) == val1) pos1 = i
|
||||
if (sol(i, attr2) == val2) pos2 = i
|
||||
end do
|
||||
ok = (abs(pos1 - pos2) == 1)
|
||||
end function
|
||||
|
||||
subroutine print_sol(sol, num)
|
||||
integer, intent(in) :: sol(5,5), num
|
||||
integer :: i, zebra_house
|
||||
|
||||
character(len=12) :: colors(5), nations(5), pets(5), drinks(5), smokes(5)
|
||||
|
||||
colors = ['Red ', 'Green ', 'White ', 'Blue ', 'Yellow ']
|
||||
nations = ['English ', 'Swede ', 'Dane ', 'Norwegian ', 'German ']
|
||||
pets = ['Dog ', 'Cat ', 'Bird ', 'Horse ', 'Zebra ']
|
||||
drinks = ['Tea ', 'Coffee ', 'Milk ', 'Beer ', 'Water ']
|
||||
smokes = ['Pall Mall ', 'Dunhill ', 'Blend ', 'Blue Master ', 'Prince ']
|
||||
|
||||
print *, "================================"
|
||||
print '(A,I0)', "Solution #", num
|
||||
print *, "================================"
|
||||
print *
|
||||
print *, "House | Color | Nation | Pet | Drink | Smoke"
|
||||
print *, "------+-------------+-------------+-------------+-------------+-------------"
|
||||
100 format(I0,T7,A,T12,A,T21,A,T24,A,T35,A,T38,A,T49,A,T52,A,T63,A,T66,A)
|
||||
do i = 1, 5
|
||||
print 100, i, ' | ', &
|
||||
trim(adjustl(colors(sol(i,1)))), ' | ', &
|
||||
trim(nations(sol(i,2))), ' | ', &
|
||||
trim(pets(sol(i,3))), ' | ', &
|
||||
trim(drinks(sol(i,4))), ' | ', &
|
||||
trim(smokes(sol(i,5)))
|
||||
end do
|
||||
|
||||
print *
|
||||
|
||||
zebra_house = 0
|
||||
do i = 1, 5
|
||||
if (sol(i,3) == ZEBRA) then
|
||||
zebra_house = i
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
|
||||
print *, "*** THE ZEBRA IS OWNED BY THE ", trim(nations(sol(zebra_house,2))), " ***"
|
||||
print *
|
||||
end subroutine
|
||||
|
||||
end program zebra_clean
|
||||
|
|
@ -1,32 +1,33 @@
|
|||
Perms ← ☇1⍉∧(≡↻⇡⟜↯+1⟜⊂):¤¤°⊂⇡
|
||||
Ps ← ≡⊏⊙¤Perms ⧻.
|
||||
Perms ← ⧅≠⊸⧻
|
||||
Perms "BGRWY" # row = 0
|
||||
▽⊸(=-1⊃(˜⨂@W|˜⨂@G)) # W right of G
|
||||
|
||||
Ps "BGRWY" # Col = 0
|
||||
▽⊸(=-1⊃(⊗@W|⊗@G)) # W right of G
|
||||
/⊂˜⊞⊟ Perms "DEGNS" # Nation = row 1
|
||||
▽⊸≡(=@N⊡1_0) # Norwegian in pos 0
|
||||
Find‼‼ ← ⊃(˜⨂^3⊡^2|˜⨂^1⊡^0)
|
||||
▽⊸≡(=Find‼‼0 @R 1 @E) # Ix(Red) == Ix(English)
|
||||
▽⊸≡(=1⌵-Find‼‼0 @B 1 @N) # Blue next to Norwegian
|
||||
|
||||
/⊂⊞⊟ :Ps "DEGNS" # Nation = 1
|
||||
▽⊸≡(=@N⊡0⊡1) # Norwegian in pos 0
|
||||
▽⊸≡(=⊃(⊗@E⊡1|⊗@R⊡0)) # Red == English
|
||||
▽⊸≡(=1⌵-⊃(⊗@N⊡1|⊗@B⊡0)) # Blue next to Norwegian
|
||||
/⊂˜⊞⊂ Perms "BCDHZ" # Pets = row 2
|
||||
▽⊸≡(=Find‼‼1 @S 2 @D) # Swede owns dog
|
||||
|
||||
/⊂⊞⊂ :Ps"BCDHZ" # Pets = 2
|
||||
▽⊸≡(=⊃(⊗@D⊡2|⊗@S⊡1)) # Swede owns dog
|
||||
/⊂˜⊞⊂ Perms "BCMTW" # Drinks = row 3
|
||||
▽⊸≡(=@M⊡3_2) # Milk in pos 2
|
||||
▽⊸≡(=Find‼‼1 @D 3 @T) # Dane drinks tea
|
||||
▽⊸≡(=Find‼‼0 @G 3 @C) # Green = Coffee
|
||||
|
||||
/⊂⊞⊂ :Ps"BCMTW" # Drinks = 3
|
||||
▽⊸≡(=@M⊡2⊡3) # Milk in pos 2
|
||||
▽⊸≡(=⊃(⊗@T⊡3|⊗@D⊡1)) # Dane drinks tea
|
||||
▽⊸≡(=⊃(⊗@C⊡3|⊗@G⊡0)) # Green = Coffee
|
||||
/⊂˜⊞⊂ Perms"BbDpP" # Cigs = row 4
|
||||
▽⊸≡(=Find‼‼2 @B 4 @p) # PallMall = Birds
|
||||
▽⊸≡(=Find‼‼0 @Y 4 @D) # Dunhill = Yellow
|
||||
▽⊸≡(=Find‼‼3 @B 4 @b) # BlueM = Beer
|
||||
▽⊸≡(=Find‼‼1 @G 4 @P) # Prince = German
|
||||
▽⊸≡(=1⌵-Find‼‼2 @C 4 @B) # Cat next to Blend
|
||||
▽⊸≡(=1⌵-Find‼‼2 @H 4 @D) # Horse next to Dunhill
|
||||
▽⊸≡(=1⌵-Find‼‼3 @W 4 @B) # Water next to Blend
|
||||
|
||||
/⊂⊞⊂ :Ps"BbDpP" # Cigs = 4
|
||||
▽⊸≡(=⊃(⊗@p⊡4|⊗@B⊡2)) # PallMall = Birds
|
||||
▽⊸≡(=⊃(⊗@D⊡4|⊗@Y⊡0)) # Dunhill = Yellow
|
||||
▽⊸≡(=⊃(⊗@b⊡4|⊗@B⊡3)) # BlueM = Beer
|
||||
▽⊸≡(=⊃(⊗@P⊡4|⊗@G⊡1)) # Prince = German
|
||||
▽⊸≡(=1⌵-⊃(⊗@B⊡4|⊗@C⊡2)) # Cat next to Blend
|
||||
▽⊸≡(=1⌵-⊃(⊗@D⊡4|⊗@H⊡2)) # Horse next to Dunhill
|
||||
▽⊸≡(=1⌵-⊃(⊗@B⊡4|⊗@W⊡3)) # Water next to Blend
|
||||
&p $"Solutions found: _" ⧻.
|
||||
&p$"_ owns the Z"⊡:⊡1,⊗@Z⊡2.⊢
|
||||
&p"One line per house: "
|
||||
&p"Col\tNat\tPet\tDrink\tCig"
|
||||
≡(&p/(⊂⊂)"\t")⍉
|
||||
&p $"Solutions found: _" ⊸⧻
|
||||
&p $"_ owns the Z"⊡⊂1˜⨂@Z⊸⊡2⊸⊢
|
||||
&p "One line per house: "
|
||||
&p "Colour\tNation\tPet\tDrink\tCiggies"
|
||||
|
||||
≡(&p/$"_\t_")⍉⊢
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue