Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

Okay, so after the criticism of your code I guess I must show an example of what I mean.

The code below solves the six by six problem, for as I said in the original node, the seven by seven is not so easy.

It's quite straightforward brute forcing: it tries all possibilities. It is not using the trick in the first spoiler block (which would make it faster). After filling each row, it checks that there are no two identical rows. Also, instead of iterating over all possible last rows, we compute its elements so that the columns are right. (In addittion, we don't need to check if the last row is right, for if each column and each other row has three white and three black squares each then the last column does too automatically.) A similar trick is used for the fifth row: instead of iterating through all possible fifth rows, we fill the fifth cell of each column in such a way that the column doesn't have more than three white or more than three black cells, and then check if the fifth row we've got is correct. We check that there are no two identical columns at the end, after filling the whole table.

The code runs in SWI prolog in 107 seconds (on a fast computer), and produces the correct answer (194400). (Start with the goal main; some debugging lines are printed to show progress.)

I hope my prolog coding style isn't too strange for you to follow.

% Six by six chessboard problem, see "http://www.perlmonks.org/?node_i +d=821272" % Logical programming variant row(R) :- length(R, 6), rowpart(6, R). rowpart(T, R) :- rowpart(3, 3, T, R). rowpart(X, Y, 0, _) :- 0 =< X, 0 =< Y. rowpart(X, Y, T, [b | R]) :- succ(Xp, X), succ(Tp, T), rowpart(Xp, Y, +Tp, R). rowpart(X, Y, T, [w | R]) :- succ(Yp, Y), succ(Tp, T), rowpart(X, Yp, +Tp, R). board(B) :- B = [R0, R1, R2, R3, R4, R5], for(lambda(arg(R), length(R, 6)), B), transpose(B, BT), row(R0), write(board_debug0([R0])), nl, row(R1), R0 \== R1, row(R2), for(lambda(arg(R), R \== R2), [R0, R1]), row(R3), for(lambda(arg(R), R \== R3), [R0, R1, R2]), for(lambda(arg(C), rowpart(5, C)), BT), row(R4), for(lambda(arg(R), R \== R4), [R0, R1, R2, R3]), for(lambda(arg(C), row(C)), BT), %row(R5), % automatically true for(lambda(arg(R), R \== R5), [R0, R1, R2, R3, R4]), iota(6, I6), for(lambda(arg(M), ( take(M, BT, CB), nth0(M, BT, C), for(lambda(arg(U), U \== C), CB))), I6). nboard(N) :- findall(x, board(_B), L), length(L, N). main :- nboard(N), write(N), nl. /*
*/ /* Homegrown functional programming library for prolog */ :- use_module(library(lists)). % Higher order programming fcall(Fn, A) :- copy_term(Fn, lambda(A, G)), !, call(G). fcall(lambda_close(D, C, P, G), A) :- copy_term(rec(C, P, G), rec(V, Pc, Gc)), V = D, Pc = A, call(Gc). % List functions, higher order map(_, [], []). map(Fn, [Ah | At], [Bh | Bt]) :- fcall(Fn, arg(Ah, Bh)), map(Fn, At, Bt). for(Fn, A) :- map(lambda_close(Fn, Fc, arg(X, _), fcall(Fc, arg(X))), A, _). zip(Fn, A, B, C) :- map(lambda(arg(X, rec(X, _)), true), A, P), map(lambda(arg(Y, rec(_, Y)), true), B, P), map(lambda_close(Fn, Fc, arg(rec(X, Y), Z), fcall(Fc, arg(X, Y, Z) +)), P, C). any(Fn, [X | _]) :- fcall(Fn, arg(X)). any(Fn, [_ | R]) :- any(Fn, R). first(Fn, L, R) :- once(any(lambda_close(rec(Fn, Ro), rec(Fni, Ri), arg(X), (fcall(Fn +i, arg(X)), Ri = X)), L)), R = Ro. foldrs(_, U, [], U). foldrs(Fn, U, [H | T], R) :- foldrs(Fn, U, T, M), fcall(Fn, arg(H, M, R)). foldrz(_, U, [], U). foldrz(Fn, U, [H | T], R) :- fcall(Fn, arg(H, M, R)), foldrz(Fn, U, T, M). foldl(_, U, [], U). foldl(Fn, U, [H | T], R) :- fcall(Fn, arg(U, H, M)), foldl(Fn, M, T, R). filter(Fn, L, R) :- foldrz( lambda_close(Fn, Fni, arg(X, M, N), (fcall(Fni, arg(X)) -> N = + [X | M] ; N = M)), [], L, R). unfoldr(Fn, U, [H | T]) :- fcall(Fn, arg(U, H, M)), !, unfoldr(Fn, M, T). unfoldr(_, _, []). % List functions, first order concat(Ls, C) :- foldrz(lambda(arg(X,M,R), append(X,M,R)), [], Ls, C). transpose([], []). transpose(Ls, Rs) :- [L1 | _] = Ls, map(lambda(arg(_, []), true), L1, Fi), foldrz( lambda(arg(L, M, R), zip(lambda(arg(X, Y, [X | Y]), true), L, +M, R)), Fi, Ls, Rs). splitat(N, L, H, T) :- length(H, N), append(H, T, L), !. splitat(N, L, L, []) :- length(L, M), M < N. take(N, L, H) :- splitat(N, L, H, _). drop(N, L, T) :- splitat(N, L, _, T). iota(N, L) :- unfoldr(lambda(arg(H, H, F), (H < N, F is H + 1)), 0, L) +. slice(N, L, R) :- unfoldr(lambda(arg(C, H, T), (C = [_ | _], splitat(N, C, H, T))), +L, R). infixes(N, L, R) :- length(H, N), append(H, _, L) -> R = [H | R1], [_ | L1] = L, infixes(N, L1, R1) ; length(L, M), M < N, R = []. /* Examples. | ?- zip(lambda(arg(X, Y, Z), Z is X * Y), [3,1,4], [10, 100, 1000], R +). R = [30,100,4000] ? ; no | ?- map(lambda_close(E, V, arg(X, V*X), true), [A, B, A+B], R). R = [E*A,E*B,E*(A+B)] ? ; no | ?- any(lambda_close(R, Rho, arg(X), (5 < X, Rho = X)), [3,1,4,1,5,9, +2,6]). R = 9 ? ; R = 6 ? ; no | ?- foldrz(lambda(arg(H, M, x(H, M)), true), 2, [3, 8, 5], R). R = x(3,x(8,x(5,2))) ? ; no | ?- foldl(lambda(arg(M, H, x(M, H)), true), 2, [3, 8, 5], R). R = x(x(x(2,3),8),5) ? ; no | ?- foldl(lambda(arg(M, H, R), R is M + H), 2, [3, 8, 5], R). R = 18 ? ; no */ % END

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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2024-04-19 09:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found