DouKaku?

use strict;

sub _c { return ($a->[0] <=> $b->[0]) || ($a->[1] <=> $b->[1]); }

sub solve {
    my ($ceil) = @_;

    my @pairs; # 組み合わせのリスト。
    my %pdup;  # 積の重複度。
    my %sdup;  # 二番目の条件のための判定テーブル。

    {
        # 積の重複度を求める。
        foreach my $i (1..$ceil) {
            foreach my $j ($i..$ceil) {
                my $p = $i * $j;
                $pdup{$p} = 0 if (! exists($pdup{$p}));
                $pdup{$p}++;
            }
        }
        # 初期状態を作成する。その際に条件(1)を考慮する。
        # (1) A さんも B さんも教えられた数字(積と和)から判定出来ない。
        # 更に条件(2)のための判定テーブルを作成する。
        foreach my $i (1..$ceil) {
            foreach my $j ($i..$ceil) {
                my $p = $i * $j;
                my $s = $i + $j;
                $sdup{$s} = 1 if (! exists($sdup{$s}));
                $sdup{$s} = 0 if ($pdup{$p} == 1);

                next if ($pdup{$p} == 1);
                next if ($s == 2);
                next if ($s == 3);
                next if ($s == (2 * $ceil - 1));
                next if ($s == (2 * $ceil));
                push(@pairs, [$i, $j]);
            }
        }
    }

    # (2) B さんは A が判定不能だと云う事を判っていた。
    # つまり和を分解して得られる組み合わせの全てに於いて、
    # その積の取り得る組み合わせが複数在ると云う事。
    {
        my @tmp;
        foreach my $e (@pairs) {
            my $s = $e->[0] + $e->[1];
            push(@tmp, $e) if ($sdup{$s});
        }
        @pairs = @tmp;
    }

    # (3) それを聞いた A さんは判ったのであるから、
    # 残りの組み合わせに積の重複は無い筈。
    # (4) A さんが判ったと聞いた B さんも判つたので、
    # 残りの組み合わせに和の重複は無い筈。
    {
        my @tmp;
        my %dup3;
        my %dup4;
        # 条件(3)のための重複検査を行う。
        foreach my $e (@pairs) {
            my $p = $e->[0] * $e->[1];
            $dup3{$p} = 0 if (! exists($dup3{$p}));
            $dup3{$p}++;
        }
        # 条件(3)の重複を取り除きながら、条件(4)のための
        # 重複検査を行う。
        foreach my $e (@pairs) {
            my $p = $e->[0] * $e->[1];
            next if ($dup3{$p} > 1);

            push(@tmp, $e);
            my $s = $e->[0] + $e->[1];
            $dup4{$s} = 0 if (! exists($dup4{$s}));
            $dup4{$s}++;
        }
        # 条件(4)の重複を取り除く。
        @pairs = ();
        foreach my $e (@tmp) {
            my $s = $e->[0] + $e->[1];
            next if ($dup4{$s} > 1);
            push(@pairs, $e);
        }
    }

    return @pairs;
}

foreach my $n (1..200) {
    printf("%4d: ", $n);
    my @pairs = &solve($n);
    if (! @pairs) {
        printf("None");
    } else {
        foreach my $e (sort _c @pairs) {
            printf("[%2d, %2d], ", @{$e});
        }
    }
    print("\n");
}