6
$\begingroup$

I have a weight graph, as generated by this code:

weightGraph=Graph[{SparseArray[Automatic, {55, 55}, 
   0, {1, {{0, 2, 4, 7, 9, 12, 15, 17, 20, 23, 26, 28, 31, 34, 37, 40,
       42, 45, 48, 51, 54, 57, 59, 62, 65, 68, 71, 74, 77, 79, 82, 85,
       88, 91, 94, 97, 100, 102, 105, 108, 111, 114, 117, 120, 123, 
      126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 
      126}, {{2}, {3}, {4}, {5}, {4}, {5}, {6}, {7}, {8}, {7}, {8}, 
{9}, {8}, {9}, {10}, {11}, {12}, {11}, {12}, {13}, {12}, {13}, {14}, 
{13}, {14}, {15}, {16}, {17}, {16}, {17}, {18}, {17}, {18}, {19}, 
{18}, {19}, {20}, {19}, {20}, {21}, {22}, {23}, {22}, {23}, {24}, 
{23}, {24}, {25}, {24}, {25}, {26}, {25}, {26}, {27}, {26}, {27}, 
{28}, {29}, {30}, {29}, {30}, {31}, {30}, {31}, {32}, {31}, {32}, 
{33}, {32}, {33}, {34}, {33}, {34}, {35}, {34}, {35}, {36}, {37}, 
{38}, {37}, {38}, {39}, {38}, {39}, {40}, {39}, {40}, {41}, {40}, 
{41}, {42}, {41}, {42}, {43}, {42}, {43}, {44}, {43}, {44}, {45}, 
{46}, {47}, {46}, {47}, {48}, {47}, {48}, {49}, {48}, {49}, {50}, 
{49}, {50}, {51}, {50}, {51}, {52}, {51}, {52}, {53}, {52}, {53}, 
{54}, {53}, {54}, {55}}}, Pattern}], 
  Null}, {EdgeWeight -> {79, 77, 59, 77, 57, 75, 109, 60, 72, 78, 90, 
    87, 124, 121, 149, 97, 112, 109, 124, 64, 121, 61, 146, 89, 174, 
    152, 139, 128, 154, 143, 120, 83, 60, 105, 145, 190, 99, 168, 77, 
    105, 93, 88, 82, 77, 114, 54, 91, 94, 136, 139, 173, 48, 82, 77, 
    110, 105, 107, 62, 104, 57, 99, 77, 136, 114, 41, 117, 44, 130, 
    78, 164, 101, 159, 96, 133, 98, 135, 127, 110, 78, 152, 120, 151, 
    98, 129, 115, 56, 42, 54, 128, 140, 89, 77, 26, 111, 63, 148, 136,
     140, 128, 130, 126, 87, 94, 55, 55, 86, 86, 143, 72, 129, 111, 
    141, 123, 101, 72, 50, 68, 135, 153, 185, 141, 173, 129, 175, 131,
     123}, VertexCoordinates -> {{0, 10}, {0, 9}, {1, 9}, {0, 8}, {1, 
     8}, {2, 8}, {0, 7}, {1, 7}, {2, 7}, {3, 7}, {0, 6}, {1, 6}, {2, 
     6}, {3, 6}, {4, 6}, {0, 5}, {1, 5}, {2, 5}, {3, 5}, {4, 5}, {5, 
     5}, {0, 4}, {1, 4}, {2, 4}, {3, 4}, {4, 4}, {5, 4}, {6, 4}, {0, 
     3}, {1, 3}, {2, 3}, {3, 3}, {4, 3}, {5, 3}, {6, 3}, {7, 3}, {0, 
     2}, {1, 2}, {2, 2}, {3, 2}, {4, 2}, {5, 2}, {6, 2}, {7, 2}, {8, 
     2}, {0, 1}, {1, 1}, {2, 1}, {3, 1}, {4, 1}, {5, 1}, {6, 1}, {7, 
     1}, {8, 1}, {9, 1}}}]

Mathematica graphics

I want to find a path with maximal total edge weight from source vertex to sink vertex. This is current the brute-force method based on FindPath

