Jump to content

Solve hanging lantern problem

From Rosetta Code
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.

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:

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


Related


ALGOL 68

Works with: ALGOL 68G version Any - tested with release 2.8.3.win32
Translation of: Python – Math sample

Note - this will get a warning: "a68g: warning: 261 digits precision impacts performance." from ALGOL 68 Genie version 3 - not sure there's a way to stop that... 

BEGIN # find the number of ways of taking down columns of lanterns          #
    # translation of the Python "Math" sample                               #

    PR precision 256 PR            # set number of digits for LONG LONG INT #
            # may need to be increased, depending on the number of lanterns #

    OP   FACTORIAL = ( INT n )LONG LONG INT:
         BEGIN
            LONG LONG INT result := 1;
            LONG LONG INT long n := 0;
            TO n DO result *:= ( long n +:= 1 ) OD;
            result
         END # FACTORIAL # ;

    PROC get lantern = ( REF[]INT arr )LONG LONG INT:
         BEGIN
            LONG LONG INT res := 0;
            INT           tot := 0;
            FOR i FROM LWB arr TO UPB arr DO
                tot +:= arr[ i ]
            OD;
            res := FACTORIAL tot;
            FOR i FROM LWB arr TO UPB arr DO
                res OVERAB FACTORIAL arr[ i ]
            OD;
            res
        END # get lantern # ;

    BEGIN
        INT n;
        print( ( "Columns> " ) );
        read( ( n, newline ) );
        [ 1 : n ]INT a;
        print( ( "lanterns per column> " ) );
        FOR i TO n DO
            read( ( a[ i ] ) )
        OD;
        print( ( whole( get lantern( a ), 0 ), newline ) )
    END
END
Output:
Columns> 3
lanterns per column> 1 2 3
60

Columns> 5
lanterns per column> 1 2 3 4 5
37837800

Columns> 8
lanterns per column> 1 2 3 4 5 6 7 8
73566121315513295589120000

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.

C++ 

#include <algorithm>
#include <cstdint>
#include <iostream>
#include <numeric>
#include <vector>

void print_vector(const std::vector<uint32_t>& list) {
	std::cout << "[";
	for ( uint64_t i = 0; i < list.size() - 1; ++i ) {
		std::cout << list[i] << ", ";
	}
	std::cout << list.back() << "]";
}

uint64_t factorial(const uint32_t& n) {
	return ( n == 0 ) ? 1 : n * factorial(n - 1);
}

uint64_t takedown_count(const std::vector<uint32_t>& numbers) {
	const uint32_t total = std::accumulate(numbers.begin(), numbers.end(), 0);
	uint64_t result = factorial(total);
	for ( const uint32_t& number : numbers ) {
		result = result / factorial(number);
	}
	return result;
}

void takedown_ways(const std::vector<uint32_t> numbers, const uint32_t& rowSize) {
	std::vector<uint32_t> limits(numbers.size(), 0);
	uint32_t sum = 0;
	std::vector<uint32_t> multi_numbers = { };
	for ( uint64_t i = 0; i < numbers.size(); ++i ) {
		sum += numbers[i];
		limits[i] = sum;
		for ( uint64_t j = 0; j < numbers[i]; ++j ) {
			multi_numbers.emplace_back(i + 1);
		}
	}

	const uint64_t takedown = takedown_count(numbers);
	std::cout << "List of " << takedown << " permutations for " << numbers.size()
		<< " groups with lanterns per group "; print_vector(numbers); std::cout << " :" << std::endl;
	uint32_t permutation_count = 0;
	do {
		std::vector<uint32_t> current(limits);
		std::vector<uint32_t> ways(sum, 0);
		for ( uint32_t i = 0; i < sum; ++i ) {
			ways[i] = current[multi_numbers[i] - 1];
			current[multi_numbers[i] - 1] -= 1;
		}
		print_vector(ways); std::cout << "  ";
		permutation_count += 1;
		if ( permutation_count % rowSize == 0 ) {
			std::cout << std::endl;
		}
	} while ( next_permutation(multi_numbers.begin(), multi_numbers.end()) );
}

int main() {
	const std::vector<std::vector<uint32_t>> tests = { { 1, 2, 3 }, { 2, 2, 3, 3 }, { 10, 2 } };
	std::cout << "Lantern arrangement => number of takedown ways:" << std::endl;
	std::for_each(tests.begin(), tests.end(), [](const std::vector<uint32_t>& numbers)
		{ print_vector(numbers); std::cout << " => " << takedown_count(numbers) << std::endl; });
	std::cout << std::endl;

	takedown_ways({ 1, 2, 3 }, 5);
}
Output:
Lantern arrangement => number of takedown ways:
[1, 2, 3] => 60
[2, 2, 3, 3] => 25200
[10, 2] => 66

List of 60 permutations for 3 groups with 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, 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]

EasyLang 

