Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^4: Seven by seven farming puzzle

by salva (Canon)
on Feb 07, 2010 at 11:15 UTC ( [id://821833]=note: print w/replies, xml ) Need Help??


in reply to Re^3: Seven by seven farming puzzle
in thread Seven by seven farming puzzle

The solution for the 7x7 problem using my combination of constraints and backtracking (I prefer to see it as just a custom labeling algorithm). The only optimization used is forcing the last five rows to be in lexicographic order.
:- use_module(library(clpfd)). different_lists([A|TA], [B|TB]) :- ( A #\= B ; A #= B, different_lists(TA, TB) ). all_different_lists([]). all_different_lists([A|T]) :- all_different_lists(T, A), all_different_lists(T). all_different_lists([], _). all_different_lists([B|T], A) :- different_lists(A, B), all_different_lists(T, A). list_sequence([]). list_sequence([H|T]) :- list_sequence(T, H). list_sequence([], _). list_sequence([B|T], A) :- list_lt(A, B), list_sequence(T, B). list_lt([A|TA], [B|TB]) :- ( A #< B ; A #= B, list_lt(TA, TB) ). solve([Row1, Row2, Row3, Row4, Row5, Row6, Row7]) :- Row1 = [A1, A2, A3, A4, A5, A6, A7], Row2 = [B1, B2, B3, B4, B5, B6, B7], Row3 = [C1, C2, C3, C4, C5, C6, C7], Row4 = [D1, D2, D3, D4, D5, D6, D7], Row5 = [E1, E2, E3, E4, E5, E6, E7], Row6 = [F1, F2, F3, F4, F5, F6, F7], Row7 = [G1, G2, G3, G4, G5, G6, G7], Col1 = [A1, B1, C1, D1, E1, F1, G1], Col2 = [A2, B2, C2, D2, E2, F2, G2], Col3 = [A3, B3, C3, D3, E3, F3, G3], Col4 = [A4, B4, C4, D4, E4, F4, G4], Col5 = [A5, B5, C5, D5, E5, F5, G5], Col6 = [A6, B6, C6, D6, E6, F6, G6], Col7 = [A7, B7, C7, D7, E7, F7, G7], global_cardinality(Row1, [0-2, 1-2, 2-3]), global_cardinality(Row2, [0-2, 1-2, 2-3]), global_cardinality(Row3, [0-2, 1-2, 2-3]), global_cardinality(Row4, [0-2, 1-2, 2-3]), global_cardinality(Row5, [0-2, 1-2, 2-3]), global_cardinality(Row6, [0-2, 1-2, 2-3]), global_cardinality(Row7, [0-2, 1-2, 2-3]), global_cardinality(Col1, [0-2, 1-2, 2-3]), global_cardinality(Col2, [0-2, 1-2, 2-3]), global_cardinality(Col3, [0-2, 1-2, 2-3]), global_cardinality(Col4, [0-2, 1-2, 2-3]), global_cardinality(Col5, [0-2, 1-2, 2-3]), global_cardinality(Col6, [0-2, 1-2, 2-3]), global_cardinality(Col7, [0-2, 1-2, 2-3]), all_different_lists([Row3, Row4, Row5, Row6, Row7], Row1), all_different_lists([Row3, Row4, Row5, Row6, Row7], Row2), list_sequence([Row3, Row4, Row5, Row6, Row7]), all_different_lists([Col1, Col2, Col3, Col4, Col5, Col6, Col7] +), label([A1, A2, A3, A4, A5, A6, A7, B1, B2, B3, B4, B5, B6, B7, C1, C2, C3, C4, C5, C6, C7, D1, D2, D3, D4, D5, D6, D7, E1, E2, E3, E4, E5, E6, E7, F1, F2, F3, F4, F5, F6, F7, G1, G2, G3, G4, G5, G6, G7]). solve(R1, R2, L) :- findall(-, solve([R1, R2 | _]), All), length(All, L). tryme([]). tryme([H|T]) :- H = [R1, R2], write('searching...'), nl, time(solve(R1, R2, L)), L120 is L * 120, write(solve(R1, R2, L, L120)), nl, tryme(T). tryme :- tryme([[[2, 1, 0, 0, 2, 2, 1], [0, 2, 2, 1, 1, 0, 2]], [[2, 0, 0, 2, 2, 1, 1], [2, 0, 1, 2, 2, 1, 0]], [[2, 1, 0, 1, 2, 0, 2], [2, 2, 1, 1, 2, 0, 0]], [[2, 1, 0, 1, 2, 2, 0], [1, 2, 0, 2, 1, 2, 0]], [[0, 2, 0, 1, 2, 1, 2], [1, 2, 0, 2, 1, 0, 2]], [[2, 0, 0, 1, 2, 2, 1], [2, 1, 1, 0, 2, 2, 0]], [[1, 2, 2, 0, 0, 2, 1], [2, 0, 1, 0, 1, 2, 2]], [[2, 2, 1, 1, 0, 2, 0], [1, 0, 2, 1, 2, 0, 2]], [[2, 0, 1, 1, 2, 0, 2], [0, 1, 2, 2, 0, 1, 2]], [[0, 2, 2, 0, 1, 2, 1], [1, 0, 1, 2, 2, 2, 0]]]).
running it (on my several years old computer)...
% 813,486,620 inferences, 296.670 CPU in 298.033 seconds (100% CPU, 27 +42059 Lips) solve([2, 1, 0, 0, 2, 2, 1], [0, 2, 2, 1, 1, 0, 2], 40916, 4909920) searching... % 76,087,028 inferences, 25.970 CPU in 26.092 seconds (100% CPU, 29298 +05 Lips) solve([2, 0, 0, 2, 2, 1, 1], [2, 0, 1, 2, 2, 1, 0], 4230, 507600) searching... % 126,148,718 inferences, 43.040 CPU in 43.119 seconds (100% CPU, 2930 +965 Lips) solve([2, 1, 0, 1, 2, 0, 2], [2, 2, 1, 1, 2, 0, 0], 6049, 725880) searching... % 177,009,601 inferences, 60.300 CPU in 60.680 seconds (99% CPU, 29354 +83 Lips) solve([2, 1, 0, 1, 2, 2, 0], [1, 2, 0, 2, 1, 2, 0], 8372, 1004640) searching... % 392,855,329 inferences, 132.700 CPU in 133.397 seconds (99% CPU, 296 +0477 Lips) solve([0, 2, 0, 1, 2, 1, 2], [1, 2, 0, 2, 1, 0, 2], 11227, 1347240) ...
So it is not too bad, specially considering that the program is almost a direct translation of the problem wording to prolog, fully declarative.

Also, SWI-Prolog is not exactly the fastest prolog available and its clpfd module is not exactly the fastest CLP(FD) library either... I would not be surprised if some other prolog could run the same program more than an order of magnitude faster!

BTW, it requires the git version of SWI-Prolog to run... there was a bug on the global_cardinality/2 constraint.

Replies are listed 'Best First'.
Re^5: Seven by seven farming puzzle
by salva (Canon) on Feb 10, 2010 at 12:38 UTC
    Also, SWI-Prolog is not exactly the fastest prolog available and its clpfd module is not exactly the fastest CLP(FD) library either... I would not be surprised if some other prolog could run the same program more than an order of magnitude faster!

    Here it goes the same program adapted for GNU Prolog. In my machine in runs on five seconds, finding the solutions for the ten pairs of input rows!

    different_lists([A|TA], [B|TB]) :- ( A #\= B ; A #= B, different_lists(TA, TB) ). all_different_lists([]). all_different_lists([A|T]) :- all_different_lists(T, A), all_different_lists(T). all_different_lists([], _). all_different_lists([B|T], A) :- different_lists(A, B), all_different_lists(T, A). list_sequence([]). list_sequence([H|T]) :- list_sequence(T, H). list_sequence([], _). list_sequence([B|T], A) :- list_lt(A, B), list_sequence(T, B). list_lt([A|TA], [B|TB]) :- ( A #< B ; A #= B, list_lt(TA, TB) ). domain_from_global_cardinality([], []). domain_from_global_cardinality([Val-_|ET], [Val|DT]) :- domain_from_global_cardinality(ET, DT). global_cardinality(L, Exactly) :- domain_from_global_cardinality(Exactly, Domain), fd_domain(L, Domain), global_cardinality1(Exactly, L). global_cardinality1([], _). global_cardinality1([Val-Rep|T], L) :- fd_exactly(Rep, L, Val), global_cardinality1(T, L). solve([Row1, Row2, Row3, Row4, Row5, Row6, Row7]) :- Row1 = [A1, A2, A3, A4, A5, A6, A7], Row2 = [B1, B2, B3, B4, B5, B6, B7], Row3 = [C1, C2, C3, C4, C5, C6, C7], Row4 = [D1, D2, D3, D4, D5, D6, D7], Row5 = [E1, E2, E3, E4, E5, E6, E7], Row6 = [F1, F2, F3, F4, F5, F6, F7], Row7 = [G1, G2, G3, G4, G5, G6, G7], Col1 = [A1, B1, C1, D1, E1, F1, G1], Col2 = [A2, B2, C2, D2, E2, F2, G2], Col3 = [A3, B3, C3, D3, E3, F3, G3], Col4 = [A4, B4, C4, D4, E4, F4, G4], Col5 = [A5, B5, C5, D5, E5, F5, G5], Col6 = [A6, B6, C6, D6, E6, F6, G6], Col7 = [A7, B7, C7, D7, E7, F7, G7], global_cardinality(Row1, [0-2, 1-2, 2-3]), global_cardinality(Row2, [0-2, 1-2, 2-3]), global_cardinality(Row3, [0-2, 1-2, 2-3]), global_cardinality(Row4, [0-2, 1-2, 2-3]), global_cardinality(Row5, [0-2, 1-2, 2-3]), global_cardinality(Row6, [0-2, 1-2, 2-3]), global_cardinality(Row7, [0-2, 1-2, 2-3]), global_cardinality(Col1, [0-2, 1-2, 2-3]), global_cardinality(Col2, [0-2, 1-2, 2-3]), global_cardinality(Col3, [0-2, 1-2, 2-3]), global_cardinality(Col4, [0-2, 1-2, 2-3]), global_cardinality(Col5, [0-2, 1-2, 2-3]), global_cardinality(Col6, [0-2, 1-2, 2-3]), global_cardinality(Col7, [0-2, 1-2, 2-3]), all_different_lists([Row3, Row4, Row5, Row6, Row7], Row1), all_different_lists([Row3, Row4, Row5, Row6, Row7], Row2), list_sequence([Row3, Row4, Row5, Row6, Row7]), all_different_lists([Col1, Col2, Col3, Col4, Col5, Col6, Col7] +), fd_labeling([A1, A2, A3, A4, A5, A6, A7, B1, B2, B3, B4, B5, B6, B7, C1, C2, C3, C4, C5, C6, C7, D1, D2, D3, D4, D5, D6, D7, E1, E2, E3, E4, E5, E6, E7, F1, F2, F3, F4, F5, F6, F7, G1, G2, G3, G4, G5, G6, G7]). time(G) :- cpu_time(Start), call(G), cpu_time(End), S is End - Start, write(time(goal(G), ms(S))), nl. solve(R1, R2, L) :- findall(-, solve([R1, R2 | _]), All), length(All, L). tryme([]). tryme([H|T]) :- H = [R1, R2], write('searching...'), nl, time(solve(R1, R2, L)), L120 is L * 120, write(solve(R1, R2, L, L120)), nl, tryme(T). tryme :- tryme([[[2, 1, 0, 0, 2, 2, 1], [0, 2, 2, 1, 1, 0, 2]], [[2, 0, 0, 2, 2, 1, 1], [2, 0, 1, 2, 2, 1, 0]], [[2, 1, 0, 1, 2, 0, 2], [2, 2, 1, 1, 2, 0, 0]], [[2, 1, 0, 1, 2, 2, 0], [1, 2, 0, 2, 1, 2, 0]], [[0, 2, 0, 1, 2, 1, 2], [1, 2, 0, 2, 1, 0, 2]], [[2, 0, 0, 1, 2, 2, 1], [2, 1, 1, 0, 2, 2, 0]], [[1, 2, 2, 0, 0, 2, 1], [2, 0, 1, 0, 1, 2, 2]], [[2, 2, 1, 1, 0, 2, 0], [1, 0, 2, 1, 2, 0, 2]], [[2, 0, 1, 1, 2, 0, 2], [0, 1, 2, 2, 0, 1, 2]], [[0, 2, 2, 0, 1, 2, 1], [1, 0, 1, 2, 2, 2, 0]]]).
Re^5: Seven by seven farming puzzle
by ambrus (Abbot) on Feb 14, 2010 at 16:46 UTC

    I ran this with Sicstus prolog 3, and wow it was fast. The ten cases together took only 68 seconds. (That's on a 2.4 GHz pentium 4 machine; and about 140 seconds on a slower 992 MHz pentium 3 machine with the newer Sicstus 4. Gave the correct results in both cases. I can't compare the speed with SWI prolog for I'm lazy to install a newer SWI, and I don't even have any SWI prolog and Sicstus running on the same machine.)

    I'm surprised how fast it is. I know that the optimization you mention (the one in the first spoiler block) helps a lot, and also that the constraint programming nature makes it so that the last row is always filled in and there aren't too many possibilities to iterate over in the sixth row either, and that also counts a great deal in time. Still, I didn't think it would be so fast after the results with my perl programs.

Re^5: Seven by seven farming puzzle
by ambrus (Abbot) on Feb 14, 2010 at 18:06 UTC

    I replaced your different_lists and list_sequence with pure constraint versions (instead of your nondeterministic versions), and the changed program runs in practically the same amount of time. Thus, even if I don't understand it, your custom labeling algorithm works well.

    If, however, you replace only list_sequence but keep your different_lists proceduce, the program gets somewhat faster (shows how the optimized library that comes with Sicstus is better than the proceduces I cobble together).

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://821833]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (2)
As of 2024-04-20 05:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found