Re: Was Fun - Each character at most once

Adam Rice <[email protected]> Sat, 26 Jul 2003 23:36:15 +0100

Newsgroups	gmane.comp.lang.perl.fun
Message-ID	<[email protected]>

Quoting James E. Tilley ([email protected]):
> Can you post the unfun, brute-force approach, and maybe we can whittle it
> down?

Here ya go. Don't say I didn't warn you.

Adam

-- 
Adam Rice -- [email protected] -- Blackburn, Lancashire, England

atmostonce (text/plain, 1.3 KB)

#!/usr/local/bin/perl -w

use strict;

# convert a Perl program to one that uses each ASCII character at most once
# usage ./atmostonce input-program.pl > output-program.pl

my($FIRST_PART,
   $MIDDLE_PART,
   $LAST_PART,
   $ALSO_REMOVE) = (
		  "s{}[",
		  '],$_^=q<',
		    ">;eval\n",
		    "()\@\\".join("", map(chr, 0x00 .. 0x1f, 0x7f .. 0xff)),
		   );

local $/;

my $input = <>;

my $maxlength = int((256-length($FIRST_PART.$MIDDLE_PART.$LAST_PART.$ALSO_REMOVE))/2);

if (length($input) > $maxlength) {
    die "Input program is too long (must be at most $maxlength characters\n";
}

my($used) = "\0\0\0\0\0\0\0\0";
foreach (split //, $FIRST_PART.$MIDDLE_PART.$LAST_PART.$ALSO_REMOVE) {
    vec($used, ord($_), 1) = 1;
}

my $string=scan(0, $used, "");
print $FIRST_PART, $string, $MIDDLE_PART, $string^$input, $LAST_PART;

sub scan {
    my($offset, $used, $answer) = @_;
    foreach my $char (0x20 .. 0x7e, 0xa0 .. 0xff, 0x00 .. 0x1f, 0x7f..0x9f) {
	my $eorchar = $char^ord(substr($input, $offset, 1));
	next if (vec($used, $char, 1) || vec($used, $eorchar, 1));
	if ($offset + 1 == length($input)) {
	    return $answer.chr($char);
	} else {
	    my $nowused = $used;
	    vec($nowused, $char, 1) = 1;
	    vec($nowused, $eorchar, 1) = 1;
	    my $next = scan($offset + 1, $nowused, $answer.chr($char));
	    return $next if defined $next;
	}
    }
    return undef;
}