1
$\begingroup$

I am working on the following code (to generate all shortest paths in a graph)

It executes fine until the last two lines.

PropertyValue[{g, t}, "ShortestPaths"] gives $Failed

Is there an issue with the use of PropertyValue in this context?

The code below sets up a graph, then runs code to determine all shortest paths from the source s.

The functions discoverFun and rediscoverFun are taken from Mathematica documentation (BreadthFirstScan and its applications on shortest paths). These functions are used to generate all shortest paths.

PropertyValue (at end of code) returns $Failed. Is there an issue with the use of PropertyValue?

The graph produced is the following:

enter image description here

The output of BreadthFirstScan is the following:

enter image description here

However, after this point, PropertyValue[{g, t}, "ShortestPaths"] gives $Failed.

Following the code, an example of an alternative graph example is given on which the code does execute fine.

BlingA[tree_, tPosition_] := ReplacePart[tree, tPosition -> aLpha];

BlingB[tree_, tPosition_] := 
Module[{time, updatedTree}, updatedTree = BlingA[tree, tPosition];
time = 333;
{tree, time, updatedTree}];

TestPositions[sourceTree_, targetTree_] := 
Complement[Position[sourceTree, bEta], Position[targetTree, bEta]];

AllupdatedTrees[sourceTree_, targetTree_] := 
Fold[BlingA[#1, #2] &, sourceTree, #] & /@ 
Subsets[TestPositions[sourceTree, targetTree]];

FanOutBlingBs[sourceTree_, targetTree_] := 
BlingA[sourceTree, #] & /@ TestPositions[sourceTree, targetTree];

FanOutBlingBsTimes[sourceTree_, targetTree_] := 
BlingB[sourceTree, #] & /@ TestPositions[sourceTree, targetTree];

ResultGraph[sourceTree_, targetTree_] := Module[{edges},
edges = 
Flatten[FanOutBlingBsTimes[#, targetTree] & /@ 
  AllupdatedTrees[sourceTree, targetTree], 1];
Graph[(#[[1]] -> #[[3]]) & /@ edges, 
EdgeWeight -> (#[[2]] & /@ edges), EdgeLabels -> "EdgeWeight", 
EdgeLabelStyle -> Directive[10, Background -> White], 
VertexLabelStyle -> Directive[10, Background -> White]]
];



s =  bEta[bEta[bEta[1, 2 ], 3 ], 4];
t = aLpha[aLpha[aLpha[1 , 2], 3], 4]; 


g = ResultGraph[s, t]

PropertyValue[{g, s}, "ShortestPaths"] = {{s}}; 
PropertyValue[{g, s}, "Distance"] = 0;

discoverFun[u_, v_, d_] := 
If[u != v, 
PropertyValue[{g, u}, "ShortestPaths"] = 
Table[Append[p, u], {p, PropertyValue[{g, v}, "ShortestPaths"]}]; 
PropertyValue[{g, u}, "Distance"] = d]

rediscoverFun[u_, v_] := 
If[PropertyValue[{g, u}, "Distance"] == 
PropertyValue[{g, v}, "Distance"] + 1, 
PropertyValue[{g, u}, "ShortestPaths"] = 
Join[PropertyValue[{g, u}, "ShortestPaths"], 
Table[Append[p, u], {p, PropertyValue[{g, v}, "ShortestPaths"]}]]]

BreadthFirstScan[g, s, {"DiscoverVertex" -> discoverFun, 
"VisitedVertex" -> rediscoverFun, 
"UnvisitedVertex" -> rediscoverFun}]


PropertyValue[{g, t}, "ShortestPaths"]

Table[HighlightGraph[g, p], {p, 
PathGraph /@ PropertyValue[{g, t}, "ShortestPaths"]}]

Note, if I run similar code on a different graph, it runs fine:

enter image description here

$\endgroup$
  • $\begingroup$ Edited now and added the missing function FanOutBlingBsTimes. Refreshed kernel and it runs as expected (with the error I indicated) $\endgroup$ – Mike Feb 25 '19 at 13:53
  • $\begingroup$ The following code runs fine, so not sure what I can narrow down BreadthFirstScan[g, s, {"DiscoverVertex" -> discoverFun, "VisitedVertex" -> rediscoverFun, "UnvisitedVertex" -> rediscoverFun}] $\endgroup$ – Mike Feb 25 '19 at 13:55
  • $\begingroup$ @Kuba not sure where your comments went. In any case, I fixed matters and the error should hopefully be clear now. $\endgroup$ – Mike Feb 25 '19 at 14:10
  • $\begingroup$ @Szabolcs I posted the new version. Not sure where the error in PropertyValue[{g, t}, "ShortestPaths"] at end of code arises from. BreadthFirstScan just before that line runs fine. $\endgroup$ – Mike Feb 25 '19 at 14:16
  • $\begingroup$ I tried adding reap and sow commands to discoverFun and rediscoverFun to pin down the problem further, but obtained no output. $\endgroup$ – Mike Feb 25 '19 at 19:16
1
$\begingroup$

Notice that this doesn't print anything:

In[84]:= If[x != 1, Print["a"], Print["b"]]

Out[84]= If[x != 1, Print["a"], Print["b"]]

But this does print something:

In[85]:= If[x =!= 1, Print["a"], Print["b"]]

During evaluation of In[85]:= a

This is the source of your problem; using Unequal and Equal instead of UnsameQ and SameQ.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks Jason, could you clarify why my second example graph works and not the first example graph (in relation to the use of UnsameQ and SameQ and Unequal and Equal mixup)? $\endgroup$ – Mike Feb 25 '19 at 19:39
  • 1
    $\begingroup$ All I can say is that your discoverFun and rediscoverFun aren't actually setting any property values as they are written. $\endgroup$ – Jason B. Feb 25 '19 at 19:41
  • $\begingroup$ Ok, I'll look into it more closely. But my code appears to run fine now (bar some issues with the highlighting at the end which does not show up). The main problem I am having seems to be fixed indeed. Much appreciated. $\endgroup$ – Mike Feb 25 '19 at 19:42
  • $\begingroup$ They are not really my discoverFun and rediscoverFun. They were supplied in Mathematica documentation (for a graph on which they ran fine). I have flagged it in a comment to Mathematica feedback as it would make the code more generally applicable. $\endgroup$ – Mike Feb 25 '19 at 19:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.