Solve hanging lantern problem: Difference between revisions
Added Uiua solution
m (→{{header|Phix}}: "count only" version removed, since it no longer manages anything the "full" version cannot) |
(Added Uiua solution) |
||
| (13 intermediate revisions by 11 users not shown) | |||
Line 1:
{{draft task}}
There are some columns of lanterns hanging from the ceiling. If you remove the lanterns one at a time, at each step removing the bottommost lantern from one column, how many legal sequences will let you take all of the lanterns down?
Line 41:
; Optional task:
Output all the sequences using this format:<br>
[
[
……
;Related:
* [[Permutations_with_some_identical_elements]]
=={{header|APL}}==
{{trans|Pascal}}
<
{{Out}}
<pre> lanterns 1 2 3
Line 69 ⟶ 73:
{{trans|FreeBASIC}}
The result for n >= 5 is slow to emerge
<
n = 4
dim a(n)
Line 93 ⟶ 97:
if res = 0 then res = 1
return res
end function</
{{out}}
<pre>Same as FreeBASIC entry.</pre>
Line 100 ⟶ 104:
{{trans|Python}}
The (1,2,3) example takes about 30 seconds to run on a stock C64; (1,2,3,4) takes about an hour and 40 minutes. Even on a 64 equipped with a 20MHz SuperCPU it takes about 5 minutes.
<
110 INPUT "HOW MANY COLUMNS "; N
120 DIM NL(N-1):T=0
Line 125 ⟶ 129:
410 GOTO 320
420 IF R(SP)=0 THEN R(SP)=1
430 RETURN</
{{Out}}
Line 139 ⟶ 143:
==={{header|FreeBASIC}}===
{{trans|Python}}
<
Dim As Ulong res = 0
For i As Ulong = 1 To Ubound(arr)
Line 163 ⟶ 167:
Print "] = "; getLantern(a())
Next i
Sleep</
{{out}}
<pre>[ 1 ] = 1
Line 176 ⟶ 180:
{{trans|FreeBASIC}}
The result for n >= 5 is slow to emerge
<
res = 0
FOR i = 1 TO UBOUND(arr)
Line 199 ⟶ 203:
PRINT "] = "; getLantern(a())
NEXT i
END</
{{out}}
<pre>Same as FreeBASIC entry.</pre>
Line 206 ⟶ 210:
{{trans|FreeBASIC}}
The result for n >= 5 is slow to emerge
<
Procedure getLantern(Array arr(1))
res.l = 0
Line 234 ⟶ 238:
Next i
Input()
CloseConsole()</
{{out}}
<pre>Same as FreeBASIC entry.</pre>
Line 249 ⟶ 253:
====Recursive version====
;Main code
<syntaxhighlight lang="vb">
Dim n As Integer, c As Integer
Dim a() As Integer
Line 290 ⟶ 294:
If res = 0 Then res = 1
getLantern = res
End Function</
;Form code:
<syntaxhighlight lang="vb">
VERSION 5.00
Begin VB.Form Form1
Line 362 ⟶ 366:
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False</
====Math solution====
Line 368 ⟶ 372:
Reimplemented "getLantern" function above
<
Dim tot As Integer, res As Integer
Dim i As Integer
For i = 1 To n
tot = tot +
Next i
res = factorial(tot)
For i = 1 To n
res = res / factorial(
Next i
getLantern = res
Line 387 ⟶ 391:
factorial = factorial * i
Next i
End Function</
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
The result for n >= 5 is slow to emerge
<
dim a(n)
for i = 1 to arraysize(a(),1)
Line 415 ⟶ 419:
if res = 0 res = 1
return res
end sub</
{{out}}
<pre>Same as FreeBASIC entry.</pre>
=={{header|FutureBasic}}==
<syntaxhighlight lang="futurebasic">
_elements = 5
local fn GetLantern( arr(_elements) as long ) as long
long i, res = 0
for i = 1 to _elements
if arr(i) != 0
arr(i) = arr(i) - 1
res = res + fn GetLantern( arr(0) )
arr(i) = arr(i) + 1
end if
next
if res = 0 then res = 1
end fn = res
long i, j, a(_elements)
for i = 1 to _elements
a(i) = i
print "[";
for j = 1 to i
if j == i then print a(j); else print a(j); ",";
next
print "] = "; fn GetLantern( a(0) )
next
HandleEvents
</syntaxhighlight>
{{output}}
<pre>
[1] = 1
[1,2] = 3
[1,2,3] = 60
[1,2,3,4] = 12600
[1,2,3,4,5] = 37837800
</pre>
=={{header|J}}==
Line 423 ⟶ 465:
Translation of [[#APL|APL]]:
<
Example use:
<
60
lanterns 1 3 3
140
</syntaxhighlight>
Also, a pedantic version where we must manually count how many values we are providing the computer:
<
assert. ({. = #@}.) y
lanterns }.y
}}</
And, in the spirit of providing unnecessary but perhaps pleasant (for some) overhead, we'll throw in an unnecessary comma between this count and the relevant values:
<
60
pedantic 3, 1 3 3
140</
If we wanted to impose even more overhead, we could insist that the numbers be read from a file where tabs, spaces and newlines are all treated equivalently. For that, we must specify the file name and implement some parsing:
<
pedantic ({.~ 1+{.) _ ". rplc&(TAB,' ',LF,' ') fread y
}}</
Examples of this approach are left as an exercise for the user (note: do not use commas with this version, unless you modify the code to treat them as whitespace).
Line 457 ⟶ 499:
Finally, enumerating solutions might be approached recursively:
<
arrange=. ($ $ (* +/\)@,) y $&>1
echo 'lantern ids:'
Line 474 ⟶ 516:
echo 'all lantern removal sequences:'
echo >a:-.~ -.&0 each;0 recur cols
}}</
Example use:
<
lantern ids:
1 2 4
Line 495 ⟶ 537:
4 1 3 2
4 3 1 2
4 3 2 1</
=={{header|jq}}==
The main focus of this entry is illustrating how cacheing can be added to the naive recursive algorithm.
Some trivial optimizations are also included.
With these changes, the algorithm becomes quite performant. For example, the C implementation of jq accurately computes the value for the lantern configuration
[1,2,3,4,5,6,7] in less than a second on a 2.53GHz machine.
For lantern configurations with more than 2^53 permutations, the accuracy of the C implementation of jq is insufficient, but the Go implementation (gojq) can be used. For the configuration [1,2,3,4,5,6,7,8], gojq takes just over 4 minutes to produce the correct answer on the same machine.
<syntaxhighlight lang=jq>
# Input: an array representing a configuration of one or more lanterns.
# Output: the number of distinct ways to lower them.
def lanterns:
def organize: map(select(. > 0)) | sort;
# input and output: {cache, count}
def n($array):
($array | organize) as $organized
| ($organized|length) as $length
| if $length == 1 then .count = 1
elif $length == 2 and $organized[0] == 1 then .count = ($organized | add)
else .cache[$organized|tostring] as $n
| if $n then .count = $n
else reduce range(0; $length) as $i ({cache, count: 0, a : $organized};
.a[$i] += -1
| .a as $new
| n($new) as {count: $count, cache: $cache}
| .count += $count
| .cache = ($cache | .[$new | tostring] = $count)
| .a[$i] += 1 )
| {cache, count}
end
end;
. as $a | null | n($a) | .count;
"Lantern configuration => number of permutations",
([1,3,3],
[100,2],
(range(2; 10) as $nlanterns
| [range(1; $nlanterns)])
| "\(.) => \(lanterns)" )
</syntaxhighlight>
'''Invocation'''
<pre>
gojq -n -rf lanterns.jq
</pre>
{{output}}
<pre>
Lantern configuration => number of permutations
[1,3,3] => 140
[100,2] => 5151
[1] => 1
[1,2] => 3
[1,2,3] => 60
[1,2,3,4] => 12600
[1,2,3,4,5] => 37837800
[1,2,3,4,5,6] => 2053230379200
[1,2,3,4,5,6,7] => 2431106898187968000
[1,2,3,4,5,6,7,8] => 73566121315513295589120000
</pre>
=={{header|Julia}}==
<
using Combinatorics
Line 533 ⟶ 639:
lanternproblem()
lanternproblem(false)
</
<pre style="height:64ex;overflow:scroll">
Input number of columns, then column heights in sequence:
Line 761 ⟶ 867:
There are 65191584694745586153436251091200000 ways to take these 9 columns down.
</pre>
=={{header|Nim}}==
Recursive solution.
The number of elements in the columns are provided as command arguments.
<syntaxhighlight lang="Nim">import std/[os, strutils]
proc sequenceCount(columns: var seq[int]): int =
for icol in 1..columns.high:
if columns[icol] > 0:
dec columns[icol]
inc result, sequenceCount(columns)
inc columns[icol]
if result == 0: result = 1
let ncol = paramCount()
if ncol == 0:
quit "Missing parameters.", QuitFailure
var columns = newSeq[int](ncol + 1) # We will ignore the first column.
for i in 1..ncol:
let n = paramStr(i).parseInt()
if n < 0:
quit "Wrong number of lanterns.", QuitFailure
columns[i] = n
echo columns.sequenceCount()
</syntaxhighlight>
=={{header|Pascal}}==
Line 766 ⟶ 899:
This solution avoids recursion and calculates the result mathematically. As noted in the Picat solution, the result is a multinomial coefficient, e.g. with columns of length 3, 6, 4 the result is (3 + 6 + 4)!/(3!*6!*4!).
<
program LanternProblem;
uses SysUtils;
Line 848 ⟶ 981:
until false;
end.
</syntaxhighlight>
{{out}}
<pre>
Line 865 ⟶ 998:
=={{header|Perl}}==
<
use strict; # https://rosettacode.org/wiki/Solve_hanging_lantern_problem
Line 881 ⟶ 1,014:
find( $` . $', $found . $& ) while $in =~ /\w\b/g;
$in =~ /\w/ or $answer .= '[' . $found =~ s/\B/,/gr . "]\n";
}</
{{out}}
<pre>
Line 948 ⟶ 1,081:
=={{header|Phix}}==
<!--<
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">include</span> <span style="color: #004080;">mpfr</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
Line 1,015 ⟶ 1,148:
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</
{{out}}
<pre>
Line 1,047 ⟶ 1,180:
=={{header|Picat}}==
{{trans|Python}}
<
run_lantern().
Line 1,073 ⟶ 1,206:
if Res == 0 then
Res := 1
end.</
Some tests:
<
A = [1,2,3],
println(lantern(A)),
Line 1,082 ⟶ 1,215:
println(1..N=lantern(1..N))
end,
nl.</
{{out}}
Line 1,100 ⟶ 1,233:
===Recursive version===
{{trans|Visual Basic}}
<
def getLantern(arr):
res = 0
Line 1,117 ⟶ 1,250:
a.append(int(input()))
print(getLantern(a))
</syntaxhighlight>
===Math solution===
<
import math
n = int(input())
Line 1,132 ⟶ 1,265:
res /= math.factorial(a[i])
print(int(res))
</syntaxhighlight>
===Showing Sequences===
<syntaxhighlight lang="python">def seq(x):
if not any(x):
yield tuple()
for i, v in enumerate(x):
if v:
for s in seq(x[:i] + [v - 1] + x[i+1:]):
yield (i+1,) + s
# an example
for x in seq([1, 2, 3]):
print(x)</syntaxhighlight>
=={{header|Raku}}==
Line 1,142 ⟶ 1,289:
If all we need is the count, then we can compute that directly:
<syntaxhighlight lang="raku"
sub postfix:<!>($n) { [*] 1..$n }
say [+](@columns)! / [*](@columns»!);</
{{Out}}
Line 1,156 ⟶ 1,303:
If we want to list all of the sequences, we have to do some more work. This version outputs the sequences as lists of column numbers (assigned from 1 to N left to right); at each step the bottommost lantern from the numbered column is removed.
<syntaxhighlight lang="raku"
my @sequences = @columns
Line 1,172 ⟶ 1,319:
say +@sequences;
}
</syntaxhighlight>
{{Out}}
Line 1,195 ⟶ 1,342:
If we want individually-numbered lanterns in the sequence instead of column numbers, as in the example given in the task description, that requires yet more work:
<syntaxhighlight lang="raku"
my @sequences = @columns
Line 1,228 ⟶ 1,375:
} else {
say +@sequences;
}</
{{Out}}
Line 1,243 ⟶ 1,390:
[6,5,4,3,1,2]
[6,5,4,3,2,1]</pre>
=={{header|Ruby}}==
===Directly computing the count===
Compute the count directly:
<syntaxhighlight lang="ruby" line>Factorial = Hash.new{|h, k| h[k] = k * h[k-1] } # a memoized factorial
Factorial[0] = 1
def count_perms_with_reps(ar)
Factorial[ar.sum] / ar.inject{|prod, m| prod * Factorial[m]}
end
ar, input = [], ""
puts "Input column heights in sequence (empty line to end input):"
ar << input.to_i until (input=gets) == "\n"
puts "There are #{count_perms_with_reps(ar)} ways to take these #{ar.size} columns down."
</syntaxhighlight>
{{Out}}
<pre>Input column heights in sequence (empty line to end input):
1
2
3
4
5
6
7
8
There are 73566121315513295589120000 ways to take these 8 columns down.
</pre>
=={{header|Uiua}}==
{{works with|Uiua|0.10.0}}
<syntaxhighlight lang="Uiua">
Fac ← /×+1⇡
Lant ← ÷⊃(/(×⊙Fac)|Fac/+)
Lant [1 2 3]
Lant [1 3 3]
Lant [1 3 3 5 7]
</syntaxhighlight>
{{out}}
<pre>
60
140
5587021440
</pre>
=={{header|Wren}}==
Line 1,248 ⟶ 1,441:
{{trans|Python}}
The result for n == 5 is slow to emerge.
<
lantern = Fn.new { |n, a|
var count = 0
Line 1,268 ⟶ 1,461:
n = n + 1
System.print("%(a) => %(lantern.call(n, a))")
}</
{{out}}
Line 1,283 ⟶ 1,476:
{{libheader|Wren-big}}
Alternatively, using library methods.
<
import "./big" for BigInt
Line 1,324 ⟶ 1,517:
System.print("%(a) => %(BigInt.multinomial(36, a))")
listPerms.call([1, 2, 3], 4)
listPerms.call([1, 3, 3], 3)</
{{out}}
Line 1,394 ⟶ 1,587:
=={{header|XPL0}}==
<
proc Tally(Level);
Line 1,416 ⟶ 1,609:
Tally(0);
IntOut(0, Sequences);
]</
{{out}}
| |||