GRAPH.p6

# this is my solution to GRAPH.
# it offers an interactive mode and some test cases

use v6;

class Graph {
    has @!nodes;
    has %!neighbour;

    method connect($a, $b) {
        %!neighbour{$a} //= [];
        %!neighbour{$b} //= [];
        push %!neighbour{$a}, $b;
        push %!neighbour{$b}, $a;
    }
    method neighbours($node) {
        %!neighbour{$node} // [];
    }
    method are-adjacent($a, $b) {
        die "node $a not in graph" unless any(@!nodes) eq $a;
        any(%!neighbour{$a}.list) eq $b;
    }
    method all-nodes() { return @!nodes.clone; }
    method all-neighbours() { return %!neighbour.clone; }

    method new(:@nodes!, :@edges!) {
        self.bless(*, :@nodes, :@edges);
    }
    submethod BUILD(:@nodes, :@edges) {
        @!nodes = @nodes[];
        die "duplicate nodes" if +@!nodes != +set(@!nodes);
        for @edges -> $k, $v {
            self.connect($k, $v);
        }
    }
}

sub create-grid-graph($w, $h) {
    my @x-names = ("A"..*)[^($w min 26)];
    my @y-names = ("1"..*)[^($h min 26)];
    my @nodes = @x-names X~ @y-names;
    my @edges;
    for @y-names -> $yn {
        for @x-names -> $xn {
            my $node = $xn ~ $yn;
            @edges.push(state $prev, $node) if $prev.defined;
            $prev = $node;
        }
    }
    for @x-names -> $xn {
        for @y-names -> $yn {
            my $node = $xn ~ $yn;
            @edges.push(state $prev, $node) if $prev.defined;
            $prev = $node;
        }
    }
    return Graph.new(:@nodes, :@edges);
}

sub render-grid-graph(Graph \g, @path = (), $visited?) {
    say "rendering grid graph";
    use Terminal::ANSIColor;
    my @nodes = g.all-nodes.list;
    #my %conns = g.all-neighbours;
    #my ($w, $h) = @nodes[*-1].match(/ (<[A..Z]>+)(<[0..9]>+) /)>>.Str;

    my $nodeset = @nodes.Set;

    my $wv = ("A"..*).first({ not $nodeset{$_ ~ "1"} });
    my $hv = (1..*)  .first({ not $nodeset{"A$_"} });

    my @x-names = ("A"..^$wv).list;
    my @y-names = ("1"..^$hv).list;

    #$visited{$_}:delete for @path;

    sub in-path($node) { @path.first($node).defined }

    for @y-names -> $yn {
        state $prev-y;
        my (@c1, @c2);
        for @x-names -> $xn {

            sub col($text, $cur, $prev) {
                if in-path(all($cur, $prev)) {
                    color("red") ~ $text ~ color("reset");
                } elsif (in-path(one($cur, $prev)) and $visited{one($cur, $prev)}:exists) or $visited{all($cur, $prev)}:exists {
                    color("blue") ~ $text ~ color("reset");
                } else {
                    $text;
                }
            }

            if (state $prev) and g.are-adjacent($xn ~ $yn, $prev) {
                @c2.push(col("\c[BOX DRAWINGS LIGHT HORIZONTAL]" x 2, $xn~$yn, $prev));
            } else {
                @c2.push("  ");
            }
            if $prev-y and g.are-adjacent($xn ~ $prev-y, $xn ~ $yn) {
                @c1.push(col("  \c[BOX DRAWINGS LIGHT VERTICAL]", $xn~$prev-y, $xn~$yn));
            } else {
                @c1.push("   ");
            }
            if in-path($xn~$yn) {
                @c2.push(color("red") ~ "\c[BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL]" ~ color("reset"));
            } elsif $visited{$xn~$yn}:exists {
                @c2.push(color("blue") ~ "\c[BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL]" ~ color("reset"));
            } else {
                @c2.push("\c[BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL]");
            }
            $prev = $xn ~ $yn;
        }
        say @c1.join("");
        say @c2.join("");
        $prev-y = $yn;
    }
}

