breadth_first_search.pl (1602B) - raw
1 #!/usr/local/bin/perl 2 3 use warnings; 4 use strict; 5 use v5.22; 6 use JSON; 7 use Data::Dumper; 8 9 # 10 # this program demonstrates an implementation of breadth-first search as 11 # described in Chapter 6 of "Grokking Algorithms" 12 # https://www.manning.com/books/grokking-algorithms 13 # 14 15 my %graph = ( 16 you => [qw( alice bob claire )], 17 bob => [qw( anuj peggy )], 18 alice => [qw( peggy )], 19 claire => [qw( thom jonny )], 20 anuj => [], 21 peggy => [], 22 thom => [], 23 jonny => [], 24 ); 25 26 #print to_json( \%graph, { pretty => 1 } ); 27 28 sub person_is_seller { 29 my $person = shift; 30 return $person =~ m/m\Z/; 31 } 32 33 sub search { 34 my $name = shift; 35 my @queue = @{$graph{$name}}; 36 my %searched = (); 37 while (@queue) { 38 my $person = shift @queue; # grab 1st person off queue 39 say "checking $person..."; 40 # unless we've already searched this person 41 unless ($searched{$person}) { 42 if (person_is_seller($person)) { # check if person is seller 43 say "$person is a seller"; 44 return 1; 45 } else { # if not, ... 46 # ... add all of person's friends to back of queue ... 47 push @queue => @{$graph{$person}}; 48 # ... and add person to the searched hash 49 $searched{$person} = 1; 50 } 51 } 52 } 53 # we've searched through everyone (queue is empty) 54 return 0; # no seller found 55 } 56 57 if (search("you")) { 58 say "you know a mango seller!"; 59 } else { 60 say "sorry. you do not know a mango seller :("; 61 }