Salire / scendere dalla scala intera

Question

Un divertente puzzle combinatorio che è apparso nel mio lavoro e penso che sarebbe carino avere una soluzione di Mathematica, se qualcuno vuole provarlo. È fondamentalmente un problema di salita / discesa della scala, quindi probabilmente ha una buona Graphsoluzione. Vale la pena notare che la mia scala può scendere nel seminterrato (cioè i miei valori interi possono andare al di sotto$0$)

A partire da $0$, al di sopra di $k$ passi di $\pm1$, quali sono i percorsi che atterreranno sull'intero $n$, supponendo ovviamente che $k \ge n$.

Non mi importa se questa domanda viene chiusa per mancanza di impegno da parte mia (sto attualmente elaborando una soluzione analitica) e sarei davvero molto felice se fosse chiusa come un duplicato / se qualcuno potesse indicarmi la corretta nome per questo problema. Ma pensavo che Mathematica.SE potesse trovare un problema facile e veloce per rompere la fatica "risolvi la mia equazione integro-differenziale".

Answer 1

Aggiornare:

Secondo la mia rilettura e i vostri commenti, quanto segue genererà tutti i percorsi. Supera notevolmente le risposte esistenti ed è circa due ordini di grandezza più veloce su${k,n}={25,7}$ test rispetto alla versione compilata utilizzando $gosperc$.

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

Il conteggio diretto è dato da:

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

Confronto dei tempi per un case leggermente più grande:

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

Vero

Post originale:

Presumo che quando a "0", un passo di -1 lasci uno ancora a "0". Sei a terra o no ...

Questa è quindi una passeggiata aleatoria limitata sugli interi, facilmente rappresentabile come un processo di Markov.

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

Utilizzo: pathsm[k, n]

Un confronto dei tempi di questo, quello di Leonid e quello di eyorble ${k,n}={30,10}$ fornisce 0,0007, 159,9 e 359,9 secondi.

Il risultato diretto per i conteggi è Binomial[k, Floor[(k - n)/2]].

NB: nel rileggere la domanda, questo potrebbe non essere reattivo, poiché conta i percorsi anziché enumerarli. Tuttavia, potrebbe essere utile nella tua indagine, quindi lo terrò qui a meno che tu non commenta diversamente.

Answer 2

Ecco un modo per ottenere i percorsi:

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

Per esempio

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

Probabilmente ci sono modi più efficienti per farlo, dato che questo si riduce a combinazioni C(k, m), dove m = (k - n) / 2, quindi questo è fondamentalmente un problema di scegliere m -1s ed k + m 1s in tutti i possibili modi distinti.

Answer 3

Supponendo $n$ è il numero di destinazione e $k$ è il numero di gradini, il numero di gradini verso l'alto è: $u=\frac{k+n}{2}$. Quindi, dobbiamo distribuire$u$ valori positivi e $d=k-u$ valori negativi in ​​un elenco.

Lavoriamo con loro usando vettori caratteristici, dove 1 bit indica un movimento verso l'alto e 0 bit indica un movimento verso il basso.

Il primo di questi vettori è banale $2^u-1$. Quindi usa l'hack di Gosper per calcolare il resto, dato che sappiamo quanti ce ne sono per cominciare.

Codice di esempio:

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

Per testare l'efficienza, perché n = 7; k = 25;questa soluzione impiega 16,7 secondi sulla mia macchina per passare attraverso le 2.042.975 combinazioni di AbsoluteTiming.

Questo può essere enormemente accelerato con Compile:

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

Questo può eseguire il test precedente, n = 7; k = 25;in 10,5 secondi NestListsulla mia macchina. La limitazione della compilazione in questo modo è quella$k$ deve essere inferiore a un numero intero delle dimensioni di una macchina (probabilmente 64, forse 32 a seconda del sistema).

Answer 4

Ecco il mio stupido approccio, basato sul fatto che (assumendo $k>=0$) il numero di gradini verso il basso è (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]
    ]]
  ]