Weekly Challenge #082 Task #2 :: (Elm, Raku)
Tags: challenge, perlweeklychallenge, elm, raku
Published: 2020-10-14 13:23:04

## *UPDATE 16th Oct, 2020*
I checked some people's script but below cases is not always passed.

```
A: ABCDEFGHIJKLMNOPQRSTUVWXYZ
B: ABCDEFGHIJKLMNOPQRSTUVWXYZ
C: ABCABCDDEFGHIJEFKLGHIJKLMNMNOOPPQRQRSTUVSTWXYUVWXYZ
```
*However* it shows 256 case(s) with my solution.

## [TASK #2 › Interleave String](https://perlweeklychallenge.org/blog/perl-weekly-challenge-082/#TASK2)
Submitted by: Mohammad S Anwar

```
You are given 3 strings; $A, $B and $C.

Write a script to check if $C is created by interleave $A and $B.

Print 1 if check is success otherwise 0.
```
```
Example 1:

Input:
    $A = "XY"
    $B = "X"
    $C = "XXY"

Output: 1

EXPLANATION

"X" (from $B) + "XY" (from $A) = $C
```
```
Example 2:

Input:
    $A = "XXY"
    $B = "XXZ"
    $C = "XXXXZY"

Output: 1

EXPLANATION

"XX" (from $A) + "XXZ" (from $B) + "Y" (from $A) = $C
```
```
Example 3:

Input:
    $A = "YX"
    $B = "X"
    $C = "XXY"

Output: 0
```

