The Josephus Problem: It’s a way of thinking

danvk tried to solve the Josephus Problem in Perl, Python, and Ruby, comparing each one. He had some pretty ignorant things to say about each.

There’s no reason to use object orientation here. It doesn’t help the problem or organize the data any better. But, it’s cargo cult to make everything a class. Even then, why all the bells and whistles? To you really need string overloading here?

Peter Scott has a natural approach using just the stuff from Learning Perl:

#!/usr/bin/perl
use strict;
use warnings;

my ($n, $k) = (40, 3);
my @soldiers = 1 .. $n;
my $pos = 0;

while ( @soldiers > 1 ) {
    $pos = ($pos + $k-1) % @soldiers;  # -1 for the one we just removed
    splice @soldiers, $pos, 1;
    }

print "Winner: Person [email protected], alive\n";

danvk complains that he doesn’t like Perl’s object-oriented framework, but doesn’t realize Larry stole it from Python, the language he prefers. The joke is on him.

Object orientation is a way of thinking about things, not a particular technology. It’s not about translating a program from another language line-by-line using the same techniques.

But, it’s not like the non-OO Perl solutions out there are any better. A Perl 5 Rosetta Code example spends a lot of time shifting array elements around so that the head of the array is the prisoner to remove:

my @prisoner = 0 .. 40;
my $k = 3;
until (@prisoner == 1) {
    push @prisoner, shift @prisoner for 1 .. $k-1;
    shift @prisoner;
}
 
print "Prisoner @prisoner survived.\n"

This is a translation of the Perl 6 solution to the same problem where the programmer was overly fond of the rotate method.

All of these solutions, including Peter’s, misses the point of the original problem. Josephus wanted to cheat so that he’d be last. But, he didn’t want to be last alone so he wanted to arrange it so a friend would be left with him. That is, the problem isn’t who is last, where where the last two should stand (and maybe, who should start).

Instead of modifying the array, you can mark soldiers as dead. In this solution, I represent each soldier as a tuple that has their name, their initial position, and the order in the killing. I’ll loop through that until I’ve dispatched enough soldiers. Afterward, I can look at that array to see what happened.

use v5.22;
use feature qw(postderef);
no warnings qw(experimental::postderef);

my $n    = $ARGV[0] // 3;
my $left = $ARGV[1] // 2;

my @soldiers = map { state $n = 0; [ $_, $n++, undef ] } qw(
	Adam
	Bruce
	Claire
	Dean
	Elvis
	Fred
	Glen
	Horace
	Ian
	Jacob
	Karl
	Lamont
	Malcolm
	Neal
	Orson
	Pat
	Quinn
	Rene
	Samson
	Todd
	Ulysses
	Victor
	Walter
	Xavier
	Yolanda
	Zach
	);

my $killed = 0;
while( $killed < @soldiers - $left ) {
	state $i     = -1; # cursor of array
	state $j     =  1; # soldiers counting off
	$i = ( $i + 1 ) % @soldiers;
	next if $soldiers[$i % @soldiers][2] != 0;
	next unless $j++ == $n;
	$soldiers[$i][2] = ++$killed;
	$j = 1;
	}


say "=== Killed ===";
foreach my $soldier ( sort { $a->[2] <=> $b->[2] } @soldiers ) {
	next unless defined $soldier->[2]; # not killed
	printf "%3d: %3d  %s\n", $soldier->@[2,1,0];
	}

say "=== Left ===";
my @alive = grep { ! defined $_->[2] } @soldiers;
foreach my $alive ( @alive ) {
	printf "%3d  %s\n", $alive->@[1,0];
	}

The command-line arguments note the interval and the number to leave. The output shows the order of killing with the soldier’s position, as well as who’s left and where they were standing:

$ perl5.22.0 josephus.pl 3 4
=== Killed ===
  1:   2  Claire
  2:   5  Fred
  3:   8  Ian
  4:  11  Lamont
  5:  14  Orson
  6:  17  Rene
  7:  20  Ulysses
  8:  23  Xavier
  9:   0  Adam
 10:   4  Elvis
 11:   9  Jacob
 12:  13  Neal
 13:  18  Samson
 14:  22  Walter
 15:   1  Bruce
 16:   7  Horace
 17:  15  Pat
 18:  21  Victor
 19:   3  Dean
 20:  12  Malcolm
 21:  24  Yolanda
 22:  10  Karl
=== Left ===
  6  Glen
 16  Quinn
 19  Todd
 25  Zach
Leave a comment

1 Comments.

  1. Just wow. I read the original, and my first reaction:

    WTF? He’s manually implementing a linked list in (a language|languages) with mutable arrays that don’t even require type homogeneity.

    Maybe this makes more sense in Python, … or Java, or C++, where munging arrays is a nightmare of code.

    But in Perl? or even Ruby? Even in the language he’s more familiar with JavaScript, I’d hardly recommend that approach.

Leave a Reply

You must be logged in to post a comment.