@@ 1,17 1,32 @@
% try this out: https://swish.swi-prolog.org/
-:- use_module(library(clpfd)).
-picross(rows, columns) :-
- %same_length(Rows, Columns).
- write(columns), nl,
- write(rows).
+:- use_module(library(clpfd)). % transpose
-% constraint <-> board state
-% ex. size 6, constraint [1, 3] -> [1, 0, 1, 1, 1, 0], ...
-board_expand(constraint, size, grid) :- write(grid).
+% solve a given picross puzzle.
+% row restraints list[list[N]] ->
+% column restraints list[list[N]] ->
+% row length int ->
+% column length int ->
+% solved picross
+%
+% ex:
+% ?- picross([[1, 1], [1], [1, 1]], [[1, 1], [1], [1, 1]], 3, 3, X).
+% X = [[1, 0, 1],
+% [0, 1, 0],
+% [1, 0, 1]].
+picross(Rc, Cc, N, X) :-
+ length(Rc, N),
+ length(Cc, N),
+ maplist(decode(N), Rc, X),
+ maplist(decode(N), Cc, X2),
+ transpose(X2, X),
+ maplist(print_row, X).
+
+print_row(R) :- maplist(write, R), nl.
% run-length encoding of a 1's in a given binary list.
-% list[{0,1}] -> resulting encoding
+% list[{0,1}] ->
+% resulting encoding
%
% ex:
% ?- encode([0,1,1,0,1,0,0,1,0], X).
@@ 20,25 35,29 @@ encode([], X) :- X = [].
encode([0], X) :- X = [].
encode([1], X) :- X = [1].
encode([F,S|R], X) :-
- T = [S|R],
- encode(T, X2),
+ encode([S|R], X2),
add_encode(F, S, X2, X).
% decode, inversion of encoding with finite length.
-% list[N] -> length int -> possible decodings of given length
+% restriction list :: list[Nat] ->
+% length :: Nat ->
+% possible decodings of given length
%
% ex:
% ?- decode([1, 1], 4, X).
% X = [1, 0, 1, 0] ;
% X = [1, 0, 0, 1] ;
% X = [0, 1, 0, 1] ;
-decode(E, N, X) :-
+decode(N, E, X) :-
length(X, N),
encode(X, E).
% add two encodings based on additional cell.
% user previous cell state to determine if run should be continued.
-% cell int -> previous int -> accumulator encoding -> resulting encoding
+% cell int ->
+% previous int ->
+% accumulator encoding ->
+% resulting encoding
%
% ex:
% ?- add_encode(1, 0, [1, 2, 3], X).