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$ Commented Apr 13, 2017 at 17:21
  • $\begingroup$ What is a violent method? $\endgroup$ Commented Apr 13, 2017 at 17:23
  • $\begingroup$ Why do you think this algorithm isn't efficient? $\endgroup$ Commented 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$ Commented Apr 13, 2017 at 17:35
  • $\begingroup$ Well of course A-star is the provably optimal path-finding algorithm applicable to such problems. $\endgroup$ Commented 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$ Commented Apr 13, 2017 at 18:00

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.