Klettern / Absteigen der Integer-Leiter

Question

Ein lustiges kombinatorisches Puzzle, das in meiner Arbeit aufgetaucht ist und das ich für niedlich halte, wenn ich eine Mathematica-Lösung hätte, wenn jemand es ausprobieren möchte. Es ist im Grunde ein Problem beim Klettern / Absteigen auf der Leiter, also hat es wahrscheinlich eine gute GraphLösung. Es ist erwähnenswert, dass meine Leiter in den Keller absteigen kann (dh meine ganzzahligen Werte können darunter liegen$0$)

Beginnt um $0$, Über $k$ Schritte von $\pm1$, was sind die Pfade, die auf der ganzen Zahl landen werden $n$vorausgesetzt natürlich das $k \ge n$.

Es macht mir nichts aus, wenn diese Frage wegen mangelnder Anstrengung von meiner Seite geschlossen wird (ich arbeite derzeit an einer analytischen Lösung) und würde mich tatsächlich sehr freuen, wenn diese als Duplikat geschlossen würde / wenn mich jemand auf das Richtige hinweisen könnte Name für dieses Problem. Aber ich dachte, Mathematica.SE könnte ein schnelles und einfaches Problem haben, um die Plackerei "Löse meine Integro-Differential-Gleichung für mich" zu brechen.

Answer 1

Aktualisieren:

Nach meinem erneuten Lesen und Ihren Kommentaren werden im Folgenden alle Pfade generiert. Es übertrifft die vorhandenen Antworten dramatisch und ist auf der Website um zwei Größenordnungen schneller${k,n}={25,7}$ Test als die kompilierte Version mit $gosperc$.

Join @@ Permutations /@ IntegerPartitions[n, {k}, {-1, 1}]

Die direkte Zählung ergibt sich aus:

(1 - Mod[n + k, 2]) Binomial[k, Floor[(k - n)/2]]

Zeitvergleich für einen etwas größeren Fall:

{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}

Wahr

Ursprünglicher Beitrag:

Ich nehme an, dass bei "0" ein Schritt von -1 einen noch bei "0" belässt. Du bist am Boden oder nicht ...

Dies ist dann ein begrenzter zufälliger Spaziergang auf den ganzen Zahlen, der leicht als Markov-Prozess dargestellt werden kann.

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 &;

Verwendung: pathsm[k, n]

Ein Vergleich der Timings von Leonid und Eyorble ${k,n}={30,10}$ ergibt 0,0007, 159,9 und 359,9 Sekunden.

Das direkte Ergebnis für die Zählung ist Binomial[k, Floor[(k - n)/2]].

NB: Beim erneuten Lesen der Frage reagiert dies möglicherweise nicht, da Pfade gezählt und nicht aufgezählt werden. Trotzdem kann es für Ihre Untersuchung nützlich sein, daher werde ich es hier behalten, sofern Sie nichts anderes kommentieren.

Answer 2

Hier ist ein Weg, um die Pfade zu bekommen:

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]
}

Beispielsweise

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}
   }
*)

Es gibt wahrscheinlich effizientere Möglichkeiten, dies zu tun, da dies auf Kombinationen hinausläuft C(k, m), bei denen es m = (k - n) / 2sich also im Grunde um ein Problem handelt, m -1s und k + m 1s auf alle möglichen unterschiedlichen Arten auszuwählen.

Answer 3

Vorausgesetzt $n$ ist die Zielnummer und $k$ ist die Anzahl der Schritte, die Anzahl der Aufwärtsschritte ist: $u=\frac{k+n}{2}$. Wir müssen also verteilen$u$ positive Werte und $d=k-u$ negative Werte in eine Liste.

Arbeiten wir mit ihnen unter Verwendung charakteristischer Vektoren, wobei ein 1-Bit eine Aufwärtsbewegung und ein 0-Bit eine Abwärtsbewegung bedeutet.

Der erste solche Vektor ist trivial $2^u-1$. Verwenden Sie dann Gospers Hack , um den Rest von ihnen zu berechnen, vorausgesetzt, wir wissen, wie viele es zu Beginn gibt.

Beispielcode:

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]]

Um dies auf Effizienz zu testen n = 7; k = 25;, benötigt diese Lösung auf meinem Computer 16,7 Sekunden, um die 2.042.975 Kombinationen von zu durchlaufen AbsoluteTiming.

Dies kann enorm beschleunigt werden mit Compile:

gosperc = 
  Compile[{{x, _Integer}}, 
   x + BitAnd[-x, x] + 
    BitShiftRight[Floor[BitXor[x, x + BitAnd[-x, x]]/BitAnd[-x, x]], 
     2], CompilationTarget -> "C"];

Dies kann den vorherigen Test n = 7; k = 25;in 10,5 Sekunden NestListauf meinem Computer durchführen. Die Einschränkung beim Kompilieren auf diese Weise besteht darin, dass$k$ muss kleiner als eine maschinengroße Ganzzahl sein (wahrscheinlich 64, möglicherweise 32, abhängig von Ihrem System).

Answer 4

Hier ist mein dummer Ansatz, basierend auf der Tatsache, dass (vorausgesetzt $k>=0$) Die Anzahl der Abwärtsschritte beträgt (n-k)/2

paths[n_, m_] :=
 If[! EvenQ[n - m],
  {},
  Permutations[Join[
    Sign[m]*ConstantArray[-1, (n - Abs[m])/2],
    Sign[m]*ConstantArray[1, n - (n - Abs[m])/2]
    ]]
  ]