Memanjat / Menuruni Tangga Integer

Question

Teka-teki kombinatorik yang menyenangkan yang muncul dalam pekerjaan saya yang menurut saya akan lucu untuk memiliki solusi Mathematica, jika ada yang ingin mencobanya. Ini pada dasarnya adalah masalah memanjat / menuruni tangga jadi mungkin memiliki Graphsolusi yang bagus . Perlu dicatat bahwa tangga saya bisa turun ke ruang bawah tanah (yaitu nilai bilangan bulat saya bisa turun di bawah$0$)

Mulai dari $0$, lebih $k$ langkah dari $\pm1$, apa jalur yang akan mendarat di bilangan bulat $n$, tentu saja dengan asumsi $k \ge n$.

Saya tidak keberatan jika pertanyaan ini ditutup karena kurangnya usaha di pihak saya (saya sedang mengerjakan solusi analitik) dan sebenarnya akan sangat senang jika ini ditutup sebagai duplikat / jika seseorang dapat mengarahkan saya ke yang tepat nama untuk masalah ini. Tapi saya pikir Mathematica.SE mungkin menikmati masalah yang cepat dan mudah untuk memecahkan pekerjaan membosankan "memecahkan persamaan integro-diferensial saya untuk saya".

Answer 1

Memperbarui:

Menurut saya baca ulang dan komentar Anda, berikut ini akan menghasilkan semua jalur. Ini secara dramatis mengungguli jawaban yang ada, dan sekitar dua kali lipat lebih cepat di${k,n}={25,7}$ uji daripada versi yang dikompilasi menggunakan $gosperc$.

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

Penghitungan langsung diberikan oleh:

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

Perbandingan waktu untuk kasus yang sedikit lebih besar:

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

Benar

Posting asli:

Saya berasumsi bahwa ketika di "0", langkah -1 meninggalkan satu masih di "0". Anda berada di tanah atau tidak ...

Ini kemudian adalah jalan acak terbatas pada bilangan bulat, dengan mudah direpresentasikan sebagai proses 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 &;

Pemakaian: pathsm[k, n]

Perbandingan waktu ini, Leonid dan eyorble ${k,n}={30,10}$ memberikan 0,0007, 159,9, dan 359,9 detik.

Hasil langsung untuk hitungan adalah Binomial[k, Floor[(k - n)/2]].

NB: dalam membaca ulang pertanyaan, ini mungkin tidak responsif, karena menghitung jalur vs menghitungnya. Meskipun demikian, ini mungkin berguna dalam penyelidikan Anda, jadi saya akan menyimpannya di sini kecuali Anda berkomentar sebaliknya.

Answer 2

Inilah salah satu cara untuk mendapatkan jalur:

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

Sebagai contoh

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

Mungkin ada cara yang lebih efisien untuk melakukan itu, mengingat ini bermuara pada kombinasi C(k, m), di mana m = (k - n) / 2, jadi ini pada dasarnya adalah masalah memilih m -1s dan k + m 1s dalam semua kemungkinan cara yang berbeda.

Answer 3

Asumsi $n$ adalah nomor target dan $k$ adalah jumlah anak tangga, jumlah anak tangga ke atas adalah: $u=\frac{k+n}{2}$. Jadi, kami perlu mendistribusikan$u$ nilai-nilai positif dan $d=k-u$ nilai-nilai negatif ke dalam daftar.

Mari bekerja dengan mereka menggunakan vektor karakteristik, di mana 1-bit berarti gerakan ke atas dan 0-bit berarti gerakan ke bawah.

Vektor pertama seperti itu sepele $2^u-1$. Kemudian gunakan peretasan Gosper untuk menghitung sisanya, mengingat kita tahu berapa banyak untuk memulai.

Kode contoh:

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

Untuk menguji efisiensi ini, karena n = 7; k = 25;, solusi ini membutuhkan 16,7 detik pada mesin saya untuk melewati 2.042.975 kombinasi AbsoluteTiming.

Ini bisa sangat dipercepat dengan Compile:

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

Ini dapat melakukan tes sebelumnya, n = 7; k = 25;dalam 10,5 detik di NestListmesin saya. Batasan menyusun dengan cara ini adalah itu$k$ harus kurang dari bilangan bulat ukuran mesin (kemungkinan 64, mungkin 32 tergantung pada sistem Anda).

Answer 4

Inilah pendekatan bodoh saya, berdasarkan fakta bahwa (dengan asumsi $k>=0$) jumlah anak tangga ke bawah adalah (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]
    ]]
  ]