sub jarnik-prim(Graph \g, $add-probab = 0) {
    my @nodes = g.all-nodes.pick(*);
    my SetHash $visited .= new;

    my @edges;

    my @node_q = @nodes[0];

    while @node_q {
        my $node = @node_q.shift;
        $visited{$node} = True;
        my @neighbours = g.neighbours($node).pick(*);

        for @neighbours -> $target {
            if not $visited{$target} or rand < $add-probab {
                @edges.push: $node, $target;
                $visited{$target} = True;
                @node_q.push($target);
                @node_q = @node_q.pick(*);
            }
        }
    }
    return Graph.new(:@nodes, :@edges);
}

sub find-path(Graph \g, $start? is copy, $end? is copy) {
    # the parent of a node is the node that's closer to the start.
    my %parent;
    # the nodes we have discovered so far, starting at $start.
    my @nodes;
    # all the nodes that have had all their neighbours inspected
    # are visited.
    my SetHash $visited .= new;

    $start = g.all-nodes.pick unless $start.defined;
    $end = g.all-nodes.pick unless $end.defined;

    $visited{$start} = True;

    @nodes.push: $start;

    my $nodecount = g.all-nodes.elems;

    loop {
        my $cursor = @nodes.shift;

        next if $visited{$cursor} && @nodes;

        for @(g.neighbours($cursor)) -> $neighbour {
            # if we see this node for the first time,
            if !$visited{$neighbour} {
                # mark our cursor as its parent
                %parent{$neighbour} = $cursor;

                # and we are also interested in its neighbours now.
                # (but add it to the end of the queue)
                @nodes.push($neighbour);
            }
        }
        $visited{$cursor} = True;

        # when we found a path to the end, the parent of
        # $end will have been set.
        if %parent{$end} :exists {
            return ($end, { %parent{$_} } ... $start).reverse.item, $visited;
        }

        # if we run out of interesting nodes, we won't find
        # a path to the end.
        if +@nodes == 0 {
            die "no path found from $start to $end";
        }
    }
}

sub run(:@nodes, :@edges, :$start = @nodes.pick, :$end = @nodes.pick) {
    my $g = Graph.new(
        nodes => @nodes, edges => @edges
    );
    my ($path, $) = find-path($g, $start, $end);
    say "found a path! $path[]";
}

multi sub MAIN() {
    say q:to/WELCOME/;
        Hey, welcome to my neat GRAPH pathfinder.

        run it with "test" to run some sanity checks or with
        "interact" to enter a graph manually.
        You could also run "grid" to get a pretty grid-like graph.
        WELCOME

    run(
        :nodes( <A B C D E F G H> ),
        :edges( <A B   B C   A D   D E   E G   B F   C H   G H> )
    );
}

multi sub MAIN("interact") {
    say q:to/INTRO/; 
        Enter as many nodes as you wish in one line to make a connection
        End with an empty line.
        The program will then find a route from the alphabetically
        earliest to the alphabetically last node.
        INTRO

    my @edges;

    loop {
        my @edge = (prompt("edges> ") // "").comb(/<ident>/);
        for @edge -> $node {
            @edges.push(state $prev, $node) if $prev.defined;
            $prev = $node;
        }
        last unless @edge;
    }
    my @nodes = set(@edges).list.sort;
    die "no nodes supplied." unless +@nodes;
    run(
        :@nodes,
        :@edges
    );
}

multi sub MAIN("test") {
    use Test;

    {
        my $g = Graph.new(
            :nodes( <A B C D E F G H I> ),
            :edges( (<A B   B C   A D   D E   E G   B F   C H   G H>) )
        );
        ok $g.are-adjacent("A", "B");
        ok $g.are-adjacent("B", "A");
        ok not $g.are-adjacent("A", "C");
        ok not $g.are-adjacent("C", "A");

        is set($g.neighbours("A")), set(<B D>);
        is set($g.neighbours("B")), set(<A C F>);

        ok find-path($g, "A", "H");
    }
    done;
}

multi sub MAIN("grid") {
    my Graph \g = jarnik-prim(create-grid-graph(20, 20), 0.1);
    for ^2 {
        my ($path, $visited) = find-path(g);
        render-grid-graph(g, $path, $visited);
    }
}