TMTOWTDI – OOP Class

In Functional Programming paradigm, we could simulate what is called a class in OO terminology. We are not here to simulate the whole OO paradigm in FP paradigm because it would be a waste of time.

A class (in fact, an object) can maintain its state through its attributes and it can expose its state through its methods (or accessors). That being said, can it be done in Perl without the bless operator? Yes, it can be done. We just need a different ingredient called closure.

Ruby language defines Closure in sweet and simple form in its unix man page as objectify the procedure.

That is what we are going to do in Perl and JavaScript as below.

use strict;
use warnings;

sub Emp {

	# class level variables
	my $objCounter = 0;

	return sub {

		# the actual constructor
		my ($empid, $fname, $lname) = @_;
		return undef if not defined $empid;
		$objCounter++;
		$fname = ''  if not defined $fname;
		$lname = ''  if not defined $lname;

		# return a hash of public methods
		return {

			# object methods
			getEmpId => sub {return $empid},
			setFName => sub {$fname = shift},
			getFName => sub { return $fname},
			setLName => sub {$lname = shift},
			getLName => sub { return $lname},

			# a class method
			getObjCounter => sub { return $objCounter},
		}
	}
}

# the Emp() function should be called only once
# so that the class-level variables work as expected
# OR you could use feature 'state';
my $Emp_Constructor = Emp();

my $e1 = $Emp_Constructor->(100, 'Hello', 'World');
print 'Objects created = ', $e1->{getObjCounter}(), "\n";

my $e2 = $Emp_Constructor->(200);

# Class methods can be called with any object
print 'Objects created = ', $e1->{getObjCounter}(), "\n";
print 'Objects created = ', $e2->{getObjCounter}(), "\n";

print $e1->{getEmpId}(), ' ', $e1->{getFName}(), "\n";
$e1->{setFName}('myname');
print $e1->{getEmpId}(), ' ', $e1->{getFName}(), "\n";

print $e2->{getEmpId}(), ' ', $e2->{getFName}(), "\n";
$e2->{setFName}('yourname');
print $e2->{getEmpId}(), ' ', $e2->{getFName}(), "\n";

print $e1->{getEmpId}(), ' ', $e1->{getFName}(), "\n";

JavaScript code looks less noisier than Perl.
And in JavaScript, both Associate Arrays (i.e. Perl hashes) and Objects can be constructed with the same object literal syntax.

function Emp() {
    var objCounter = 0;
    return function(EmpID, FName, LName) {
        if(EmpID == undefined) return undefined;
        objCounter++;
        if(FName == undefined) FName = '';
        if(LName == undefined) LName = '';
        return {getEmpID: function(){return EmpID},
                getFName: function(){return FName},
                getLName: function(){return LName},
                setFName: function(X){FName = X},
                setLName: function(X){LName = X},
                getObjCounter: function(){return objCounter}
                }
    }
}

var EmpConstructor = Emp();
var e1 = EmpConstructor(100, 'Hello', 'World');
console.log('Objects created = ' + e1.getObjCounter());

var e2 = EmpConstructor(200);
console.log('Objects created = ' + e1.getObjCounter());
console.log('Objects created = ' + e2.getObjCounter());

console.log(e1.getEmpID() + '  ' + e1.getFName() + ' ' + e1.getLName());
e1.setFName('myname');
console.log(e1.getEmpID() + '  ' + e1.getFName() + ' ' + e1.getLName());

console.log(e2.getEmpID() + '  ' + e2.getFName() + ' ' + e2.getLName());
e2.setFName('yourname');
console.log(e2.getEmpID() + '  ' + e2.getFName() + ' ' + e2.getLName());

Erlang being a functional language, how could we achieve the same in it?

Happy Programming!

15 Puzzle

During my childhood:
I used to play the 15 puzzle sliding game in a toy. The rear-side of the toy shows the jig-saw puzzle of a simple Tajmahal drawing. If we complete the 15 puzzle, the other side reveals the correctly aligned Tajmahal drawing.

