aheui_num_gen

ang.pl

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

use Data::Dumper;
use Test::More;
use Capture::Tiny ':all';
use Acme::Aheui;
use Encode qw/encode_utf8/;
use List::Util qw/shuffle/;

use constant {
  TABLE => {
    0     => '바',
    1     => '반반나',
    2     => '박',
    3     => '받',
    4     => '밤',
    5     => '발',
    6     => '밦',
    7     => '밝',
    8     => '밣',
    9     => '밞',
  },
  TABLE_LAST => 9,
};

sub println_unicode_to_win_cmd {
  my ($string) = @_;
  my $len = length $string;
  print encode_utf8($string), ' ' x ($len*2), "\r\n";
}
sub p {
  my ($string) = @_;
  println_unicode_to_win_cmd($string);
}

sub get_aheui_output {
  my ($source) = @_;
  
  my ($stdout, $stderr, @result) = capture {
    my $interpreter = Acme::Aheui->new( source => $source );
    $interpreter->execute();
  };
  return $stdout;
}

sub verify_table {
  my ($table) = @_;

  for my $key (keys %$table) {
    my $source = $$table{$key};
    my $output = get_aheui_output($source.'망히');
    is ( $key, $output );
  }
}
verify_table(TABLE);


sub prime_factorize {
  my ($num) = @_;

  if ($num < 2) {
    return {$num => 1};
  }

  my %result = ();
  my $div = 2;
  while ($num != 1) {
    while ($num != 1 && ($num % $div == 0)) {
      my $deg = $result{$div} or 0;
      $deg++;
      $result{$div} = $deg;
      $num /= $div;
    }
    $div++;
  }
  return condense_factors(\%result);
}

# from:
#     252: { 2=>2, 3=>2, 7=>1 }
# to:
#     252: { 4=>1, 9=>1, 7=>1 }
sub condense_factors {
  my ($factors) = @_;
  my %factors = %$factors;

  my $result = undef;
  my $condensed_anything = 1;
  while ($condensed_anything) {
    $condensed_anything = 0;

    my %result = ();
    for my $num (keys %factors) {
      my $deg = $factors{$num};
      if ($num == 2) {
        if ($deg >= 3) {
          my $deg_of_8 = int($deg/3);
          $deg -= $deg_of_8*3;
          $result{8} += $deg_of_8;
          $condensed_anything = 1;
        }
        if ($deg >= 2) {
          my $deg_of_4 = int($deg/2);
          $deg -= $deg_of_4*2;
          $result{4} += $deg_of_4;
          $condensed_anything = 1;
        }
        $result{2} += $deg if $deg > 0;
      }
      elsif ($num == 3) {
        if ($deg >= 2) {
          my $deg_of_9 = int($deg/2);
          $deg -= $deg_of_9*2;
          $result{9} += $deg_of_9;
          $condensed_anything = 1;
        }
        $result{3} += $deg if $deg > 0;
      }
      else {
        $result{$num} += $deg if $deg > 0;
      }
    }
    if (exists $result{2} && exists $result{3}) {
      my $deg_of_2 = $result{2};
      my $deg_of_3 = $result{3};
      my $deg_min = ($deg_of_2 < $deg_of_3) ? $deg_of_2 : $deg_of_3;
      $deg_of_2 -= $deg_min;
      $deg_of_3 -= $deg_min;
      my $deg_of_6 = $deg_min;
      $result{6} += $deg_of_6 if $deg_of_6 > 0;
      $result{2} = $deg_of_2;
      $result{3} = $deg_of_3;
      delete $result{2} if $deg_of_2 == 0;
      delete $result{3} if $deg_of_3 == 0;
      $condensed_anything = 1;
    }
    $result = \%result;
    %factors = %$result;
  }
  return $result;
}

sub is_nth_number {
  my ($num, $n) = @_;
  my $root = nth_root_floor($num, $n);
  return ($root ** $n) == $num;
}

sub nth_root_floor {
  my ($num, $n) = @_;
  return int( $num ** (1/$n) );
}

sub shortest_str {
  my ($str_arr) = @_;
  my $shortest = undef;
  for my $str (@$str_arr) {
    if (!$shortest && $str) {
      $shortest = $str;
    }
    if ($str && $shortest && length $str < length $shortest) {
      $shortest = $str;
    }
  }
  die "all str are invalid\n" unless $shortest;
  return $shortest;
}