func factorial n .
   r = 1
   for i = 2 to n
      r *= i
   .
   return r
.
func latern a[] .
   for i to len a[]
      tot += a[i]
   .
   res = factorial tot
   for v in a[]
      res /= factorial v
   .
   return res
.
print latern [ 1 2 3 ]
Output:
60

FutureBasic 

_elements = 5

local fn GetLantern( arr(_elements) as long ) as long
  long i, res = 0
  for i = 1 to _elements
    if arr(i) != 0
      arr(i) = arr(i) - 1
      res = res + fn GetLantern( arr(0) )
      arr(i) = arr(i) + 1
    end if
  next
  if res = 0 then res = 1
end fn = res

long i, j, a(_elements)
for i = 1 to _elements
  a(i) = i
  print "[";
  for j = 1 to i
    if j == i then print a(j); else print a(j); ",";
  next
  print "] = "; fn GetLantern( a(0) )
next

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

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

Java 

import java.math.BigInteger;
import java.util.ArrayList;
import java.util.Collections;
import java.util.List;

public final class SolveHangingLanternProblem {

	public static void main(String[] args) {
		List<List<Integer>> tests = List.of(
			List.of( 1, 2, 3 ), List.of( 2, 2, 3, 3 ), List.of ( 100, 2 ) );
		
		System.out.println("Lantern arrangement => number of takedown ways:");
		tests.forEach( list -> System.out.println(list + " => " + takedownCount(list)) );
		System.out.println();
		
		takedownWays( new ArrayList<Integer>(List.of( 1, 2, 3 )), 5 );
	}
	
	private static BigInteger takedownCount(List<Integer> numbers) {
		final int total = numbers.stream().mapToInt(Integer::intValue).sum();
		BigInteger result = factorial(total);
		for ( int number : numbers ) {
			result = result.divide(factorial(number));
		}
		return result;
	}
	
	private static void takedownWays(List<Integer> numbers, int rowSize) {
		List<Integer> limits = new ArrayList<Integer>(Collections.nCopies(numbers.size(), 0));
	    int sum = 0;
	    List<Integer> multiNumbers = new ArrayList<Integer>();
	    for ( int i = 0; i < numbers.size(); i++ ) {
	        sum += numbers.get(i);
	        limits.set(i, sum);
	        for ( int j = 0; j < numbers.get(i); j++ ) {
	        	multiNumbers.addLast(i + 1);
	        }
	    }
	    
	    final BigInteger takedownCount = takedownCount(numbers);
	    System.out.println("List of " + takedownCount + " permutations for " + numbers.size()
	    	+ " groups with lanterns per group " + numbers + " :");
	    int permutationCount = 0;
	    for ( List<Integer> permutation : permutations(multiNumbers) ) {
	        List<Integer> current = new ArrayList<Integer>(limits);
	        List<Integer> ways = new ArrayList<Integer>(Collections.nCopies(sum, 0));
	        for ( int i = 0; i < sum; i++ ) {
	            ways.set(i, current.get(permutation.get(i) - 1));
	            current.set(permutation.get(i) - 1, current.get(permutation.get(i) - 1) - 1);
	        }
	        System.out.print(ways + "  ");
	        permutationCount += 1;
	        if ( permutationCount % rowSize == 0 ) {
	        	System.out.println();
	        }
	    }
	}
		
	// Return the distinct permutations of a list possibly containing duplicates
	private static List<List<Integer>> permutations(List<Integer> numbers) {
	   List<List<Integer>> result = new ArrayList<List<Integer>>();
	   Collections.sort(numbers);
	   List<Boolean> used = new ArrayList<Boolean>(Collections.nCopies(numbers.size(), false));
	   backtrack(numbers, new ArrayList<Integer>(), used, result);
	   return result;
	}
	
	private static void backtrack(List<Integer> numbers, List<Integer> temp,
								  List<Boolean> used, List<List<Integer>> result) {
	    if ( temp.size() == numbers.size() ) {
	        result.addLast( new ArrayList<Integer>(temp) );
	    } else {
	        for ( int i = 0; i < numbers.size(); i++ ) {
	            if ( used.get(i) ||
 	            	( i > 0 && numbers.get(i) == numbers.get(i - 1) && ! used.get(i - 1) ) ) {
	            	continue;
	            }
	            used.set(i, true); 
	            temp.addLast(numbers.get(i));
	            backtrack(numbers, temp, used, result);
	            used.set(i, false); 
	            temp.removeLast();
	        }
	    }
	}
	
	private static BigInteger factorial(int n) {
		return ( n == 1 ) ? BigInteger.ONE : BigInteger.valueOf(n).multiply(factorial(n - 1));
	}
	
}
Output:
Lantern arrangement => number of takedown ways:
[1, 2, 3] => 60
[2, 2, 3, 3] => 25200
[100, 2] => 5151

List of 60 permutations for 3 groups with 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, 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]

jq

