Solve hanging lantern problem

From Rosetta Code
Revision as of 00:07, 25 May 2022 by Petelomax (talk | contribs) (→‎fast analytical count only: slightly neater test loop)
Task
Solve hanging lantern problem
You are encouraged to solve this task according to the task description, using any language you may know.

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?

For example, there are some lanterns hanging like this:

🏮 🏮 🏮
   🏮 🏮
      🏮

If we number the lanterns like so:

1 2 4
  3 5
    6

You can take like this: [6,3,5,2,4,1] or [3,1,6,5,2,4]
But not like this: [6,3,2,4,5,1], because at that time 5 is under 4.

In total, there are 60 ways to take them down.


Task

Input:
First an integer (n): the number of columns.
Then n integers: the number of lanterns in each column.
Output:
An integer: the number of sequences.

For example, the input of the example above could be:

3
1
2
3

And the output is:

60

Optional task

Output all the sequences using this format:

[a,b,c,…]
[b,a,c,…]
……


BASIC

BASIC256

Translation of: FreeBASIC

The result for n >= 5 is slow to emerge <lang freebasic>arraybase 1 n = 4 dim a(n) for i = 1 to a[?]

   a[i] = i
   print "[ ";
   for j = 1 to i
       print a[j]; " ";
   next j
   print "] = "; getLantern(a)

next i end

function getLantern(arr)

   res = 0
   for i = 1 to arr[?]
       if arr[i] <> 0 then
           arr[i] -= 1
           res += getLantern(arr)
           arr[i] += 1
       end if
   next i
   if res = 0 then res = 1
   return res

end function</lang>

Output:
Same as FreeBASIC entry.

QBasic

Works with: QBasic version 1.1
Works with: QuickBasic version 4.5
Translation of: FreeBASIC

The result for n >= 5 is slow to emerge <lang QBasic>FUNCTION getLantern (arr())

   res = 0
   FOR i = 1 TO UBOUND(arr)
       IF arr(i) <> 0 THEN
           arr(i) = arr(i) - 1
           res = res + getLantern(arr())
           arr(i) = arr(i) + 1
       END IF
   NEXT i
   IF res = 0 THEN res = 1
   getLantern = res

END FUNCTION

n = 4 DIM a(n) FOR i = 1 TO UBOUND(a)

   a(i) = i
   PRINT "[";
   FOR j = 1 TO i
       PRINT a(j); " ";
   NEXT j
   PRINT "] = "; getLantern(a())

NEXT i END</lang>

Output:
Same as FreeBASIC entry.

PureBasic

Translation of: FreeBASIC

The result for n >= 5 is slow to emerge <lang PureBasic>;;The result For n >= 5 is slow To emerge Procedure getLantern(Array arr(1))

 res.l = 0
 For i.l = 1 To ArraySize(arr(),1)
   If arr(i) <> 0
     arr(i) - 1
     res + getLantern(arr())
     arr(i) + 1
   EndIf
 Next i
 If res = 0 
   res = 1
 EndIf
 ProcedureReturn  res

EndProcedure

OpenConsole() n.i = 4 Dim a.i(n) For i.l = 1 To ArraySize(a())

 a(i) = i
 Print("[")
 For j.l = 1 To i
   Print(Str(a(j)) + " ")
 Next j
 PrintN("] = " + Str(getLantern(a())))

Next i Input() CloseConsole()</lang>

Output:
Same as FreeBASIC entry.

Yabasic

Translation of: FreeBASIC

The result for n >= 5 is slow to emerge <lang yabasic>n = 4 dim a(n) for i = 1 to arraysize(a(),1)

   a(i) = i
   print "[ "; 
   for j = 1 to i
       print a(j), " ";
   next j
   print "] = ", getLantern(a())

next i

sub getLantern(arr())

   local res, i
   res = 0
   for i = 1 to arraysize(arr(),1)
       if arr(i) <> 0 then
           arr(i) = arr(i) - 1
           res = res + getLantern(arr())
           arr(i) = arr(i) + 1
       fi
   next i
   if res = 0  res = 1
   return res

end sub</lang>

Output:
Same as FreeBASIC entry.


Commodore BASIC

Translation of: 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. <lang basic>100 PRINT CHR$(147);CHR$(18);"*** HANGING LANTERN PROBLEM ***" 110 INPUT "HOW MANY COLUMNS "; N 120 DIM NL(N-1):T=0 130 FOR I=0 TO N-1 140 : PRINT "HOW MANY LANTERNS IN COLUMN"I+1; 150 : INPUT NL(I):T=T+NL(I) 160 NEXT I 170 DIM I(T),R(T) 180 SP=0 190 GOSUB 300 200 PRINT R(0) 220 END 300 R(SP)=0 310 I(SP)=0 320 IF I(SP)=N THEN 420 330 IF NL(I(SP))=0 THEN 400 340 NL(I(SP))=NL(I(SP))-1 350 SP=SP+1 360 GOSUB 300 370 SP=SP-1 370 R(SP)=R(SP)+R(SP+1) 390 NL(I(SP))=NL(I(SP))+1 400 I(SP)=I(SP)+1 410 GOTO 320 420 IF R(SP)=0 THEN R(SP)=1 430 RETURN</lang>

Output:
***     HANGING LANTERN PROBLEM      ***

HOW MANY COLUMNS ? 4
HOW MANY LANTERNS IN COLUMN 1 ? 1
HOW MANY LANTERNS IN COLUMN 2 ? 2
HOW MANY LANTERNS IN COLUMN 3 ? 3
HOW MANY LANTERNS IN COLUMN 4 ? 4
 12600

FreeBASIC

Translation of: Python

<lang freebasic>Function getLantern(arr() As Uinteger) As Ulong

   Dim As Ulong res = 0
   For i As Ulong = 1 To Ubound(arr)
       If arr(i) <> 0 Then
           arr(i) -= 1
           res += getLantern(arr())
           arr(i) += 1
       End If
   Next i
   If res = 0 Then res = 1
   Return res

End Function

Dim As Uinteger n = 5 Dim As Uinteger a(n) 'Dim As Integer a(6) = {1,2,3,4,5,6} For i As Ulong = 1 To Ubound(a)

   a(i) = i
   Print "[ "; 
   For j As Ulong = 1 To i
       Print a(j); " ";
   Next j
   Print "] = "; getLantern(a())

Next i Sleep</lang>

Output:
[ 1 ] = 1
[ 1 2 ] = 3
[ 1 2 3 ] = 60
[ 1 2 3 4 ] = 12600
[ 1 2 3 4 5 ] = 37837800

Julia

<lang ruby>""" rosettacode.org /wiki/Lantern_Problem """

using Combinatorics

function lanternproblem(verbose = true)

   println("Input number of columns, then column heights in sequence:")
   inputs = [parse(Int, i) for i in split(readline(), r"\s+")]
   n = popfirst!(inputs)
   println("\nThere are ", multinomial(BigInt.(inputs)...), " ways to take these ", n, " columns down.")

   if verbose
       idx, fullmat = 0, zeros(Int, n, maximum(n))
       for col in 1:size(fullmat, 2), row in 1:size(fullmat, 1)
           if inputs[col] >= row
               fullmat[row, col] = (idx += 1)
           end
       end
       show(stdout, "text/plain", map(n -> n > 0 ? "$n " : "  ", fullmat))
       println("\n")
       takedownways = unique(permutations(reduce(vcat, [fill(i, m) for (i, m) in enumerate(inputs)])))
       for way in takedownways
           print("[")
           mat = copy(fullmat)
           for (i, col) in enumerate(way)
               row = findlast(>(0), @view mat[:, col])
               print(mat[row, col], i == length(way) ? "]\n" : ", ")
               mat[row, col] = 0
           end
       end
   end

end

lanternproblem() lanternproblem() lanternproblem(false)

</lang>

Output:
Input number of columns, then column heights in sequence:
3 1 2 3

There are 60 ways to take these 3 columns down.
3×3 Matrix{String}:
 "1 "  "2 "  "4 "
 "  "  "3 "  "5 "
 "  "  "  "  "6 "

[1, 3, 2, 6, 5, 4]
[1, 3, 6, 2, 5, 4]
[1, 3, 6, 5, 2, 4]
[1, 3, 6, 5, 4, 2]
[1, 6, 3, 2, 5, 4]
[1, 6, 3, 5, 2, 4]
[1, 6, 3, 5, 4, 2]
[1, 6, 5, 3, 2, 4]
[1, 6, 5, 3, 4, 2]
[1, 6, 5, 4, 3, 2]
[3, 1, 2, 6, 5, 4]
[3, 1, 6, 2, 5, 4]
[3, 1, 6, 5, 2, 4]
[3, 1, 6, 5, 4, 2]
[3, 2, 1, 6, 5, 4]
[3, 2, 6, 1, 5, 4]
[3, 2, 6, 5, 1, 4]
[3, 2, 6, 5, 4, 1]
[3, 6, 1, 2, 5, 4]
[3, 6, 1, 5, 2, 4]
[3, 6, 1, 5, 4, 2]
[3, 6, 2, 1, 5, 4]
[3, 6, 2, 5, 1, 4]
[3, 6, 2, 5, 4, 1]
[3, 6, 5, 1, 2, 4]
[3, 6, 5, 1, 4, 2]
[3, 6, 5, 2, 1, 4]
[3, 6, 5, 2, 4, 1]
[3, 6, 5, 4, 1, 2]
[3, 6, 5, 4, 2, 1]
[6, 1, 3, 2, 5, 4]
[6, 1, 3, 5, 2, 4]
[6, 1, 3, 5, 4, 2]
[6, 1, 5, 3, 2, 4]
[6, 1, 5, 3, 4, 2]
[6, 1, 5, 4, 3, 2]
[6, 3, 1, 2, 5, 4]
[6, 3, 1, 5, 2, 4]
[6, 3, 1, 5, 4, 2]
[6, 3, 2, 1, 5, 4]
[6, 3, 2, 5, 1, 4]
[6, 3, 2, 5, 4, 1]
[6, 3, 5, 1, 2, 4]
[6, 3, 5, 1, 4, 2]
[6, 3, 5, 2, 1, 4]
[6, 3, 5, 2, 4, 1]
[6, 3, 5, 4, 1, 2]
[6, 3, 5, 4, 2, 1]
[6, 5, 1, 3, 2, 4]
[6, 5, 1, 3, 4, 2]
[6, 5, 1, 4, 3, 2]
[6, 5, 3, 1, 2, 4]
[6, 5, 3, 1, 4, 2]
[6, 5, 3, 2, 1, 4]
[6, 5, 3, 2, 4, 1]
[6, 5, 3, 4, 1, 2]
[6, 5, 3, 4, 2, 1]
[6, 5, 4, 1, 3, 2]
[6, 5, 4, 3, 1, 2]
[6, 5, 4, 3, 2, 1]


Input number of columns, then column heights in sequence:
3 1 3 3

There are 140 ways to take these 3 columns down.
3×3 Matrix{String}:
 "1 "  "2 "  "5 "
 "  "  "3 "  "6 "
 "  "  "4 "  "7 "

[1, 4, 3, 2, 7, 6, 5]
[1, 4, 3, 7, 2, 6, 5]
[1, 4, 3, 7, 6, 2, 5]
[1, 4, 3, 7, 6, 5, 2]
[1, 4, 7, 3, 2, 6, 5]
[1, 4, 7, 3, 6, 2, 5]
[1, 4, 7, 3, 6, 5, 2]
[1, 4, 7, 6, 3, 2, 5]
[1, 4, 7, 6, 3, 5, 2]
[1, 4, 7, 6, 5, 3, 2]
[1, 7, 4, 3, 2, 6, 5]
[1, 7, 4, 3, 6, 2, 5]
[1, 7, 4, 3, 6, 5, 2]
[1, 7, 4, 6, 3, 2, 5]
[1, 7, 4, 6, 3, 5, 2]
[1, 7, 4, 6, 5, 3, 2]
[1, 7, 6, 4, 3, 2, 5]
[1, 7, 6, 4, 3, 5, 2]
[1, 7, 6, 4, 5, 3, 2]
[1, 7, 6, 5, 4, 3, 2]
[4, 1, 3, 2, 7, 6, 5]
[4, 1, 3, 7, 2, 6, 5]
[4, 1, 3, 7, 6, 2, 5]
[4, 1, 3, 7, 6, 5, 2]
[4, 1, 7, 3, 2, 6, 5]
[4, 1, 7, 3, 6, 2, 5]
[4, 1, 7, 3, 6, 5, 2]
[4, 1, 7, 6, 3, 2, 5]
[4, 1, 7, 6, 3, 5, 2]
[4, 1, 7, 6, 5, 3, 2]
[4, 3, 1, 2, 7, 6, 5]
[4, 3, 1, 7, 2, 6, 5]
[4, 3, 1, 7, 6, 2, 5]
[4, 3, 1, 7, 6, 5, 2]
[4, 3, 2, 1, 7, 6, 5]
[4, 3, 2, 7, 1, 6, 5]
[4, 3, 2, 7, 6, 1, 5]
[4, 3, 2, 7, 6, 5, 1]
[4, 3, 7, 1, 2, 6, 5]
[4, 3, 7, 1, 6, 2, 5]
[4, 3, 7, 1, 6, 5, 2]
[4, 3, 7, 2, 1, 6, 5]
[4, 3, 7, 2, 6, 1, 5]
[4, 3, 7, 2, 6, 5, 1]
[4, 3, 7, 6, 1, 2, 5]
[4, 3, 7, 6, 1, 5, 2]
[4, 3, 7, 6, 2, 1, 5]
[4, 3, 7, 6, 2, 5, 1]
[4, 3, 7, 6, 5, 1, 2]
[4, 3, 7, 6, 5, 2, 1]
[4, 7, 1, 3, 2, 6, 5]
[4, 7, 1, 3, 6, 2, 5]
[4, 7, 1, 3, 6, 5, 2]
[4, 7, 1, 6, 3, 2, 5]
[4, 7, 1, 6, 3, 5, 2]
[4, 7, 1, 6, 5, 3, 2]
[4, 7, 3, 1, 2, 6, 5]
[4, 7, 3, 1, 6, 2, 5]
[4, 7, 3, 1, 6, 5, 2]
[4, 7, 3, 2, 1, 6, 5]
[4, 7, 3, 2, 6, 1, 5]
[4, 7, 3, 2, 6, 5, 1]
[4, 7, 3, 6, 1, 2, 5]
[4, 7, 3, 6, 1, 5, 2]
[4, 7, 3, 6, 2, 1, 5]
[4, 7, 3, 6, 2, 5, 1]
[4, 7, 3, 6, 5, 1, 2]
[4, 7, 3, 6, 5, 2, 1]
[4, 7, 6, 1, 3, 2, 5]
[4, 7, 6, 1, 3, 5, 2]
[4, 7, 6, 1, 5, 3, 2]
[4, 7, 6, 3, 1, 2, 5]
[4, 7, 6, 3, 1, 5, 2]
[4, 7, 6, 3, 2, 1, 5]
[4, 7, 6, 3, 2, 5, 1]
[4, 7, 6, 3, 5, 1, 2]
[4, 7, 6, 3, 5, 2, 1]
[4, 7, 6, 5, 1, 3, 2]
[4, 7, 6, 5, 3, 1, 2]
[4, 7, 6, 5, 3, 2, 1]
[7, 1, 4, 3, 2, 6, 5]
[7, 1, 4, 3, 6, 2, 5]
[7, 1, 4, 3, 6, 5, 2]
[7, 1, 4, 6, 3, 2, 5]
[7, 1, 4, 6, 3, 5, 2]
[7, 1, 4, 6, 5, 3, 2]
[7, 1, 6, 4, 3, 2, 5]
[7, 1, 6, 4, 3, 5, 2]
[7, 1, 6, 4, 5, 3, 2]
[7, 1, 6, 5, 4, 3, 2]
[7, 4, 1, 3, 2, 6, 5]
[7, 4, 1, 3, 6, 2, 5]
[7, 4, 1, 3, 6, 5, 2]
[7, 4, 1, 6, 3, 2, 5]
[7, 4, 1, 6, 3, 5, 2]
[7, 4, 1, 6, 5, 3, 2]
[7, 4, 3, 1, 2, 6, 5]
[7, 4, 3, 1, 6, 2, 5]
[7, 4, 3, 1, 6, 5, 2]
[7, 4, 3, 2, 1, 6, 5]
[7, 4, 3, 2, 6, 1, 5]
[7, 4, 3, 2, 6, 5, 1]
[7, 4, 3, 6, 1, 2, 5]
[7, 4, 3, 6, 1, 5, 2]
[7, 4, 3, 6, 2, 1, 5]
[7, 4, 3, 6, 2, 5, 1]
[7, 4, 3, 6, 5, 1, 2]
[7, 4, 3, 6, 5, 2, 1]
[7, 4, 6, 1, 3, 2, 5]
[7, 4, 6, 1, 3, 5, 2]
[7, 4, 6, 1, 5, 3, 2]
[7, 4, 6, 3, 1, 2, 5]
[7, 4, 6, 3, 1, 5, 2]
[7, 4, 6, 3, 2, 1, 5]
[7, 4, 6, 3, 2, 5, 1]
[7, 4, 6, 3, 5, 1, 2]
[7, 4, 6, 3, 5, 2, 1]
[7, 4, 6, 5, 1, 3, 2]
[7, 4, 6, 5, 3, 1, 2]
[7, 4, 6, 5, 3, 2, 1]
[7, 6, 1, 4, 3, 2, 5]
[7, 6, 1, 4, 3, 5, 2]
[7, 6, 1, 4, 5, 3, 2]
[7, 6, 1, 5, 4, 3, 2]
[7, 6, 4, 1, 3, 2, 5]
[7, 6, 4, 1, 3, 5, 2]
[7, 6, 4, 1, 5, 3, 2]
[7, 6, 4, 3, 1, 2, 5]
[7, 6, 4, 3, 1, 5, 2]
[7, 6, 4, 3, 2, 1, 5]
[7, 6, 4, 3, 2, 5, 1]
[7, 6, 4, 3, 5, 1, 2]
[7, 6, 4, 3, 5, 2, 1]
[7, 6, 4, 5, 1, 3, 2]
[7, 6, 4, 5, 3, 1, 2]
[7, 6, 4, 5, 3, 2, 1]
[7, 6, 5, 1, 4, 3, 2]
[7, 6, 5, 4, 1, 3, 2]
[7, 6, 5, 4, 3, 1, 2]
[7, 6, 5, 4, 3, 2, 1]