## **Apology**
I apologize about [Weekly Challenge #080 Task #2 :: Raku](/jeongoon/weekly-challenge-080-task-2-kkj) because it is wrong solution.
please refer to [Colin Crain's ultimate review](https://perlweeklychallenge.org/blog/review-challenge-080/#PWC080TASK2) Yes!! Of course I just didn't know that it was incorrect but I'm really sorry if I mislead some people with wrong information. I hope this solution would not do the same thing.

**Welcome back to another episode.**

## **Why Task2 First?**
  I skipped the task #1 for tomorrow because it looks like "can be easily done by brute-force but it would be hard if we do it in 'better' way".. But Task #2 turns out the same difficulty in the same manner as Task #1 😂

## **An Elm Solution**
  I wanted to explain the task with Elm but it is beyond my time and energy so I leave the link below
[Ch2.elm](https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-082/jeongoon/elm/src/Ch2.elm)

## **Interleave and Un-interleave**
  A child crying and another child yelling at me at the same time.
and I need to figure out why a child is crying and what another is asking me for.. It can be done after tiresome childcare like asking A and looking around the B and again hug A and saying kind words to B..... but how about next one?

  Both strings can be used unevenly as you can see the examples. So maybe we can divide $C into some blocks and make a pair of strings -- which I'd like to call "un-interleave" here -- and compare those with our given A, B in order to confirm that they can be interleaved in harmony in C. It does make sense for me so I took the this senario.

so we are going to split "abcdef" into [1,2,3]
we can do by ourselves like...
```perl
# abcdef
# 012345 # index
"abcdef".substr(^1)      # same as "abcdef".substr(0 .. 1)
"abcdef".substr(1 .. ^3) # same as "abcdef".substr(1 .. 2)
"abcdef".substr(3 .. ^6) # same as "abcdef".substr(1 .. 5)
```

Of course! we can give more jobs to Raku. but we need some numbers before we get sub-strings.
```perl
> my $i = 0;
> (0,1,2,3).map( -> $x { $i += $x; $i } ) # 0 prepended to easier caluation
(0 1 3 6)
```
We can reduce or accumulate the results like below because Raku support some higher order function, which I learnt from [markus holzer code](https://github.com/manwar/perlweeklychallenge-club/blob/a86e289ff2bb02e7c579be9175c92f2667168a28/challenge-081/markus-holzer/raku/ch-1.raku#L11) during last challenge. the more contributing and get more information. 👍

```perl
> [\+] (0,1,2,3)
(0 1 3 6)
```
Okay, we are going to use [rotor](https://docs.raku.org/routine/rotor) again to make this numbers more meaningful.
```perl
> ([\+] (0,1,2,3)).rotor( 2 => -1 );
((0 1) (1 3) (3 6))
```
  Probably you could catch the similarity with the numbers in my first try.
Let's map over ingredients! 🤩
```perl
> ([\+] [0..3]).rotor( 2 => -1 ).map( -> ($a, $b) { "abcdef".substr( $a ..^ $b ) } );
(a bc def)
```

## **Uninterleaving(Decomposing)**  *(odd and even)*
 Undo interleaving is can be done by getting every odd-number indexed blocks and join into a string and even-number ones also be joined. Sounds easy... but how exactly???

 we have [.pairs](https://docs.raku.org/routine/pairs#(List)_routine_pairs) method.
```perl
> <a b c>.pairs # same as ("a", "b", "c").pairs
(0 => a 1 => b 2 => c)
```
and we [.classify](https://docs.raku.org/routine/classify#(List)_routine_classify) them
which are PWC team's gift for me last week.
```perl
<a b c>.pairs.classify( {.key %% 2 ?? "evens" !! "odds" } )
{evens => [0 => a 2 => c], odds => [1 => b]}
```
But we only needs values not indices(keys)
```perl
> <a b c>.pairs.classify( {.key %% 2 ?? "evens" !! "odds" }, :as{.value} )
{evens => [a c], odds => [b]}
```

But I'd like to get as an array what we can do here is
```perl
> <a b c>.pairs.classify( {.key %% 2 ?? "evens" !! "odds" }, :as{.value} )<odds evens>
([b] [a c])
```

Joining string should be easy in most of script lanuage
```perl
> <a b c>.pairs.classify( {.key %% 2 ?? "evens" !! "odds" }, :as{.value} )<odds evens>.map({.join})
(b ac)
```

  So now. If we know the String $C and each block size and we can make two **un-interleaved** strings.

## **Take A chance or All of them?** 🤔
  What Task #2 asks us is only simple "Yes" or "No" question though the question does not make our job easier. because we have to check many or all possible cases until we are sure.

### **Poorman's poor implementation of Permutation** <a name="permutation"></a>

If a string has length of 5, deviding 5 into integers looks like
```perl
(1,1,1,1,1)
(1,1,1,2)
(1,1,2,1)
...
(4,1)
(5)
```

  It is almost looks like permutations with repeatition as choosing 5 from 5 with repeatition. but number of cases should be less than that due to the same summation of of those number Let's make a perm... with repe ... things. with number of 3
Raku has [X](https://docs.raku.org/routine/X) subroutine. I am really enjoying X 
```perl
> (0..3) X (0..3) X (0..3)
((0 0 0) (0 0 1) (0 0 2) (0 0 3) (0 1 0) (0 1 1) (0 1 2) (0 1 3) (0 2 0) (0 2 1) (0 2 2) (0 2 3) (0 3 0) (0 3 1) (0 3 2) (0 3 3) (1 0 0) (1 0 1) (1 0 2) (1 0 3) (1 1 0) (1 1 1) (1 1 2) (1 1 3) (1 2 0) (1 2 1) (1 2 2) (1 2 3) (1 3 0) (1 3 1) (1 3 2) (1 3 3) (2 0 0) (2 0 1) (2 0 2) (2 0 3) (2 1 0) (2 1 1) (2 1 2) (2 1 3) (2 2 0) (2 2 1) (2 2 2) (2 2 3) (2 3 0) (2 3 1) (2 3 2) (2 3 3) (3 0 0) (3 0 1) (3 0 2) (3 0 3) (3 1 0) (3 1 1) (3 1 2) (3 1 3) (3 2 0) (3 2 1) (3 2 2) (3 2 3) (3 3 0) (3 3 1) (3 3 2) (3 3 3))
```
or could be done by recursive call.
```perl
> sub p($num-cases, $internal-use = $num-cases) {
if $internal-use == 1 { (0...$num-cases).cache }
else { (((0..$num-cases) X p($num-cases, $internal-use.pred).List).map(*.flat.cache)) } }
&p
> p(3)
...
```
and we can seive the results
```perl
> p(3).  # unfolded for better reading
         # you need to concat. them if you want to check in shell.
grep(*.sum == 3).
map(*.cache.grep(*>0)).
sort.
unique( :with(&[eqv]) )
((1 1 1) (1 2) (2 1) (3))
```

### **A Little Smarter Way**
  The previous implementation is not my thing, which I rather avoid to do because it could easily ignore what the task really ask.
  But a brute-force way always show a guide line for our answer. and also what if we really busy to solve the problem??
  I also believe that recursively calling method is also good approach to solve this kind of problem.

```perl
multi sub p( Int $n, Int $sum, $parts, $siblings ) {
    ().return if $sum == 0;

    my $parts-new = (|$parts, $n);

    if $n == $sum { # last case in the siblings (or depth)
        # (no more *next* cases in other word)
        # because we are checking from 1 to maximum
        (|$siblings, ($n,)).return; # comma required
    }
    else {
        # may have lower cases (if valid) and next cases
        my $lower-cases = samewith( 1, ($sum-$n), $parts-new,
                                   Empty );

        my $curr-cases = (($n,) X $lower-cases.List).map(*.flat);
        # note: .List is needed because it's itemized
        # and which makes slip and flattening very hard :-$
        # check next cases with current cases as a sibling
        samewith($n.succ, $sum, $parts,
                 (|$siblings, |$curr-cases) );

    }
}
multi sub p( Int $sum ) {
    samewith( 1, $sum, $empty, $empty );
}
```
```perl
> p(3)
((1 1 1) (1 2) (2 1) (3))
```
  And probably we don't need (3) because one element doesn't make any slices.
```perl
> p(3).grep( *.elems > 1 )
((1 1 1) (1 2) (2 1))
```

## **Back to the Future Past(Interleaving)**
  Now we know how to divide a string into two pieces so we can compare them twice (because A, B is not necessarily in a certain order) and if any cases are True it's a possible way to make it.

```perl
> my $A = "X";
my $C = "XY";
my $C = "XXY";

> p(3).grep(*.elems > 1).map({([\+] (0,|$_)).rotor( 2 => -1 ).map( -> ($a, $b) { $C.substr( $a ..^ $b ) } ) });
}
((X X Y) (X XY) (XX Y)
```
and you can join them.
```perl
>  p(3).grep(*.elems > 1).map({([\+] (0,|$_)).rotor( 2 => -1 ).map( -> ($a, $b) { $C.substr( $a ..^ $b ) } ) }).map({ .pairs.classify( {.key %% 2 ?? "evens" !! "odds" }, :as{.value} )<odds evens>}).map({.map(*.join(""))});
((X XY) (XY X) (Y XX))
```

 The series of the previous codes are for Raku interactive shell (so you can possibly copy and paste and test) and if we unfold it, it will look like
```perl
p(3).                # possible block partitions
grep(*.elems > 1).   # skip unuseful parts
map({([\+] (0,|$_)). # making (index) ranges
rotor( 2 => -1 ).
map( -> ($a, $b) { $C.substr( $a ..^ $b ) } ) }). # make slices
map({ .pairs.
      classify( {.key %% 2 ?? "evens" !! "odds" },
      :as{.value} )<odds evens>}).    # group by (odd or even)
map({.map(*.join(""))});              # make two words
```

 Comparing code is not very hard job so... let me skip this part. My Apology!! 😱 but I leave snippet code in my own solution.
```perl
...
              ( (A,B)|(B,A) ).map( # |: any
                    {
                        my \om = ($^a, o)>>.chars.min;
                        my \em = ($^b, e)>>.chars.min;

                        [eq] ($^a,o)>>.substr(^om)
                        and
                        [eq] ($^b,e)>>.substr(^em)
                    })[0].so
...
```
(".so" evaluate code or object as Boolean value.)

## **Final Code**
  My final code is different from what I explain here. because I wanted to make it a medium level of article and my solution is more complicated than it should be.
  I add more constraints to filter out more unnecessary cases but I guess that this is beyond what Task #2 request. If it starts with "We have  2Kb text data ...", this solution would suit for it.

```perl
#!/usr/bin/env raku
# -*- Mode: Raku; indent-tabs-mode: nil; coding: utf-8 -*-
# vim: set et ts=4 sw=4:

use v6.d;

sub all-possible-partitions( \A, \B, \C ) { # real entry point
    my $sum = C.chars;
    sps_( 1, $sum, Empty, Empty,
          sub (List $parts) {
                if ( $parts.elems <= 1 ) {
                    return True; # only needed to keep going through
                }
                # check interleaved **partially**
                my ( $splited, \o, \e ) = uninterleave( C, $parts );

                ( (A,B)|(B,A) ).map( # |: any
                    {
                        my \om = ($^a, o)>>.chars.min;
                        my \em = ($^b, e)>>.chars.min;

                        [eq] ($^a,o)>>.substr(^om)
                        and
                        [eq] ($^b,e)>>.substr(^em)
                    })[0].so
            } ).
    grep( *.elems > 0 ).
    map(
        {
            with uninterleave( C, $_.List ) { # .List needed
                (( A eq .[1] and B eq .[2])
                 or
                 ( B eq .[1] and A eq .[2])).so
                or next;

                $_; # return result of uninterleave() when True
            }
        });
}


# make permutations with repeatition and filtering
# to divide the given $sum into smaller natural numbers
# note: still need to sieve after work to get right result.
sub sps_ ( Int $n, Int $sum, $parts, $siblings, &is-valid ) returns List {
    ().return if $sum == 0;

    my $parts-new = (|$parts, $n);

    if is-valid( $parts-new ) {
        if $n == $sum { # last case in the siblings (or depth)
                        # (no more *next* cases in other word)
                        # because we are checking from 1 to maximum
            (|$siblings, ($n,)).return; # comma required
        }
        else {
            # may have lower cases (if valid) and next cases
            my $lower-cases = samewith( 1, ($sum-$n), $parts-new,
                                        Empty, &is-valid );

            my $curr-cases = (($n,) X $lower-cases.List).map(*.flat);
            # note: .List is needed because it's itemized
            # and which makes slip and flattening very hard :-$

            # check next cases with current cases as a sibling
            samewith($n.succ, $sum, $parts,
                     (|$siblings, |$curr-cases), &is-valid);
        }
    }
    else {
        $siblings.return;
    }
}

sub uninterleave( Str $str, List $split-rule ) {
    # return as ( <splited $str>, <odd joined> <even joined> ) )
    $split-rule.elems > 1 or Empty.return;

    with ( ([\+] (0, |$split-rule)). # each block size -> each index in string
            rotor( 2 => -1 ).         # two pairs of indices surrounding a block
            map({$str.substr(.[0] ..^ .[1])}) ).cache {
        ## return values ...

        .self,
        # `-> 1. string partitions itself
        (.pairs.
         classify( {.key %% 2 ?? "e" !! "o" },
                   :as{.value} )).<o e>>>.join("").Slip;

        # `-> 2. string joined out of odd indexed blocks
        #     3. string joined out of even indexed blocks

    }
}

sub MAIN ( *@str where { @str.elems == 3 and @str.all.chars > 0 } ) {
    my (\A, \B, \C) = @str;

    if A.chars + B.chars != C.chars {
        say "0 as length A + B != C";
        exit 0;
    }

    my @found-cases = all-possible-partitions( A, B, C );
    if @found-cases.elems == 0 {
        say "0 as no interleaved cases found"
    }
    else {
        say "1 as we found {@found-cases.elems} possible senario(s)\n" ~
        "e.g) `{C}' can be decomposed like below.\n";

        for @found-cases -> ($splited, $a, $b) {
            say "{$splited.Array.raku} -(uninterleave)-> $a, $b";
        }
    }
}

```

And the result
```perl
$ raku ch-2.raku XXY XXZ XXXXZY
1 as we found 6 possible senario(s)
e.g) `XXXXZY' can be decomposed like below.

["X", "X", "X", "X", "Z", "Y"] -(uninterleave)-> XXY, XXZ
["X", "X", "X", "XZ", "Y"] -(uninterleave)-> XXZ, XXY
["X", "XX", "X", "Z", "Y"] -(uninterleave)-> XXZ, XXY
["X", "XX", "XZ", "Y"] -(uninterleave)-> XXY, XXZ
["XX", "XX", "Z", "Y"] -(uninterleave)-> XXY, XXZ
["XX", "XXZ", "Y"] -(uninterleave)-> XXZ, XXY

```

Thank you for reading ~~

## **Comments**
  Task #2 was beyond my expectation. and I had a lot of problem with Raku's ".cache" problem and ".List", ".flat" things.. but I will save it for next one.

  If you are interested in, Don't hesitate to visit ["Perl Weekly Challenge"](https://perlweeklychallenge.org/challenges/)
and have a look for previous episodes as well 😎