http://www.perlmonks.org?node_id=614464

newbio has asked for the wisdom of the Perl Monks concerning the following question:

Since there was no response from dear Monks to my earlier post..:(, I guess I need to present the problem in a more
visual manner by taking an example. Thus, I have redrafted my code and the problem. Hope, this time it works and dear Monks get pleased and solve my problem...:).

OK, the program does the following:

Given the graphical network topology with all nodes and their associated values, the program creates conditional
probability tables (cpt) associated with each node in the network. As an example, I have tried to implement the
graphical network shown here: http://www.snn.ru.nl/~wimw/asci2003/bayesintro.html . Please note that CPTs in the
example are the tables shown next to each node (see the URL). So, for each combination of values of a particular node
and its parents a probability value is assigned in the node cpt. Since the probability is conditional, all rows in a cpt add up to
1. My program does not learn the probability values "yet", and simply assigns 1 for each of those probability slots.

However, there appears some error in the code somewhere which I am unable to detect. When I pass single node name in
my code through @nodes (such as @nodes=('sprinkler'); or @nodes=('wetgrass') etc);, the result (i.e. cpt) comes
out correct. However, when I pass multiple nodes through @nodes (such as
@nodes=('sprinkler','cloudy','wetgrass','rain');) then the first cpt (for node sprinkler) in the result comes out correct, however, the
remaining ones are wrong (output shown below).
Please guide me as to where the fault lies in the code. Also, are you happy with my data structures for cpts?

The idea is to use the graph structure for training and inference later.

##############
Actual program Output (the first cpt i.e for sprinkler is correct, while the rest aren't):

sprinkler cpt:
cloudy sprinkler =>1
f t=>1
f f=>1
t f=>1
t t=>1

cloudy cpt:
=>1

wetgrass cpt:
rain wetgrass =>1
f t=>1
f f=>1
t f=>1
t t=>1

rain cpt:
=>1



whereas the desired output should be:

sprinkler cpt:
cloudy sprinkler =>1
f t=>1
f f=>1
t f=>1
t t=>1

cloudy cpt:
cloudy =>1
f=>1
t=>1

wetgrass cpt:
sprinkler rain wetgrass =>1
f f f=>1
t t f=>1
t f t=>1
f t t=>1
t f f=>1
f t f=>1
t t t=>1
f f t=>1

rain cpt:
cloudy rain =>1
f t=>1
f f=>1
t f=>1
t t=>1
##############
#!/usr/bin/perl use warnings; use strict; my $couldy=['cloudy','t','f']; # 'cloudy' is the node name and 't','f' + are the values this node can assume. Likewise for other nodes. my $sprinkler=['sprinkler','t','f']; my $rain=['rain','t','f']; my $wetgrass=['wetgrass','t','f']; my $values=[$sprinkler,$couldy,$rain,$wetgrass]; my @nodes=('sprinkler','cloudy','wetgrass','rain'); foreach my $i (@nodes) { my $nodeparents=[parentchildrelationship($i)]; print "$i $nodeparents $values\n"; my $hash1=cpt($i,$nodeparents,$values); foreach my $i (keys %{$hash1}) { print "$i=>${$hash1}{$i}\n"; #print "$i\n"; } } sub cpt { my $node=$_[0]; my @parents=@{$_[1]}; my @nodevalues=@{$_[2]}; my %hash=(); my @nodeindex=(); my @temparray=(); my $string=""; my @temp=(); my $s; foreach my $i (@parents) { for (my $j=0;$j<=$#nodevalues;$j++) { if ($i eq ${$nodevalues[$j]}[0]) { push (@nodeindex, $j); } } } foreach my $i (reverse @nodeindex) { push (@temparray, $nodevalues[$i]); } for (my $i=0;$i<=$#temparray;$i++) { $string="$string"."${$temparray[$i]}[0] "; shift @{$temparray[$i]}; $temp[$i]=join (",",@{$temparray[$i]}); } $hash{$string}=1; #fill %hash with the header (header is simply th +e name of the node along with its parents) $s = join "\\ ", map "{$_}", @temp; #print "$s\n"; $hash{$_}=1 for glob $s; return {%hash}; $node=""; @parents=(); @nodevalues=(); %hash=(); @nodeindex=(); @temparray=(); $string=""; @temp=(); $s=""; } sub parentchildrelationship { my $node=$_[0]; #or use "shift" my %parentchild=(); my @nodeset=(); %parentchild=('cloudy'=>['none'], 'sprinkler'=>['cloudy'], 'rain'= +>['cloudy'], 'wetgrass'=>['rain','sprinkler']); #This is the structur +e of the graph, for example node 'cloudy' has no parent; node 'sprink +ler' has 'cloudy' as its parents; node 'rain' has 'cloudy' as its pa +rents; node 'weygrass' has 'rain' and 'sprinkler' as its parents; (d +irectionality of the arrow determines the child-parent relationship). push (@nodeset, $node, @{$parentchild{$node}}); return @nodeset; }