~jleightcap/nonolog

57167fb3d681a259d7fabda62274d69828779272 — jleightcap 3 years ago 31cb056
working square solver
1 files changed, 33 insertions(+), 14 deletions(-)

M test.prolog
M test.prolog => test.prolog +33 -14
@@ 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).