sub num2ah_by_nth_root {
  my ($num, $n) = @_;

  if (is_nth_number($num, $n)) {
    my $ah = num2ah(nth_root_floor($num, $n));
    $ah .= '빠'x($n-1);
    $ah .= '따'x($n-1);
    return $ah;
  }
  else {
    my $minor_root = nth_root_floor($num, $n);
    my $minor = $minor_root ** $n;
    my $shortage = $num - $minor;
    my $minor_ah = num2ah($minor);
    my $shortage_ah = num2ah($shortage);
    my $ah_try1 = $minor_ah.$shortage_ah.'다';

    my $major_root = $minor_root+1;
    my $major = $major_root ** $n;
    my $excess = $major - $num;
    my $major_ah = num2ah($major);
    my $excess_ah = num2ah($excess);
    my $ah_try2 = $major_ah.$excess_ah.'타';

    return shortest_str([$ah_try1, $ah_try2]);
  }
}

sub num2ah_by_prime_factors {
  my ($num) = @_;

  my $factors = prime_factorize($num);
  if ((scalar keys %$factors) == 1) { # prime number (19~)
    my @trials = ();
    for my $i (2..TABLE_LAST*2) {
      my $ah = num2ah_by_div_by_n($num, $i);
      push @trials, $ah;
    }
    return shortest_str(\@trials);
  }
  my @result = ();
  for my $prime (keys %$factors) {
    my $deg = $factors->{$prime};
    my $ah = num2ah($prime).('빠'x($deg-1)).('따'x($deg-1));
    push @result, $ah;
  }
  my $ah = join '', @result;
  $ah .= '따' x ((scalar keys %$factors)-1);

  return $ah;
}

sub num2ah_by_div_by_n {
  my ($num, $n) = @_;

  if ($num <= $n) {
    return undef;
  }

  my $quo = int($num / $n);
  my $rem = $num % $n;

  my $quo_ah = num2ah($quo);
  my $rem_ah = num2ah($rem);
  my $n_ah = num2ah($n);

  my $ah = $quo_ah.$n_ah.'따'.$rem_ah.'다';
  return $ah;
}

sub num2ah {
  my ($num) = @_;

  # 0~9
  return TABLE->{$num} if exists TABLE->{$num};

  die "NEGATIVES not implemented\n" if $num < 0;

  # 10~18
  if ($num <= TABLE_LAST*2) {
    my $part1 = int($num/2);
    my $part2 = $num - $part1;
    my $ah = num2ah($part1).num2ah($part2).'다';
    TABLE->{$num} = $ah;
    return $ah;
  }

  my $ah_try1 = num2ah_by_prime_factors($num);
  my $ah_try2 = num2ah_by_nth_root($num, 2);

  my $ah = shortest_str([$ah_try1, $ah_try2]);
  TABLE->{$num} = $ah;
  return $ah;
}

sub char2num {
  my ($char) = @_;

  return unpack 'U', $char;
}

sub char2ah {
  my ($char) = @_;

  return num2ah(char2num($char));
}

sub str2ah {
  my ($str) = @_;

  my @result = ();
  my $prev_num = 0;
  for my $char (split //, $str) {
    my $num = char2num($char);
    if ($prev_num == 0) {
      push @result, char2ah($char);
    }
    else {
      my $delta = $num - $prev_num;
      if ($delta == 0) {
        push @result, '';
      }
      elsif ($delta > 0) {
        push @result, num2ah($delta).'다';
      }
      else {
        push @result, num2ah(-$delta).'타';
      }
    }
    $prev_num = $num;
  }

  return join('빠맣', @result).'맣희';
}

sub shuffle_str {
  my ($str) = @_;

  my @arr = shuffle(split //, $str);
  return join '', @arr;
}

sub print_cost_list {
  my ($str) = @_;
  my @arr = split //, $str;
  for my $char_from (@arr) {
    my $num_from = char2num($char_from);
    my $len = length char2ah($char_from);
    p "FROM: $char_from ($len)";
    my %result = ();
    for my $char_to (@arr) {
      if ($char_from eq $char_to) {
        next;
      }
      my $num_to = char2num($char_to);
      my $delta = $num_to - $num_from;
      my $ah = num2ah(abs($delta));
      my $len = length $ah;
      $result{$char_to} = $len;
    }
    for my $char (sort { $result{$a} <=> $result{$b} } keys %result) {
      my $len = $result{$char};
      p "\t[$len]\t$char";
    }
    p '';
  }
}


p num2ah(123201);



done_testing();

empty_lines.txt

run.bat

cls
type empty_lines.txt
perl ang.pl