Skip to content

Instantly share code, notes, and snippets.

@timo
Last active May 17, 2016 16:14
Show Gist options
  • Save timo/32cdd8ee9a602e6e75180e9e84d014d0 to your computer and use it in GitHub Desktop.
Save timo/32cdd8ee9a602e6e75180e9e84d014d0 to your computer and use it in GitHub Desktop.
# 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);
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment