Rosetta Code

Solve hanging lantern problem

Revision as of 09:32, 19 June 2022 by Petelomax (talk | contribs) (added related 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?

Solve hanging lantern problem is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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:

[1,2,3,…]
[2,1,3,…]
……


Related


APL

Translation of: Pascal

<lang apl>lanterns ← { (!+/⍵) ÷ ×/!⍵ }</lang>

Output:
      lanterns 1 2 3
60
      lanterns 1 3 3
140

Of course, for the simple sequences from 1, we can use iota to generate them instead of typing them out: 

      lanterns ⍳3 ⍝ same as lanterns 1 2 3
60
      lanterns ⍳4
12600
      lanterns ⍳5
37837800

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.

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

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.

VBA

See Visual Basic

Visual Basic

Works with: Visual Basic version 6

Note: Integer may overflow if the input number is too big. To solve this problem, simply change Integer to Long or Variant for Decimal.

Recursive version

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, i 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>

Math solution

Translation of: Python

Reimplemented "getLantern" function above

<lang vb>Function getLantern(arr() As Integer) As Integer 

   Dim tot As Integer, res As Integer
   Dim i As Integer
   For i = 1 To n
       tot = tot + arr(i)
   Next i
   res = factorial(tot)
   For i = 1 To n
       res = res / factorial(arr(i))
   Next i
   getLantern = res

End Function

Function factorial(num As Integer) As Integer 

   Dim i As Integer
   factorial = 1
   For i = 2 To n
       factorial = factorial * i
   Next i

End Function</lang>

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.

J

Translation of APL:

<lang J>lanterns=: Template:(!+/y) % */!y<</lang>

Example use:

<lang J> lanterns 1 2 3 60 

  lanterns 1 3 3

140 </lang>

Also, a pedantic version where we must manually count how many values we are providing the computer:

<lang J>pedantic=: {{ 

  assert. ({. = #@}.) y
  lanterns }.y

}}</lang>

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:

<lang J> pedantic 3, 1 2 3 60 

  pedantic  3, 1 3 3

140</lang>

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:

<lang J>yetmoreoverhead=: {{ 

 pedantic ({.~ 1+{.) _ ". rplc&(TAB,' ',LF,' ') fread y

}}</lang>

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).

Finally, enumerating solutions might be approached recursively:

<lang J>showlanterns=: {{ 

 arrange=. ($ $ (* +/\)@,) y $&>1
 echo 'lantern ids:'
 echo rplc&(' 0';'  ')"1 ' ',.":|:arrange
 echo 
 cols=. <@-.&0"1 arrange
 recur=: <@Template:Todo=. ("0 1
 echo 'all lantern removal sequences:'
 echo >a:-.~ -.&0 each;0 recur cols

}}</lang>

Example use:

<lang J> showlanterns 1 2 1 lantern ids: 

1 2 4
  3

all lantern removal sequences: 1 3 2 4 1 3 4 2 1 4 3 2 3 1 2 4 3 1 4 2 3 2 1 4 3 2 4 1 3 4 1 2 3 4 2 1 4 1 3 2 4 3 1 2 4 3 2 1</lang>

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

Perl

<lang perl>#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Solve_hanging_lantern_problem use warnings;

$_ = 'a bc def';

my $answer = ; find($_, ); print "count = @{[ $answer =~ tr/\n// ]}\n", $answer;

sub find 

 {
 my ($in, $found) = @_;
 find( $` . $', $found . $& ) while $in =~ /\w\b/g;
 $in =~ /\w/ or $answer .= '[' . $found =~ s/\B/,/gr . "]\n";
 }</lang>
Output:
count = 60
[a,c,b,f,e,d]
[a,c,f,b,e,d]
[a,c,f,e,b,d]
[a,c,f,e,d,b]
[a,f,c,b,e,d]
[a,f,c,e,b,d]
[a,f,c,e,d,b]
[a,f,e,c,b,d]
[a,f,e,c,d,b]
[a,f,e,d,c,b]
[c,a,b,f,e,d]
[c,a,f,b,e,d]
[c,a,f,e,b,d]
[c,a,f,e,d,b]
[c,b,a,f,e,d]
[c,b,f,a,e,d]
[c,b,f,e,a,d]
[c,b,f,e,d,a]
[c,f,a,b,e,d]
[c,f,a,e,b,d]
[c,f,a,e,d,b]
[c,f,b,a,e,d]
[c,f,b,e,a,d]
[c,f,b,e,d,a]
[c,f,e,a,b,d]
[c,f,e,a,d,b]
[c,f,e,b,a,d]
[c,f,e,b,d,a]
[c,f,e,d,a,b]
[c,f,e,d,b,a]
[f,a,c,b,e,d]
[f,a,c,e,b,d]
[f,a,c,e,d,b]
[f,a,e,c,b,d]
[f,a,e,c,d,b]
[f,a,e,d,c,b]
[f,c,a,b,e,d]
[f,c,a,e,b,d]
[f,c,a,e,d,b]
[f,c,b,a,e,d]
[f,c,b,e,a,d]
[f,c,b,e,d,a]
[f,c,e,a,b,d]
[f,c,e,a,d,b]
[f,c,e,b,a,d]
[f,c,e,b,d,a]
[f,c,e,d,a,b]
[f,c,e,d,b,a]
[f,e,a,c,b,d]
[f,e,a,c,d,b]
[f,e,a,d,c,b]
[f,e,c,a,b,d]
[f,e,c,a,d,b]
[f,e,c,b,a,d]
[f,e,c,b,d,a]
[f,e,c,d,a,b]
[f,e,c,d,b,a]
[f,e,d,a,c,b]
[f,e,d,c,a,b]
[f,e,d,c,b,a]

Phix

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

Translation of: Visual Basic

<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

Note: All of these solutions accept the list of column sizes as command-line arguments and infer the number of columns from the number of sizes provided, rather than requiring that a count be supplied as an extra distinct parameter.

Directly computing the count

Translation of: Pascal

If all we need is the count, then we can compute that directly:

<lang perl6>unit sub MAIN(*@columns);

sub postfix:<!>($n) { [*] 1..$n }

say [+](@columns)! / [*](@columns»!);</lang>

Output:
$ raku lanterns.raku 1 2 3
60

Sequence as column numbers

Translation of: Julia

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.

<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 --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 lantern numbers

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:

<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                                                   
        1       2       4
                3       5
                        6
There are 60 possible takedown sequences:
[1,3,2,6,5,4]
[1,3,6,2,5,4]
[1,3,6,5,2,4]
...
[6,5,4,1,3,2]
[6,5,4,3,1,2]
[6,5,4,3,2,1]

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]

XPL0

<lang XPL0>char N, Column, Sequences, I, Lanterns;

proc Tally(Level); char Level, Col; [for Col:= 0 to N-1 do 

   if Column(Col) > 0 then
       [Column(Col):= Column(Col)-1;
       if Level = Lanterns-1 then Sequences:= Sequences+1
       else Tally(Level+1);
       Column(Col):= Column(Col)+1;
       ];

];

[Sequences:= 0; Lanterns:= 0; N:= IntIn(0); Column:= Reserve(N); for I:= 0 to N-1 do 

       [Column(I):= IntIn(0);
       Lanterns:= Lanterns + Column(I);
       ];

Tally(0); IntOut(0, Sequences); ]</lang>

Output:
5
1 3 5 2 4
37837800
Retrieved from "https://rosettacode.org/wiki/Solve_hanging_lantern_problem?oldid=320895"