[SPOILER] turning machine solution

I thought that the most interesting part of the design was the tape.
So I made it a class.  Of course, for an infinite tape, the most
obvious solution was a hash from index to character.

I thought about having the tape never hold blanks, but in the end,
found it easier to allow that, and get rid of them before I output the
tape.

The transitions are of course a hash from [begin state, input] to
[output, end state, direction].  I check to make sure that there are
no duplicate transitions.  Maybe I should have made this an NFSM?
That would be ugly, since I would need to have not just a set of
current states (including tape position), but a set of current tapes.

Fortunately, a non-deterministic turing machine is turing complete, so
I can leave it as an exercise for the student.

Of course, my program has an optional third parameter specifying the
initial position.


use strict;

sub Tape::new
{
  my ($class, $init, $init_loc) = @_;

  my %cells;
  my $curr = 0;
  $cells{$curr++} = $_ for split '', $init;

  my $self = { cells => \%cells,
               curr => $init_loc };
  bless($self, $class);
  return $self;
}

sub Tape::read
{
  my ($self) = @_;
  return '_' unless exists $self->{cells}->{$self->{curr}};
  return $self->{cells}->{$self->{curr}};
}

sub Tape::write
{
  my ($self, $char) = @_;
  $self->{cells}->{$self->{curr}} = $char;
}

sub Tape::move
{
  my ($self, $dir) = @_;
  $self->{curr} += (($dir eq 'L') ? -1 : 1);
}

sub Tape::output
{
  my ($self) = @_;

  $self->remove_blanks();

  my @keys = keys %{$self->{cells}};
  return "" unless scalar(@keys);

  my ($start, $end) = (sort { $a <=> $b } @keys)[0, -1];
  return join '', map {
    exists($self->{cells}->{$_}) ? $self->{cells}->{$_} : '_'
  } ($start .. $end);
}

sub Tape::remove_blanks
{
  my ($self) = @_;

  $self->{cells}->{$_} eq '_' and delete $self->{cells}->{$_}
    for keys %{$self->{cells}};
}

# sub main
{
  my ($file, $init, $init_loc) = @ARGV;

  ################################################################
  #
  # Handle Inputs
  #
  ################################################################

  die "Usage: turing <file> [<initstring> [<initposition>]]\n"
    unless defined $file;

  $init = "" unless defined $init;
  $init_loc = 0 unless defined $init_loc;

  ################################################################
  #
  # Initialize States.
  #
  ################################################################

  my %states;
  my $curr_state;
  open FH, "< $file" or die "cannot open $file for reading: $!\n";
  while (<FH>)
  {
    chomp;
    s/\s*(#.*)?$//;             # remove trailing spaces and comments
    next if /^$/;               # skip blanks

    my (   $start, $input, $end,   $output, $dir) =
      /^\s*(\w+)\s+(\w)\s+ (\w+)\s+(\w)\s+  ([LR])$/x
        or die "invalid input line $.\n";

    die "duplicate input [$start, $input] on line $.\n"
      if exists $states{$start}{$input};

    $states{$start}{$input} = { end    => $end,
                                output => $output,
                                dir    => $dir    };

    $curr_state = $start unless defined $curr_state;
  }

  ################################################################
  #
  # Initialize Tape.
  #
  ################################################################

  my $tape = new Tape($init, $init_loc);

  ################################################################
  #
  # Run machine.
  #
  ################################################################

  while (defined (my $transition = $states{$curr_state}{$tape->read()}))
  {
    $tape->write($transition->{output});
    $tape->move($transition->{dir});
    $curr_state = $transition->{end};
  }

  ################################################################
  #
  # Print Tape.
  #
  ################################################################

  print $tape->output(), "\n";
}

# end file turing