Re: Need a Challenge?
Irv Mullins wrote:
> I found this puzzle in an example program
> for a language I downloaded. Can you write
> a program (100 lines or less, plz) to solve it?
I've included two versions. The first uses some pruning, so it doesn't take
forever. It's about 125 lines of code. The second works in theory - I
haven't had the patience to run it all the way through. But it's 100 lines
long. 
Basically, it's a brute force approach. 'calc_permutes' pre-calculates all
the combinations of {1..5}. 'main' loops through the entire search space,
looking for a match. 'test' checks to see if a particular combination
matches the criteria. If it does, the program halts. There are some pruning
tests to reduce the search space, so the redundant tests in test() are
commented out. Otherwise, it would be a *long* time to arrive at the answer.
as it is, it takes my P200 about 18 seconds to find the solution. The code
could be a lot more efficient, but it would take more lines, and I think
it's *sort* of explanatory, even without comments.
The answer is:
english red snail sculptor milk third
spanish white dog violinist juice fifth
japanese green zebra painter coffee fourth
italian blue horse doctor tea second
norwegian yellow fox diplomat water first
If you *really* want to speed it up, just change the constants to match the
solution. 
-- David Cuny
-- Version 1
sequence color, job, pet, drink, house, permutes, list
constant
colors = { "red", "green", "yellow", "white", "blue" },
nations = { "english", "spanish", "japanese", "italian", "norwegian" },
jobs = { "painter", "sculptor", "diplomat", "violinist", "doctor" },
pets = { "dog", "snail", "fox", "horse", "zebra" },
drinks = { "tea", "coffee", "milk", "juice", "water" },
houses = { "first", "second", "third", "fourth", "fifth" },
country = { 1, 2, 3, 4, 5 },
Red = 1, Green = 2, Yellow = 3, White = 4, Blue = 5,
English = 1, Spaniard = 2, Japanese = 3, Italian = 4, Norwegian = 5,
Painter = 1, Sculptor = 2, Diplomat = 3, Violinist = 4, Doctor = 5,
Dog = 1, Snail = 2, Fox = 3, Horse = 4, Zebra = 5,
Tea = 1, Coffee = 2, Milk = 3, Juice = 4, Water = 5
procedure calc_permutes( integer i, integer j )
if j = 0 then
-- initialize
permutes = {}
list = repeat( 0, i )
calc_permutes( i, j+1 )
elsif j > i then
permutes = append( permutes, list )
return
else
for k = 1 to i do
if list[k] = 0 then
list[k] = j
calc_permutes( i, j+1 )
list[k] = 0
end if
end for
end if
end procedure
function both( sequence s1, integer i1, sequence s2, integer i2 )
integer at
at = find( i1, s1 )
if at then
return s2[at] = i2
else
return 0
end if
end function
function nextTo( sequence s1, integer i1, sequence s2, integer i2 )
integer at1, at2
at1 = find( i1, s1 )
at2 = find( i2, s2 )
if at1 and at2 then
return ( house[at1] = house[at2]-1 or house[at1] = house[at2]+1 )
else
return 0
end if
end function
function onRight( sequence s1, integer i1, sequence s2, integer i2 )
integer at1, at2
at1 = find( i1, s1 )
at2 = find( i2, s2 )
return ( house[at1] = house[at2]-1 )
end function
procedure test()
if 1
-- and both( country, English, color, Red )
-- and both( country, Spaniard, pet, Dog )
-- and both( country, Japanese, job, Painter )
-- and both( country, Italian, drink, Tea )
-- and both( country, Norwegian, house, 1 )
and both( color, Green, drink, Coffee )
and onRight( color, Green, color, White )
and both( job, Sculptor, pet, Snail )
and both( job, Diplomat, color, Yellow )
and both( drink, Milk, house, 3 )
and nextTo( country, Norwegian, color, Blue )
and both( job, Violinist, drink, Juice )
and nextTo( pet, Fox, job, Doctor )
and nextTo( pet, Horse, job, Diplomat )
then
for i = 1 to 5 do
puts( 1, nations[i] & " " & colors[color[i]] & " " &
pets[pet[i]] & " " & jobs[job[i]] & " " &
drinks[drink[i]] & " " & houses[house[i]] & "\n" )
end for
abort(0)
end if
end procedure
procedure main()
calc_permutes( 5, 0 )
for colors = 1 to length( permutes ) do
color = permutes[colors]
if color[English] = Red then
for pets = 1 to length( permutes ) do
pet = permutes[pets]
if pet[Spaniard] = Dog then
for jobs = 1 to length( permutes ) do
job = permutes[jobs]
if job[Japanese] = Painter then
for drinks = 1 to length( permutes ) do
drink = permutes[drinks]
if drink[Italian] = Tea then
for houses = 1 to length( permutes ) do
house = permutes[houses]
if house[Norwegian] = 1 then
test()
end if
end for
end if
end for
end if
end for
end if
end for
end if
end for
end procedure
main()
-- Version 2: *very* slow
sequence color, job, pet, drink, house, permutes, list, matrix
constant
colors = { "red", "green", "yellow", "white", "blue" },
nations = { "english", "spanish", "japanese", "italian", "norwegian" },
jobs = { "painter", "sculptor", "diplomat", "violinist", "doctor" },
pets = { "dog", "snail", "fox", "horse", "zebra" },
drinks = { "tea", "coffee", "milk", "juice", "water" },
houses = { "first", "second", "third", "fourth", "fifth" },
country = { 1, 2, 3, 4, 5 },
Color = 1, Job = 2, Pet = 3, Drink = 4, House = 5,
Red = 1, Green = 2, Yellow = 3, White = 4, Blue = 5,
English = 1, Spaniard = 2, Japanese = 3, Italian = 4, Norwegian = 5,
Painter = 1, Sculptor = 2, Diplomat = 3, Violinist = 4, Doctor = 5,
Dog = 1, Snail = 2, Fox = 3, Horse = 4, Zebra = 5,
Tea = 1, Coffee = 2, Milk = 3, Juice = 4, Water = 5
procedure calc_permutes( integer i, integer j )
if j > i then
permutes = append( permutes, list )
return
else
for k = 1 to i do
if list[k] = 0 then
list[k] = j
calc_permutes( i, j+1 )
list[k] = 0
end if
end for
end if
end procedure
function both( sequence s1, integer i1, sequence s2, integer i2 )
integer at
at = find( i1, s1 )
if at then
return s2[at] = i2
end if
return 0
end function
function nextTo( sequence s1, integer i1, sequence s2, integer i2 )
integer at1, at2
at1 = find( i1, s1 )
at2 = find( i2, s2 )
if at1 and at2 then
return ( house[at1] = house[at2]-1 or house[at1] = house[at2]+1 )
end if
return 0
end function
function onRight( sequence s1, integer i1, sequence s2, integer i2 )
integer at1, at2
at1 = find( i1, s1 )
at2 = find( i2, s2 )
return ( house[at1] = house[at2]-1 )
end function
procedure test()
if both( country, English, matrix[Color], Red )
and both( country, Spaniard, matrix[Pet], Dog )
and both( country, Japanese, matrix[Job], Painter )
and both( country, Italian, matrix[Drink], Tea )
and both( country, Norwegian, matrix[House], 1 )
and both( matrix[Color], Green, matrix[Drink], Coffee )
and onRight( matrix[Color], Green, matrix[Color], White )
and both( matrix[Job], Sculptor, matrix[Pet], Snail )
and both( matrix[Job], Diplomat, matrix[Color], Yellow )
and both( matrix[Drink], Milk, matrix[House], 3 )
and nextTo( country, Norwegian, matrix[Color], Blue )
and both( matrix[Job], Violinist, matrix[Drink], Juice )
and nextTo( matrix[Pet], Fox, matrix[Job], Doctor )
and nextTo( matrix[Pet], Horse, matrix[Job], Diplomat )
then
for i = 1 to 5 do
puts( 1, nations[i] & " " & colors[matrix[Color][i]] & " " &
pets[matrix[Pet][i]] & " " & jobs[matrix[Job][i]] & " "
&
drinks[matrix[Drink][i]] & " " &
houses[matrix[House][i]] & "\n" )
end for
abort(0)
end if
end procedure
procedure search( integer index, integer max )
for i = 1 to length( permutes ) do
matrix[index] = permutes[i]
if index = max then
test()
else
search( index+1, max )
end if
end for
end procedure
permutes = {}
list = repeat( 0, 5 )
calc_permutes( 5, 1 )
matrix = repeat( {}, House )
search( 1, House )
|
Not Categorized, Please Help
|
|