In college days:
As a lab exercise, I had written a C program under Turbo C compiler using clrscr() of conio.h and direct video memory access to give colors and the extended character set to draw the borders. Unfortunately, I somehow missed the source code.

Just before two years:
I had written the same puzzle in HTML/JavaScript. JavaScript being an interpreted language that is readily available in any system, I wrote it quickly and/or easily.

Now:
Using Gtk2 Perl bindings, I have written another one.

Please see the codes below.

HTML/JavaScript:

<!DOCTYPE html>
<html>
<head><title>Sliding Puzzle</title>
<style type="text/css">
body{font-family:Arial;margin:7%;padding:0;text-align:center;}
h1{padding:5px; background-color:#aaf;border:dashed 3px #ddf;}
div#hdr{text-align:center}
div#lpane, div#rpane {float:left;width:50%;padding-top:2%;}
table#tbl {
  border:solid 0px maroon;
  background-color:#aaf;
  float:left;
  width:100%;
  text-align:center;
}
table#tbl tr{border:solid 0px maroon;}
table#tbl tr td{
  border:solid 1px maroon;
  background-color: #ddf;
  font-family: Arial;
  padding: 3px;
  margin: 3px;
  width:20.8%;
  text-align:center;
  font-size:2.8em;
}
table#track tr.success {color:#afa;}
</style>
<script type="text/javascript">
//Global Variables
var gamenum = 0;
var movenum = 0;
function handleKey(e){
    var t=document.getElementById("tbl").tBodies[0];
    if(e.keyCode == 0 && (e.charCode == 110 || e.charCode == 78)) {
      //'n' or 'N' is pressed
      newPuzzle();
      return;
    }
    if(e.keyCode >= 37 && e.keyCode <= 40)
    OUTER:
      for(i=0;i<=3;i++)
      for(j=0;j<=3;j++)//{alert(t.rows[i].cells[j].innerHTML);}return;
        if(t.rows[i].cells[j].innerHTML == "&nbsp;")
          switch(e.keyCode){
            case 37: if(j==3) return; //Left Arrow Key
                     var tmp = t.rows[i].cells[j+1].innerHTML;
                     t.rows[i].cells[j+1].innerHTML = t.rows[i].cells[j].innerHTML;
                     t.rows[i].cells[j].innerHTML = tmp;
                     movenum++;
                     break OUTER;
            case 38: if(i==3) return; //Upper Arrow Key
                     var tmp = t.rows[i+1].cells[j].innerHTML;
                     t.rows[i+1].cells[j].innerHTML = t.rows[i].cells[j].innerHTML;
                     t.rows[i].cells[j].innerHTML = tmp;
                     movenum++;
                     break OUTER;
            case 39: if(j==0) return; //Right Arrow Key
                     var tmp = t.rows[i].cells[j-1].innerHTML;
                     t.rows[i].cells[j-1].innerHTML = t.rows[i].cells[j].innerHTML;
                     t.rows[i].cells[j].innerHTML = tmp;
                     movenum++;
                     break OUTER;
            case 40: if(i==0) return; //Down Arrow Key
                     var tmp = t.rows[i-1].cells[j].innerHTML;
                     t.rows[i-1].cells[j].innerHTML = t.rows[i].cells[j].innerHTML;
                     t.rows[i].cells[j].innerHTML = tmp;
                     movenum++;
                     break OUTER;
          }
    document.getElementById("track").tBodies[0].rows[0].cells[3].innerHTML = movenum;
    checkCorrectness();
}
function checkCorrectness(){
  var t = document.getElementById("tbl");
  OUTER:
  for(var i=0;i<=3;i++)
  for(var j=0;j<=3;j++)
    if(t.rows[i].cells[j].innerHTML == i*4+j+1)
      ;
    else break OUTER;
  if(i*4+j+1==16){
    document.getElementById("track").tBodies[0].rows[0].className="success";
    alert("Very Good!\nNew Game Starts ...");
    newPuzzle();
  }
}
function newPuzzle(){
  gamenum++;
  movenum=0;
  var numbag=Array();
  var t = document.getElementById("tbl");
  for(var i=0; i<=3; ++i){
    for(var j=0; j<=3; ++j){
      if((i+1)*(j+1)==16)break;
      while(1){
        var num = Math.round(Math.random()*20);
        if(num >=1 && num <= 15 && numbag[""+num]==null){
          numbag[""+num]=(i+1)*(j+1);
          t.rows[i].cells[j].innerHTML = num;
          break;
        }
      }
      //t.rows[i].cells[j].innerHTML = i*4+j+1;
    }
  }
  t.rows[3].cells[3].innerHTML = "&nbsp;";
  var trk = document.getElementById("track").tBodies[0];
  var tr = trk.insertRow(0);
  var td = tr.insertCell(0); td.innerHTML = "Game";
      td = tr.insertCell(1); td.innerHTML = gamenum;
      td = tr.insertCell(2); td.innerHTML = "Moves";
      td = tr.insertCell(3); td.innerHTML = movenum;
}
</script>
</head>
<body onkeydown="handleKey(event);" onload="newPuzzle();">
<div id="hdr"><h1>15-Puzzle</h1>
Use 'N' to start a new game.<br />
Use arrow keys to move the numbers into the empty box.
</div>
<div id="bdy">
<div id="lpane">
<script type="text/javascript">
document.write('<table id="tbl"><tbody>');
for(var i=0; i<=3; ++i){
  document.write("<tr>");
  for(var j=0; j<=3; ++j){
    document.write("<td>&nbsp;</td>");
  }
  document.write("</tr>");
}
document.write("</tbody></table>");
</script>
</div><div id="rpane">
<table id="track">
<tbody></tbody>
</table>
</div></div>
</body>
</html>

Perl:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(shuffle);
use List::MoreUtils qw(any all apply);
use Gtk2 -init;
use Glib qw/TRUE FALSE/;

sub cust_window {
	my $window = Gtk2::Window->new ('toplevel');
	$window->set_title('15 Puzzle');
	$window->signal_connect (delete_event => sub { Gtk2->main_quit });
	return $window;
}

sub cust_btn {
	my $btn = Gtk2::Button->new(shift);
	$btn->set_can_focus(FALSE);
	$btn->set_size_request(100, 100);
	return $btn;
}

sub gen_btn_arr {
	map {
		my $r = $_;
		my @btns = map {
			my $c = $_;
			$r * $c == 16 ? undef : cust_btn(($r - 1) * 4 + $c);
		} 1 .. 4;
		\@btns;
	} 1 .. 4
}

sub randomize_btn_label {
	my $btn_arr = shift;
	my @labels  = @_;
	apply {
		my $r = $_;
		apply {
			my $c = $_;
			$btn_arr->[$r - 1][$c - 1]->set_label( $r * $c == 16 ? ' ' : $labels[($r - 1) * 4 + $c - 1]);
		} 1 .. 4;
	} 1 .. 4
}

sub is_complete {
	my $btn_arr = shift;
	all {
		my $r = $_;
		all {
			my $c = $_;
			$btn_arr->[$r - 1][$c - 1]->get_label() eq ($r * $c == 16 ? ' ' : ($r - 1) * 4 + $c);
		} 1 .. 4;
	} 1 .. 4
}

sub cursor_btn {
	my $btn = Gtk2::Button->new(' ');
	return $btn;
}

sub attach_btns {
	my $tbl = shift;
	my $btn_arr = shift;
	apply {
		my $r = $_;
		apply {
			my $c = $_;
			$tbl->attach($btn_arr->[$r - 1][$c - 1], $c - 1, $c, $r - 1, $r, 'fill', 'fill', 0, 0);
		} 1 .. 4
	} 1 .. 4
}

