Solve hanging lantern problem

Revision as of 15:33, 28 August 2022 by Thundergnat (talk | contribs) (syntax highlighting fixup automation)

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
lanterns  { (!+/) ÷ ×/! }
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

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

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

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
Output:
Same as FreeBASIC entry.

PureBasic

Translation of: FreeBASIC

The result for n >= 5 is slow to emerge

;;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()
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
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
Form code
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

Math solution

Translation of: Python

Reimplemented "getLantern" function above

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

Yabasic

Translation of: FreeBASIC

The result for n >= 5 is slow to emerge

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
Output:
Same as FreeBASIC entry.

J

Translation of APL:

lanterns=: {{ (!+/y) % */!y }}<

Example use:

   lanterns 1 2 3
60
   lanterns 1 3 3
140

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

pedantic=: {{
   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:

   pedantic  3, 1 2 3
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:

yetmoreoverhead=: {{
  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).

Finally, enumerating solutions might be approached recursively:

showlanterns=: {{
  arrange=. ($ $ (* +/\)@,) y $&>1
  echo 'lantern ids:'
  echo rplc&(' 0';'  ')"1 ' ',.":|:arrange
  echo ''
  cols=. <@-.&0"1 arrange
  recur=: <@{{
    todo=. (#~ ~:&a:) y -.L:0 x
    if. #todo do.
      next=. {:@> todo
      ,x <@,S:0 every next recur todo
    else.
      <x
    end.
  }}"0 1
  echo 'all lantern removal sequences:'
  echo >a:-.~ -.&0 each;0 recur cols
}}

Example use:

   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

Julia

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

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

#!/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";
  }
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
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.

Some tests:

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

Math solution

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

Showing Sequences

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)

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:

unit sub MAIN(*@columns);

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

say [+](@columns)! / [*](@columns»!);
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.

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;
}
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:

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;
}
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.

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

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

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);
]
Output:
5
1 3 5 2 4
37837800