A World Without Strings Is Chaos

string-chaos.p6

# Characters are expensive, and the accountants tell me we can’t hand them out
# willy-nilly anymore. Given a string x and a character y, how many times does y
# occur in x?
put "\nMultiplicity";
sub Multiplicity (Str $a, Str $b) { $a.comb.Bag{$b} }

for < fhqwhgads h mississippi s life . >
  -> $a, $b {  put "$a, $b: ", Multiplicity $a, $b }


# Sometimes I try reading sentences right-to-left to make my life more exciting.
# Results have been mixed. Given a string x, is it identical when read forwards
# and backwards?
put "\nTrapeze-Part";
sub Trapeze-Part (Str $a) { $a.flip eq $a }

for < racecar wasitaratisaw palindrome >
  -> $a {  put "$a: ", Trapeze-Part $a }


# One is the loneliest number. Given a string x, produce a list of characters
# which appear more than once in x.
put "\nDuplicity";
sub Duplicity (Str $a) { $a.comb.Bag.grep( *.value > 1 )».key }

for < applause foo baz >
  -> $a {  put "$a: ", Duplicity $a }


# Alphabetical filing systems are passe. It’s far more Zen to organize words by
# their histograms! Given strings x and y, do both strings contain the same
# letters, possibly in a different order?
put "\nSort-Yourself-Out";
sub Sort-Yourself-Out (Str $a, Str $b) { $a.comb.sort eqv $b.comb.sort }

for < teapot toptea apple elap listen silent >
  -> $a, $b {  put "$a, $b: ", Sort-Yourself-Out $a, $b }


# It’s virtuous to be unique, just like everyone else. Given a string x, find
# all the characters which occur exactly once, in the order they appear.
put "\nPrecious-Snowflakes";
sub Precious-Snowflakes (Str $a) { my %b = $a.comb.Bag.grep( *.value == 1 ); $a.comb.map( { next unless %b{$_}; $_ } ).join }

for qww< 'somewhat heterogenous' aaabccddefffgg >
  -> $a {  put "$a: ", Precious-Snowflakes $a }


# Imagine four chars on the edge of a cliff. Say a direct copy of the char
# nearest the cliff is sent to the back of the line of char and takes the place
# of the first char. The formerly first char becomes the second, the second
# becomes the third, and the fourth falls off the cliff. Strings work the same
# way. Given strings x and y, is x a rotation of the characters in y?
put "\nMusical-Chars";
sub Musical-Chars (Str $a, Str $b) {
    for ^$a.comb {
        return True if $a.comb.list.rotate($_).join eq $b
    }
    False
}

for < foobar barfoo fboaro foobar abcde deabc >
  -> $a, $b {  put "$a, $b: ", Musical-Chars $a, $b }


# Sometimes small things come first. Given a list of strings x, sort the strings
# by length, ascending.
put "\nSize-Matters";
sub Size-Matters ( *@a ) { @a.sort: -*.chars }

put < books apple peanut aardvark melon pie >, ': ',
  Size-Matters < books apple peanut aardvark melon pie >;


# Sixty-two thousand four hundred repetitions make one truth. Given a string x,
# identify the character which occurs most frequently. If more than one
# character occurs the same number of times, you may choose arbitrarily. Is it
# harder to find all such characters?
put "\nPopularity-Contest";
sub Popularity-Contest (Str $a) { $a.comb.Bag.max( *.value ).key }

for < abdbbac CCCBBBAA CCCBBBBAA >
  -> $a {  put "$a: ", Popularity-Contest $a }

put "\nPopularity-Contest2";
sub Popularity-Contest2 (Str $a) {
    my $b = $a.comb.Bag.max( *.value ).value;
    $a.comb.Bag.grep( *.value == $b )».key
}

for < abdbbac CCCBBBAA CCCBBBBAA >
  -> $a {  put "$a: ", Popularity-Contest2 $a }


# Little-endian encoding is such a brilliant idea I want to try applying it to
# English. Given a string x consisting of words (one or more non-space
# characters) which are separated by spaces, reverse the order of the characters
# in each word.
put "\nesreveR-A-ecnetneS";
sub esreveR-A-ecnetneS (Str $a) { $a.words».flip.join: ' ' }

for 'a few words in a sentence',
    'zoop',
    'one two three four',
    "Unicode FTW lol 🤦🏽‍♂️🇬🇧" # Much harder problem? https://news.ycombinator.com/reply?id=22660799&goto=item%3Fid%3D22652130%2322660799
  -> $a {  put "$a: ", esreveR-A-ecnetneS $a }