sub swpbtns {
	my ($btn_arr, $oldcurr, $oldcurc, $keypressed) = @_;
	my ($newcurr, $newcurc) = $keypressed eq 'Up'    ? ($oldcurr - 1, $oldcurc) :
							  $keypressed eq 'Down'  ? ($oldcurr + 1, $oldcurc) :
							  $keypressed eq 'Left'  ? ($oldcurr, $oldcurc - 1) :
							  $keypressed eq 'Right' ? ($oldcurr, $oldcurc + 1) : ();
	my ($t1, $t2) = ($btn_arr->[$oldcurr][$oldcurc]->get_label(), $btn_arr->[$newcurr][$newcurc]->get_label());
	$btn_arr->[$oldcurr][$oldcurc]->set_can_focus(FALSE);
	$btn_arr->[$newcurr][$newcurc]->set_can_focus(TRUE);
	$btn_arr->[$newcurr][$newcurc]->grab_focus();
	$btn_arr->[$newcurr][$newcurc]->set_label($t1);
	$btn_arr->[$oldcurr][$oldcurc]->set_label($t2);
	return ($newcurr, $newcurc);
}

sub main {
	my $win = cust_window();
	my $tbl = Gtk2::Table->new(4, 4, TRUE);
	my @btn_arr = gen_btn_arr();
	my $dialog = undef;
	my ($cur_r, $cur_c) = (3, 3);
	my $moves = 0;

	$btn_arr[3][3] = cursor_btn();
	attach_btns($tbl, \@btn_arr);

	$win->add($tbl);
	$win->signal_connect('key-press-event' => sub {
				my ($widget, $event, $parameter) = @_;
				my $key_nr = $event->keyval();
				if($key_nr == 110) {
					randomize_btn_label(\@btn_arr, shuffle 1 .. 15);
				}
				if($key_nr >= 65361 and $key_nr <= 65364) { 					my %key_human = (65361 => 'Left', 65362 => 'Up', 65363 => 'Right', 65364 => 'Down');
					return undef if(($key_nr == 65361 and $cur_c == 0)
								 or ($key_nr == 65362 and $cur_r == 0)
								 or ($key_nr == 65363 and $cur_c == 3)
								 or ($key_nr == 65364 and $cur_r == 3));
					($cur_r, $cur_c) = swpbtns(\@btn_arr, $cur_r, $cur_c, $key_human{$key_nr});
					$moves++;
					if (is_complete(\@btn_arr)) {
						$dialog = Gtk2::MessageDialog->new($win, 'modal', 'info', 'ok',
												"Completed in %s moves.\nNew game starts ...", $moves);
						$dialog->run(); $dialog->destroy();
						$moves = 0 ;
						randomize_btn_label(\@btn_arr, shuffle 1 .. 15);
					}
				}});
	$win->show_all();
	randomize_btn_label(\@btn_arr, 1 .. 15);
	Gtk2->main();
}

main();

– How about writing the same perl program in Prima GUI (or) wxPerl (or) Tcl/Tk (or) Qt libraries?
– How about writing a program that solves the puzzle instead of just simulating the toy game?

Happy Programming!

Fox, Goose, Beans

Here is the wiki entry about the Fox, Goose and bag of Beans puzzle.

The following Perl program prints the solution to it.

use strict;
use warnings;
use sigtrap;

my @items = qw(goose fox beans farmer);
my %locns = map {$_ => 'A'} @items;     # initially, all items on Shore A

sub is_all_transported {
    my %locns = @_;
	my $count = 0;
    for (keys %locns) {
        $count += 1 if $locns{$_} eq 'B';
    }
    return ($count == 4) ? 1 : 0;
}

sub is_eatable {
    my @eatables = ( {goose => 'A', beans => 'A', farmer => 'B'}
                   , {goose => 'A', fox   => 'A', farmer => 'B'}
                   , {goose => 'B', beans => 'B', farmer => 'A'}
                   , {goose => 'B', fox   => 'B', farmer => 'A'}
			       ) ;
    my %tmp_locn = @_;
    for my $i (0 .. @eatables) {
		my $count = 0;
		for my $item (keys %{$eatables[$i]}) {
			$count += 1 if $tmp_locn{$item} eq $eatables[$i]->{$item};
		}
		return 1 if $count == 3;
    }
	return 0;
}

