Bags and stuff

gistfile1.pl

my class KeySet { ... }
my class Bag    { ... }
my class KeyBag { ... }

class KeySet does Associative {
    has Bool %!elems;

    method keys { %!elems.keys }
    method values { %!elems.values }
    method elems returns Int { %!elems.elems }
    method exists($a) returns Bool { %!elems.exists($a) && %!elems{$a} }
    method Bool { %!elems.Bool }
    method Numeric { %!elems.Numeric }
    method hash { %!elems.hash }
    method at_key($k) {
        Proxy.new(FETCH => { %!elems.exists($k) ?? True !! False },
                  STORE => -> $, $value { if $value { %!elems{$k} = True } else { %!elems.delete($k) }});
    }

    # Constructor
    method new(*@args --> KeySet) {
        my %e;
        for @args {
            when Set | KeySet { for .keys -> $key { %e{$key} = True; } }
            # when Bag | KeyBag { for .keys -> $key {
            #     if %e{$key}:exists { %e{$key} += $_{$key} } else { %e{$key} = $_{$key} }
            # } }
            default { %e{$_} = True; }
        }
        self.bless(*, :elems(%e));
    }

    submethod BUILD (:%!elems) { }

    submethod Str(Any:D $ : --> Str) { "set(< %!elems.keys() >)" }
    submethod gist(Any:D $ : --> Str) { "set({ %!elems.keys».gist.join(', ') })" }
    submethod perl(Any:D $ : --> Str) { 'set(' ~ join(', ', map { .perl }, %!elems.keys) ~ ')' }

    method iterator() { %!elems.keys.iterator }
    method list() { %!elems.keys }
    method pick($arg) { %!elems.keys.pick: $arg }
    method roll($arg) { %!elems.keys.roll: $arg }
}

class Bag does Associative {
    has %!elems;

    method keys { %!elems.keys }
    method values { %!elems.values }
    method elems returns Int { [+] self.values }
    method exists($a) returns Bool { %!elems.exists($a) }
    method Bool { %!elems.Bool }
    method Numeric { self.elems }
    method hash { %!elems.hash }
    method at_key($k) { +(%!elems{$k} // 0) }

    # Constructor
    method new(*@args --> Bag) {
        my %e;
        sub register-arg($arg) {
            given $arg {
                when Pair { if %e.exists(.key) { %e{.key} += .value } else { %e{.key} = .value } }
                when Set | KeySet { for .keys -> $key { %e{$key}++; } }
                when Associative { for .pairs -> $p { register-arg($p) } }
                when Positional { for .list -> $p { register-arg($p) } }
                default { %e{$_}++; }
            }
        }

        for @args {
            register-arg($_);
        }
        say %e.perl;
        self.bless(*, :elems(%e));
    }

    submethod BUILD (:%!elems) { }

    submethod Str(Any:D $ : --> Str) { "bag({ self.pairs>>.perl.join(', ') })" }
    submethod gist(Any:D $ : --> Str) { "bag({ self.pairs>>.gist.join(', ') })" }
    submethod perl(Any:D $ : --> Str) { 'Bag.new(' ~ %!elems.perl ~ ')' }

    method iterator() { %!elems.pairs.iterator }
    method list() { %!elems.keys }
    method pairs() { %!elems.pairs }

    method pick($count = 1) { my $kb = KeyBag.new(self); $kb.pick($count); }
    method roll($count = 1) { my $kb = KeyBag.new(self); $kb.roll($count); }
}

sub bag(*@a) {
    Bag.new(|@a);
}

class KeyBag does Associative {
    has Bool %!elems;

    method keys { %!elems.keys }
    method values { %!elems.values }
    method elems returns Int { [+] self.values }
    method exists($a) returns Bool { %!elems.exists($a) }
    method Bool { %!elems.Bool }
    method Numeric { self.elems }
    method hash { %!elems.hash }
    method at_key($k) {
        Proxy.new(FETCH => { %!elems.exists($k) ?? %!elems{$k} !! 0 },
                  STORE => -> $, $value { if $value > 0 { %!elems{$k} = $value } else { %!elems.delete($k) }});
    }

    # Constructor
    method new(*@args --> KeyBag) {
        my %e;
        sub register-arg($arg) {
            given $arg {
                when Pair { if %e.exists(.key) { %e{.key} += .value } else { %e{.key} = .value } }
                when Set | KeySet { for .keys -> $key { %e{$key}++; } }
                when Associative { for .pairs -> $p { register-arg($p) } }
                when Positional { for .list -> $p { register-arg($p) } }
                default { %e{$_}++; }
            }
        }

        for @args {
            register-arg($_);
        }
        self.bless(*, :elems(%e));
    }

    submethod BUILD (:%!elems) { }

    submethod Str(Any:D $ : --> Str) { "keybag({ self.pairs>>.perl.join(', ') })" }
    submethod gist(Any:D $ : --> Str) { "keybag({ self.pairs>>.gist.join(', ') })" }
    submethod perl(Any:D $ : --> Str) { 'KeyBag.new(' ~ %!elems.perl ~ ')' }

    method iterator() { %!elems.pairs.iterator }
    method list() { %!elems.keys }
    method pairs() { %!elems.pairs }

    method pick($count = 1) {
        return self.roll if $count ~~ Num && $count == 1;

        my $temp-bag = KeyBag.new(self);
        my $lc = $count ~~ Whatever ?? Inf !! $count;
        gather while $temp-bag && $lc-- {
            my $choice = $temp-bag.roll;
            take $choice;
            $temp-bag{$choice}--;
        }
    }
    method roll($count = 1) {
        my @inverse-mapping;
        my $a = 0;
        for %!elems.pairs -> $pair {
            $a += $pair.value;
            @inverse-mapping.push((+$a) => $pair.key);
        }

        sub choose {
            my $choice = $a.rand;
            my $i = 0;
            for @inverse-mapping -> $im {
                if $choice ~~ $i ..^ +$im.key {
                    return $im.value;
                }
                $i = $im.key;
            }
        }

        return choose() xx * if $count ~~ Whatever;
        return choose() if $count == 1;
        return choose() xx $count;
    }
}