Input number of columns, then column heights in sequence:
9 1 2 3 4 5 6 7 8 9

There are 65191584694745586153436251091200000 ways to take these 9 columns down.

Pascal

A console application in Free Pascal, created with the Lazarus IDE.

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!). <lang pascal> program LanternProblem; uses SysUtils;

// Calculate multinomial coefficient, e.g. input array [3, 6, 4] // would give (3 + 6 + 4)! / (3!*6!*4!). // Result is calculated as a product of binomial coefficients. function Multinomial( a : array of integer) : UInt64; var

 n, i, j, k : integer;
 b : array of integer;   // sorted copy of ionput
 row : array of integer; // start of row in Pascal's triangle

begin

 result := 1; // in case of trivial input
 n := Length( a);
 if (n <= 1) then exit;
 // Copy caller's array to local array in descending order
 SetLength( b, n);
 for j := 0 to n - 1 do begin
   k := j;
   while (k > 0) and (b[k - 1] < a[j]) do begin
     b[k] := b[k - 1];  dec(k);
   end;
   b[k] := a[j];
 end;
 // Zero entries don't affect the result, so remove them
 while (n > 0) and (b[n - 1] = 0) do dec(n);
 if (n <= 1) then exit;
 // Non-trivial input, do the calculation by means of Pascal's triangle
 SetLength( row, b[1] + 1);
 row[0] := 1;
 for k := 1 to b[1] do row[k] := 0;
 for i := 1 to b[0] + b[1] do begin
   for k := b[1] downto 1 do inc( row[k], row[k - 1]);
 end;
 result := row[b[1]];  // first binomial coefficient
 // Since b[1] >= b[2] >= b[3] ... there are always enough valid terms
 //   in the row to allow calculation of the next binomial coefficient.
 for j := 2 to n - 1 do begin
   for i := 1 to b[j] do begin
     for k := b[1] downto 1 do inc( row[k], row[k - 1]);
   end;
   result := result*row[b[j]]; // multiply by next binomial coefficient
 end;

end;

// Prompt user for non-negative integer. // Avoid raising exception when user input isn't an integer. function UserInt( const prompt : string) : integer; var

 userInput : string;
 inputOK : boolean;

begin

 repeat
   Write( prompt, ' ');
   ReadLn(userInput);
   inputOK := SysUtils.TryStrToInt( userInput, result) and (result >= 0);
   if not inputOK then WriteLn( 'Try again');
 until inputOK;

end;

// Main routine var

 nrCols, j : integer;
 counts : array of integer;

begin

 repeat
   nrCols := UserInt( 'Number of columns (0 to quit)?');
   if nrCols = 0 then exit;
   SetLength( counts, nrCols);
   for j := 0 to nrCols - 1 do
     counts[j] := UserInt( SysUtils.Format('How many in column %d?',
                  [j + 1])); // column numbers 1-based for user
   Write( 'Columns are ');
   for j := 0 to nrCols - 1 do Write(' ', counts[j]);
   WriteLn( ',  number of ways = ', Multinomial(counts));
 until false;

end. </lang>

Output:
Number of columns (0 to quit)? 3
How many in column 1? 1
How many in column 2? 2
How many in column 3? 3
Columns are  1 2 3,  number of ways = 60
[input omitted from now on]
Columns are  1 2 3 4,  number of ways = 12600
Columns are  1 2 3 4 5,  number of ways = 37837800
Columns are  1 2 3 4 5 6,  number of ways = 2053230379200
Columns are  1 2 3 4 5 6 7,  number of ways = 2431106898187968000
Columns are  1 3 3,  number of ways = 140

Phix

fast analytical count only

with javascript_semantics
include mpfr.e
function get_lantern(sequence s)
    mpz {z,f} = mpz_inits(2)
    mpz_fac_ui(z,sum(s))
    for d in s do
        mpz_fac_ui(f,d)
        mpz_fdiv_q(z,z,f)
    end for
    return mpz_get_str(z)
end function

for t in apply(tagset(9),tagset)&{{1,3,3},{10,14,12}} do
    printf(1,"%v = %s\n",{t,get_lantern(t)})
