Merge pull request #2245 from jeongoon/ch-077

[ch-077/jeongoon] Haskell, Perl solution

4 files changed, 531 insertions, 0 deletions

diff --git a/challenge-077/jeongoon/haskell/ch-1.hs b/challenge-077/jeongoon/haskell/ch-1.hs
new file mode 100644
index 0000000000..6a6bf0296b
--- /dev/null
+++ b/challenge-077/jeongoon/haskell/ch-1.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Options.Generic
+import Data.List (findIndex, intersect, intercalate, sortBy, unfoldr)
+
+{- tested with:
+runhaskell 150 # total 8 cases found
+-}
+-- fib, fib2: credit: https://wiki.haskell.org/The_Fibonacci_sequence
+fib = fst . fib2
+
+-- | Return (fib n, fib (n + 1))
+fib2 0 = (1, 1)
+fib2 1 = (1, 2)
+fib2 n
+ | even n    = (a*a + b*b, c*c - a*a)
+ | otherwise = (c*c - a*a, b*b + c*c)
+ where (a,b) = fib2 (n `div` 2 - 1)
+       c     = a + b
+
+-- solution
+fibNumbers n = unfoldr (\(x, i) -> let fn = fib i in
+                          if fn <= x then Just(fn, (x, i+1))
+                          else Nothing ) (n, 1)
+reversedFibNumbers = sortBy (\a b -> compare b a).fibNumbers
+
+-- find the all cases of a fib number can be expressed
+divideAFib :: Integer -> [Integer] -> [Integer] -> [[Integer]]
+divideAFib f [] fibNumsUsed = divideAFib f (reversedFibNumbers f) fibNumsUsed
+divideAFib f rfibNums fibNumsUsed = -- fibNumUsed cannot be used twice or more
+  case (findIndex (f==) rfibNums) of
+    Nothing   -> [] --  wrong fib number
+    Just fidx -> [[f]] -- always include one fib number itself
+                      -- which is not effeceted by fibNumsUsed
+                ++ unfoldr divideAFibInner (fidx, rfibNums, [f])
+  where
+    divideAFibInner (_, [], _) = Nothing -- only for silence warning message
+    divideAFibInner (idx, rfs@(_:rfs'), acc)
+      | idx +2 >= length rfs = Nothing
+      | null (intersect nextTwoFibs fibNumsUsed) =
+          Just ( acc', (idx+1, rfs', acc' ) )
+      | otherwise = Nothing
+      where
+        nextTwoFibs = [ rfs !! (idx+1), rfs !! (idx+2) ]
+        acc' = (init acc) ++ nextTwoFibs
+
+rExpandFibCombination :: [Integer] -> [Integer] -> [[Integer]]
+rExpandFibCombination rfibNumsCombi [] =
+  rExpandFibCombination rfibNumsCombi (reversedFibNumbers (head rfibNumsCombi))
+rExpandFibCombination rfibNumsCombi rAllFibNums =
+  -- rfibNumsCombi: expect to get reversed sorted fib numbers
+  unfoldr productExpandedCases ((replicate nof 0),
+                                 lastCsr ) -- starting from last (smallest) fib.
+  where
+    rcases :: [[[Integer]]] -- list of each expanded list of a fib num
+    rcases = unfoldr (\fibs
+                        -> if null fibs then Nothing
+                          else Just( divideAFib
+                                  (head fibs) rAllFibNums (tail fibs),
+                                  (tail fibs) ) ) rfibNumsCombi
+
+    nof = length rfibNumsCombi
+    lastCsr = nof - 1
+    allNumRange = [ 0 .. lastCsr ]
+    increaseAt    idx list =
+      take idx list ++ ((list!!idx) +1) : drop (idx+1) -- increase pos at idx
+      ( if idx == lastCsr then list
+        else  take (idx+1) list ++ (replicate (lastCsr-idx) 0) )
+
+    productExpandedCases :: ([Int], Int) -> Maybe ([Integer], ([Int], Int))
+    productExpandedCases (pos, csr)
+      | null pos       = Nothing
+      | otherwise      =
+          Just ( ((foldr (++) []).(map rCaseAtCursor)) allNumRange,
+                 (pos', csr') )
+      where
+        (pos', csr') = case nextCsr csr of
+                         Nothing -> ([], csr) -- make edge case
+                         Just c' -> (increaseAt c' pos,
+                                    if csr == c' then c' else lastCsr )
+                       -- not c' but lastCsr
+                       -- because always rewind cursor after increase pos
+                       -- at higher order number
+                       -- e.g) increase at 2nd order 19 -> 20
+                       -- after that increase 1st order -> 21
+
+        rCaseAtCursor :: Int -> [Integer]
+        rCaseAtCursor i = ((rcases!!i)!!(pos!!i))
+
+        fibAtCursorHasMoreCases c = ((length (rcases!!c)) -1) /= pos!!c
+
+        nextCsr curcsr
+          | fibAtCursorHasMoreCases curcsr = Just curcsr
+          | curcsr < 1 = Nothing
+          | otherwise = nextCsr (curcsr -1)
+
+allCombiFibSum targetSum =
+  case (minCombiFibSum targetSum 0 []) of
+    Nothing -> []
+    Just foundMinCombiSum -> rExpandFibCombination foundMinCombiSum rFibNumbers
+  where
+    rFibNumbers = reversedFibNumbers targetSum
+    -- minCombiFibSum -> a combination of minimum number of fib. numbers
+    minCombiFibSum tsum majorFibIdx minCombiAcc
+      | majorFibIdx >= (length rFibNumbers) = Nothing -- no more fib
+      | tsum < majorFib = minCombiFibSum -- try next available one
+                           tsum (1+majorFibIdx) minCombiAcc
+      | tsum == majorFib = Just $ minCombiAcc ++ [majorFib] -- exact match
+      | null otherFibs   = Nothing -- run out of fib numbers
+      | otherwise = -- go recursively until find other smaller fib numbers
+          case (minCombiFibSum (tsum-majorFib) (1+majorFibIdx) []) of
+            Nothing -> minCombiFibSum tsum (1+majorFibIdx) []
+            Just foundMinCombiSum -> Just $ majorFib : foundMinCombiSum
+      where
+        majorFib = rFibNumbers !! majorFibIdx
+        otherFibs = drop (1+majorFibIdx) rFibNumbers
+
+-- testing
+main = do
+  args <- getRecord "Challenge #077 - Task #1"
+  let targetSum = args :: Integer
+      allCombi   = allCombiFibSum targetSum in
+    do
+      putStr "Input:"
+      putStrLn $ "$N = "   ++ (show targetSum)
+      putStrLn $ "possible ways are: "
+      mapM_ ((\combiStr ->
+                putStrLn( combiStr ++ " = " ++ (show targetSum)))
+              .(intercalate " + ".map show)) allCombi
+
+      putStrLn $ "Total " ++ (show (length allCombi)) ++ " case(s) found"
diff --git a/challenge-077/jeongoon/haskell/ch-2.hs b/challenge-077/jeongoon/haskell/ch-2.hs
new file mode 100644
index 0000000000..94ba2ded42
--- /dev/null
+++ b/challenge-077/jeongoon/haskell/ch-2.hs
@@ -0,0 +1,82 @@
+--{-# LANGUAGE DeriveGeneric     #-}
+--{-# LANGUAGE OverloadedStrings #-}
+--import Options.Generic
+import System.IO
+
+import Data.List (lines, isPrefixOf, groupBy)
+import Data.Char (toUpper)
+import Data.Maybe (isJust, fromJust)
+
+{- tested with:
+echo -e "[O O X]\n[X O O]\n[X O O]" | runhaskell ch-2.hs
+# or even without space
+echo -e "[OOXO][XOOO][XOOX][OXXOO]" | runhaskell ch-2.hs
+-}
+-- solution
+getMatrixFromStdin :: IO [[Int]]
+getMatrixFromStdin =
+  getContents >>= matrixLines >>= return . map parseMatrixLine
+  >>= return . map (map (\x -> case toUpper( x!!0 ) of
+                           'O' -> 1
+                           'X' -> 0 )) -- convert into integer
+  >>= return . filterEmptyRow
+  where
+    parseMatrixLine = filter (not.isPrefixOf " ").
+                       groupBy (\a b -> a == ' ' && a == b).
+                       filter (\c -> c `elem` " OX")
+    matrixLines = return . lines . unlines . groupBy (\a b -> b /= ']')
+    filterEmptyRow = filter ((0/=).length)
+
+getMatrixValueAt matrix (r, c)
+  | length matrix <= r || r < 0 = Nothing
+  | length (matrix!!r) <= c || c < 0 = Nothing
+  | otherwise = Just $ (matrix!!r)!!c
+
+getPosAroundAt (r, c) = foldr (++) [] -- flatten once
+  [ [ (r,c) | c <- [(c-1) .. (c+1)] ] | r <- [(r-1) .. (r+1)] ]
+
+getSumAroundAt matrix (r, c) =
+  sum $ map (\(r',c') ->
+         case getMatrixValueAt matrix (r',c') of
+           Nothing -> 1
+           Just  v -> v ) $ getPosAroundAt (r,c)
+
+data RowStatus = RowStatus { r :: Int, c :: Int,
+                             val :: Maybe Int,
+                             lsum  :: Int } deriving (Eq, Show)
+
+getAllSumAround matrix =
+  let maybeNumRows = if length matrix == 0 then Nothing else Just (length matrix)
+      maybeNumColumns = case maybeNumRows of
+                     Nothing -> Nothing
+                     Just nr -> if length (matrix!!0) == 0 then Nothing
+                               else Just( length (matrix!!0) )
+  in
+    if isJust maybeNumRows && isJust maybeNumColumns then
+      let numRows = fromJust( maybeNumRows )
+          numColumns = fromJust( maybeNumColumns ) in
+        foldr (++) [] -- flatten once
+        [ [ RowStatus { r = ri, c = ci,
+                        val  = (getMatrixValueAt matrix (ri,ci)),
+                        lsum = (getSumAroundAt matrix (ri,ci)) }
+          | ci <- [0..numColumns] ] | ri <- [0..numRows] ]
+    else []
+
+isLonenlyX rowst = isJust (val rowst)  && (fromJust (val rowst)) == 0
+                   && (lsum rowst) == 8
+filterLonelyX = (filter isLonenlyX).getAllSumAround
+showRowStatus :: RowStatus -> String
+showRowStatus rowst = "Lonely X at row " ++ ((show.r) rowst) ++ ", column "
+                      ++ ((show.c) rowst)
+
+-- testing
+main = do
+  aSample <- getMatrixFromStdin
+  putStrLn "Given Matrix ( O -> 1,  X -> 0 ):"
+  mapM_ (putStrLn.unwords.map show) aSample
+  let theLonelyX = filterLonelyX aSample in
+    do
+      putStr "Total Lonely X: "
+      putStrLn $ (show.length) theLonelyX
+      putStrLn "Details are: "
+      mapM_ (putStrLn.showRowStatus)  theLonelyX
diff --git a/challenge-077/jeongoon/perl/ch-1.pl b/challenge-077/jeongoon/perl/ch-1.pl
new file mode 100644
index 0000000000..c5eb2a3eab
--- /dev/null
+++ b/challenge-077/jeongoon/perl/ch-1.pl
@@ -0,0 +1,231 @@
+#!/usr/bin/env perl
+# -*- Mode: cperl; cperl-indent-level:4 tab-width: 8; indent-tabs-mode: nil -*-
+# -*- coding: utf-8 -*-
+
+=pod Fibonacci Sum
+
+=head1 SYNOPSIS
+
+perl ch-1.pl <sum>
+
+=head1 Solution
+
+1. find a minimum number of fibonacci combination which tally "target sum"
+   ex) 89 + 8 + 3 = 100
+2. figure out how many ways to express each fibonacci in the combination
+   which must be not duplicated or overlaped with other numbers
+
+   ex) 89 -> [ 89 ], [ 55, 34 ], [ 55, 21, 13 ]
+        8 -> [ 8 ] # only one
+        3 -> [ 3 ], [ 2, 1]
+
+3. Product all the cases shown above.
+
+=head1 About Sub-cases For Each Fibonacci Number
+
+if we have fibonacci number like below (in a reversed order)
+
+ a b c d e f g h   (`a' is largest number)
+
+ 1. a = b + c
+ 2. c = d + e
+ therefore an easy way to find sub cases is that
+ a = b + (d + e)
+
+ but if we're trying to change the number between `a', 'c' e.g `b'
+ 1'. a = b + c -> a = (c+d) + c
+ `c' is duplicated
+ (repeated) a = (c+d) + c = 2c + d
+ if we can find `2c' where c <= `2c' <= a, this is True
+ e.g) 2c == b which is impossible in any case
+ because b = c + d, and of course `d' != `c'
+
+so I concluded that chaging the fibonacci number into two lower
+fibonacci numbers (right next to the current) until not overlapping
+is the only way to make sub cases.
+
+=cut
+
+use strict; use warnings;
+use v5.26;
+use Getopt::Long qw(:config gnu_compat);
+use Pod::Usage;
+use List::Util qw{any product};
+
+BEGIN {
+    sub fs { "File::Spec" }
+    $::debugging = 0;
+
+    my $help = 0;
+
+    GetOptions( "debug"   => \$::debugging,
+                "help"    => \$help,
+        ) or pod2usage(2);
+
+    pod2usage( -exitval => 0, -verbose => 2 ) if $help;
+
+
+    our $dprint = sub( @ ) {
+        ++$|;
+        print @_;
+    };
+
+    *::dprint = $::debugging ? $dprint : sub {};
+}
+
+sub fibs ($) { # excluding first 1 for challenge purpose
+    my $limit = shift;
+    $limit <= 1 and return (1);
+    $limit <= 2 and return (1,2);
+
+    my @fibs = ( 1, 2 );
+    while ( (my $new_fib = ($fibs[-2] + $fibs[-1] )) <= $limit ) {
+        push @fibs, $new_fib;
+    }
+    @fibs
+}
+
+sub rfibs ($) { reverse (fibs shift) }
+
+# return the all possible ways a fib number can be expressed
+#   which includes the fib number itself
+# ex) f(55) -> [55], [34, 21], [34, 13, 8], [34, 13, 5, 3], [34, 13, 5, 2, 1]
+# return as array of arrayref
+# FIXME: need more information about implmentation
+
+sub allCasesSubFibs ($$$) {
+    # assume allRevFibsRef is sorted desc.
+    my ( $afib, $allRevFibsRef, $fibsNotToUseRef )  = @_;
+    my @allRevFibs = @{$allRevFibsRef}; # copy: no side effect
+
+    my $skip = 0;
+    for my $fi ( 0..$#allRevFibs ) { # FIXME: I saw something new expression
+        $allRevFibs[$fi] == $afib and ( $skip = $fi + 1 );
+    }
+    my @subfibs = splice @allRevFibs, $skip;
+    my @allCases = ( [$afib] ); # add fib number itself.
+                                # XXX: even if it's already banned.
+
+    for ( my $fi = 0; $fi+1 < @subfibs; $fi += 2 ) {
+        my @lastFibs = splice( @{[@{$allCases[-1]}]}, # copy
+                               0, $#{$allCases[-1]} );
+        my @twoFibs = @subfibs[ $fi, $fi+1 ];
+        if ( any { my $bomb = $_;
+                   grep { $bomb eq $_ } @twoFibs } @$fibsNotToUseRef ) {
+            last; # stop here on purpose
+        }
+        push @allCases, [ @lastFibs, @twoFibs ];
+    }
+    @allCases;
+}
+
+sub productCases ($) {
+    my ( $casesRef, @pos, $csr ) = $_[0];
+    my @cases = @{$casesRef}; # side note: this is copy method
+    @pos = (0) x scalar @cases;
+    if ( @pos == 1 ) {
+        ::dprint "[WRN] only one case given\n";
+    }
+    my @num_cases = map { scalar @{$_} } @cases;
+    ::dprint "[INF] total: ".( join " x ", @num_cases  )." = ".
+      (product @num_cases)." case(s)\n";
+
+    $csr = $#cases;
+
+    my @allcases;
+    {
+        if ( $pos[$csr] < @{$cases[$csr]} ) {
+            ::dprint "[DBG] $csr: @pos: ",
+              (join ",", map { @{$cases[$_][$pos[$_]]} } 0..$#cases ),$/;
+            # add record
+            push @allcases,
+              [ map { @{$cases[$_][$pos[$_]]} } 0..$#cases ];
+            ++$pos[$csr];
+            redo;
+        }
+        else {
+            # find higher order case
+            my $newCsr;
+            for ( my $c = $csr-1; $c >= 0; --$c ) {
+                if ( $pos[$c] < $#{$cases[$c]} ) {
+                    $newCsr = $c;
+                    ::dprint "[DBG] New Cursor: $newCsr\n";
+                    last;
+                }
+            }
+            if ( defined $newCsr ) {
+                ++$pos[$newCsr];
+                @pos[ $newCsr+1 .. $#pos ] = (0) x (scalar @pos);
+                $csr = $#cases;
+                redo;
+            }
+        }
+    }
+    @allcases;
+}
+
+# product all cases of each fib numbers
+sub productRevFibCombination ($$) {
+    my ( $aRevFibCombiRef, $allRevFibsRef ) = @_;
+    my @fibsNotToUse = @{$aRevFibCombiRef};
+
+    my @rcases = map {
+        shift @fibsNotToUse; # remove one by one from ban list
+                             # for shorter comparison
+        my @a = allCasesSubFibs( $_, $allRevFibsRef, \@fibsNotToUse );
+        ::dprint( ('[DBG] ', join "|", map{ "[".join( ",", @$_)."]" } @a), $/ );
+        [ @a ];
+
+    } @$aRevFibCombiRef;
+    productCases \@rcases;
+}
+
+sub minRevFibSumCombination ($$);
+sub minRevFibSumCombination ($$) { # found a case tally the target sum.
+    my ( $targetSum, $allRevFibRef ) = @_;
+    #my @allRevFib = grep { $_ <= $targetSum } @{$allRevFibRef};
+    my @allRevFib = @{$allRevFibRef}; # assuming it's already sieved.
+    my $majorFib;
+    {
+        $majorFib = shift @allRevFib;
+        defined $majorFib or return ();
+        ::dprint "[DBG] current major fib: $majorFib, target sum: $targetSum\n";
+        redo if $majorFib > $targetSum;
+
+        $majorFib == $targetSum and return ($majorFib);
+    }
+
+
+    my @rest = minRevFibSumCombination( ($targetSum-$majorFib), \@allRevFib );
+    ::dprint "[DBG] rest for $majorFib: @rest\n";
+    return ( @rest > 0 ? ( $majorFib, @rest ) : () )
+}
+
+# final solution form
+sub allCombiFibSum ($) {
+    my $targetSum = shift;
+    my @reversedFibNumbers = rfibs $targetSum;
+
+    my @aCombi = minRevFibSumCombination( $targetSum, \@reversedFibNumbers );
+    ::dprint( "[DBG] A possible minimum combination: ", join( ",", @aCombi ), $/ );
+    return () if @aCombi == 0;
+    productRevFibCombination( \@aCombi, \@reversedFibNumbers );
+}
+
+if (0) {
+    say "@{[rfibs 999]}";
+    say "@$_" for allCasesSubFibs 55, [rfibs(55)], [8,3];
+    say "@$_" for productRevFibCombination ( [89,21,3], [rfibs 55] );
+    say "@{[minRevFibSumCombination(150, [rfibs 150])]}";
+}
+
+my $N = shift @ARGV;
+( defined $N and $N > 0 ) or pod2usage( -exitval => 0, -verbose => 1 );
+
+say "Input: \$N = $N";
+my @allCombi = allCombiFibSum $N;
+say "Output:";
+say map {
+    join( " + ",  @$_ ). " = " . $N . $/;
+} @allCombi;
+say "Total ".(scalar @allCombi)." case(s) found";
diff --git a/challenge-077/jeongoon/perl/ch-2.pl b/challenge-077/jeongoon/perl/ch-2.pl
new file mode 100644
index 0000000000..5042028970
--- /dev/null
+++ b/challenge-077/jeongoon/perl/ch-2.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/env perl
+# -*- Mode: cperl; cperl-indent-level:4 tab-width: 8; indent-tabs-mode: nil -*-
+# -*- coding: utf-8 -*-
+
+use strict; use warnings;
+use v5.26;
+use List::Util qw(sum);
+
+=pod
+
+=head1 Test
+
+echo "[OOX][XOO][XOO]" | perl ch-2.pl
+
+=cut
+
+sub readBinaryMatrixFromStdin () {
+    local $/ = '';
+    my $contents = <STDIN> // '';
+    $contents =~ s/\]\n*/\n/g;
+    my @lines = split "\n", $contents;
+    map { [ map { if (/[OX]/) { y/OX/10/; $_ } # O -> 1, X -> 0
+                  else { () } } split //, $_ ] } grep { $_ ne '' } @lines;
+}
+
+sub showMatrix ($) {
+    my $mat = shift;
+    say "@{$$mat[$_]}" for ( 0 .. $#$mat );
+}
+
+sub VAL { 0 }
+sub ROW { 1 }
+sub COL { 2 }
+sub SUM { 3 }
+
+# return as ( value at (r,c),
+#             row,
+#             column,
+#             sum around (r,c) )
+
+sub getLonelyStatusAround ($$$) {
+    my ( $mat, $r, $c ) = @_;
+    ( 0 <= $r && $r < @$mat && 0 <= $c && $c < @{$$mat[0]})
+        or return (-1,$r,$c,-1);
+    ( $mat->[$r][$c] ) == 0 or return (1,$r,$c,-1);
+
+    my @rg = (-1, 0, 1);
+    # assume non-exist cell has value of 1
+    my @cellValues = map { my $y = $r+$_;
+                           $y < 0 ? (1)x 3 : # note: fill the non-exist row
+                               map { my $x = $c+$_;
+                                     $x < 0 ? 1 : $$mat[$y][$x] // 1 } @rg } @rg;
+
+    0, $r, $c, (sum @cellValues);
+}
+
+package main;
+
+say "Input: (Ctrl-D or Ctrl-Z to finish input)";
+say "ex) [OOX][XOO][XOO]";
+my @matrix = readBinaryMatrixFromStdin;
+if ( @matrix < 1 ) {
+    say 'Usage: echo "[OOX][XOO][XOO]" | perl ch-2.pl';
+    warn "Using default matrix ...";
+
+    @matrix = ([1,1,0,1],
+               [0,1,1,1],
+               [0,1,1,0],
+               [1,0,1,1]);
+}
+
+say "Showing matrix again (O -> 1; X -> 0):";
+showMatrix \@matrix;
+
+my $count = 0;
+for my $r ( 0 .. $#matrix ) {
+    for my $c ( 0 .. $#{$matrix[0]} ) {
+        my @stat = getLonelyStatusAround( \@matrix, $r, $c );
+
+        if ( $stat[VAL] == 0 and $stat[SUM] == 8 ) {
+            ++$count;
+            say "$count: Lonely X found at Row ".($r+1)." Col ".($c+1);
+        }
+    }
+}
+
+say "Total $count Lonely X(s) found";