# Linear Integer Programming-Find all path on a GridGraph

I would like to solve my birth and death problem.

SeedRandom[124]
With[{λ = 3, μ = 2, initialPopulation = 10,
numOfReaction = 5, numOfSim = 1},
ListLinePlot[
sim = birthDeath[λ, μ, initialPopulation,
numOfReaction], InterpolationOrder -> 0,
PlotStyle -> {Black, Thick}, Frame -> True,
GridLines -> Transpose@sim, FrameLabel -> {"Time", "Population"},
ImageSize -> 300]]

And one possible path is

sim={{0, 10}, {0.168871, 9}, {0.824082, 10}, {0.92576, 11}, {0.956336, 12}, {1.06251, 11}}

Differences@sim[[All, 1]]

deltaT={0.168871, 0.655211, 0.101678, 0.0305756, 0.106177}

after 0.168871s there is a death but it could be a birth and after 0.655211s there is birth but it could be death and so on.

Initial population is 10 and end up with population 11 after some number of birth and death.Number of reaction is constant which is 5 in this case namely 2 death, 3 birth. I would like to find All path between initial population and last population. I thought I can use Graph and find all path that satisfy the condition.

Do you think it is better to use Linear Integer Programming? Total population cannot be negative. Sum of #birth and #death=last population-initial population. birth and death are integer.

Assume I have $5\times5$ GridGraph. I would like to find all path (not necessarily shortest ) under some condition.

1. Start from initial population and always move to Right, Up Or Down at the beginning.
2. You cannot move Right and Right consecutively. Meaning that after Right either move UP or Down if possible.
3. Never move Left.

Here is the sample code I got from Help page which violets some rules I have.

s = 1;
t = 16;
g = GridGraph[{4, 4}, VertexSize -> {s -> Medium, t -> Medium}]

path=FindPath[g, s, t, {GraphDistance[g, s, t]}, All]