sub transport_to {
    my $locn_ref = shift;
    my $item     = shift;
	my $locn_dst = shift;
	my $locn_alt = ($locn_dst eq 'A') ? 'B' : 'A';
    
	return 0 if $locn_ref->{'farmer'} eq $locn_dst;
	return 0 if $locn_ref->{$item}    eq $locn_dst;

	$locn_ref->{$item}    = $locn_dst;
	$locn_ref->{'farmer'} = $locn_dst;
    
    return 1 if not is_eatable(%$locn_ref);

	$locn_ref->{$item}    = $locn_alt;
	$locn_ref->{'farmer'} = $locn_alt;

	return 0;
}

sub my_print {
	my ($item, $back) = @_;
	print "Return\n" and return 1 if $item eq 'farmer';
	print "Bring $item$back\n";
}

sub main {
    while(not is_all_transported(%locns)) {
        for(@items) {
            my_print ($_, '') and next if transport_to(\%locns, $_, 'B');
            my_print ($_, ' back') if transport_to(\%locns, $_, 'A');
        }
    }
}

main();

Simple puzzle but solving it with a computer program gives you much more happiness. (Oh! forgive me for poorly naming the functions 😉

Happy programming!

Eight Queens Puzzle

I tried to solve the Eight Queens Puzzle in my own way. The script written in Perl prints only the 1st possible solution and exits. But this can be modified to print all the solutions. The program is given below.

use strict;
use warnings;
no warnings 'recursion';

use constant BLANK => '~';
use constant OCCUP => 'x';
use constant BRDSZ => 8;

my @qpos  = ();

sub print_board {
	my @qpos = @_;
	print "\n";
	for my $r (0 .. BRDSZ - 1) {
		for my $c1 (0 .. BRDSZ - 1) {
			my $c2 = $qpos[$r];
			print ($c1 == $c2 ? OCCUP : BLANK);
		}
		print "\n";
	}
	print "\n";
}

sub col_presence {
	my $c = shift;
	for my $r (0 .. @qpos - 1) {
		return 1 if $qpos[$r] == $c;
	}
}

sub diag_presence {
	my ($r, $c) = @_;
	my ($i, $j);

	$i = $r - 1; $j = $c - 1;
	while($i >= 0 and $j >= 0) {
		return 1 if $qpos[$i--] == $j--;
	}

	$i = $r - 1; $j = $c + 1;
	while($i >= 0 and $j <= BRDSZ - 1) {
		return 1 if $qpos[$i--] == $j++;
	}

	return 0;
}

sub try_pos {
	my ($r, $c) = @_;
	if($r == BRDSZ) {
		print_board @qpos;
		return;
	}
	if($c == BRDSZ and @qpos >= 1) {
		my $lastr = @qpos - 1;
		my $lastc = $qpos[$lastr];
		if($lastr < $r) {
			pop @qpos;
			try_pos($lastr, $lastc + 1);
		}
	} elsif(col_presence($c) or diag_presence($r, $c)) {
		try_pos($r, $c + 1);
	} else {
		push @qpos, $c;
		try_pos($r + 1, 0);
	}
}

try_pos(0, 0); @qpos = ();
try_pos(0, 1); @qpos = ();
try_pos(0, 2); @qpos = ();
try_pos(0, 3); @qpos = ();
try_pos(0, 4); @qpos = ();
try_pos(0, 5); @qpos = ();
try_pos(0, 6); @qpos = ();
try_pos(0, 7);

As I am calling try_pos function for all eight columns of 1st row, we get eight different solutions. This algorithm uses backtracking (see the call to the function pop). WARNING: This program may not be the best possible algorithm. Please refer wikipedia or google for various algorithms.

How to convert this program to use loops instead of recursion?
Happy Programming!