end for
Output:
{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
{1,2,3,4,5,6,7,8,9} = 65191584694745586153436251091200000
{1,3,3} = 140
{10,14,12} = 2454860399191200

full solution

with javascript_semantics
include mpfr.e
function get_lantern(mpz z, sequence s, bool bJustCount=true, integer na=-1)
    if bJustCount then
        sequence l = apply(s,length)
        mpz_fac_ui(z,sum(l))
        mpz f = mpz_init()
        for d in l do
            mpz_fac_ui(f,d)
            mpz_fdiv_q(z,z,f)
        end for
        return 0
    end if  
    if na=-1 then na = sum(apply(s,length)) end if
    if na=0 then
        mpz_set_si(z,1)
        return {""}
    end if
    s = deep_copy(s)
    sequence res = {}
    for i=1 to length(s) do
        if length(s[i]) then
            integer si = s[i][$]
            s[i] = s[i][1..$-1]
            mpz z2 = mpz_init()
            object r = get_lantern(z2, s, false, na-1)
            for k=1 to length(r) do
                res = append(res,si&r[k])
            end for
            mpz_add(z,z,z2)
            s[i] &= si
        end if
    end for
    return res
end function

procedure test(sequence s, bool bJustCount=true)
    mpz z = mpz_init()
    object r = get_lantern(z,s,bJustCount)
    string sj = join(s,", "),
           sz = mpz_get_str(z)
    if bJustCount then
        printf(1,"%s = %s\n",{sj,sz})
    else
        string rj = join_by(r,1,10,",")
        printf(1,"%s = %s:\n%s\n",{sj,sz,rj})
    end if
end procedure

test({"1"},false)
test({"1","23"},false)
test({"1","23","456"},false)
test({"1","234","567"})
test({"1234567890","ABCDEFGHIJKLMN","OPQRSTUVWXYZ"})
sequence s = {"1",
              "23",
              "456",
              "7890",
              "ABCDE",
              "FGHIJK",
              "LMNOPQR",
              "STUVWXYZ",
              "abcdefghi"}
for i=1 to 9 do
    test(s[1..i])
end for
Output:
1 = 1:
1

1, 23 = 3:
132,312,321

1, 23, 456 = 60:
132654,136254,136524,136542,163254,163524,163542,165324,165342,165432
312654,316254,316524,316542,321654,326154,326514,326541,361254,361524
361542,362154,362514,362541,365124,365142,365214,365241,365412,365421
613254,613524,613542,615324,615342,615432,631254,631524,631542,632154
632514,632541,635124,635142,635214,635241,635412,635421,651324,651342
651432,653124,653142,653214,653241,653412,653421,654132,654312,654321

1, 234, 567 = 140
1234567890, ABCDEFGHIJKLMN, OPQRSTUVWXYZ = 2454860399191200
1 = 1
1, 23 = 3
1, 23, 456 = 60
1, 23, 456, 7890 = 12600
1, 23, 456, 7890, ABCDE = 37837800
1, 23, 456, 7890, ABCDE, FGHIJK = 2053230379200
1, 23, 456, 7890, ABCDE, FGHIJK, LMNOPQR = 2431106898187968000
1, 23, 456, 7890, ABCDE, FGHIJK, LMNOPQR, STUVWXYZ = 73566121315513295589120000
1, 23, 456, 7890, ABCDE, FGHIJK, LMNOPQR, STUVWXYZ, abcdefghi = 65191584694745586153436251091200000

Picat

Translation of: Python

<lang Picat>main =>

 run_lantern().

run_lantern() =>

 N = read_int(),
 A = [],
 foreach(_ in 1..N)
    A := A ++ [read_int()]
 end,
 println(A),
 println(lantern(A)),
 nl.

table lantern(A) = Res =>

 Arr = copy_term(A),
 Res = 0,
 foreach(I in 1..Arr.len)
   if Arr[I] != 0 then
     Arr[I] := Arr[I] - 1,
     Res := Res + lantern(Arr),
     Arr[I] := Arr[I] + 1
   end
 end,
 if Res == 0 then
    Res := 1
 end.</lang>

Some tests: <lang Picat>main =>

 A = [1,2,3],
 println(lantern(A)),
 foreach(N in 1..8)
   println(1..N=lantern(1..N))
 end,
 nl.</lang>
Output:
60
[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

The sequence of lantern(1..N) is the OEIS sequence A022915 ("Multinomial coefficients (0, 1, ..., n)! = C(n+1,2)!/(0!*1!*2!*...*n!)").

Python

Recursive version

<lang python> def getLantern(arr):

   res = 0
   for i in range(0, n):
       if arr[i] != 0:
           arr[i] -= 1
           res += getLantern(arr)
           arr[i] += 1
   if res == 0:
       res = 1
   return res

a = [] n = int(input()) for i in range(0, n):

   a.append(int(input()))

print(getLantern(a)) </lang>

Math solution

<lang python> import math n = int(input()) a = [] tot = 0 for i in range(0, n):

   a.append(int(input()))
   tot += a[i]

res = math.factorial(tot) for i in range(0, n):

   res /= math.factorial(a[i])

print(int(res)) </lang>

Raku

Translation of: Julia

Rather than take the number of columns as an explicit argument, this program infers the number from the size of the array of columns passed in.

Sequence as columns

The verbose mode of this version outputs the sequence of columns to remove lanterns from, rather than numbering the lanterns individually as in the description:

<lang perl6>unit sub MAIN(*@columns, :v(:$verbose)=False);

my @sequences = @columns

             . pairs
             . map({ (.key+1) xx .value })
             . flat
             . permutations
             . map( *.join(',') )
             . unique;

if ($verbose) {

 say "There are {+@sequences} possible takedown sequences:";
 say "[$_]" for @sequences;

} else {

 say +@sequences;

} </lang>

Output:
$ raku lanterns.raku 1 2 3
60
$ raku lanterns.raku --verbose 1 2 3
There are 60 possible takedown sequences:
[1,2,2,3,3,3]
[1,2,3,2,3,3]
[1,2,3,3,2,3]
[1,2,3,3,3,2]
[1,3,2,2,3,3]
[1,3,2,3,2,3]
...
[3,3,2,2,3,1]
[3,3,2,3,1,2]
[3,3,2,3,2,1]
[3,3,3,1,2,2]
[3,3,3,2,1,2]
[3,3,3,2,2,1]

Sequence as lanterns

This longer version numbers the lanterns as in the example in the task description.

<lang perl6>unit sub MAIN(*@columns, :v(:$verbose)=False);

my @sequences = @columns

             . pairs
             . map({ (.key+1) xx .value })
             . flat
             . permutations
             . map( *.join(',') )
             . unique;

if ($verbose) {

 my @offsets = |0,|(1..@columns).map: { [+] @columns[0..$_-1] };
 my @matrix;
 for ^@columns.max -> $i {
   for ^@columns -> $j {
     my $value = $i < @columns[$j] ?? ($i+@offsets[$j]+1) !! Nil;
     @matrix[$j][$i] = $value if $value;;
     print "\t" ~ ($value // " ");
   }
   say ;
 }
 say "There are {+@sequences} possible takedown sequences:";
 for @sequences».split(',') -> @seq {
   my @work = @matrix».clone;
   my $seq = '[';
   for @seq -> $col {
     $seq ~= @work[$col-1].pop ~ ',';
   }
   $seq ~~ s/','$/]/;
   say $seq;
 }

} else {

 say +@sequences;

}</lang>

Output:
$ raku lanterns.raku -v 1 2 3 4                                                   
        1       2       4       7
                3       5       8
                        6       9
                                10
There are 12600 possible takedown sequences:
[1,3,2,6,5,4,10,9,8,7]
[1,3,2,6,5,10,4,9,8,7]
[1,3,2,6,5,10,9,4,8,7]
[1,3,2,6,5,10,9,8,4,7]
[1,3,2,6,5,10,9,8,7,4]
...
[10,9,8,7,6,5,3,4,1,2]
[10,9,8,7,6,5,3,4,2,1]
[10,9,8,7,6,5,4,1,3,2]
[10,9,8,7,6,5,4,3,1,2]
[10,9,8,7,6,5,4,3,2,1]

VBA

See Visual Basic

Visual Basic

Works with: Visual Basic version 6
Main code

<lang vb> Dim n As Integer, c As Integer Dim a() As Integer

Private Sub Command1_Click()

   Dim res As Integer
   If c < n Then Label3.Caption = "Please input completely.": Exit Sub
   res = getLantern(a())
   Label3.Caption = "Result:" + Str(res)

End Sub

Private Sub Text1_Change()

   If Val(Text1.Text) <> 0 Then
       n = Val(Text1.Text)
       ReDim a(1 To n) As Integer
   End If

End Sub


Private Sub Text2_KeyPress(KeyAscii As Integer)

   If KeyAscii = Asc(vbCr) Then
       If Val(Text2.Text) = 0 Then Exit Sub
       c = c + 1
       If c > n Then Exit Sub
       a(c) = Val(Text2.Text)
       List1.AddItem Str(a(c))
       Text2.Text = ""
   End If

End Sub

Function getLantern(arr() As Integer) As Integer

   Dim res As Integer
   For i = 1 To n
       If arr(i) <> 0 Then
           arr(i) = arr(i) - 1
           res = res + getLantern(arr())
           arr(i) = arr(i) + 1
       End If
   Next i
   If res = 0 Then res = 1
   getLantern = res

End Function</lang>

Form code

<lang vb> VERSION 5.00 Begin VB.Form Form1

  Caption         =   "Get Lantern"
  ClientHeight    =   4410
  ClientLeft      =   120
  ClientTop       =   465
  ClientWidth     =   6150
  LinkTopic       =   "Form1"
  ScaleHeight     =   4410
  ScaleWidth      =   6150
  StartUpPosition =   3  
  Begin VB.CommandButton Command1 
     Caption         =   "Start"
     Height          =   495
     Left            =   2040
     TabIndex        =   5
     Top             =   3000
     Width           =   1935
  End
  Begin VB.ListBox List1 
     Height          =   1320
     Left            =   360
     TabIndex        =   4
     Top             =   1440
     Width           =   5175
  End
  Begin VB.TextBox Text2 
     Height          =   855
     Left            =   3360
     TabIndex        =   1
     Top             =   480
     Width           =   2175
  End
  Begin VB.TextBox Text1 
     Height          =   855
     Left            =   360
     TabIndex        =   0
     Top             =   480
     Width           =   2175
  End
  Begin VB.Label Label3 
     Height          =   495
     Left            =   2040
     TabIndex        =   6
     Top             =   3720
     Width           =   2295
  End
  Begin VB.Label Label2 
     Caption         =   "Number Each"
     Height          =   375
     Left            =   3960
     TabIndex        =   3
     Top             =   120
     Width           =   1695
  End
  Begin VB.Label Label1 
     Caption         =   "Total"
     Height          =   255
     Left            =   960
     TabIndex        =   2
     Top             =   120
     Width           =   1455
  End

End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False</lang>

Wren

Version 1

Translation of: Python

The result for n == 5 is slow to emerge. <lang ecmascript>var lantern // recursive function lantern = Fn.new { |n, a|

   var count = 0
   for (i in 0...n) {
       if (a[i] != 0) {
           a[i] = a[i] - 1
           count = count + lantern.call(n, a)
           a[i] = a[i] + 1
       }
   }
   if (count == 0) count = 1
   return count

}

System.print("Number of permutations for n (<= 5) groups and lanterns per group [1..n]:") var n = 0 for (i in 1..5) {

  var a = (1..i).toList
  n = n + 1
  System.print("%(a) => %(lantern.call(n, a))")

}</lang>

Output:
Number of permutations for n (<= 5) groups and lanterns per group [1..n]:
[1] => 1
[1, 2] => 3
[1, 2, 3] => 60
[1, 2, 3, 4] => 12600
[1, 2, 3, 4, 5] => 37837800

Version 2

Library: Wren-perm
Library: Wren-big

Alternatively, using library methods. <lang ecmascript>import "./perm" for Perm import "./big" for BigInt

var listPerms = Fn.new { |a, rowSize|

   var lows = List.filled(a.count, 0)
   var sum = 0
   var mlist = []
   for (i in 0...a.count) {
       sum = sum + a[i]
       lows[i] = sum
       mlist = mlist + [i+1] * a[i]
   }
   var n = Perm.countDistinct(sum, a)
   System.print("\nList of %(n) permutations for %(a.count) groups and lanterns per group %(a):")
   var count = 0
   for (p in Perm.listDistinct(mlist)) {
       var curr = lows.toList
       var perm = List.filled(sum, 0)
       for (i in 0...sum) {
           perm[i] = curr[p[i]-1]
           curr[p[i]-1] = curr[p[i]-1] - 1
       }
       System.write("%(perm) ")
       count = count + 1
       if (count % rowSize == 0) System.print()
   }
   if (count % rowSize != 0) System.print()

}

System.print("Number of permutations for the lanterns per group shown:") var n = 0 for (i in 1..9) {

  var a = (1..i).toList
  n = n + i
  System.print("%(a) => %(BigInt.multinomial(n, a))")

} var a = [1, 3, 3] System.print("%(a) => %(BigInt.multinomial(7, a))") a = [10, 14, 12] System.print("%(a) => %(BigInt.multinomial(36, a))") listPerms.call([1, 2, 3], 4) listPerms.call([1, 3, 3], 3)</lang>

Output:
Number of permutations for the lanterns per group shown:
[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
[1, 2, 3, 4, 5, 6, 7, 8, 9] => 65191584694745586153436251091200000
[1, 3, 3] => 140
[10, 14, 12] => 2454860399191200

List of 60 permutations for 3 groups and lanterns per group [1, 2, 3]:
[1, 3, 2, 6, 5, 4] [1, 3, 6, 2, 5, 4] [1, 3, 6, 5, 2, 4] [1, 3, 6, 5, 4, 2] [1, 6, 3, 2, 5, 4] 
[1, 6, 3, 5, 2, 4] [1, 6, 3, 5, 4, 2] [1, 6, 5, 3, 2, 4] [1, 6, 5, 3, 4, 2] [1, 6, 5, 4, 3, 2] 
[3, 1, 2, 6, 5, 4] [3, 1, 6, 2, 5, 4] [3, 1, 6, 5, 2, 4] [3, 1, 6, 5, 4, 2] [3, 2, 1, 6, 5, 4] 
[3, 2, 6, 1, 5, 4] [3, 2, 6, 5, 1, 4] [3, 2, 6, 5, 4, 1] [3, 6, 2, 1, 5, 4] [3, 6, 2, 5, 1, 4] 
[3, 6, 2, 5, 4, 1] [3, 6, 1, 2, 5, 4] [3, 6, 1, 5, 2, 4] [3, 6, 1, 5, 4, 2] [3, 6, 5, 1, 2, 4] 
[3, 6, 5, 1, 4, 2] [3, 6, 5, 2, 1, 4] [3, 6, 5, 2, 4, 1] [3, 6, 5, 4, 2, 1] [3, 6, 5, 4, 1, 2] 
[6, 3, 2, 1, 5, 4] [6, 3, 2, 5, 1, 4] [6, 3, 2, 5, 4, 1] [6, 3, 1, 2, 5, 4] [6, 3, 1, 5, 2, 4] 
[6, 3, 1, 5, 4, 2] [6, 3, 5, 1, 2, 4] [6, 3, 5, 1, 4, 2] [6, 3, 5, 2, 1, 4] [6, 3, 5, 2, 4, 1] 
[6, 3, 5, 4, 2, 1] [6, 3, 5, 4, 1, 2] [6, 1, 3, 2, 5, 4] [6, 1, 3, 5, 2, 4] [6, 1, 3, 5, 4, 2] 
[6, 1, 5, 3, 2, 4] [6, 1, 5, 3, 4, 2] [6, 1, 5, 4, 3, 2] [6, 5, 3, 1, 2, 4] [6, 5, 3, 1, 4, 2] 
[6, 5, 3, 2, 1, 4] [6, 5, 3, 2, 4, 1] [6, 5, 3, 4, 2, 1] [6, 5, 3, 4, 1, 2] [6, 5, 1, 3, 2, 4] 
[6, 5, 1, 3, 4, 2] [6, 5, 1, 4, 3, 2] [6, 5, 4, 1, 3, 2] [6, 5, 4, 3, 1, 2] [6, 5, 4, 3, 2, 1] 

List of 140 permutations for 3 groups and lanterns per group [1, 3, 3]:
[1, 4, 3, 2, 7, 6, 5] [1, 4, 3, 7, 2, 6, 5] [1, 4, 3, 7, 6, 2, 5] [1, 4, 3, 7, 6, 5, 2] 
[1, 4, 7, 3, 2, 6, 5] [1, 4, 7, 3, 6, 2, 5] [1, 4, 7, 3, 6, 5, 2] [1, 4, 7, 6, 3, 2, 5] 
[1, 4, 7, 6, 3, 5, 2] [1, 4, 7, 6, 5, 3, 2] [1, 7, 4, 3, 2, 6, 5] [1, 7, 4, 3, 6, 2, 5] 
[1, 7, 4, 3, 6, 5, 2] [1, 7, 4, 6, 3, 2, 5] [1, 7, 4, 6, 3, 5, 2] [1, 7, 4, 6, 5, 3, 2] 
[1, 7, 6, 4, 3, 2, 5] [1, 7, 6, 4, 3, 5, 2] [1, 7, 6, 4, 5, 3, 2] [1, 7, 6, 5, 4, 3, 2] 
[4, 1, 3, 2, 7, 6, 5] [4, 1, 3, 7, 2, 6, 5] [4, 1, 3, 7, 6, 2, 5] [4, 1, 3, 7, 6, 5, 2] 
[4, 1, 7, 3, 2, 6, 5] [4, 1, 7, 3, 6, 2, 5] [4, 1, 7, 3, 6, 5, 2] [4, 1, 7, 6, 3, 2, 5] 
[4, 1, 7, 6, 3, 5, 2] [4, 1, 7, 6, 5, 3, 2] [4, 3, 1, 2, 7, 6, 5] [4, 3, 1, 7, 2, 6, 5] 
[4, 3, 1, 7, 6, 2, 5] [4, 3, 1, 7, 6, 5, 2] [4, 3, 2, 1, 7, 6, 5] [4, 3, 2, 7, 1, 6, 5] 
[4, 3, 2, 7, 6, 1, 5] [4, 3, 2, 7, 6, 5, 1] [4, 3, 7, 2, 1, 6, 5] [4, 3, 7, 2, 6, 1, 5] 
[4, 3, 7, 2, 6, 5, 1] [4, 3, 7, 1, 2, 6, 5] [4, 3, 7, 1, 6, 2, 5] [4, 3, 7, 1, 6, 5, 2] 
[4, 3, 7, 6, 1, 2, 5] [4, 3, 7, 6, 1, 5, 2] [4, 3, 7, 6, 2, 1, 5] [4, 3, 7, 6, 2, 5, 1] 
[4, 3, 7, 6, 5, 2, 1] [4, 3, 7, 6, 5, 1, 2] [4, 7, 3, 2, 1, 6, 5] [4, 7, 3, 2, 6, 1, 5] 
[4, 7, 3, 2, 6, 5, 1] [4, 7, 3, 1, 2, 6, 5] [4, 7, 3, 1, 6, 2, 5] [4, 7, 3, 1, 6, 5, 2] 
[4, 7, 3, 6, 1, 2, 5] [4, 7, 3, 6, 1, 5, 2] [4, 7, 3, 6, 2, 1, 5] [4, 7, 3, 6, 2, 5, 1] 
[4, 7, 3, 6, 5, 2, 1] [4, 7, 3, 6, 5, 1, 2] [4, 7, 1, 3, 2, 6, 5] [4, 7, 1, 3, 6, 2, 5] 
[4, 7, 1, 3, 6, 5, 2] [4, 7, 1, 6, 3, 2, 5] [4, 7, 1, 6, 3, 5, 2] [4, 7, 1, 6, 5, 3, 2] 
[4, 7, 6, 3, 1, 2, 5] [4, 7, 6, 3, 1, 5, 2] [4, 7, 6, 3, 2, 1, 5] [4, 7, 6, 3, 2, 5, 1] 
[4, 7, 6, 3, 5, 2, 1] [4, 7, 6, 3, 5, 1, 2] [4, 7, 6, 1, 3, 2, 5] [4, 7, 6, 1, 3, 5, 2] 
[4, 7, 6, 1, 5, 3, 2] [4, 7, 6, 5, 1, 3, 2] [4, 7, 6, 5, 3, 1, 2] [4, 7, 6, 5, 3, 2, 1] 
[7, 4, 3, 2, 1, 6, 5] [7, 4, 3, 2, 6, 1, 5] [7, 4, 3, 2, 6, 5, 1] [7, 4, 3, 1, 2, 6, 5] 
[7, 4, 3, 1, 6, 2, 5] [7, 4, 3, 1, 6, 5, 2] [7, 4, 3, 6, 1, 2, 5] [7, 4, 3, 6, 1, 5, 2] 
[7, 4, 3, 6, 2, 1, 5] [7, 4, 3, 6, 2, 5, 1] [7, 4, 3, 6, 5, 2, 1] [7, 4, 3, 6, 5, 1, 2] 
[7, 4, 1, 3, 2, 6, 5] [7, 4, 1, 3, 6, 2, 5] [7, 4, 1, 3, 6, 5, 2] [7, 4, 1, 6, 3, 2, 5] 
[7, 4, 1, 6, 3, 5, 2] [7, 4, 1, 6, 5, 3, 2] [7, 4, 6, 3, 1, 2, 5] [7, 4, 6, 3, 1, 5, 2] 
[7, 4, 6, 3, 2, 1, 5] [7, 4, 6, 3, 2, 5, 1] [7, 4, 6, 3, 5, 2, 1] [7, 4, 6, 3, 5, 1, 2] 
[7, 4, 6, 1, 3, 2, 5] [7, 4, 6, 1, 3, 5, 2] [7, 4, 6, 1, 5, 3, 2] [7, 4, 6, 5, 1, 3, 2] 
[7, 4, 6, 5, 3, 1, 2] [7, 4, 6, 5, 3, 2, 1] [7, 1, 4, 3, 2, 6, 5] [7, 1, 4, 3, 6, 2, 5] 
[7, 1, 4, 3, 6, 5, 2] [7, 1, 4, 6, 3, 2, 5] [7, 1, 4, 6, 3, 5, 2] [7, 1, 4, 6, 5, 3, 2] 
[7, 1, 6, 4, 3, 2, 5] [7, 1, 6, 4, 3, 5, 2] [7, 1, 6, 4, 5, 3, 2] [7, 1, 6, 5, 4, 3, 2] 
[7, 6, 4, 3, 1, 2, 5] [7, 6, 4, 3, 1, 5, 2] [7, 6, 4, 3, 2, 1, 5] [7, 6, 4, 3, 2, 5, 1] 
[7, 6, 4, 3, 5, 2, 1] [7, 6, 4, 3, 5, 1, 2] [7, 6, 4, 1, 3, 2, 5] [7, 6, 4, 1, 3, 5, 2] 
[7, 6, 4, 1, 5, 3, 2] [7, 6, 4, 5, 1, 3, 2] [7, 6, 4, 5, 3, 1, 2] [7, 6, 4, 5, 3, 2, 1] 
[7, 6, 1, 4, 3, 2, 5] [7, 6, 1, 4, 3, 5, 2] [7, 6, 1, 4, 5, 3, 2] [7, 6, 1, 5, 4, 3, 2] 
[7, 6, 5, 4, 1, 3, 2] [7, 6, 5, 4, 3, 1, 2] [7, 6, 5, 4, 3, 2, 1] [7, 6, 5, 1, 4, 3, 2]