#!/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";

{

    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, \&number_cmp;
        [matrix_numrelations($$sorted[0]), matrix_numrelations($$sorted[-1])]
    }
    [7, 8];

}

perhaps_run_tests "main" or repl;
