#!/usr/bin/perl

use Getopt::Std;
getopts('z:n:g:d:s') or usage();

my $N = $opt_n || 5;
my $GUESSES = $opt_g || 2;
my $DEPTH = $opt_d || 3;
my $SCALARS = $opt_s || 0;
my $Z = $opt_z || 1;

my $CORRECT = 0;
for (1..$N) {
  print "\nQuestion $_/$N:\n";
  $QQ = "A";
  my $depth = rand_depth($DEPTH);
  my ($ds, $v, $a) = invent_question($depth, $SCALARS, 1);
  my $notref = int rand 2;
  if (ask_question($ds, $v, $notref, $GUESSES)) {
    $CORRECT++;
  } else {
    my $ans = generate_answer($notref, $a);
    print "The correct answer was: '$ans'.\n";
    print "I'll go on to another question.\n";
  }
  sleep $Z if $Z;
}
my $pct = sprintf("%.1f", 100*$CORRECT/$N);
print "You got $CORRECT out of $N right, for a score of $pct%.\n";

################################################################

# Produce a random number from 1 to N, biased towards N.
# N=2 produces [0.333, 0.667]
# N=3 produces [0.167, 0.333, 0.500]
# N=4 produces [0.100, 0.200, 0.300, 0.400]
# N=5 produces [0.067, 0.133, 0.200, 0.267, 0.333]
# etc.

sub rand_depth {
  my $N = shift;
  my $r = rand($N*($N+1)/2);
  my $s = int((sqrt(1+8*$r)-1)/2);
  $s;
}

sub generate_answer {
  my ($notref, $a) = @_;
  my $ans = '$s';
  $ans .= "->" unless $notref;
  while (@$a) {
    my ($type, $index) = splice @$a, 0, 2;
    if ($type eq "hash") {
      $ans .= "{$index}";
    } else {
      $ans .= "[$index]";
    }
  }
  $ans;
}


sub invent_question {
  my $depth = shift;

  if ($depth == 0) {
    my $nv = nextval();
    return ($nv, $nv);
  }

  my $scalars = shift;
  my $toplevel = shift;
  my $r = $toplevel ? rand(2) : rand(3);
  if ($r < 0.7) {                 # hash
    my ($question, $answer, $data);
    my $keys = int(rand(5) + 2);
    for (1 .. $keys) {
      my ($s, $q, $a) = invent_question($depth-1, $scalars);
      my $k = $QQ++;
      $data->{$k} = $s;
      if (rand() < 1/$_) {
        $question = $q;
        $answer = ['hash', $k, @$a];
      }
    }
    return ($data, $question, $answer);
  } elsif ($r < 2) {            # array
    my ($question, $answer, $data);
    my $elements = int(rand(5) + 2) ;
    for (1 .. $elements) {
      my ($s, $q, $a) = invent_question($depth-1, $scalars);
      $data->[$_-1] = $s;
      if (rand() < 1/$_) {
        $question = $q;
        $answer = ['array', $_-1, @$a];
      }
    }
    return ($data, $question, $answer);
  } else {                      # scalar
    my $nv = nextval();
    return ($nv, $nv, []);
  }
}

# returns an ARRAY of LINES flush with LEFT MARGIN
sub dump_struct {
  my $ref = shift;
  my $notref = shift;
  my $type = ref $ref;
  if ($type eq 'SCALAR') {
    my $sc = dump_struct($$ref);
    "\\$sc";
  } elsif ($type eq 'ARRAY') {
    my ($o, $c) = $notref ? qw| ( ) | : qw| [ ] |;
    my @ls;
    for (@$ref) {
      my @nl = dump_struct($_);
      $nl[-1] .= ",";
      push @ls, @nl;
    }
    chop $ls[-1];              # extraneous comma
    $ls[0] = "$o $ls[0]";
    for (@ls[1..$#ls]) {
      $_ = "  $_";
    }
    $ls[-1] .= " $c";
    @ls;
  } elsif ($type eq 'HASH') {
    my ($o, $c) = $notref ? qw| ( ) | : qw| { } |;
    my @ls;
    my $firstkey = 1;
    for my $k (sort keys %$ref) {
      my $pref = "$k => ";
      $pref = ($firstkey ? "$o " : "  ") . $pref;
      $firstkey = 0;
      my $i = " " x length $pref;
      my @nl = dump_struct($ref->{$k});
      $nl[0] = "$pref$nl[0]";
      for (@nl[1 .. $#nl]) {
        $_ = "$i$_";
      }
      $nl[-1] .= ",";
      push @ls, @nl;
    }
    chop $ls[-1];              # extraneous comma
    $ls[-1] .= " $c";
    @ls;
  } else {
    return "$ref";
  }
}

sub ask_question {
  my ($ds, $v, $notref, $g) = @_;
  my @lines = dump_struct($ds, $notref);
  for (@lines[1..$#lines]) {
    $_ = "     $_";
  }
  $lines[-1] .= ";";
  my $sigil = $notref ? ref $ds eq 'ARRAY' ? '@' : '%' : '$';
  $lines[0] = $sigil . "s = " . $lines[0];
  print join "\n", @lines;
  print "\n\n";
  while ($g) {                  # guesses left
    print "What expression will yield the value '$v'?\n";
    my $exp = "";
    while (<STDIN>) {
      chomp;
      $exp .= $_;
      last;   #  if $exp =~ /;\s*$/;
    }
    return unless $exp =~ /\S/;
    my ($correct, $err, $result) = try_answer($ds, $v, $notref, $exp);
    if ($err) {
      $err =~ s/\s+at \(eval.*$//mg;
      $err =~ s/^/\t/mg;
      print "That expression was erroneous:\n$err\n";
    } elsif ($correct) {
      print "Correct!\n";
      return 1;
    } else {
      print "Sorry, incorrect.\n";
      if (defined $result) {
        print "The value of your expression was:\n";
        my @ls = dump_struct($result);
        if (@ls >= 10) {
          splice @ls, 10;
          push @ls, "...";
        }
        for (@ls) {
          print "  $_\n";
        }
        print "\n";
      } else {
        print "The value of your expression was undefined.\n";
      }
    }
    print "Try again.\n" if --$g;
  }
  return;
}

sub try_answer {
  my ($ds, $v, $notref, $exp) = @_;
  my $result;
  {
    local $s = $ds unless $notref;
    local *s = $ds if $notref;
    $result = eval $exp;
  }
  return (undef, $@) if $@;
  return ($result eq $v, undef, $result);
}


my @words;
my %seen;
sub nextval {
  unless (@words) {
    local *DICT;
    open DICT, "<", "/usr/dict/words" or die "$!";
    my $N = 100;
    my $D = 25000;
    local $_;
    while (<DICT>) {
      chomp;
      next if /[^A-Za-z]/;
      next if $seen{lc $_};
      if (rand() < $N/$D) {
        $N--;
        $seen{lc $_} = 1;
        push @words, $_;
      }
      last unless --$D;
    }
    for (reverse 1 .. $#words) {
      my $n = rand($_);
      @words[$n, $_] = @words[$_, $n];
    }
  }
  return shift @words;
}