The main focus of this entry is illustrating how cacheing can be added to the naive recursive algorithm. Some trivial optimizations are also included.

With these changes, the algorithm becomes quite performant. For example, the C implementation of jq accurately computes the value for the lantern configuration [1,2,3,4,5,6,7] in less than a second on a 2.53GHz machine.

For lantern configurations with more than 2^53 permutations, the accuracy of the C implementation of jq is insufficient, but the Go implementation (gojq) can be used. For the configuration [1,2,3,4,5,6,7,8], gojq takes just over 4 minutes to produce the correct answer on the same machine. 

# Input: an array representing a configuration of one or more lanterns.
# Output: the number of distinct ways to lower them.
def lanterns:

  def organize: map(select(. > 0)) | sort;

  # input and output: {cache, count}
  def n($array):
    ($array | organize) as $organized
    |  ($organized|length) as $length
    | if   $length == 1 then .count = 1
      elif $length == 2 and $organized[0] == 1 then .count = ($organized | add)
      else .cache[$organized|tostring] as $n
      | if $n then .count = $n
        else reduce range(0; $length) as $i ({cache, count: 0, a : $organized};
            .a[$i] += -1
            | .a as $new
            | n($new) as {count: $count, cache: $cache}
            | .count += $count
            | .cache = ($cache | .[$new | tostring] = $count)
            | .a[$i] += 1 )
        | {cache, count}
        end
      end;
  . as $a | null | n($a) | .count;

"Lantern configuration => number of permutations",
([1,3,3],
 [100,2],
 (range(2; 10) as $nlanterns
 | [range(1; $nlanterns)])
 | "\(.) => \(lanterns)" )

Invocation 

gojq -n -rf lanterns.jq
Output:
Lantern configuration => number of permutations
[1,3,3] => 140
[100,2] => 5151
[1] => 1
[1,2] => 3
[1,2,3] => 60
[1,2,3,4] => 12600
[1,2,3,4,5] => 37837800
[1,2,3,4,5,6] => 2053230379200
[1,2,3,4,5,6,7] => 2431106898187968000
[1,2,3,4,5,6,7,8] => 73566121315513295589120000


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.

Nim

Recursive solution.

The number of elements in the columns are provided as command arguments. 

import std/[os, strutils]

proc sequenceCount(columns: var seq[int]): int =
  for icol in 1..columns.high:
    if columns[icol] > 0:
      dec columns[icol]
      inc result, sequenceCount(columns)
      inc columns[icol]
  if result == 0: result = 1

let ncol = paramCount()
if ncol == 0:
  quit "Missing parameters.", QuitFailure
var columns = newSeq[int](ncol + 1)   # We will ignore the first column.
for i in 1..ncol:
  let n = paramStr(i).parseInt()
  if n < 0:
    quit "Wrong number of lanterns.", QuitFailure
  columns[i] = n

echo columns.sequenceCount()

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)

Quackery 

  [ 1 swap times [ i 1+ * ] ]   is !     ( n --> n )

  [ 0 over witheach + !
    1 rot witheach [ ! * ]
    / ]                         is solve ( [ --> n )

  [ []
    $ "Number of columns? "
    input quackery times
      [ $ "How many lanterns? "
        input quackery join ]
    solve
    say "Removal sequences: "
    echo ]                      is task   (  -->   )
Output:
Number of columns? 8
How many lanterns? 1
How many lanterns? 2
How many lanterns? 3
How many lanterns? 4
How many lanterns? 5
How many lanterns? 6
How many lanterns? 7
How many lanterns? 8
Removal sequences: 73566121315513295589120000

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]

RPL

Works with: RPL version HP-48R
« DUP ∑LIST FACT SWAP FACT ΠLIST /      
» 'LANTERN' STO

{ 1 2 3 } LANTERN
Output:
1: 60

Ruby

Directly computing the count

Compute the count directly: 

Factorial = Hash.new{|h, k| h[k] = k * h[k-1] } # a memoized factorial
Factorial[0] = 1

def count_perms_with_reps(ar)
  Factorial[ar.sum] / ar.inject{|prod, m| prod * Factorial[m]}
end

ar, input = [], ""
puts "Input column heights in sequence (empty line to end input):"
ar << input.to_i until (input=gets) == "\n"
puts "There are #{count_perms_with_reps(ar)} ways to take these #{ar.size} columns down."
Output:
Input column heights in sequence (empty line to end input):
1
2
3
4
5
6
7
8

There are 73566121315513295589120000 ways to take these 8 columns down.

Uiua

Works with: Uiua version 0.10.0
Fac ← /×+1⇡
Lant ← ÷⊃(/(×⊙Fac)|Fac/+)

Lant [1 2 3]
Lant [1 3 3]
Lant [1 3 3 5 7]
Output:
60
140
5587021440

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
Retrieved from "https://rosettacode.org/wiki/Solve_hanging_lantern_problem?oldid=371134"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information