Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

bliako's scratchpad

by bliako (Prior)
on Jun 11, 2016 at 14:36 UTC ( #1165398=scratchpad: print w/replies, xml ) Need Help??

# shortest OO example
{ package Person; sub new { my ($class, $name, $surname) = @_; my $self = { 'name' => $name, 'surname' => $surname }; bless $self => $class; return $self; } sub name { return shift->{'name'} } sub surname { return shift->{'surname'} } sub toString { my $self = shift; return "name: ".$self->name() ."\nsurname: ".$self->surname() } } # test in main my $A = Person->new("aa", "bb"); my $B = Person->new("cc", "dd"); print $A->toString()."\n".$B->toString(); # after implementing a Family class: # my $family = Family->new($A, $B, $C, $D); # print $family->toString(); # after implementing a Family tree # my $ft = FamilyTree->new(...) # after implementing a Neighbourhood class # my $ne = Neighbourhood->new(...) # after implementing a World class # our $world = World->new(...)
{ package GNH; use Deep::Hash::Utils; =pod this is a class to store a nested hash either 1) read from a file (usi +ng Perl syntax of hashref but without the initial assignment, e.g. starting end ending with curly br +ackets) or 2) read from a string again Perl syntax of a hashref or 3) receive an already made Perl hash +ref, e.g. {"a"=>42}; How do you instantiate an object from this class: my $obj = GNH->new({ 'filename' => foods.txt, }) or die "failed to instantiate"; that's it, now $obj contains all the %foods and has some functions(aka + methods) to process the data it contains, to select it, to print it. All these are enclose +d within $obj and are called by something like: print $obj->toString(); The paths() method returns an arrayref of ALL paths in the nested hash +. The random_path() returns one of these paths at random. This is the pl +ace where you can add more of fancy_rand()'s functionality. Just remember that the d +ata, the hash is now contained within your class along with any other data you want to stor +e, within the $self hash which you can see how is initialised at creation: new() and then accessed by any method of the class using: sub fancy_rand { my $self = shift; # this is where we get access to $self, our data s +tash print $self->{'hash'} # this is our %foods data stored in the objec +t } and you call the above like this $obj->fancy_rand(); note that first parameter we shift in the method body is taken care by + Perl and you do not have to explicitly specify it when calling the method. The %food data makes it look big. What you see there is a class which reads (on init, i.e. in new()) %food, %drink, anything in the form of nested hashes. Once read, it remembers it as it is stored in $self has +h. But size is not so important. The main benefit of this approach is that all functionality is enclosed within the class and the instantiat +ed object carries it with it all the time. And secondly, you use just ONE class (GNH) in order for storing all different types of data +you have in this form: food, drink, etc. All you have to do is: my $foods = GNH->new({'filename'=>'foods.txt'}); my $drinks = GNH->new({'filename'=>'drinks.txt'}); my $random_food = $foods->random_path(); my $random_drinks = $drinks->random_path(); This is a proof-of-concept exercise in getting you started with OO and decide if it suits you. It does not try to implement all the functionality of the code you have written so far! Although I do not claim that this is the best approach or it can't be +improved, IMO, using this approach simplifies a lot of code. Just remember: generic methods for specific data. I.e. $foods->random_path() and not random_path_foods() because complexity will bite you worst than a dragon :) bw bliako. =cut sub new { my $class = $_[0]; my $params = $_[1]; my $self = { 'hash' => undef }; if( defined($params->{'filename'}) ){ # read a perl hash from file (content is enclosed in {}) # e.g. {'a'=>12} # filename must either be absolute or if relative to current, # use './blahblah' $self->{'hash'} = do $params->{'filename'} or die "failed to do '".$params->{'filename'}."'."; } elsif( defined($params->{'string'}) ){ # read a perl hash from string (e.g. '{"a"=>12}' # warning evals are dangerous if you are not sure about # the content of the string - e.g. if it contains a "system('d +elete *');" $self->{'hash'} = eval { $params->{'string'} }; die $@ if $@; } elsif( defined($params->{'hash'}) ){ # we have an already created perl hash as a hashref $self->{'hash'} = $params->{'hash'}; } bless $self => $class; # object created (instantiated) return $self; } # returns a list (as an arrayref) of paths in the hash sub paths { my $self = shift; my @ret; while( my @list = Deep::Hash::Utils::reach($self->{'hash'}) ){ push @ret, \@list; } return \@ret; } # returns a randomly selected path by recursively diving into # the hash until it reaches a leaf (a scalar) and not an array or a ha +sh sub random_path { my $self = shift; my @path; _random_path($self->{'hash'}, \@path); return \@path; } sub _random_path { my ($data, $retarr) = @_; if( ref($data) eq 'HASH' ){ my $k = (keys %$data)[0]; push @$retarr, $k; _random_path($data->{$k}, $retarr); } elsif( ref($data) eq 'ARRAY' ){ my $v = $data->[rand @$data]; _random_path($v, $retarr); } else { push @$retarr, $data; return; } } sub iterator { my $self = shift; return Deep::Hash::Utils::slurp($self->{'hash'}); } # return the hash as a string sub toString { my $self = shift; return join("\n", map { join '->', @$_ } @{$self->paths()} ); } 1; } # end package # this is the main package as a demo # this is the nested hash data, it can also be in a file # in which case do not include 'my $foods = ' my $foods = { 'fruit' => [ 'apple', 'apricot', 'banana', 'blueberry', 'cherry', 'grape', 'grapefruit', 'lemon', 'lime', 'orange', 'peach', 'pear', 'plum', 'raspberry', 'strawberry', 'tomato' ], 'Lucky Charms' => [ 'heart lucky charm', 'star lucky charm', 'horseshoe lucky charm', 'green clover lucky charm', 'blue moon lucky charm', 'hourglass lucky charm', 'rainbow lucky charm', 'red balloon lucky charm', 'swirled pink moon lucky charm', 'swirled orange moon lucky charm', 'swirled yellow moon lucky charm', 'swirled green moon lucky charm', 'swirled blue moon lucky charm', 'swirled purple moon lucky charm', 'green hat with a dark green clover luck +y charm', 'blue hat with a pink clover lucky charm +', 'purple hat with a green clover lucky ch +arm', 'dark green hat with a orange clover luc +ky charm', 'yellow hat with a blue clover lucky cha +rm', 'orange hat with a green clover lucky ch +arm', 'dark green and yellow swirled diamond l +ucky charm', 'purple and pink swirled diamond lucky c +harm', 'blue and green swirled diamond lucky ch +arm', 'pink and white swirled diamond lucky ch +arm', 'green and orange swirled diamond lucky +charm' ], 'Klondike bar' => [ 'original Klondike bar', 'dark chocolate Klondike bar', 'double chocolate Klondike bar', 'neopolitan Klondike bar', 'mint chocolate chip Klondike bar', 'rocky road Klondike bar', 'cookie dough swirl Klondike bar', 'brownie fudge swirl Klondike bar', 'caramel pretzel Klondike bar', 's\'mores Klondike bar', 'Oreo Klondike bar', 'Reese\'s Klondike bar', 'Krunch Klondike bar', 'Heath Klondike bar' ], 'M&Ms' => [ 'milk chocolate M&Ms', 'peanut M&Ms', 'dark chocolate M&Ms', 'dark chocolate peanut M&Ms', 'almond M&Ms', 'peanut butter M&Ms', 'pretzel M&Ms', 'triple chocolate M&Ms', 'raspberry almond M&Ms', 'chocolate almond M&Ms', 'mint chocolate M&Ms' ], 'meat' => [ 'beef', 'lamb', 'chicken', 'pork', 'turkey', 'fish' ], 'tuber' => [ 'potato', 'sweet potato', 'yam' ], 'junk food' => [ 'corn chips', 'potato chips', 'pretzels', 'crackers' ] }; my $f = GNH->new({'hash'=>$foods}) or die "GNH"; print "the menu:\n".$f->toString()."\n"; print "I choose: ".join(" -> " , @{$f->random_path()})."\n";
============================= end =======================
#!/usr/bin/perl use strict; use warnings; use Paths::Graph; use Data::Dump qw/dd/; use Benchmark qw/cmpthese/; srand 123; my $max = $ARGV[0] || 4; my @aoa = map{ [ map{ int(rand(4))+1 }0..$max ] } 0..$max; my %graph; if( 1 ){ # compare recursive and loopy graph building my %graph2; cmpthese(-2, { 'recursive' => sub { %graph = (); # empty the graph where results g +o for each iteration # else no work is done if %graph +is already completed. # builds the graph by recursing to all neighbours of curre +nt location # starting from 0,0 build_graph_recursively(0, 0, \@aoa, \%graph, 0); }, 'loopy' => sub { %graph2 = build_graph(); # uses a nested loop over all gri +d elements }, }); #$graph{"aa"} = {"abc" => 12}; # test to yield not-same-graphs err +or if( compare_graphs(\%graph, \%graph2) ){ die "graphs not the same" + } else { print "graph methods same results\n" } } else { build_graph_recursively(0, 0, \@aoa, \%graph, 0); } #graph_stringify(\%graph); exit 0; print "finding shortest path...\n"; my $dest = ${max}.'_'.${max}; if( ! exists $graph{$dest} ){ die "destination does not exist '$dest'" + } my $obj = Paths::Graph->new(-origin=>"0_0",-destiny=>"${max}_${max}",- +graph=>\%graph); my @paths = $obj->shortest_path(); for my $path (@paths) { print "Shortest Path:" . join ("->" , @$path) . " Cost:". $obj->get_path_cost(@$path) . "\n"; } sub build_graph_recursively { # a recursive graph builder # builds the graph by recursing to all neighbours of current locat +ion # starting from 0,0 # WARNING: may yield the dreaded "Deep recursion on subroutine" me +ssage for when recursion depth reaches 100 # but no problem usually! my ( $i, $j, # current location $grid, # the grid as an AoA (arrayref) accessed like grid[i][ +j] may not be square $graph, # the resultant graph as a HoH (hashref) we keep modif +ying $depth # recursion depth ) = @_; my $maxI = $#{$grid}; my $maxJ = $#{$grid->[$i]}; # at the current i # check if within bounds #print "build_graph_recursively() : entering for ($i,$j) bound(0,0 +,$maxI,$maxJ) at depth $depth...\n"; return(0) if $i < 0 || $j < 0 || $i > $maxI || $j > $maxJ ; my $id = $i.'_'.$j; $graph->{$id} = {} unless exists $graph->{$id}; my $neigh = find_neighbours($i, $j, $grid); return(0) unless defined $neigh; my $suc = 0; foreach my $aneigh (@$neigh){ my ($ni, $nj) = @$aneigh; my $nid = $ni.'_'.$nj; if( ! exists $graph->{$id}->{$nid} ){ $graph->{$id}->{$nid} = $grid->[$ni]->[$nj]; #print "build_graph_recursively() : ($i,$j) -> ($ni,$nj) = + ".$graph->{$id}->{$nid}."\n"; #print "build_graph_recursively() : recursing into ($i,$j) + -> ($ni,$nj), depth $depth ...\n"; $suc += build_graph_recursively($ni, $nj, $grid, $graph, $ +depth+1); #print "build_graph_recursively() : back from recursing in +to ($i,$j) -> ($ni,$nj), depth $depth ...\n"; } } return $suc == 0 ? 0 : 1; } # given a current location on the grid find its immediate neighbours f +ollowing Discipulus rules: cross, no diagonals. sub find_neighbours { my ( $i, $j, # current location $grid # the grid as an AoA (arrayref) accessed like grid[i][ +j] may not be square ) = @_; my $maxI = $#{$grid}; my $maxJ = $#{$grid->[$i]}; # at the current i my @ret = grep { $_ if $_->[0] >= 0 and $_->[0] <= $maxI and $_->[1] >= 0 and $_->[1] <= $maxJ } ([$i-1,$j],[$i+1,$j],[$i,$j-1],[$i,$j+1]); return scalar(@ret) > 0 ? \@ret : undef; } # compare two graphs to find out if same both ways. sub compare_graphs { my ($g1, $g2) = @_; foreach my $k1 (keys %$g1){ if( ! exists $g2->{$k1} ){ print "not same because of $k1\n"; +return 1 } foreach my $k2 (keys %{$g1->{$k1}}){ if( ! exists $g2->{$k1}->{$k2} ){ print "not same because +of $k1".'->'."$k2 not exists\n"; return 1 } if( $g2->{$k1}->{$k2} != $g1->{$k1}->{$k2} ){ print "not s +ame because value of $k1->$k2 ".$g1->{$k1}->{$k2}." and ".$g2->{$k1}- +>{$k2}."\n"; return 1} } } foreach my $k2 (keys %$g2){ if( ! exists $g1->{$k2} ){ print "not same because of $k2\n"; +return 1 } foreach my $k1 (keys %{$g2->{$k2}}){ if( ! exists $g1->{$k2}->{$k1} ){ print "not same because +of $k2".'->'."$k1 not exists\n"; return 1 } if( $g1->{$k2}->{$k1} != $g2->{$k2}->{$k1} ){ print "not s +ame because value of $k2->$k1 ".$g2->{$k2}->{$k1}." and ".$g1->{$k2}- +>{$k1}."\n"; return 1} } } return 0; } # return a string with sorted-keys graph sub graph_stringify { my $g = $_[0]; my $ret = ""; foreach my $k1 (sort keys %$g){ my $G = $g->{$k1}; $ret .= "$k1\n{"; foreach my $k2 (sort keys %$G){ $ret .= $k2 .' => '.$G->{$k2} . ','; } $ret .= "}\n"; } return $ret; } sub build_graph{ # Discipulus original graph builder my %graph; foreach my $row (0..$#aoa){ foreach my $col( 0..$#{$aoa[$row]} ){ #print $row."_".$col." is current..\n"; map{ $graph{$row."_".$col}{$_->[0].'_'.$_->[1]} = $aoa[$_-> +[0]][$_->[1]] if $_->[0] >= 0 and $_->[0] <= $#{$aoa[$row]} and $_->[1] >= 0 and $_->[1] <= $#aoa } ([$row-1,$col],[$row+1,$col],[$row,$col-1],[$row,$col+1] +); } } return %graph; }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2020-09-30 05:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (160 votes). Check out past polls.

    Notices?