How to draw all paths from (1,1) to (n,n) by move (+1, 0) or (0, +1)?

Question

Now I can draw some grid:

But what I want(I'm sorry for the weird line. I have no image processing software in my mac...):

Please notice:

f(1, 1) = f(2, 1) = f(3, 1) = 1
f(1, 1) = f(1, 2) = f(1, 3) = 1 
f(2, 2) = f(1, 2) + f(2, 1) = 2 
f(3, 3) = f(3, 2) + f(2, 3) = 2*(f(2, 2) + f(1, 2)) = 2*3 = 6

So there is 6 paths from (1,1) to (n,n) by two possible moves: (+1,0), (0, +1).

My question is, how to draw all paths into the grid with different color or different label?

I know the number of paths may be very large when n grows and I just want to make a nice illustration about that problem. So you can assume n <= 5.

Answer 1

Stealing half of evanb's answer we could do:

With[{n = 3}, Graphics[{
   LightGray, Disk[#, 0.5] & /@ Flatten[Table[{i, j}, {i, 0, n}, {j, 0, n}], 1],
   Thick, Module[{m, paths = Sort@Permutations[Join @@ ({{0, 1}, {1, 0}} & /@ Range[n])]},
    m = Length@paths; 
    Table[{Hue[(i - 1)/(m - 1)], Line@FoldList[Plus, 
        1/(2 Sqrt[2]) {-1 + (2 (-1 + i))/(-1 + m), 
          1 - (2 (-1 + i))/(-1 + m)}, paths[[i]]]}, {i, m}]
    ]}]]

Answer 2

You can use the Graph capabilities to solve this problem. First, note that every path from $(1,1)$ to $(n,n)$ has $2n-2$ moves, so it is just a matter of using FindPath with GridGraph

n = 3;
g = GridGraph[{n, n}, VertexLabels -> "Name"]
FindPath[g, 1, n n, {2 n - 2}, All] /. 
 Thread[Range[n n] -> GraphEmbedding[g]]

You can visualize all the paths with PathGraph,

With[{n = 4},
 g = GridGraph[{n, n}];
 HighlightGraph[g, PathGraph@#] & /@ 
  FindPath[g, 1, n n, {2 n - 2}, All]]

ListAnimate@%

Edit

Here is a method, less simple than above, but still distinctly different from kirma's answer, that answer's OP's request to draw all of the paths together in a manner in which they are all visible.

gridpaths[n_] := Module[{g, coords, paths},
  g = GridGraph[{n, n}, EdgeStyle -> Opacity[0]];

  coords[offs_] := Thread[Range@(n n) -> (offs + GraphEmbedding@g)];
  paths = FindPath[g, 1, n n, 2 n - 2, All];
  Show[
   PathGraph[#1,
      VertexCoordinates -> #1 /. coords[#3],
      EdgeStyle -> Directive[Thick, #2],
      VertexSize -> 0] & @@@ 
   Transpose[{paths,
      ColorData[97] /@ Ordering@paths,
      Subdivide[-.3, .3, Length@paths - 1]}]}],
   GridLines -> {#, #} &@Range[0.5, n + .5, 1],
   PlotRange -> {{.5, n + .5}, {.5, n + .5}}
   ]
  ]

It can be tested via

gridpaths /@ Range[2, 7]

Answer 3

You could try something like this:

Show[Graphics[{RandomColor[], Line[#]}] & /@ ( (* Make graphics of *)
FoldList[Plus, RandomReal[{0, 0.1}, 2] + {0, 0}, #] & /@ (* Trajectories built from *)
Permutations[ (* All possible orderings of *)
    Join @@ ({{0, 1}, {1, 0}} & /@ Range[5]) (* Five steps N and five steps E*)
   ]
)]

The RandomReal[{0,0.1},2] is a random near-the-origin starting location, just to offset the different lines from one another visually.

Answer 4

A solution just to show Solve can also be used directly on basis of the problem specification:

With[{max = 4},
  With[{coords = Table[{x[n], y[n]}, {n, 2 max - 1}]},
    coords /. Solve[
       (* the first and last points *)
       {x[1] == y[1] == 1,
        x[2 max - 1] == y[2 max - 1] == max, 
        (* intermediate constrained steps *)
        Sequence @@ Table[
          x[n + 1] == x[n] + 1 && y[n + 1] == y[n] || 
           x[n + 1] == x[n] && y[n + 1] == y[n] + 1,
          {n, 2 max - 2}]}, 
      Flatten@coords]] // 
  (* the rest is just formatting output *)
  Function[sols, 
     MapIndexed[#1 + 
        Table[{1/2, -1/2} + {-1, 1} First@#2/Length@sols, Length@#] &, 
      sols]] // ListLinePlot[#, AspectRatio -> Automatic] &]

Another solution finding all paths on a directed GridGraph, giving the same result:

With[{max = 4}, 
 With[{g = 
      VertexReplace[GridGraph[{max, max}, DirectedEdges -> True],
       (* convert vertex numbers to coordinates, 
          working around what seems like a pattern matching bug... *)
       Flatten@Table[
         FromDigits[{x, y} - {1, 1}, max] + 1 -> {x, y},
          {x, max}, {y, max}]]},
    (* find all paths in a directed grid graph *)
    FindPath[g, {1, 1}, {max, max}, \[Infinity], All]] //
   (* the rest is just formatting output *)
   Function[sols, 
    MapIndexed[#1 + 
       Table[{1/2, -1/2} + {-1, 1} First@#2/Length@sols, Length@#] &, 
     sols]] // ListLinePlot[#, AspectRatio -> Automatic] &]

Answer 5

g[n_] := Module[{tup = Tuples[{{1, 0}, {0, 1}}, 2 n]},
   Pick[tup, Total[#] == {n, n} & /@ tup]];
fun[n_] := 
 With[{r = Accumulate /@ (Join[{{1/2, 1/2}}, #] & /@ g[n])}, 
  Join @@ MapIndexed[ 
    Panel[#1, ToString[#2[[1]]] <> " of " <> ToString[Length@r]] &,
    Table[ListPlot[#[[1 ;; j]], Joined -> True, AxesOrigin -> {0, 0},
        PlotStyle -> {Red, Thick},
        PlotRange -> Table[{0, n + 1}, {2}], 
        GridLines -> {Range[0, n], Range[0, n]}, Frame -> True, 
        FrameTicks -> None, AspectRatio -> Automatic], {j, 1, 
        2 n + 1}] & /@ r, {2}]]

The animation is not efficient. Others will doubt have better ways. I only illustrate paths from {1,1} (lower left hand corner) to {4,4}.

dat = fun[3];

Answer 6

So, paths can be found by traversing a grid graph. But also, they can be stacked in a 3D graphic.

paths[rows_, cols_] := FindPath[
  GridGraph[{rows, cols}], 1, rows*cols,
  ManhattanDistance[{1, 1}, {rows, cols}] + 1, All]

This has the advantage of rotating the stack and looking at it from different view points.

draw3D[rows_, cols_, options___] :=
 Module[{lines, hues},
  lines = Module[{z = 0},
    paths[rows, cols] /. path : {__Integer} :> (z += 1; Line[
        {Quotient[#, rows, 1], Mod[#, rows, 1], z} & /@ path])];
  hues = ColorData["Rainbow"] /@ Rescale[Range@Length@lines];
  Graphics3D[{Thick, JoinForm["Round"], Transpose[{hues, lines}]},
   options,
   ImageSize -> Small,
   BoxRatios -> {cols, rows, Min[cols, rows]},
   Boxed -> False]]

draw3D[4, 3, SphericalRegion -> True]

Answer 7

This can be solved using Permutations[], Accumulate[] and the graphics commands.

Letting, for simplicity,

rep = {{1, 0} -> x, {0, 1} -> y};

The list of all paths is given simply by all different step sequences

stepsequs[n_] := Permutations[Join[Array[x &, n], Array[y &, n]]]

Example

stepsequs[3]

(* Output suppressed *)

The number of paths is obviously given by

nPaths[n_] := Binomial[2 n, n]

checking some values: ok

Table[{nPaths[n], Binomial[2 n, n]}, {n, 1, 5}]

(* Out[179]= {{2, 2}, {6, 6}, {20, 20}, {70, 70}, {252, 252}} *)

The graphical representation can be done in a primitive form like this

First, we add the start Point, and we do this with a random shift (in order to be able to distinguish different paths, which works only to a certain degree, I admit)

r := RandomReal[]/10

sequ[n_] := Join[{{r, r}}, #] & /@ stepsequs[n] /. {x -> {1, 0}, y -> {0, 1}}

The lines to be drawn are generated from the step sequence using Accumulate[]

Putting things together we arrive at

With[{n = 3}, Show[Graphics[Line[Accumulate /@ sequ[n]]]]]

Remark: my graphis abilities are very limited. Others have provided nice pictures already.