#!/usr/bin/env perl
# Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.
# This was written while working through the online course material
# "Introduction to Logic" at Stanford University
# http://logic.stanford.edu/intrologic/
# http://logic.stanford.edu/intrologic/chapters/chapter_01.html
# It mostly uses functions (like array_any) over methods (like ->any),
# for demonstration purposes and since we can here since there's no
# need for this code to be generic, otherwise the latter would be the
# right choice.
use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use experimental "signatures";
# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname);
BEGIN {
    my $location = (-l $0) ? abs_path($0) : $0;
    $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname) = ($1, $2);
}
use lib "$mydir/../lib";
#use Sub::Call::Tail;
use FP::Array ":all";
use FP::Predicates qw(complement);
use FP::Stream ":all";    # incl. F
use FP::Ops ":all";
use Chj::TEST ":all", use => 'FP::Repl::Dependencies';
use FP::Equal;
use FP::Repl::Stack;
use FP::Repl::Trap;       # or Chj::Backtrace
use FP::Repl;
use FP::Hash ":all";
use FP::Show;
use FP::Array_sort ":all";
use FP::Carp;
{
    package examples_logic::Predicate;
    use FP::Struct ["coderef", "stack"];
    use overload ('&{}' => "coderef", '""' => "FP_Show_show");
    sub FP_Show_show ($self, @args) {
        "predicate from:\n" . $self->stack->backtrace(0)
    }
    _END_
}
my @tests;
sub test($pred) {
    push @tests, examples_logic::Predicate->new($pred, FP::Repl::Stack->get(1));
}
sub matrix_likes ($matrix, $subj, $obj) {
    $$matrix{$subj}{$obj}
}
sub likes ($subj, $obj) {
    sub($matrix) {
        matrix_likes $matrix, $subj, $obj
    }
}
sub does_not_like ($subj, $obj) {
    complement likes($subj, $obj)
}
sub likes_either ($subj, @objs) {
    sub($matrix) {
        array_any sub($obj) {
            matrix_likes $matrix, $subj, $obj
            }, \@objs
    }
}
sub matrix_people($matrix) {
    # XX only works if there are entries (at least in the first level)
    # even for false relations!
    [keys %$matrix]
}
sub matrix_likers ($matrix, $liked) {
    # find who likes $liked
    array_filter sub($person) {
        matrix_likes $matrix, $person, $liked
        }, matrix_people $matrix
}
sub matrix_liked ($matrix, $subj) {
    # array of who $subj likes
    my $l2 = $$matrix{$subj};
    [grep { $$l2{$_} } keys %$l2]
}
sub matrix_numrelations($matrix) {
    my $n = 0;
    for my $k0 (keys %$matrix) {
        my $m = $$matrix{$k0};
        for my $k1 (keys %$m) {
            $n++ if $$m{$k1}
        }
    }
    $n
}
sub likes_everyone_that_x_likes ($subj, $othersubj) {
    sub($matrix) {
        array_every sub($obj) {
            matrix_likes $matrix, $subj, $obj
        }, matrix_liked($matrix, $othersubj)
    }
}
sub likes_everyone_who_likes ($subj, $liked) {
    # is this cheating, walking the matrix? Should it look at
    # predicates? ehr no, ehr?
    sub($matrix) {
        array_every sub($liker) {
            matrix_likes $matrix, $subj, $liker
        }, matrix_likers($matrix, $liked)
    }
}
sub Or ($t0, $t1) {
    sub($matrix) {
        &$t0($matrix) or &$t1($matrix)
    }
}
sub contradictions_for($matrix) {
    array_to_stream(\@tests)->filter(complement applying_to $matrix)
}
sub checks($matrix) {
    is_null contradictions_for $matrix
}
# logic sentences
# Dana likes Cody.
test likes "Dana", "Cody";
# Abby does not like Dana.
test does_not_like "Abby", "Dana";
# Dana does not like Abby.
test does_not_like "Dana", "Abby";
# Bess likes Cody or Dana.
test likes_either "Bess", "Cody", "Dana";
# Abby likes everyone that Bess likes.
test likes_everyone_that_x_likes "Abby", "Bess";
# Cody likes everyone who likes her.
test likes_everyone_who_likes "Cody", "Cody";
# Nobody likes herself.
test does_not_like $_, $_ for qw(Dana Cody Abby Bess);
# Logical Entailment:
# is this compatible with the above world? Does it *change* the
# outcome? Then, *is* there still a successful match?
# Abby likes Bess or Bess likes Abby.
test Or(likes("Abby", "Bess"), likes "Bess", "Abby");
my $onesolution = {
    Abby => { Abby => '', Bess => 1,  Cody => 1,  Dana => '' },
    Bess => { Abby => '', Bess => '', Cody => 1,  Dana => '' },
    Cody => { Abby => 1,  Bess => 1,  Cody => '', Dana => 1 },
    Dana => { Abby => '', Bess => '', Cody => 1,  Dana => '' },
};
TEST { matrix_numrelations $onesolution } 7;
sub T($pred) {
    &$pred($onesolution)
}
TEST { T likes "Dana", "Cody" } 1;
TEST { T likes "Abby", "Dana" } '';
# test likes_everyone_who_likes "Abby", "Bess":
TEST { T likes "Cody", "Bess" } 1;
TEST { T likes "Abby", "Cody" } 1;    # because Cody likes Bess
#^ ehr that was crap, 'odd' that it fits into the same world?
# test likes_everyone_that_x_likes "Abby", "Bess":
TEST { T likes "Bess", "Cody" } 1;
TEST { T likes "Abby", "Cody" } 1;
TEST { matrix_liked $onesolution, "Bess" } ["Cody"];
TEST { T likes_everyone_that_x_likes "Abby", "Bess" } 1;
# test likes_everyone_who_likes "Cody", "Cody":
TEST { T likes "Dana", "Cody" } 1;
TEST { T likes "Bess", "Cody" } 1;
TEST { T likes "Abby", "Cody" } 1;
TEST { T likes "Cody", "Dana" } 1;    # because Dana likes Cody
TEST { T likes "Cody", "Bess" } 1;
TEST { T likes "Cody", "Abby" } 1;
# does_not_like:
TEST { T does_not_like "Abby", "Dana" } 1;
# nobody likes herself:
TEST { T does_not_like "Cody", "Cody" } 1;
TEST { T does_not_like "Abby", "Abby" } 1;
TEST { checks $onesolution } 1;
#TEST { checks hash2_set $onesolution, "Bess", "Cody", 0 } 0;
#TEST { checks hash2_set $onesolution, "Bess", "Dana", 0 } 1;
#TEST { checks hash2_set $onesolution, "Bess", "Dana", 1 } 0; got 1 hm
our $people   = matrix_people $onesolution;
our $people_i = [0 .. $#$people];
sub buildmatrix($bits) {
    array_to_hash_map sub ($subj, $subji) {
        $subj => array_to_hash_map(
            sub ($obj, $obji) {
                my $i = $subji * 4 + $obji;
                $obj => !!($bits & (1 << $i))
            },
            $people,
            $people_i
        )
        }, $people, $people_i
}
sub search () {
    stream_iota->take(2**16)->map(\&buildmatrix)->filter(\&checks)
}
if ($ENV{RUN_SLOW_TESTS}) {
    my $results;
    TEST {
        $results = search->array;
        array_length $results
    }
    2;
    TEST {
        array_length array_filter(sub($v) { equal $v, $onesolution }, $results)
    }
    1;
    my $sorted;
    TEST {
        $sorted = array_sort $results, on \&matrix_numrelations, \&real_cmp;
        [matrix_numrelations($$sorted[0]), matrix_numrelations($$sorted[-1])]
    }
    [7, 8];
}
perhaps_run_tests "main" or repl;