path = MaximalBy[
  Catenate[FindPath[weightGraph, 
      First[GraphComputation`SourceVertexList[weightGraph]], #, 
      Infinity, All] & /@ 
    GraphComputation`SinkVertexList[weightGraph]], 
  Total[PropertyValue[{weightGraph, #}, EdgeWeight] & /@ 
     EdgeList[PathGraph[#, DirectedEdges -> True]]] &]

{{35$374,42$376,67$379,82$383,92$387,98$392,75$399,89$406,51$414,90$422}}

Show the path

HighlightGraph[weightGraph, PathGraph[#, DirectedEdges -> True], 
 GraphHighlightStyle -> "Thick", 
 EdgeLabels -> 
  Thread[EdgeList[
     PathGraph[#, 
      DirectedEdges -> 
       True]] -> (PropertyValue[{weightGraph, #}, EdgeWeight] & /@ 
      EdgeList[PathGraph[#, DirectedEdges -> True]])]]

Mathematica graphics

And the maximal path cost is

Total[PropertyValue[{weightGraph, #}, EdgeWeight] & /@ 
  EdgeList[PathGraph[First[path], DirectedEdges -> True]]]

1317

Any higher efficient method can do this but not brute force?

Improve this question
$\endgroup$
6
  • $\begingroup$ I think some of the shortest path finding methods work with negative weights in acyclic graphs. Have you tried them? $\endgroup$
    – Szabolcs
    Apr 13, 2017 at 17:21
  • $\begingroup$ What is a violent method? $\endgroup$
    – Szabolcs
    Apr 13, 2017 at 17:23
  • $\begingroup$ Why do you think this algorithm isn't efficient? $\endgroup$
    – David G. Stork
    Apr 13, 2017 at 17:29
  • $\begingroup$ @David Well, it's brute forcing it. Find all paths, select the longest ones. I think yode might mean "brute force" when he says "violent", perhaps a literal translation from Chinese. There are some problems where the brute force is the best one can do. Maybe this is one of those problems. But more often this is not the case. $\endgroup$
    – Szabolcs
    Apr 13, 2017 at 17:35
  • $\begingroup$ Well of course A-star is the provably optimal path-finding algorithm applicable to such problems. $\endgroup$
    – David G. Stork
    Apr 13, 2017 at 17:39

1 Answer 1

Reset to default
4
$\begingroup$

You could make all weights negative and find shortest paths. I believe this will work with the "BellmanFord" method of FindShortestPath when the graph has no cycles.

This function maps fun onto the edge weight vector:

ClearAll[weightMap];
weightMap[fun_, g_ /; PropertyValue[g, EdgeWeight] =!= Automatic] := 
 Graph[VertexList[g], EdgeList[g], 
  EdgeWeight -> fun /@ PropertyValue[g, EdgeWeight], 
  FilterRules[Options[g], Except[EdgeWeight]]]

Gets sources and sinks with documented functions:

sinks = 
 Pick[VertexList[weightGraph], VertexOutDegree[weightGraph], 0]
(* {46, 47, 48, 49, 50, 51, 52, 53, 54, 55} *)

sources = 
 Pick[VertexList[weightGraph], VertexInDegree[weightGraph], 0]
(* {1} *)

There's only one source, 1. FindShortestPath will select the right method with negative weights:

spf = FindShortestPath[weightMap[Minus, weightGraph], 1, All]

paths = spf /@ sinks
(* {{1, 3, 6, 10, 14, 19, 24, 30, 37, 46}, {1, 3, 6, 10, 14, 
  19, 24, 30, 37, 47}, {1, 3, 6, 10, 14, 19, 26, 33, 40, 48}, {1, 3, 
  6, 10, 14, 19, 26, 33, 41, 49}, {1, 3, 6, 10, 14, 19, 26, 33, 41, 
  50}, {1, 3, 6, 10, 14, 19, 26, 33, 41, 51}, {1, 3, 6, 10, 14, 19, 
  26, 34, 43, 52}, {1, 3, 6, 10, 14, 19, 26, 34, 43, 53}, {1, 3, 6, 
  10, 15, 21, 28, 35, 44, 54}, {1, 3, 6, 10, 15, 21, 28, 36, 45, 55}} *)

HighlightGraph[weightGraph, PathGraph[#, DirectedEdges -> True]] & /@ 
  paths // Multicolumn

Mathematica graphics

Improve this answer
$\endgroup$
1
  • $\begingroup$ I do forget the FindShortestPath can serve the negtive weight,I have tried FindMinimumCostFlow many many times.As this documentation,FindMinimumCostFlow can work in negtive edge cost.But as my test,it not work.I don't sure it is a bug or not.. $\endgroup$
    – yode
    Apr 13, 2017 at 18:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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