Last active
December 16, 2015 20:59
-
-
Save timo/5496509 to your computer and use it in GitHub Desktop.
solutions to masak/workshop
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# this solves the FRINGE problem, to lazily compare the | |
# fringes (left-to-right traversals of the leaves) of | |
# two trees and aborts as early as a difference is found. | |
# highlights of this include: | |
# | |
# - use of my excellent ADT module ;) | |
# - returning a False value for "same-fringe", whose | |
# .Str returns a detailed report | |
# - overriding the .storage method of a leaf in the | |
# test code to verify that an early abort has | |
# happened | |
use v6; | |
use ADT; | |
my $adt = q{Tree = Branch Tree left, Tree right | Leaf Str storage}; | |
my %res = create_adt($adt); | |
my \Tree = %res<Tree>; | |
my \Branch = %res<Branch>; | |
my \Leaf = %res<Leaf>; | |
my $a = Tree.new-branch( | |
Tree.new-leaf("a"), | |
Tree.new-branch( | |
Tree.new-leaf("b"), | |
Tree.new-leaf("c"))); | |
my $b = Tree.new-branch( | |
Tree.new-branch( | |
Tree.new-leaf("a"), | |
Tree.new-leaf("b")), | |
Tree.new-leaf("c")); | |
my $c = Tree.new-branch( | |
Tree.new-branch( | |
Tree.new-leaf("a"), | |
Tree.new-leaf("c")), | |
Tree.new-leaf("b")); | |
sub fringe($t) { | |
multi sub iter-tree($_) { | |
when Branch { | |
iter-tree($_.left); | |
iter-tree($_.right); | |
} | |
when Leaf { | |
take $_.storage | |
} | |
} | |
gather iter-tree($t); | |
} | |
sub same-fringe($a, $b) { | |
my $pos = 1; | |
for fringe($a) Z fringe($b) -> $fa, $fb { | |
return False but "difference at $pos: $fa !eq $fb" if $fa ne $fb; | |
$pos++; | |
} | |
return True; | |
} | |
use Test; | |
plan 7; | |
ok same-fringe($a, $b); | |
ok !same-fringe($a, $c); | |
is ~same-fringe($a, $c), "difference at 2: b !eq c"; | |
{ | |
my $*fail = False; | |
my $d = Tree.new-branch( | |
Tree.new-branch( | |
Tree.new-leaf("x"), | |
Tree.new-leaf("c")), | |
Tree.new-leaf("a") but role { method storage { $*fail = True; "a" } }); | |
is $d.right.storage, "a", "storage of mocked Leaf works"; | |
is $*fail, True, "storage of mocked Leaf sets failure"; | |
$*fail = False; | |
ok ~same-fringe($a, $d) ~~ /'at 1'/; | |
ok !$*fail, "lazyness of fringe."; | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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) { | |
push %!neighbour{$a}, $b; | |
push %!neighbour{$b}, $a; | |
} | |
method neighbours($node) { | |
%!neighbour{$node}; | |
} | |
method are-adjacent($a, $b) { | |
any(%!neighbour{$a}.list) eq $b; | |
} | |
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 find-path(Graph \g, $start, $end) { | |
# 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 KeySet $visited .= new; | |
$visited{$start} = True; | |
@nodes.push: $start; | |
loop { | |
my $cursor = @nodes.shift; | |
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; | |
} | |
# 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[0], :$end = @nodes[*-1]) { | |
my $g = Graph.new( | |
nodes => @nodes, edges => @edges | |
); | |
my @path = find-path($g, $start, $end); | |
say "I 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. | |
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; | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# this is my solution to JAPH | |
# it makes a fancy blinky animation! | |
use v6; | |
my @phrase = "Just Another Perl Hacker".comb; | |
my @visible = False xx +@phrase; | |
loop { | |
@visible = do for @visible.kv -> $k, $v { | |
$v ?? (False, True xx 14).pick !! (True, False xx 3).pick; | |
} | |
print "\r", (for @phrase.keys { @visible[$_] ?? @phrase[$_] !! " " }).join(""); | |
last if all(@visible); | |
} | |
say ""; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment