[ch-082/jeongoon] ch-2.pl has two solution now. quick check without option "-a|--show-all-cases"

3 files changed, 244 insertions, 130 deletions

diff --git a/challenge-082/jeongoon/perl/Ch2PlanA.pm b/challenge-082/jeongoon/perl/Ch2PlanA.pm
new file mode 100644
index 0000000000..3e559e2a5b
--- /dev/null
+++ b/challenge-082/jeongoon/perl/Ch2PlanA.pm
@@ -0,0 +1,79 @@
+# -*- Mode: cperl; cperl-indent-level:4 tab-width: 8; indent-tabs-mode: nil -*-
+# -*- coding: utf-8 -*-
+
+package Ch2PlanA;
+
+use strict; use warnings;
+use parent 'Exporter';
+use List::Util qw(sum);
+
+our @EXPORT = qw(isInterleaving);
+
+sub isInterleaving ($$$) {
+    my ( $A, $B, $C ) = @_;
+    my ( $Alen, $Blen, $Clen ) = map {length} @_;
+
+    $Alen + $Blen == $Clen or return 0; # already done in main() but for sure.
+
+    my ( $checkingPlanB, @saved ) = ( 0, () );
+    my ( $Ai, $Bi, $Ci ) = (0) x 3;
+    ++$|;
+    my $interleaved = 0;
+    {
+        if ( $checkingPlanB ) {
+            last if @saved == 0; # there is no plan B ...
+
+            ( $Ai, $Bi ) = @saved;
+            @saved = ();
+            $checkingPlanB = 0; # reset status
+        }
+        $Ci = $Ai + $Bi;
+
+        if ( $Ci == $Clen ) {  # no more from $C:  we are done.
+            $interleaved = 1
+        }
+        elsif ( $Ai == $Alen ) { # used $A all
+            if ( (substr $B, $Bi) eq (substr $C, $Ci) ) {
+                # and rest of B is same as rest of C
+                $interleaved = 1
+            }
+            else {
+                ( $checkingPlanB = 1, redo );
+            }
+        }
+        elsif ( $Bi == $Blen ) { # used $B all
+            # but no need to check plan B
+            # just because we are always take 'A' when we have to choose
+            $interleaved = ( substr $A, $Ai ) eq ( substr $C, $Ci )
+        }
+        else {
+            my ( $headA, $headB ) = ((substr $A, $Ai, 1), (substr $B, $Bi , 1));
+            if ( $headA eq $headB ) {
+                if ( $headA eq ( substr $C, $Ci, 1 ) ) {
+                    # save this place
+                    @saved = ( $Ai, ($Bi+1) );
+                    # then try A (always) first for next case
+                    ++$Ai
+                }
+                else {
+                    $checkingPlanB = 1
+                }
+            }
+            else {
+                my $headC = substr $C, $Ci, 1;
+                if ( $headA eq $headC ) {
+                    ++$Ai
+                }
+                elsif ( $headB eq $headC ) {
+                    ++$Bi
+                }
+                else {
+                    $checkingPlanB = 1
+                }
+            }
+            redo;
+        }
+    }
+
+    $interleaved
+}
diff --git a/challenge-082/jeongoon/perl/Ch2PlanB.pm b/challenge-082/jeongoon/perl/Ch2PlanB.pm
new file mode 100644
index 0000000000..bb34881410
--- /dev/null
+++ b/challenge-082/jeongoon/perl/Ch2PlanB.pm
@@ -0,0 +1,122 @@
+# -*- Mode: cperl; cperl-indent-level:4 tab-width: 8; indent-tabs-mode: nil -*-
+# -*- coding: utf-8 -*-
+
+package Ch2PlanB;
+
+use strict; use warnings;
+use parent 'Exporter';
+use List::Util qw(all any min);
+
+our @EXPORT = qw(allPossiblePartitions);
+
+sub allPossiblePartitions ($$$) {
+    my ( $A, $B, $C ) = @_;
+    my $sum = length $C;
+    my @sps = somePossilbeSum( 1, $sum, [], [],
+          sub ($) { # check if we can continue to make a permutation sequences
+              my $parts = shift;
+              @$parts <= 1 and return 1; # 1 block is too short
+                                        # because we need to compare both A,B
+
+              my ( $splited, $o, $e ) # o: odd indexed  chars(string)
+                                      # e: even indexed chars(string)
+                  = uninterleave( $C, $parts );
+              # check if *maybe* interleaved
+              # we will confirm later
+              return any { # any case of A, B vs B, A
+                  my ($l, $r) = @$_; # left, right
+
+                  all {
+                      # minimum compare  left  vs odds
+                      #               or right vs evens
+                      my ($m, $n, $len) = @$_;
+                      $len = min map {length} $m, $n;
+                      substr( $m, 0, $len ) eq substr( $n, 0, $len )
+                      } [$l, $o], [$r, $e];
+              } [$A,$B], [$B,$A];
+          }
+        );
+
+    map { # confirm the cases if actually interleaved
+        if ( @$_ > 1 ) {
+            my @resultRow = uninterleave( $C, $_ );
+            my ( $splited, $o, $e ) = @resultRow;
+
+            if ( any {
+                my ( $a, $b ) = @$_;
+                $a eq $o and $b eq $e
+                 } [$A, $B], [$B, $A] ) {
+                \@resultRow
+            }
+            else {
+                ()  # not interleaved
+            }
+        } else {
+            # skip if only one block,  becuase it doesn't make a interleave str.
+            # it is okay only if A or B is empty.
+            # but it doesn't make sense for me
+            # because interleaving has no meaning if one of them is empty
+            ()
+        }
+    } @sps;
+}
+
+# limited permutations with repeatition and filtering ...
+# find any possible cases of group of natural numbers can make $sum
+
+sub somePossilbeSum ( $$$$$ );
+sub somePossilbeSum ( $$$$$ ) {
+    my ( $n, $sum,
+         $parentPartitions, # store numbers into ArrayRef
+                            # to remember current depth and totoal summation
+         $siblings,         # possible other cases at the same level
+         $isValid           # validator for current case
+        ) = @_;
+    return () if $sum == 0;
+
+    my $maybeNewPartitions = [ @$parentPartitions, $n ];
+
+    if ( $isValid->( $maybeNewPartitions ) ) {
+
+        if ( $n == $sum ) { # last (edge case) for parent case
+                            # no more *next* cases in other word
+                            # due to $n starts from 1 until meet $sum
+            @$siblings, [ $n ]
+        }
+        else {
+             # *maybe* have lower cases
+            my @childrenCases = somePossilbeSum( 1,           # starts from 1
+                                                 ($sum - $n ), # with rest
+                                                 $maybeNewPartitions,
+                                                 [],          # without siblings
+                                                 $isValid );
+
+            my @expandedCurrentCases = map { [ $n, @$_ ] } @childrenCases;
+
+            # go for next case with siblings which includes current one.
+            somePossilbeSum( ++$n,              # next case
+                             $sum,              # with same number
+                             $parentPartitions, # with the same parent
+                             [ @$siblings, @expandedCurrentCases ],
+                             $isValid )
+        }
+    } else {
+        @$siblings
+    }
+}
+
+sub uninterleave ( $$ ) {
+    # return as ( <splited $str as ArrayRef>, <odd joined> <even joined> )
+    my ( $str, $partitionsRule ) = @_;
+    @$partitionsRule > 1 or return ();
+
+    my ( $ff, @splited, $odds, $evens ) = (0); # ff: flip flop
+    for my $size ( @$partitionsRule ) {
+        my $choped = (substr $str, 0, $size, "");
+        push @splited, $choped;
+        ${ ($ff ^= 1) ? \$odds : \$evens } .= $choped;
+    }
+    \@splited, $odds, $evens
+}
+
+!!"But there is No Planet B";
diff --git a/challenge-082/jeongoon/perl/ch-2.pl b/challenge-082/jeongoon/perl/ch-2.pl
index e5eba1d0f0..a9d00051aa 100644
--- a/challenge-082/jeongoon/perl/ch-2.pl
+++ b/challenge-082/jeongoon/perl/ch-2.pl
@@ -5,165 +5,78 @@
 use strict; use warnings;
 use v5.26;
 use List::Util qw(all any min);
+use FindBin;
+use lib ($FindBin::Bin);
 
-# this will find the all the possilbe way to make interleave string
+=pod Interleave String
+
+=head1 SYNOPSIS
+
+this will find the all the possilbe way to make interleave string
+
+perl ch-2.pl [-a|--show-all-cases] <string> <string> <maybe interleaved string>
+  Options:
+    --show-all-cases: show all possible interleaving cases
+                      otherwise show simple (1|0) answer.
+
+=head1 Tested cases
 
 # tested with:
 # perl ch-2.pl ABCDEFGHIJKLMNOPQRSTUVWXYZ ABCDEFGHIJKLMNOPQRSTUVWXYZ ABCABCDDEFGHIJEFKLGHIJKLMNMNOOPPQRQRSTUVSTWXYUVWXYZZ   # 1: 256 cases
 # perl ch-2.pl XY XX XYXX   # 1: 1 cases
 # perl ch-2.pl 1X XX XXX1   # 0
 
+=cut
+
 sub usage {
-    say $/,'Usage: perl ch-2.pl <string> <string> <may be interleaved string>',
+    say $/,'Usage: perl ch-2.pl [-a|--show-all-cases] <string> <string>'.
+      ' <maybe interleaved string>',
       $/,'ex) perl ch-1.pl AY AA AYAA  # only 1 case.',$/;
 }
 
-# real entry point
-sub allPossiblePartitions ($$$) {
-    my ( $A, $B, $C ) = @_;
-    my $sum = length $C;
-    my @sps = somePossilbeSum( 1, $sum, [], [],
-          sub ($) { # check if we can continue to make a permutation sequences
-              my $parts = shift;
-              @$parts <= 1 and return 1; # 1 block is too short
-                                        # because we need to compare both A,B
-
-              my ( $splited, $o, $e ) # o: odd indexed  chars(string)
-                                      # e: even indexed chars(string)
-                  = uninterleave( $C, $parts );
-              # check if *maybe* interleaved
-              # we will confirm later
-              return any { # any case of A, B vs B, A
-                  my ($l, $r) = @$_; # left, right
-
-                  my $omin = (min (map {length} $l, $o));
-                  my $emin = (min (map {length} $r, $e));
-
-                  all {
-                      # minimum compare  left  vs odds
-                      #               or right vs evens
-                      my ($m, $n, $len) = @$_;
-                      substr( $m, 0, $len ) eq substr( $n, 0, $len )
-                      } [$l, $o, $omin], [$r, $e, $emin];
-              } [$A,$B], [$B,$A];
-          }
-        );
-
-    map { # confirm the cases if actually interleaved
-        if ( @$_ > 1 ) {
-            my @resultRow = uninterleave( $C, $_ );
-            my ( $splited, $o, $e ) = @resultRow;
-
-            if ( any {
-                my ( $a, $b ) = @$_;
-                $a eq $o and $b eq $e
-                 } [$A, $B], [$B, $A] ) {
-                \@resultRow
-            }
-            else {
-                ()  # not interleaved
-            }
-        } else {
-            # skip if only one block,  becuase it doesn't make a interleave str.
-            # it is okay only if A or B is empty.
-            # but it doesn't make sense for me
-            # because interleaving has no meaning if one of them is empty
-            ()
-        }
-    } @sps;
-}
-
-# limited permutations with repeatition and filtering ...
-# find any possible cases of group of natural numbers can make $sum
-
-sub somePossilbeSum ( $$$$$ );
-sub somePossilbeSum ( $$$$$ ) {
-    my ( $n, $sum,
-         $parentPartitions, # store numbers into ArrayRef
-                            # to remember current depth and totoal summation
-         $siblings,         # possible other cases at the same level
-         $isValid           # validator for current case
-        ) = @_;
-    return () if $sum == 0;
-
-    my $maybeNewPartitions = [ @$parentPartitions, $n ];
-
-    if ( $isValid->( $maybeNewPartitions ) ) {
-
-        if ( $n == $sum ) { # last (edge case) for parent case
-                            # no more *next* cases in other word
-                            # due to $n starts from 1 until meet $sum
-            @$siblings, [ $n ]
-        }
-        else {
-             # *maybe* have lower cases
-            my @childrenCases = somePossilbeSum( 1,           # starts from 1
-                                                 ($sum - $n ), # with rest
-                                                 $maybeNewPartitions,
-                                                 [],          # without siblings
-                                                 $isValid );
-
-            my @expandedCurrentCases = map { [ $n, @$_ ] } @childrenCases;
-
-            # go for next case with siblings which includes current one.
-            somePossilbeSum( ++$n,              # next case
-                             $sum,              # with same number
-                             $parentPartitions, # with the same parent
-                             [ @$siblings, @expandedCurrentCases ],
-                             $isValid )
-        }
-    } else {
-        @$siblings
-    }
-}
-
-sub uninterleave ( $$ ) {
-    # return as ( <splited $str as ArrayRef>, <odd joined> <even joined> )
-    my ( $str, $partitionsRule ) = @_;
-    @$partitionsRule > 1 or return ();
-
-    my ( $ff, @splited, $odds, $evens ) = (0); # ff: flip flop
-    for my $size ( @$partitionsRule ) {
-        my $choped = (substr $str, 0, $size, "");
-        push @splited, $choped;
-        ${ ($ff ^= 1) ? \$odds : \$evens } .= $choped;
-    }
-    \@splited, $odds, $evens
-}
-
 sub saySeprately ($$) {
     local $|; ++$|;
 
     print $_[0];
     print STDERR $_[1];
-    say "";
+    print "\n";
 }
 
 package main;
 
-my ( $A, $B, $C ) = @ARGV;
+my @f_ARGV = grep { ! /^-(a|-*show-all-cases)$/ } @ARGV;
+our $quickCheckOnly = (@f_ARGV == @ARGV);
 
-(  @ARGV == 3
+my ( $A, $B, $C ) = @f_ARGV;
+(  @f_ARGV == 3
    and
    all { length $_ > 0 } $A, $B, $C  ) or usage, exit 0;
 
+# minimum sanity check
 (length $A) + (length $B) == (length $C)
-    or saySeprately( 0, " as length A + B != C" );
-
-my @correctCases = allPossiblePartitions( $A, $B, $C );
+  or saySeprately( 0, " as length A + B != C" );
 
-if ( @correctCases == 0 ) {
-    saySeprately( 0, " as no interleaved case found" );
+if ( $quickCheckOnly ) {
+    require Ch2PlanA;
+    Ch2PlanA->import();
+    say 0 + isInterleaving( $A, $B, $C );
 }
 else {
-    saySeprately( 1, " as we found ".+@correctCases." possible case(s).\n" );
-    say STDERR "e.g) $C can be decomposed like below:\n";
-
-    local $" = "|";
+    require Ch2PlanB;
+    Ch2PlanB->import();
+    my @correctCases = allPossiblePartitions( $A, $B, $C );
+    if ( @correctCases == 0 ) {
+        saySeprately( 0, " as no interleaved case found" );
+    }
+    else {
+        saySeprately( 1, " as we found ".+@correctCases." possible case(s).\n");
+        say STDERR "e.g) $C can be decomposed like below:\n";
 
-    for ( @correctCases ) {
+        local $" = "|";
 
-        my ( $splited, $left, $right ) = @$_;
-        say STDERR "[@{$splited}] -(uninterleave)-> $left, $right ";
+        for ( @correctCases ) {
+            my ( $splited, $left, $right ) = @$_;
+            say STDERR "[@{$splited}] -(uninterleave)-> $left, $right ";
+        }
     }
 }