# Let’s cut some text down to size. Given a string x and a boolean vector y of
# the same length, extract the characters of x corresponding to a 1 in y.
put "\nCompression-Session";
sub Compression-Session (Str $a, *@b) { ^@b .map( { next unless +@b[$_]; $a.comb[$_] } ).join }

for 'foobar', <1 0 0 1 0 1>,
    'embiggener', <0 0 1 1 1 1 0 0 1 1>
  -> $a, @b { say "$a, @b[]: ", Compression-Session $a, @b }


# Wait, strike that- reverse it. Given a string x and a boolean vector y, spread
# the characters of x to the positions of 1s in y, filling intervening
# characters with underscores.
put "\nExpansion-Mansion";
sub Expansion-Mansion (Str $a, *@b) { my $c = 0; @b.map( { +$_ ?? $a.comb[$c++] !! '_' } ).join }

for 'fbr', <1 0 0 1 0 1>,
    'bigger', <0 0 1 1 1 1 0 0 1 1>
  -> $a, @b { say "$a, @b[]: ", Expansion-Mansion $a, @b }


# Vowels make prose far too… pronounceable. Given a string x, replace all the
# vowels (a, e, i, o, u, or y) with underscores.
put "\nC_ns_n_nts";
sub C_ns_n_nts (Str $a) { $a.subst( /:i <[aeiouy]> /, '_', :g ) }

for 'FLAPJACKS', 'Several normal words'
  -> $a { say "$a: ", C_ns_n_nts $a }


# On second thought, I’ve deemed vowels too vile for placeholders. Given a
# string x, remove all the vowels entirely.
put "\nCnsnnts-Rdx";
sub Cnsnnts-Rdx (Str $a) { $a.subst( /:i <[aeiouy]> /, '', :g ) }

for 'Several normal words', 'FLAPJACKS'
  -> $a { say "$a: ", Cnsnnts-Rdx $a }


# Given a string x consisting of words separated by spaces (as above), and a
# string y, replace all words in x which are the same as y with a series of xes.
put "\nTITLE-REDACTED";
sub TITLE-REDACTED (Str $a, Str $b) { $a.subst( /<$b>/, 'X' x $b.chars, :g ) }

for 'a few words in a sentence', 'words',
    'one fish two fish', 'fish',
    "I don't give a care", 'care'
  -> $a, $b { say "$a, $b: ", TITLE-REDACTED $a, $b }


# My ingenious histogram-based filing system has a tiny flaw: some people insist
# that the order of letters in their names is significant, and now I need to
# re-file everything. Given a string x, generate a list of all possible
# reorderings of the characters in x. Can you do this non-recursively?
put "\nIt's-More-Fun-to-Permute";
sub It's-More-Fun-to-Permute (Str $a) { $a.comb.permutations».join }

say "xyz: ", It's-More-Fun-to-Permute 'xyz'

Output:

Multiplicity
fhqwhgads, h: 2
mississippi, s: 4
life, .: 0

Trapeze-Part
racecar: True
wasitaratisaw: True
palindrome: False

Duplicity
applause: p a
foo: o
baz:

Sort-Yourself-Out
teapot, toptea: True
apple, elap: False
listen, silent: True

Precious-Snowflakes
somewhat heterogenous: mwa rgnu
aaabccddefffgg: be

Musical-Chars
foobar, barfoo: True
fboaro, foobar: False
abcde, deabc: True

Size-Matters
books apple peanut aardvark melon pie: aardvark peanut books apple melon pie

Popularity-Contest
abdbbac: b
CCCBBBAA: B
CCCBBBBAA: B

Popularity-Contest2
abdbbac: b
CCCBBBAA: B C
CCCBBBBAA: B

esreveR-A-ecnetneS
a few words in a sentence: a wef sdrow ni a ecnetnes
zoop: pooz
one two three four: eno owt eerht ruof
Unicode FTW lol 🤦🏽‍♂️🇬🇧: edocinU WTF lol 🇬🇧🤦🏽‍♂️

Compression-Session
foobar, 1 0 0 1 0 1: fbr
embiggener, 0 0 1 1 1 1 0 0 1 1: bigger

Expansion-Mansion
fbr, 1 0 0 1 0 1: f__b_r
bigger, 0 0 1 1 1 1 0 0 1 1: __bigg__er

C_ns_n_nts
FLAPJACKS: FL_PJ_CKS
Several normal words: S_v_r_l n_rm_l w_rds

Cnsnnts-Rdx
Several normal words: Svrl nrml wrds
FLAPJACKS: FLPJCKS

TITLE-REDACTED
a few words in a sentence, words: a few XXXXX in a sentence
one fish two fish, fish: one XXXX two XXXX
I don't give a care, care: I don't give a XXXX

It's-More-Fun-to-Permute
xyz: (xyz xzy yxz yzx zxy zyx)