HighlightGraph[g, PathGraph[#]] & /@ path

• If "you always move to the right at the beginning" and "you cannot move right and right," then your problem is a general shortest search on a $3 \times 3$ grid. All valid paths "start" at the location $(1,1)$ and exclude the three "right-right" paths that remain. Commented Jan 20, 2018 at 1:35
• Yes you right. Let me fix my condition. Commented Jan 20, 2018 at 1:39
• I just realized that graph approach may not be a good idea. Commented Jan 20, 2018 at 2:06
• loosely/ tangentially related: Counting all perpendicular paths crossing a grid
– kglr
Commented Jan 20, 2018 at 2:35
• What about Up + Up? Or Up+Down? Commented Jan 20, 2018 at 2:43

Here is one idea. First, let's look at the vertex labels:

g = GridGraph[{5, 5}, VertexLabels -> "Name"]

Since FindPath doesn't revisit vertices, we don't have to worry about up + down paths. The paths that FindPath generates that are not allowed are the up + up, down + down and right + right (in addition to left). I use the following to encode this information:

up = {
{1, 2, 3}, {2, 3, 4}, {3, 4, 5},
{6, 7, 8}, {7, 8, 9}, {8, 9, 10},
{11, 12, 13}, {12, 13, 14}, {13, 14, 15},
{16, 17, 18}, {17, 18, 19}, {18, 19, 20},
{21, 22, 23}, {22, 23, 24}, {23, 24, 25}
};

down = Reverse /@ up;

right = {
{1, 6, 11}, {6, 11, 16}, {11, 16, 21},
{2, 7, 12}, {7, 12, 17}, {12, 17, 22},
{3, 8, 13}, {8, 13, 18}, {13, 18, 23},
{4, 9, 14}, {9, 14, 19}, {14, 19, 24},
{5, 10, 15}, {10, 15, 20}, {15, 20, 25}
};

left = {
{6, 1}, {11, 6}, {16, 11}, {21, 16},
{7, 2}, {12, 7}, {17, 12}, {22, 17},
{8, 3}, {13, 8}, {18, 13}, {23, 18},
{9, 4}, {14, 9}, {19, 14}, {24, 19},
{10, 5}, {15, 10}, {20, 15}, {25, 20}
};

Using the above data, we can create a function to determine whether a path is allowed or not:

goodQ[path_, set_, len_] := Max[
Length[LongestCommonSubsequence[path, #]]& /@ set
] < len

goodQ[path_] := And[
goodQ[path, left, 2],
goodQ[path, right, 3],
goodQ[path, up, 3],
goodQ[path, down, 3]
]

Finally, we can construct all the paths and then select only the good ones:

paths = Join @@ Table[
FindPath[g, 1, end, 9, All],
{end, 21, 25}
];
good = Select[paths, goodQ]

{{1, 6, 7, 12, 13, 18, 17, 22, 21}, {1, 6, 7, 12, 11, 16, 17, 22, 21}, {1, 2, 7, 8, 13, 12, 17, 16, 21}, {1, 2, 7, 6, 11, 12, 17, 16, 21}, {1, 6, 7, 12, 13, 18, 17, 22}, {1, 6, 7, 12, 11, 16, 17, 22}, {1, 2, 7, 8, 13, 14, 19, 18, 23, 22}, {1, 2, 7, 8, 13, 12, 17, 18, 23, 22}, {1, 2, 7, 8, 13, 12, 17, 16, 21, 22}, {1, 2, 7, 6, 11, 12, 17, 18, 23, 22}, {1, 2, 7, 6, 11, 12, 17, 16, 21, 22}, {1, 6, 7, 12, 13, 18, 19, 24, 23}, {1, 6, 7, 12, 13, 18, 17, 22, 23}, {1, 6, 7, 12, 11, 16, 17, 22, 23}, {1, 2, 7, 8, 13, 14, 19, 18, 23}, {1, 2, 7, 8, 13, 12, 17, 18, 23}, {1, 2, 7, 6, 11, 12, 17, 18, 23}, {1, 6, 7, 12, 13, 18, 19, 24}, {1, 2, 7, 8, 13, 14, 19, 20, 25, 24}, {1, 2, 7, 8, 13, 14, 19, 18, 23, 24}, {1, 2, 7, 8, 13, 12, 17, 18, 23, 24}, {1, 2, 7, 6, 11, 12, 17, 18, 23, 24}, {1, 6, 7, 12, 13, 18, 19, 24, 25}, {1, 2, 7, 8, 13, 14, 19, 20, 25}}

Visualization:

Multicolumn[
HighlightGraph[
Graph[g, EdgeStyle->LightGray, VertexLabels->None],
BlockMap[Apply[UndirectedEdge], #, 2, 1]
]& /@ good,
3
]

If we only want paths that start at 1 and end at 22, with 3 up steps and 2 down steps, then the path has length 9:

paths = FindPath[g, 1, 22, {9}, All];
good = Select[paths, goodQ]

{{1, 2, 7, 8, 13, 14, 19, 18, 23, 22}, {1, 2, 7, 8, 13, 12, 17, 18, 23, 22}, {1, 2, 7, 8, 13, 12, 17, 16, 21, 22}, {1, 2, 7, 6, 11, 12, 17, 18, 23, 22}, {1, 2, 7, 6, 11, 12, 17, 16, 21, 22}}

Visualization:

Multicolumn[
HighlightGraph[
Graph[g, EdgeStyle->LightGray, VertexLabels->None],
BlockMap[Apply[UndirectedEdge], #, 2, 1]
]& /@ good,
3
]

Update

Here's a version of goodQ that should generalize better:

goodQ[path_] := With[{d = Differences[path]},
With[{odd = Tally[Abs[d][[1;;-1;;2]]], even = Tally[Abs[d][[2;;-1;;2]]]},
Min[d]>=-1 && Length[odd]==1 && Length[even]==1 &&odd!=even
]
]

Check:

paths = Join@@Table[FindPath[g, 1, end, 9, All], {end, 21, 25}];
good = Select[paths, goodQ]

{{1, 6, 7, 12, 13, 18, 17, 22, 21}, {1, 6, 7, 12, 11, 16, 17, 22, 21}, {1, 2, 7, 8, 13, 12, 17, 16, 21}, {1, 2, 7, 6, 11, 12, 17, 16, 21}, {1, 6, 7, 12, 13, 18, 17, 22}, {1, 6, 7, 12, 11, 16, 17, 22}, {1, 2, 7, 8, 13, 14, 19, 18, 23, 22}, {1, 2, 7, 8, 13, 12, 17, 18, 23, 22}, {1, 2, 7, 8, 13, 12, 17, 16, 21, 22}, {1, 2, 7, 6, 11, 12, 17, 18, 23, 22}, {1, 2, 7, 6, 11, 12, 17, 16, 21, 22}, {1, 6, 7, 12, 13, 18, 19, 24, 23}, {1, 6, 7, 12, 13, 18, 17, 22, 23}, {1, 6, 7, 12, 11, 16, 17, 22, 23}, {1, 2, 7, 8, 13, 14, 19, 18, 23}, {1, 2, 7, 8, 13, 12, 17, 18, 23}, {1, 2, 7, 6, 11, 12, 17, 18, 23}, {1, 6, 7, 12, 13, 18, 19, 24}, {1, 2, 7, 8, 13, 14, 19, 20, 25, 24}, {1, 2, 7, 8, 13, 14, 19, 18, 23, 24}, {1, 2, 7, 8, 13, 12, 17, 18, 23, 24}, {1, 2, 7, 6, 11, 12, 17, 18, 23, 24}, {1, 6, 7, 12, 13, 18, 19, 24, 25}, {1, 2, 7, 8, 13, 14, 19, 20, 25}}