This is explained at
Degrees of Everything and for now is kinda aimed at
edev members.
For now, this code is also posted at http://charon.sjs.org/~mcc/epathfind.pl
Thank you for looking. I hope it's OK, i hope my code and comments are clear enough :) Enjoy (you won't)
[%
# EVERYTHING PATHFINDER .. VERSION 0.004
# i don't think this even works.
# any explanation of this can be found in the node linked at the bottom.. please read it
# the comments have been BASTARDISED so that i can post this on e2 using a PRE tag. I wish
# --- I had just posted it offsite.
# -- mcc@charon.sjs.org
# Versions of this
# * 0 : "\0" (01.20)
# * 0.001 : N-wing explains the ever-cryptic "$str" thing to me; i had been doing it wrong..
# * 0.002 : N-wing points out some problems (with qq[] and my list and such) and they get fixed..
# * 0.003 : Fixed a couple typos.
# * 0.004 : Found a typo (02.22)
# These two things have been abstracted up here so that the operator can easily redefine the concept
# of a "link", or hijack the "random nodes", in their implementation..
sub dgetlinks {return @{ selectLinks $_[0], "food" } }; #pass node_id, get list of linked node_ids
sub dgetrandom {return ${getNodeById(getRandomNode, 'light')}{title};}; #returns random node title
############################# Operational half. #############################
# in: $(env)dsname, $(env)dgname, @(env)davoid -- start node, goal node, avoid list.
# i'm assuming query->param automatically list-izes parameters passed to it seperated by commas.
# --- err-- it does, doesn't it...??
# out:
my ($derror, $dtouch, $dcoll, $dacoll, @dpath);
if ($query->param('dsname') and $query->param('dgname')) {
OPERATE: { #surely there are better ways to do exception handling in perl than this?
# This script starts at both ends and works toward the center. This is why if you look everything
# --- seems redundant, everything has to be done twice-- because it's trying to run itself from
# --- both directions at once. The reason for this is that if it started at one end and worked
# --- toward the other, and there turned out to be NO path between the two, this script could have
# --- to touch every single node on the system before it realized what was going on.
# As such we need dupes of all used variables. Items in "touch" have the touched node's id for the
# --- key, and contain the id of the node that linked that node. (the items with keys of dstart or
# --- dend contain null.)
my ( $dstart=nodeId($query->param('dsname') ), %d1touch, @d1passq, @d1nextpassq,
$dend=nodeId($query->param('dgname') ), %d2touch, @d2passq, @d2nextpassq,
%davoid, $dwin );
$derror .= (qq(<br>Starting node "), $query->param('dsname'), qq(" does not exist.))
and last OPERATE unless ($dstart);
$derror .= (qq(<br>Starting node "), $query->param('$dgname'), qq(" does not exist.))
and last OPERATE unless ($dend);
foreach $nodename ($query->param('davoid')) {$davoid{nodeId($nodename)}=0}
# ^--- dump it all into a nice little hash
@d1passq=$dstart; @d2passq=$dend; # set up start thing
$d1touch{$dstart}=0; $d2touch{$dend}=0; #dstart and dend are the only keys equal to 0
PASS: while(1) {
# ( Before i start, here's the pseudocode algorithm i wrote as the first version of this. I left
# --- it here because my code comments are mediocre :)
#
# PASS: for each item in passqueue, do the following twice, once for each end:
# load all of item's links into @checknow
# CHECK: for each link in checknow:
# if link exists in (env)davioid or my touchhash, increment (env)dcoll or (env)dacoll
# --- and next CHECK.
# put item into touchhash with key link. (increment dtouch?)
# if link exists in other touchhash, store link in dwin and last PASS
# add link to my nextpassqueue.
# next CHECK
# delete all queues and checknow
# put dwin in @(env)dpath and $link
# while ($link=$d1touch{$link}) {put link in dpath}
# reverse dpath
# while ($link=$d1touch{$link}) {put link in dpath}
#
# work from the beginning
NODE: foreach $item (@d1passq) #check all of an individual node's links
{
CHECK: foreach $link (dgetlinks($item)) #check an individual link
{
$dcoll++ and next CHECK if (exists $d1touch{$link}); #already been here
$dacoll++ and next CHECK if (exists $davoid{$link}); #don't want it
$d1touch{$link}=$item; # store who linked us here
$dwin=$link and last NODE if (exists $d2touch{$link}); #we are DONE!
push (@d1nextpassq, $link);
}
}
$derror .= qq(<br>No path exists!) and last PASS unless (@d1nextpassq); #what if there's no path?
@d1passq=@d1nextpassq; @d1nextpassq=(); #clean up our mess.
# work from the end
NODE: foreach $item (@d2passq) #check all of an individual node's links
{
CHECK: foreach $link (dgetlinks($item)) #check an individual link
{
$dcoll++ and next CHECK if (exists $d2touch{$link}); #already been here
$dacoll++ and next CHECK if (exists $davoid{$link}); #don't want it
$d2touch{$link}=$item;
$dwin=$link and last NODE if (exists $d2touch{$link}); #we are DONE!
push(@d2nextpassq,$link);
}
}
$derror .= qq(<br>No path exists!) and last PASS unless (@d2nextpassq); #what if there's no path?
@d2passq=@d2nextpassq; @d2nextpassq=(); #clean up our mess.
}
$dtouch=scalar(keys(%d1touch)) + scalar(keys(%d2touch)) - 1; #number of nodes touched by all this.
# --- how efficient is "keys"? it doesn't actually allocate an array does it?
#start at the center and work out. remember, when we hit the end, $link will be 0, so..
push(@dpath,($link=$dwin));
push(@dpath,$link) while ($link=$d1touch{$link});
@dpath=reverse dpath;
push(@dpath,$link) while ($link=$d2touch{$link});
#that's all.
}
}
# ideally, i would like here for the number of steps to be added to a list somewhere-- probably nothing
# --- complex, probably just a long file or one-column table containing every single step value from
# --- every single run of this script. This could be done just so that there could be stats here like
# --- longest chain length between nodes/average chain length between nodes.
############################# Display half. #############################
# I decided not to go with the whole $str thing, since there's no actual flow control going on..
# instead, i just made a long list, which is strung together. Seems.. cleaner. To me, anyway.
return join("",(
$query->startform(-method=>'get'),
"<b>Starting node:</b> ",
$query->textfield(-name=>'dsname', #.. fields contain either the previous value, or random.
-default=> ( $query->param('dsname') ? $query->param('dsname') : dgetrandom() ),
-size=>50,
-maxlength=>80),
"<br><b>Ending node:</b> ",
$query->textfield(-name=>'dgname',
-default=> ( $query->param('dgname') ? $query->param('dgname') : dgetrandom() ),
-size=>50,
-maxlength=>80),
"<p><b>Avoid touching:</b> ",
$query->textfield(-name=>'davoid',
-default=>join(",",$query->param('davoid')),
-size=>50,
-maxlength=>1000),
"<p>",
$query->submit(-name=>'Go'),
"<hr>",
($derror ? qq(<font color="#CC0000"><b>ERROR:$derror</b></font><p>) : "") ,
(@dpath ? ("<b>Path taken:</b><ul><li>",
join("<li>", map( linkNode($_) , @dpath) ) , # link nodes and join them.. blah
"</ul>Total steps: <b>", scalar @dpath, "</b><p>") : ""),
($dtouch ? "Search touched <b>$dtouch</b> nodes." : ""),
($dcoll ? "<br>The path collided with itself <b>$dcoll</b> times" : ""),
($dacoll ? "<br>And collided with the \"Avoid touching\" list <b>$dacoll</b> times." : ".") ));
%]
<p>Can't figure out how to work this thing? Look [Degrees of Everything|here.]