Climbing/Descending the Integer Ladder
Here is one way to get the paths:
ClearAll[paths]
paths[n_, k_] := With[{m = (k - n)/2},
ReplaceAll[
Flatten @ paths[{}, k - m , m],
list -> Sequence
] /; m >= 0 && IntegerQ[m]
]
paths[accum_, 0, n_] := list[Join[accum, ConstantArray[-1, n]]]
paths[accum_, n_, 0] := list[Join[accum, ConstantArray[1, n]]]
paths[accum_ , forwardLeft_, backwardLeft_] := {
paths[Append[accum, 1], forwardLeft - 1, backwardLeft],
paths[Append[accum, -1], forwardLeft, backwardLeft - 1]
}
For example
paths[3, 5]
(*
{
{1, 1, 1, 1, -1}, {1, 1, 1, -1, 1}, {1, 1, -1, 1, 1},
{1, -1, 1, 1, 1}, {-1, 1, 1, 1, 1}
}
*)
There probably are more efficient ways to do that, given that this boils down to combinations C(k, m)
, where m = (k - n) / 2
, so this is basically a problem of picking m
-1
s and k + m
1
s in all possible distinct ways.
Update:
Per my reread and your comments, the following will generate all paths. It dramatically outperforms the existing answers, and is about two orders of magnitude faster on the ${k,n}={25,7}$ test than the compiled version using $gosperc$.
Join @@ Permutations /@ IntegerPartitions[n, {k}, {-1, 1}]
The direct count is given by:
(1 - Mod[n + k, 2]) Binomial[k, Floor[(k - n)/2]]
Timing comparison for a slightly larger case:
{n, k} = {9, 29};
ClearAll[r, me, ls]
ClearSystemCache[]
(* This *)
me = Join @@ Permutations /@ IntegerPartitions[n, {k}, {-1, 1}]; //
AbsoluteTiming // First
(* eyorble compiled C *)
up = (n + k)/2;
r = Map[cvlist[k, #] &,
NestList[gosperc, 2^up - 1, Binomial[k, up] - 1]]; //
AbsoluteTiming // First
(* Leonid *)
ls = paths[n, k]; // AbsoluteTiming // First
Length /@ {r, me, ls}
Sort[me] == Sort[r] == Sort[ls]
1.45388
153.622
104.509
{20030010, 20030010, 20030010}
True
Original post:
I presume that when at "0", a step of -1 leaves one still at "0". You're on the ground or not...
This then is a bounded random walk on the integers, easily represented as a Markov process.
pathsm = PDF[
DiscreteMarkovProcess[1,
SparseArray[{{#1 + 1, #1 + 1} -> 1, {1, 1} -> 1/2,
Band[{2, 1}, {#1, #1 + 1}] -> 1/2,
Band[{1, 2}] -> 1/2}, {#1 + 1, #1 + 1}]][#1], #2 + 1]*2^#1 &;
Usage: pathsm[k, n]
A comparison of timings of this, Leonid's and eyorble's on ${k,n}={30,10}$ gives 0.0007, 159.9, and 359.9 seconds.
The direct result for counts is Binomial[k, Floor[(k - n)/2]]
.
N.B.: in rereading the question, this may not be responsive, as it counts paths vs enumerating them. Nonetheless, it may be useful in your investigation, so I'll keep it here unless you comment otherwise.
Assuming $n$ is the target number and $k$ is the number of steps, the number of upward steps is: $u=\frac{k+n}{2}$. Thus, we need to distribute $u$ positive values and $d=k-u$ negative values into a list.
Let's work with them using characteristic vectors, where a 1-bit means an upward movement and a 0-bit means a downward movement.
The first such vector is trivially $2^u-1$. Then use Gosper's hack to calculate the rest of them, given that we know how many there are to begin with.
Example code:
gosper[x_] := With[{u = BitAnd[x, -x], v = x + BitAnd[x, -x]},
v + BitShiftRight[Floor[BitXor[v, x]/u], 2]];
cvlist[l_, v_] := PadLeft[IntegerDigits[v, 2], l] /. {0 -> -1};
(* convert a characteristic vector to a list representation *)
n = 3;
k = 5;
up = (n + k)/2;
Map[cvlist[k, #] &, NestList[gosper, 2^up - 1, Binomial[k, up] - 1]]
To test this for efficiency, for n = 7; k = 25;
, this solution takes 16.7 seconds on my machine to go through the 2,042,975 combinations by AbsoluteTiming
.
This can be tremendously sped up with Compile
:
gosperc =
Compile[{{x, _Integer}},
x + BitAnd[-x, x] +
BitShiftRight[Floor[BitXor[x, x + BitAnd[-x, x]]/BitAnd[-x, x]],
2], CompilationTarget -> "C"];
This can perform the prior test, n = 7; k = 25;
in 10.5 seconds in NestList
on my machine. The limitation of compiling this way is that $k$ must be less than a machine sized integer (likely 64, maybe 32 depending on your system).