« Drude revisited Perl Weekly Challenge 109. »

Perl Weekly Challenge 108.

My solutions (task 1 and task 2) to the The Weekly Challenge - 108.

Task 1: Locate Memory

Submitted by: Mohammad S Anwar

Write a script to declare a variable or constant and print it’s location in the memory.

If I understand correctly, when you print a reference you get the location within parenthesis. Thus, it seems that all that is required is to remove the parenthesis. I try it below with a few my and our variables, with a subroutine and with a constant (which is actually a function):

# Perl weekly challenge 108
# Task 1: Locate Memory
#
# See https://wlmb.github.io/2021/04/12/PWC108/#task-1-locate-memory
use strict;
use warnings;
use v5.12;

use constant PI=>3.14;

sub X {}
my ($x, @x, %x);
our ($X, @X, %X);
my %map=('$x'=>\$x, '@x'=>\@x, '%x'=>\%x, '$X'=>\$X, '@X'=>\@X, '%X'=>\%X, '&X'=>\&X, 'PI'=>\&PI);
foreach (sort keys %map){
    my $r=$map{$_};
    $r=~/\((.*)\)/;
    say "$_=>$1";
}

Run it:

./ch-1.pl

Results:

$X=>0x5582b0a0e710
$x=>0x5582b09e0da0
%X=>0x5582b0a03f98
%x=>0x5582b0a0e8f0
&X=>0x5582b0a0e860
@X=>0x5582b0a0e8a8
@x=>0x5582b09e0cc8
PI=>0x5582b0a0e170

Task 2: Bell Numbers

Submitted by: Mohammad S Anwar

Write a script to display top 10 Bell Numbers. Please refer to wikipedia page for more informations.

Example:

B0: 1 as you can only have one partition of zero element set
B1: 1 as you can only have one partition of one element set {a}.
B2: 2
   {a}{b}
   {a,b}
B3: 5
   {a}{b}{c}
   {a,b}{c}
   {a}{b,c}
   {a,c}{b}
   {a,b,c}
B4: 15
   {a}{b}{c}{d}
   {a,b,c,d}
   {a,b}{c,d}
   {a,c}{b,d}
   {a,d}{b,c}
   {a,b}{c}{d}
   {a,c}{b}{d}
   {a,d}{b}{c}
   {b,c}{a}{d}
   {b,d}{a}{c}
   {c,d}{a}{b}
   {a}{b,c,d}
   {b}{a,c,d}
   {c}{a,b,d}
   {d}{a,b,c}

One can obtain partitions of n+1 elements by either adding a set {z} to the previous partitions, where z is the n+1-th element, or creating new partitions from old partitions by adding the element z to one of the previous sets. This is easily done recursively.

I make a routine bell($n) that returns a ref to an array with all partitions of $n elemens. Each partition is a ref to an array of sets. Each set is a ref to an array of elements. The Bell number may be obtained from the number of partitions.

# Perl weekly challenge 108
# Task 2: Bell numbers
# Complete enumeration.
#
# See https://wlmb.github.io/2021/04/12/PWC108/#task-2-bell-numbers
use warnings;
use strict;
use v5.12;

use Memoize;
memoize('bell');
my $last=shift @ARGV;
die "Usage: ./ch-2a.pl last\n to generate Bell numbers up to last>=0"
    unless defined $last and $last >=0;
foreach(0..$last){
    my $partitions=bell($_);
    my $bell=@$partitions;
    say "\nbell($_)=$bell";
    foreach my $p(@$partitions){
	print "\t";
	foreach(@$p){
	    print "{", join(",", @$_), "}";
	}
	say "";
    }
}
sub bell {
    my $n=shift;
    die "Argument of Bell should be non-negative" if $n<0;
    return [[[]]] if $n==0;
    return [[[1]]] if $n==1;
    my $previous=bell($n-1);
    my @with_new_set=map {[@$_, [$n]]} @$previous;
    my @with_new_element=map {
	my @sets=@$_; map {[@sets[0..$_-1], [@{$sets[$_]}, $n], @sets[$_+1..@sets-1]]}
	(0..@sets-1)} @$previous;
    my @current=(@with_new_set, @with_new_element);
    return [@current];
}

Example

./ch-2a.pl 4

Results:

bell(0)=1
	{}

bell(1)=1
	{1}

bell(2)=2
	{1}{2}
	{1,2}

bell(3)=5
	{1}{2}{3}
	{1,2}{3}
	{1,3}{2}
	{1}{2,3}
	{1,2,3}

bell(4)=15
	{1}{2}{3}{4}
	{1,2}{3}{4}
	{1,3}{2}{4}
	{1}{2,3}{4}
	{1,2,3}{4}
	{1,4}{2}{3}
	{1}{2,4}{3}
	{1}{2}{3,4}
	{1,2,4}{3}
	{1,2}{3,4}
	{1,3,4}{2}
	{1,3}{2,4}
	{1,4}{2,3}
	{1}{2,3,4}
	{1,2,3,4}

The problem with the approach above is that the listing of all partitions rapidly becomes too large. If it is not needed and only the Bell numbers are required, I could add a flag to avoid printing the partitions, but a better, simpler and more efficient alternative would be to use an algorithm such as the triangle algorithm to compute the Bell numbers.

# Perl weekly challenge 108
# Task 2: Bell numbers
# Triangle solution without enumeration.
#
# See https://wlmb.github.io/2021/04/12/PWC108/#task-2-bell-numbers
use strict;
use warnings;
use strict;
use v5.12;

my $last=shift @ARGV;
die "Usage: ./ch-2.pl last\n to generate Bell numbers up to last>=0"
    unless defined $last and $last >=0;
my @triangle=([1], [1]);
for my $row(1..$last-1){
    for my $col(1..$row){
	$triangle[$row][$col]=$triangle[$row-1][$col-1]+$triangle[$row][$col-1];
    }
    $triangle[$row+1][0]=$triangle[$row][$row];
}
my @bell=map {$triangle[$_][0]} (0..$last);
say "Bell($_)=$bell[$_]" for 0..$last;

Example:

./ch-2.pl 10

Results:

Bell(0)=1
Bell(1)=1
Bell(2)=2
Bell(3)=5
Bell(4)=15
Bell(5)=52
Bell(6)=203
Bell(7)=877
Bell(8)=4140
Bell(9)=21147
Bell(10)=115975

Written on April 12, 2021