DouKaku?beta

Comment detail

トランプの和と積のパズル (Nested Flatten)

This comment is reply for 3390 herumi: <pre> ここにトランプ...(トランプの和と積のパズル). Go to thread root. 

Perl が無かったので取り敢えず。
ぜんぜんフラットですが。
三番目の四番目の条件を誤った理解をして
悩みました。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
use strict;

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

    # 一番目と二番目の条件から組み合わせを絞り込む。
    my $pairs = [];
    {
        # 最初に二人が取り得る組み合わせ。
        my $la = {};
        my $lb = {};
        for (my $i = 1; $i <= $ceil; $i++) {
            for (my $j = $i; $j <= $ceil; $j++) {
                my $p = $i * $j;
                if ($la->{$p}) {
                    $la->{$p}[$#{$la->{$p}} + 1] = [$i, $j];
                } else {
                    $la->{$p} = [[$i, $j]];
                }
                my $s = $i + $j;
                if ($lb->{$s}) {
                    $lb->{$s}[$#{$lb->{$s}} + 1] = [$i, $j];
                } else {
                    $lb->{$s} = [[$i, $j]];
                }
            }
        }

        # A さんも B さんも教えられた数字(積と和)から
        # 判定出来ない。
        foreach my $k (keys(%{$la})) {
            delete($la->{$k}) if ($#{$la->{$k}} == 0);
        }

        foreach my $k (keys(%{$lb})) {
            delete($lb->{$k}) if ($#{$lb->{$k}} == 0);
        }

        # B さんは A が判定不能だと云う事を判っていた。
        # つまり和を分解して得られる組み合わせの全てに於いて、
        # その積の取り得る組み合わせが複数在ると云う事。
        foreach my $k (keys(%{$lb})) {
            foreach my $e (@{$lb->{$k}}) {
                ($la->{$e->[0] * $e->[1]}) || delete($lb->{$k});
            }
        }

        foreach my $k (keys(%{$lb})) {
            foreach my $e (@{$lb->{$k}}) {
                $pairs->[$#{$pairs} + 1] = $e;
            }
        }
    }

    # それを聞いた A さんは判ったのであるから、
    # 残りの組み合わせに積の重複は無い筈。
    {
        my $t = {};
        foreach my $e (@{$pairs}) {
            my $p = $e->[0] * $e->[1];
            $t->{$p} && $t->{$p}++ || ($t->{$p} = 1);
        }
        my $r = [];
        foreach my $e (@{$pairs}) {
            my $p = $e->[0] * $e->[1];
            ($t->{$p} == 1) && ($r->[$#{$r} + 1] = $e);
        }

        $pairs = $r;
    }

    # A さんが判ったと聞いた B さんも判つたので、
    # 残りの組み合わせに和の重複は無い筈。
    {
        my $t = {};
        foreach my $e (@{$pairs}) {
            my $s = $e->[0] + $e->[1];
            $t->{$s} && $t->{$s}++ || ($t->{$s} = 1);
        }
        my $r = [];
        foreach my $e (@{$pairs}) {
            my $s = $e->[0] + $e->[1];
            ($t->{$s} == 1) && ($r->[$#{$r} + 1] = $e);
        }

        $pairs = $r;
    }

    return $pairs;
}

foreach my $n (1..100) {
    printf("%4d: ", $n);
    my $e = &solve($n);
    if (! @{$e}) {
        printf("None");
    } else {
        foreach my $f (sort {($a->[0] <=> $b->[0]) || ($a->[1] <=> $b->[1])} @{$e}) {
            printf("[%2d, %2d], ", @{$f});
        }
    }
    print("\n");
}

汚かったので書き直しました。
これから他の人の解答をよんで勉強します。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
use strict;

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

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

    my @pairs; # 組み合わせのリスト。
    my %pdup;  # 積の重複度。
    my %sdup;  # 和の重複度。

    # 初期状態。全ての組み合わせと、積・和の重複度を求める。
    {
        for (my $i = 1; $i <= $ceil; $i++) {
            for (my $j = $i; $j <= $ceil; $j++) {
                my $e = [$i, $j];
                push(@pairs, $e);
                $pdup{&_p($e)} = [] if (! $pdup{&_p($e)});
                $sdup{&_s($e)} = [] if (! $sdup{&_s($e)});
                $pdup{&_p($e)}[$#{$pdup{&_p($e)}}+1] = $e;
                $sdup{&_s($e)}[$#{$sdup{&_s($e)}}+1] = $e;
            }
        }
    }

    # (1) A さんも B さんも教えられた数字(積と和)から判定出来ない。
    {
        my @tmp;
        foreach my $e (@pairs) {
            next if (@{$pdup{&_p($e)}} == 1);
            next if (@{$sdup{&_s($e)}} == 1);
            push(@tmp, $e);
        }
        @pairs = @tmp;
    }

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

    # (3) それを聞いた A さんは判ったのであるから、
    # 残りの組み合わせに積の重複は無い筈。
    {
        my @tmp;
        my %dup;
        foreach my $e (@pairs) {
            $dup{&_p($e)} = 0 if (! $dup{&_p($e)});
            $dup{&_p($e)}++;
        }
        foreach my $e (@pairs) {
            push(@tmp, $e) if ($dup{&_p($e)} == 1);
        }
        @pairs = @tmp;
    }

    # (4) A さんが判ったと聞いた B さんも判つたので、
    # 残りの組み合わせに和の重複は無い筈。
    {
        my @tmp;
        my %dup;
        foreach my $e (@pairs) {
            $dup{&_s($e)} = 0 if (! $dup{&_s($e)});
            $dup{&_s($e)}++;
        }
        foreach my $e (@pairs) {
            push(@tmp, $e) if ($dup{&_s($e)} == 1);
        }
        @pairs = @tmp;;
    }

    return @pairs;
}

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

まとめられるループをまとめました。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
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");
}

Index

Feed

Other

Link

Pathtraq

loading...
Creative Commons License このサイトの内容は、 クリエイティブ・コモンズ・ライセンスの下でライセンスされています。 [詳細]