DEV Community: Myoungjin Jeon

Let's Fold a Tree

Myoungjin Jeon — Tue, 21 Jun 2022 12:22:19 +0000

folding-tree?

The term of folding-tree is not an official or common name. But I'll call the function as folding-tree here. I guess Tree Merging is more accurate term. see more.

~~I lost the original source code because link I have is broken now. So this article is licensed under MIT as I borrow from other's~~

Credit Update

I found the original link! and What I saw for the first time is this.

I found this function in another function generating prime numbers.

which I hardly understand at the time, even though it looks very interesting. Fortunately I have better understanding about it, so I'd like to share.

How to use (test)

This source code is written in literate haskell and you try to use in ghci like below:

shell> curl -sL https://raw.githubusercontent.com/jeongoon/jeongoon.github.io/main/posts/2022-06-05-foldt.lhs -o FoldTree.lhs
shell> ghci
GHCi, version 8.10.7: https://www.haskell.org/ghc/  :? for help
Loaded GHCi configuration from /home/myoungjin/.config/ghc/ghci.conf
λ= :l FoldTree.lhs 
[1 of 1] Compiling FoldTree         ( FoldTree.lhs, interpreted )
Ok, one module loaded.
λ= take 7 . foldt $ [[3,6..], [5,10..], [7,14..]]
[3,5,6,7,9,10,12]

Module FoldTree

module FoldTree (foldt) where

foldt :: Ord a => [[a]] -> [a]

foldt

foldt takes a list of list of series of numbers and return a merged (union) and sorted list. It is more like making a rope with the strings.

However, there are some assumption about usage:

Each inner list contains sorted already in ascending order
All the (outter) groups are sorted by order of the first element of each group.

So If we have multiples of number three and five and seven,

λ> make_some_multiples n = [ n, n+n .. 20 ]
λ> three_multiples = make_some_multiples 3
λ> take 5 $ three_multiples
[3,6,9,12,15]
λ> -- ^ note: already sorted
λ> five_multiples = make_some_multiples 5
λ> seven_multiples = make_some_multiples 7

We need to apply the list of each multiples in this way:

λ> foldt [ three_multiples, five_multiples, seven_multiples ]

Note: In general, if your implementation has specific limitation on input value, you might need to write the function name as something imposing the limitation or your own data type.

Another option would be phantom type¹.

Those assumptions help for our thunk²s to care about only the members of list in the future, which goes pretty well with the nature of lazy evaluation!

The original foldt implementation is for the infinite list has less condition, however, I'd like to apply foldt to fixed size of list so has more edge cases:

foldt [] = []
foldt ([]:_) = []

So, on second condition, we can return empty list if the list of left hand side has empty body. Because each multiples has longer list if the initial number is less. (so if longer list is empty, we don't need to check shorter list)

foldt ((x:xs):t) = x : unionSort xs (foldt (pairs t))

The last pattern is for general condition. And foldt appears in the end again to make recursive call.

Basically the first element of leftmost group has lowest value, so it will be the first element in the result. This is the basic concept of foldt. And rest of list (xs) will be union-ed with rest of foldt-ed list.

unionSort will remove a duplicated member and take the element at lowest value out of the both list.

unionSort

unionSort :: Ord a => [a] -> [a] -> [a]
unionSort [] ys = ys
unionSort xs [] = xs
unionSort xs@(x:xt) ys@(y:yt) =
  case x `compare` y of
    LT -> x : unionSort xt ys -- x used; do unionSort on rest of them
    EQ -> x : unionSort xt yt -- x used; y is duplicated
    GT -> y : unionSort xs yt

unionSort also has recursive call to finish the union and sort on rest of members which depend on the value chosen for the head of result.

pairs

pairs do the same sort method used in foldt. foldt takes only one group each time, on the other hand, pairs tries to take every two groups each time. If the pair is not available, it returns empty or the leftmost group so that foldt will end its job earlier. Those edge cases are also only required when applied to finite list.

pairs :: Ord a => [[a]] -> [[a]]
-- edge cases ...
pairs [] = []
pairs ([]:_) = [] -- left always has longer list; no need to go further
pairs (ms:[]) = [ms] -- just return leftmost group

The second pattern matching will reduce the searching time as well -- as we saw in the pattern matching of foldt.

Those edge cases could be different when the different types of series of numbers are used.

pairs ((m:ms):ns:t') = (m : unionSort ms ns) : pairs t'

If two groups are taken to perform union, m is supposed to be the lowest value and will be the first value of pairs function -- which is actually doing amazing job to wire all the foldt and pairs smoothly because it doesn't need to go further to get first value.

Note: there is no doubt that less evaluation tends to be more efficient in lazy computation.

To organize the rest of them unionSort will be applied on rest of between two groups, and pairs will pursue the tail of the code again to finish the job.

This is one of most beautiful piece of recursive programming.

foldt examples

sumOfMultiples

This task is introduced at exercism.org. Even though, we could solve this problem by checking divisibility of all the member numbers which is given as factor list, it was worth to try because foldt is fast enough to solve by union-ing the numbers and get only one of common multiples if some are duplicated.

sumOfMultiples factors limit =
  sum $ foldt [ [n,n+n..(limit -1)] | n <- factors', n > 0 ]
  where factors' = sort factors
  -- note: sort is required due to the foldt has assumption!

λ= sumOfMultiples [2,3,5,7,11] 100000
3961010983

the origin of foldt - prime numbers

the original file contains a lot more implementation of prime numbers³.

Too many recursive call probably makes us confused at first. But if you know how foldt acts in there, it will be easier to figure out how it works!

To be honest, This code is still hard for me to understand. Or even if I could understand it, I don't think I could invent something like this. 😅

The basic idea of the generating is called Sieve of Eratosthenes. But foldt accomplish the task in unique way to perform sieving when compared to imperative pseudo code.

We could think minus function is to used sieve and foldt function used to eliminate the duplication and to sort.

module PrimeNumber
  ( primesTME
  ) where

primesTME :: [Int]
primesTME =   2 : ([3,5..] `minus` foldt [ [p*p,p*p+2*p..] | p <- primes_ ])
  where
    primes_ = 3 : ([5,7..] `minus` foldt [ [p*p,p*p+2*p..] | p <- primes_ ])
    foldt ~((x:xs):t) = x : union xs (foldt (pairs t))
    pairs ~((x:xs):ys:t) = (x : union xs ys) : pairs t

minus :: [Int] -> [Int] -> [Int]
minus xs@(x:xt) ys@(y:yt) = case compare x y of
                              LT -> x : minus xt ys
                              EQ ->     minus xt yt
                              GT ->     minus xs yt

union :: [Int] -> [Int] -> [Int]
union xs@(x:xt) ys@(y:yt) = case compare x y of
                              LT -> x : union xt ys
                              EQ -> x : union xt yt
                              GT -> y : union xs yt

As you can see foldt and pairs are now much simpler because it works on the infinite list. and ~ prefix will calm down the ghc because it tells ghc to trust that our pattern matching will serve all the cases even though it doesn't look like exhaustive.

I was able to compile this module without ~. I guess that there are some still possibility for older ghc complier to complain about non-exhaustive pattern matching.

What we can do more?

I was thinking about making business hours by using foldt. A set of trading hours could rely the public holiday and day light saving time if applicable. (because most of times, UTC will be preferred to save time information) or each weekday could have the different schedule like "shopping day" (which is Thursday in Australia).

So we could have many groups of time tables and get the final trading hours list by applying union and sort them and also filter them by removing some special occasion or public holidays!

It sounds the usage of foldt is suitable for this tasks, doesn't it?

I hope I could write an article about it! Thank you for reading!

Foot Notes

Grep with Head Line

Myoungjin Jeon — Sun, 24 Apr 2022 01:50:20 +0000

No Head Line in grep search

when I tried to find a process, I normally use ps with grep command.

sh> ps aux | grep fish
myoungj+     695  0.0  0.0  88596  7000 tty2     S+   09:17   0:00 -/usr/bin/fish -c /usr/bin/gnome-session -l 
myoungj+    2490  0.0  0.1 164660 10140 pts/1    Ss   09:21   0:00 -fish
myoungj+    2665  0.0  0.1 172848 10076 pts/2    Ss+  09:24   0:00 -fish
myoungj+    2781  0.0  0.1 172724  9712 pts/0    Ss+  09:27   0:00 -fish
myoungj+    3024  0.0  0.1 164528  9552 pts/3    Ss+  09:32   0:00 -fish
myoungj+    4709  0.0  0.0   9136  2692 pts/5    S+   10:00   0:00 grep --color=auto fish

Headline is helpful

However, I found that no head line sometimes makes me wondering what those information actually means. i.e: I'd though it would be nicer if I could see the head line of ps command along with search results.

USER         PID %CPU %MEM    VSZ   RSS TTY      STAT START   TIME COMMAND
myoungj+     695  0.0  0.0  88596  7000 tty2     S+   09:17   0:00 -/usr/bin/fish -c /usr/bin/gnome-session -l 
myoungj+    2490  0.0  0.1 164660 10140 pts/1    Ss   09:21   0:00 -fish
.. snip ..

Quick Solution for single use

awk or sed could be useful in this category if you don't need any other feature from grep.

sh> ps aux | awk 'NR == 1 || /fish/ { print; }'

But I think grep is more powerful tool.

In bash, it looks straight forward for me.

bash> ps aux | { read line; echo "$line"; grep 'fish'; }

or using sub-shell.

bash> ps aux | ( read line; echo "$line"; grep 'fish'; )

or in fish shell (little longer)

fish> ps aux | begin read -l line; echo "$line"; grep 'fish'; end

Still, I think bash is better than fish in one-liner command.

More Serious Approach

But those one-liners are not very friendly. IMHO, all the programmes, at least, provide us of simple usage. So I decided to go little deeper.

Fish shell solution

The recent file is on my github: hgrep.fish

The basic options are below:

-h|help : help message and exit
-C|context : which is passed to as a 'grep option', Which is sometimes useful when we need the context literally.

#!/usr/bin/env fish

set -l PROG = 'hgrep.fish'
# ref: https://fishshell.com/docs/current/cmds/argparse.html#cmd-argparse
set -l options 'C/context=' 'h/help'

function usage -S -d "basic usage for $PROG"
    echo \
"Usage: $PROG [-C|--context context] <SEARCH> [<INPUT PATH>]"
end

# parse args here
argparse $options -- $argv

set -l argc (count $argv)
# note: processed arguments are removed from $argv
if test $argc -ne 1 -a $argc -ne 2
    usage
    exit 0
end

set -l search_string $argv[1] # first argument
set -l input_path /dev/stdin

if test $argc -gt 1
    # <INPUT PATH> is specified
    set input_path $argv[-1]
end

echo $input_path

set -l grep_options -i

if set -q _flag_context
    set --append grep_options '-C' $_flag_context
end

set --append grep_options $search_string

begin
    # print head first
    read -l line
    echo "$line"

    # let 'grep' do the rest
    exec grep $grep_options

end < $input_path

begin .. end < $input_path pattern is used before when I made fish-pandoc-any-to-markdown. So I found this version a bit easier than others.

Perl Solution

My perl solution was made very long time ago. I'm happy to see that it is still working. Basic routine is the same, except it has one more options. --nohead which is not neccessary. I think I just wanted to chceck the how the OptArgs is working at that time.

I realized today that the routine in fish shell is also applicable.

read one line from input and print to stdout

exec to grep with option

Nevertheless, I believed that it is worth to learn!

parsing options in perl

And thanks to OptArgs module, I could handle option handy and in a more structural approach. (However, I think this is little heavier than python's argparse.)

The recent file is on my github:
hgrep.pl

#!/usr/bin/env perl
# -*- Mode: cperl; cperl-indent-level:4; tab-width: 8; indent-tabs-mode: nil -*-
# -*- coding: utf-8 -*-
# vim: set tabstop=8 expandtab:

use strict; use warnings;
use feature qw(switch);
use OptArgs; # https://metacpan.org/dist/OptArgs/view/bin/optargs

my @grep_options = qw(-i);

for ( $ENV{'TERM'} ) {
    if ( $_ =~ /dumb/ ) { }
    default { push @grep_options, "--color=auto" }
}

# ref: https://metacpan.org/pod/OptArgs
## option parts ...
opt context =>
  ( isa => 'Num',
    alias => 'C',
    default => 3,
    comment => 'print NUM lines of output context' );

opt help =>
  ( isa => 'Bool',
    alias => 'h',
    comment => 'print a help message and exit',
    ishelp => 1 );

# argument parts ...
arg search =>
  ( isa => 'Str',
    required => 1,
    comment => 'string to search from file' );

arg file_name =>
  ( isa => 'Str',
    default => '-', # default input from stdin
    comment => 'the file which we search from' );

# parsing options via optargs function!
my $opts = optargs;

And now processing the parsed arguments and open a file (or stdin)

if ( defined $opts->{'context'} and $opts->{'context'} > 0 ) {
    push @grep_options, '-C', $opts->{'context'};
}
my $fh;

if ( $opts->{'file_name'} ne '-' ) {
    open my $fh, "<$opts->{file_name}",
        or die "Can't open `$opts->{file_name}'";
}
else {
    # http://perldoc.perl.org/functions/open.html
    open( $fh, "<&=",*STDIN );
}

if ( not $opts->{nohead} ) {
    my $head = <$fh>;
    # FIXME: colourising ....
    print "$head";
}

my $to_gh;

requirement for system programming

And when I try to go further, I found that I need little more system programming underneath, which shell normally does for me.

To communicate with grep function, we need to open a pipe via open function.

my $grep_pid = open( $to_gh, '|-' );
if ( not defined $grep_pid ) {
    die "Can't fork: $!";
}

|- means creating a pipe, and fork implicitly at the same time and now we have two processes, when the parent writing into new handle \$to_gh, the child will read from the stdin.

In terms of shell script, it looks like below at the moment.

sh>  parent_perl <some options ...> | child_perl

i.e. parent_perl and child_perl now communicate with piple(|) and the child_perl process will be replaced with grep process via exec.

There is a simple way to we are in the parent_perl process or child_perl process, which is checking the $grep_pid value.

if ( $grep_pid ) {
    # if grep_pid is not zero, this is parent_perl (parent process)
    # which handle both file handles.
    while ( <$fh> ) { print $to_gh $_; }

    close $_ for $to_gh, $fh;

    # parent process have to wait any children processes finsished.
    waitpid $grep_pid, 0;
}
else {
    # otherwise, this is child_perl (child process)
    close $fh; # not used in child process
    exec 'grep', @grep_options, $opts->{'search'};
}

exit 0;

and last exec 'grep' ... will replace its own perl process to grep process. no process could not be created without a
parent.

I found that it is worth trying to understand basic system programming in perl, However shell script will be much easier to handle it.

Python Solution (as a newbie)

How about python? I think the same logic could be applied in python as well. However, I didn't get chance to write down a python script yet. So, I didn't make any function and write it as simple as possible.

credit:

os pipe: https://www.tutorialspoint.com/python/os_pipe.htm
for loop: https://realpython.com/python-for-loop/
file i/o: https://www.w3schools.com/python/python_file_open.asp
optparse: https://docs.python.org/3/library/optparse.html
execvp: https://docs.python.org/3/library/os.html?highlight=popen#os.execvp
waitpid: https://docs.python.org/3/library/os.html#os.waitpid

I go through similar pattern as I did in perl you can find the recent file on my github: hgrep.py

#!/usr/bin/env python3

import os, sys
import argparse

# handle options first
parser = argparse.ArgumentParser()#prog="hgrep.py")
parser.add_argument( "-C", "--context",
                     nargs = 1,
                     type = int,
                     dest = "context",
                     required = False,
                     help="print NUM lines of output context" )

parser.add_argument( "search",
                     # upper case in the help message
                     metavar = "<SEARCH>",
                     help = "string to search from <file_path>" )

parser.add_argument( "file_path",
                     # upper case in the help message
                     metavar = "[<FILE PATH>]",
                     default = '-',
                     help = "<file_path> to search" )

# case insenstive search
grep_options = [ '-i' ]

# highligting
if os.environ['TERM'].lower != 'dumb':
    grep_options.append( "--color=auto" )

I found argparse module cannot handle optional positional argument. optional positional argument is natural in grep. So I'd like to keep that behaviour.

# argparse cannot handle optional argument
# WORKAROUND:
argv = sys.argv[1::]
if len(argv) == 0:
    print( "{prog}: No argument given".format(prog= sys.argv[0] ),
           file = sys.stderr )
    parser.print_help()
    exit( 1 )

if len(argv) == 1:
    # user ommit input file path
    # default : - (stdin)
    argv.append( '-' )

args = parser.parse_args( argv )

# check more grep options
if args.context is not None and args.context > 0:
    grep_options.extend( [ '-C', args.context ] )

grep_options.append( args.search )

I don't really know about python, but I guess I took the very low-level pipe() function in python.

# and let's go for plumbing
# file descriptors r,w for reading and writing
r, w = os.pipe()

if args.file_path == "-":
    # or from stdin
    file_to_read = sys.stdin
else:
    # or open file path to read
    if os.path.isfile( args.file_path ):
        file_to_read = open( args.file_path, "r" )
    else:


        print( "A file path:({fp}) is not readable"
               .format( fp=args.file_path )
               , file = sys.stderr )
        exit( 2 )

# read head first and print into stdout directly
print( file_to_read.readline() , file = sys.stdout, flush = True )

# fork() will create a child process
# and we can distinguish which one is parent process by checking
# return value
grep_pid = os.fork()

if grep_pid:
    # parent process

    # to communicate with to a child process
    # writing file descriptor will be used
    os.close(r)
    os.dup2( w, sys.stdout.fileno() )

    for line in file_to_read:
        print( line )

    # It is good practice to close all the file open
    os.close( w )

    # safely waiting for children processes
    os.waitpid( grep_pid,
                os.WNOHANG # if child process status not available: no wait
               )

else:
    # child process
    os.dup2( r, sys.stdin.fileno() )

    # child process only requires 'r' as stdin
    # and stdout so it is better to close r,w here.
    os.closerange( r, w )
    os.execvp( 'grep', grep_options )

exit(0)

Where I found difficulty

os.dup2 is essential to communicate with the grep in child process as grep only care about stdin here, but there is no way to inform the child that parent is going to newly open file descriptors (r,w). So we should kindly re-bind the new file descriptor to stdin. TBH, I spent too much time on this because lacks of my knowledge about system programming.

and os.waitpid requires os.WNOHANG option value, I thought it will be 0, which is actually not. so my programme was on hang after grep had finished its job.

Wrapping Up

pipe and shell's power

Even though it was good chance to learn about basic pipe usage, Shell script is very powerful for basic process communication between two processes.
perl's old open function's arguments are a little bit hacky.

parsing option is easier with modules

And also I tried to add option and test them.

fish's argparse is relatively new, but useful for my cases.
Perl's OptArgs has more features and handle optional argument as well
python's argparse has good type system for checking data type and is performant, however it doesn't support optional (positional) arguments. so I applied some workaround.

Suggestion after post

It would be nicer, if we have option for case sensitive option because I put case-insensitive for default.
After making fish-pandoc-any-to-markdown and hgrep, only I need a programme to pre-process and let the other application could handle rest of it. So it becomes more general programme like below:

sh> ps aux | head-with get-one-line --tail-with grep -i /fish/
    # or in fish-pandoc-any-to-markdown
sh> cat some.org | head-with retrieve-metadata --tail-with pandoc -t markdown > some.md

Well... but not for today. maybe after I get more chance to use the similar patterns!

Thank you for reading! and Happy coding!

Fish Shell Function

Myoungjin Jeon — Thu, 21 Apr 2022 11:03:13 +0000

My PATH has so duplicated paths

I was cleaning up my PATH environment value yesterday
and I found my path has so many duplicated paths inside.

My duplicated PATH env.

~> set -S PATH
$PATH: set in global scope, exported, a path variable with 27 elements
$PATH[1]: |/home/myoungjin/.local/share/go/bin|
$PATH[2]: |/home/myoungjin/.local/share/rakudo/share/perl6/site/bin|
$PATH[3]: |/home/myoungjin/.local/share/rakudo/bin|
$PATH[4]: |/home/myoungjin/.rakudo/install/share/perl6/site/bin|
$PATH[5]: |/home/myoungjin/.rakudo/install/bin|
$PATH[6]: |/home/myoungjin/.ghcup/bin|
$PATH[7]: |/home/myoungjin/.local/bin|
$PATH[8]: |/home/myoungjin/perl5/bin|
$PATH[9]: |/home/myoungjin/sbin|
$PATH[10]: |/home/myoungjin/bin|
$PATH[11]: |/home/myoungjin/perl5/bin|
$PATH[12]: |/home/myoungjin/bin|
$PATH[13]: |/home/myoungjin/.local/share/go/bin|
$PATH[14]: |/home/myoungjin/.local/share/rakudo/share/perl6/site/bin|
$PATH[15]: |/home/myoungjin/.local/share/rakudo/bin|
$PATH[16]: |/home/myoungjin/.rakudo/install/share/perl6/site/bin|
$PATH[17]: |/home/myoungjin/.rakudo/install/bin|
$PATH[18]: |/home/myoungjin/.ghcup/bin|
$PATH[19]: |/home/myoungjin/.local/bin|
$PATH[20]: |/home/myoungjin/perl5/bin|
$PATH[21]: |/home/myoungjin/sbin|
$PATH[22]: |/home/myoungjin/bin|
$PATH[23]: |/usr/local/bin|
$PATH[24]: |/usr/bin|
$PATH[25]: |/usr/bin/site_perl|
$PATH[26]: |/usr/bin/vendor_perl|
$PATH[27]: |/usr/bin/core_perl|

Starting making block of code (function)

So I found that when I added some new path for my apps in new PATH, I hadn't check its possibility of existence already in there.

There are millions of way to check. A famous way maybe done
by external programme.

function elem_ -d 'find first value is in the list of rest values'
    # note: fish index start from 1
    for p in $argv[2..-1]; echo $p; end | grep -q $argv[1]
end

But how about just using pure fish shell script by using basic
array that fish provides. so my first try was like:

function elem -d 'find first value is in the list of rest values'
    set found 0
    for arg in $argv[2..-1]
        if test $found -eq 0 && test $arg = $argv[1]
            set found 1
            break
        end
    end

    if test $found -eq 1
        true
    else
        false
    end
end


~> elem 1 1 2 3
~> echo $status
0

Add A function in your fish shell permanently

now you can make a file which has file path of
~/.config/fish/functions/elem.fish

so that you can use it whenever you want to use it.

Now, we did make how to check, we could make append_to_path or prepend_to_path function like this.

~/.config/functions/fish/append_to_path.fish

function append_to_path -d 'append given path into PATH environment variable with checking '
    if ! elem $argv[1] $PATH
        set -x --append PATH $argv[1]
    end
end

So, we can append a path safely now.

# middle of ~/.config/fish/config.fish
for p in ~/perl5/bin ~/.local/share/go/bin ~/.ghcup/bin \ 
        ~/.cabal/bin

    append_to_path $p
end

Thank you for reading!

If you would like to know more about fish function
please visit my blog post.

Combinations in Haskell

Myoungjin Jeon — Fri, 15 Apr 2022 11:06:42 +0000

LICENSE: Open Software License 3.0

There was war between my favourite languages ...

Not So Precise Benchmark

And I am too obsessed with How to make combinations in haskell.

Combinations in Haskell Series

Combinations In Haskell (called Tail After Tail)
Tail After Tail Story (Combinations In Haskell)

Same Theory; Different Implementation

In programming world, the pseudo code or theory will trigger your programming implementation in many ways. This kind of diversion makes programming interesting as well.

Previously I made TailAfterTail.lhs

And I found that inits or tails are not quite necessary if I don't rely on scanl or zipWith.

It is probably generally accepted that some different kind of implementation, which consist of even small amount of codes, but which run at very high frequency, will eventually show huge gaps in performance after many iterations of execution.

So, this is about what I found during implementation of Tail After Tail combinations.

Module Begins

Firstly, I going to write down the all function will be exposed.

{-# LANGUAGE BangPatterns #-}

module TailAfterTail
  ( combinationsWithScanl
  , combinationsWithSingleStep
  , combinations
  , combinationsWithTwoSteps
  , allCombinationsWithScanl
  , allCombinationsWithSingleStep
  , allCombinationsWithTwoSteps
  , allCombinations
  ) where

import Data.List (tails, inits, scanl') -- only required for **WithScanl

Original Version (scanl)

Please Find out more information HERE.

However, combinations1', flatten_allCombinationsGrouped and
genPart will be common helper functions.

combinations1' :: [a] -> [[[a]]]
combinations1' ms = [ [[m]] | m <- ms ]

flatten_allCombinationsGrouped allComboFunc = map concat . allComboFunc

genPart :: Foldable t => a -> t [[a]] -> [[a]]
genPart leader followerGroups = [ leader : followers
                                  | followers <- concat followerGroups ]

And I define some helper functions.

usefulTails :: [a] -> [[a]]
usefulTails = init . tails

genStep :: [[[a]]] -> [a] -> [[[a]]]
genStep prevTails members' =
  zipWith genPart members' (usefulTails prevTails')
  where
    prevTails' = tail prevTails -- head is not useful

membersTails = reverse . tail . inits -- tail is used to skip empty list.

and finally combinationsWithScanl family goes below.

allCombinationsWithScanl' :: [a] -> [[[[a]]]]
allCombinationsWithScanl' ms =
  scanl' genStep (combinations1' ms) (membersTails ms)

allCombinationsWithScanlGrouped :: [a] -> [[[a]]]
allCombinationsWithScanlGrouped =
  flatten_allCombinationsGrouped allCombinationsWithScanl'

allCombinationsWithScanl :: [a] -> [[a]]
allCombinationsWithScanl = concat . allCombinationsWithScanlGrouped

Pure Implementation Without Scanl (SingleStep)

The following code is created without scanl or zipWith.

It gains slightly more performance with (bang pattern: !).
Which will be covered may be in another article.
But IMHO, it helps to reduce laziness and use less stack.

unsafe_allCombinationsWithSingleStep :: [a] -> [[[[a]]]]
unsafe_allCombinationsWithSingleStep members =
  let
    helper ! cases = -- bang pattern added
      let
        genStep (m:ms) (_:cs:[]) = [ [ m : c | c <- cs ] ]
        genStep (m:ms) (_:cs) =
          -- note       ^ : we don't use first element
          genPart m cs : genStep ms cs
      in
         cases : helper (genStep members cases)
  in
    helper . combinations1' $ members

As you can see helper function is just an entry level wrapper function and make a recursion call.

genStep will actually create next cases and act as thunk which is evaluated later thanks to laziness in haskell.

I named the function as unsafe_ on purpose. Because helper function actually doesn't know when it will stop, and if you run unsafe_allCombinationsWithSingleStep in bare context will explode with exception.

sh> ghci
GHCi, version 8.10.7: https://www.haskell.org/ghc/  :? for help
Loaded GHCi configuration from /your/home/.config/ghc/ghci.conf
λ> :l 2022-04-15-Combinations-TailAfterTail'.lhs
[1 of 1] Compiling TailAfterTail    ( 2022-04-15-Combinations-TailAfterTail'.lhs, interpreted )
Ok, one module loaded.
λ> unsafe_allCombinationsWithSingleStep [1..5]
[[[[1]],[[2]],[[3]],[[4]],[[5]]],[[[1,2],[1,3],[1,4],[1,5]],[[2,3],[2,4],[2,5]],[[3,4],[3,5]],[[4,5]]],[[[1,2,3],[1,2,4],[1,2,5],[1,3,4],[1,3,5],[1,4,5]],[[2,3,4],[2,3,5],[2,4,5]],[[3,4,5]]],[[[1,2,3,4],[1,2,3,5],[1,2,4,5],[1,3,4,5]],[[2,3,4,5]]],[[[1,2,3,4,5]]],[[]*** Exception: 2022-04-15-Combinations-TailAfterTail'.lhs:(120,9)-(122,52): Non-exhaustive patterns in function genStep

unsafe_allCombinationsWithSingleStepGrouped flatten the result but yet grouped by selection size, this is still unsafe but combinationsWith will handle it.

unsafe_allCombinationsWithSingleStepGrouped :: [a] -> [[[a]]]
unsafe_allCombinationsWithSingleStepGrouped =
  flatten_allCombinationsGrouped unsafe_allCombinationsWithSingleStep

So now we could get all combinations by flatten a more time.

allCombinationsWithSingleStep :: [a] -> [[a]]
allCombinationsWithSingleStep members =
  concat
  --  this makes unsafe_* safe by limiting the size of list.
  . take (length members)
  . unsafe_allCombinationsWithSingleStepGrouped
  $ members

With Two Steps

This is another version of without scanl. the Main improvement is that
this function separates the jobs into two operations:

create first cases from the previous tails.
create rest of cases and start next next case based on the result.

allCombinationsWithTwoSteps' :: [a] -> [[[[a]]]]
allCombinationsWithTwoSteps'
  members@(fm:rms) = -- ^ fm : first member; rms: rest members
  let
    initFirstCase = [[fm]]
    initRestCases = combinations1' rms

    genFirstCases = genPart fm

    genRestCases _ [] = []
    genRestCases (m:ms) rcs@(_:rcs') = -- ^ rcs : rest of cases
      (genPart m $ rcs) : (genRestCases ms rcs')

It looks almost identical when comparing to SingleStep but
now helper function knows exactly where to start as newTail is
memorized at the moment. It only saves time to tail by pattern matching
in SingleStep but resuts are propagated when the choices are growing.

BTW, tail by pattern matching means (_:cs) in the following code.

        genStep (m:ms) (_:cs) =
          -- note       ^ : we don't use first element
          [ m : c | c <- concat cs ] : genStep ms cs

And let's wire them up with initial case and helper function

    helper [] = []
    helper ! prevTail =
      let
        newTail = genRestCases rms (tail prevTail)
      in
        ((genFirstCases prevTail) : newTail) : helper newTail
  in (initFirstCase : initRestCases) : helper initRestCases

the following steps are similar to the other implementation.

allCombinationsWithTwoStepsGrouped :: [a] -> [[[a]]]
allCombinationsWithTwoStepsGrouped =
  flatten_allCombinationsGrouped allCombinationsWithTwoSteps'

allCombinationsWithTwoSteps :: [a] -> [[a]]
allCombinationsWithTwoSteps members =
  concat . allCombinationsWithTwoStepsGrouped $ members

Another benefit of the TwoSteps implementation is that we can stop
easily because now newTail is always available and we could know whether
next step is available or not. I don't need to name it unsafe_ any more.

combinations variant from each implementation

Now, it's time to make select K out of given choice.

And I found that this is a common helper function:

combinationsWith

combinationsWith :: ([a] -> [[[a]]]) -> [a] -> Int -> Int -> [[a]]
combinationsWith allComboGroupedFunc ms n1@selectFrom n2@selectTo =
  let
    ( isFlipped, n1', n2' ) = -- smaller value first
      if n1 < n2 then ( False
                      , max n1 0
                      , max n2 0)
      else            ( True
                      , max n2 0
                      , max n1 0)
      -- and ensure all range value are zero or positive by using `max`
    rangeLength = n2' - n1' + 1
    reverseIfNeeded
      | isFlipped = reverse
      | otherwise = id

  in
    -- note: read from the bottom
    concat                      -- 4. final flattening
    . reverseIfNeeded           -- 3. if user put opposite way, reverse it.
    . take rangeLength          -- 2. takes only interested lists
    . drop (pred n1')           -- 1. ignore some
    $ allComboGroupedFunc ms

And all variant combinations* function available as below:

combinationsWithScanl      = combinationsWith allCombinationsWithScanlGrouped
combinationsWithSingleStep = combinationsWith unsafe_allCombinationsWithSingleStepGrouped
combinationsWithTwoSteps   = combinationsWith allCombinationsWithTwoStepsGrouped

Benchmark

you can find the benchmark code on my github repository.
To save your time, THIS
is one of my benchmark result.

Choose Default allCombinations and combinations

After benchmarking, I found AllcombinationsWithTwoSteps shows best result
in all categories(small, medium, large) among them.

allCombinations = allCombinationsWithTwoSteps
combinations = combinationsWithTwoSteps

Benchmark with Go

Myoungjin Jeon — Wed, 13 Apr 2022 04:27:05 +0000

Credit

This article is based on the Official Document

Go Built-in Benchmark and Test

As a modern development tool, go language is shipped with built-in benchmark tool(module)! And there are some rules to follow. let's find out.

File Name with surfix "_test.go"

go test -bench=. in the shell (or command) will find any files have the name ends with _test.go to recognize handle it as a test code. For example I'd like make a benchmark code about combinations, I need to make a file with combinations_test.go

sh> head -n 6 combinations_test.go
package main

import "testing"

/* my own module for go lang */
import jeongoon "github.com/jeongoon/go-combinations"

Package name as "main"

as it says:

package main

otherwise cannot find the module automatically by running go test

  sh> go test -bench=.
  can't load package: package .: found packages main (someCode.go) and in /your/path/to/code

Importing "testing" module

import "testing"

This is the package all we need. simple.

Any Function has prefix "Benchmark"

In your code, there might be some helper function which does not perform benchmark,
On the other hand, your benchmark code should start with Benchmark prefix.

func Benchmark_something(b *testing B) {
        // do your benchmark
}

And also note that the argument it will take is b *testing B.

please note that you don't need to put '_' between Benchmark and something.
you only need Benchmark prefix. That's only personal taste matters.

Issues

Go language has simple and easy rule to follow. however I found some issues about unreliable benchmark time elapsed.

WARNING
This is not proved but only my opinion. I hope this information will help you get more accurate result out of the benchmark in go language.

warming up code

when you are running and compare the performance between two similar functions do the same job. you might need to put some extra codes which wrap around your real benchmark code.

To test aFunc, you might need to put a warming up code before doing that.

func aFunc() {
        // some codes go here
}

func Benchmark_warmingup_aFunc() {
        someTimes := 10
        for j := 0; j < someTimes; j++ {
                aFunc()
        }
}

func Benchmark_actually_aFunc() {
        for j := 0; j < 10000; j++ {
                aFunc()
        }
}

Otherwise the results looks slower on the first run or vice versa.

code after another

I used the same function(aFunc) in the prior example, however when we are comparing other types of codes, we need another warming up code will be required to achieve the even effects as the prior code.

func aFunc() {
        // some codes go here
}

func bFunc() {
        // another implementation goes here
}

// .. snip ..

func Benchmark_actually_bFunc() {
        for j := 0; j < 10000; j++ {
                aFunc()
        }
}

// and warming up again
func Benchmark_warmingup_bFunc() {
        someTimes := 10
        for j := 0; j < someTimes; j++ {
                aFunc()
        }
}

func Benchmark_actually_bFunc() {
        for j := 0; j < 10000; j++ {
                aFunc()
        }
}

outro code for last test

And for some unknown reason, last benchmark does not seems to show correct measured time. Last one looked like finishing rashly. This is because maybe I have perception already. but if the last code block get affected by the position, we will need to re-arrange them to see the changes.

Or just put another outro code. And it will not harm if there was no effect depending on whether it is located on the last or not, either.

So, I tried to put another cFunc or just another aFunc after testing bFunc block.

func Benchmark_actually_bFunc() {
        for j := 0; j < 10000; j++ {
                bFunc()
        }
}
func Benchmark_byebye_aFunc() {
        for j := 0; j < 10; j++ {
                aFunc
        }

Again, I hope it will help you find the more trustful benchmark result out of go benchmark.

If you'd like to get an example of the benchmark code of mine,
please visit my combinations-bench repository.

Css Parallax Effect revised in 2022

Myoungjin Jeon — Tue, 22 Mar 2022 09:09:52 +0000

Credit Information

This article is highly based on Keith Clark's article.

Another article I found is from orangetable.com
which has simpler approach but also talked about another kind of caveat
found on Safarai and iOS.

My first css parallax example

I have some article about css parallax which is work in process.
and THIS is the first version of working Html+Css.

The Parallax Effects solely by CSS

It has been more than eight years since he posted about parallax effect by using css transformation. the Most of major web browser implements differently, so we need to embrace the caveats in the end.

However it still has technical merit if we could gain those effects even
without javascript. and so many websites have the basic parallax on their
home page..

So why don't you check out?

Css Transformation

the basic concepts are very well explained in

The Theory on Keith's article.

concisely, to get 3d transformation we need:

three elements with some attributes

base element and a perspective from where we see the object on the page. (which is generally not moving during transformation)
an anchor element(normally div) contains the elements which is actually transformed.
transformation origin (default is the center of the anchor (parent) element.

In another words -- in css:
(this is different from original article but using same magic)

.css-parallax-toplevel {
    perspective: 100px;
    height: 100vh;
    overflow-x: hidden;
    overflow-y: auto;
}

.css-parallax-group {
    /* we can have several parallax group but
     * we are going to use only one group here */
    position: relative;
    height: 500px; /* fallback for older browsers */
    height: 100vh;

    /* prevents the browser flattening the `css-parallax-group` elements */
    transform-style: preserve-3d;
}

.css-parallax-layer {
    /* common settings for an element under `css-parallax-group` */

    /* v fill the space of the container */
    top: 0; right: 0; bottom: 0; left: 0;
    position: relative;
}

/* about css selectors:
 * https://www.w3schools.com/cssref/css_selectors.asp
 */
.css-parallax-layer.as-background {
    /* v pull out from the content flow */
    position: absolute;
    transform: translateZ(-400px);
   -webkit-transform: translateZ(-400px);
}

.css-parallax-layer > *
, .css-parallax-layer.as-base {
    z-index: 1;
    /* prevents the browser flattening the `css-parallax-group` elements */
    transform-style: preserve-3d;
}

So if the elements are located in different depth (on Z-axis) and moving
relatively to the perspective will be transformed differently.
and which is literally real parallax.

and The Demo #1 is first one for you to understand how the tranformation works.

But Size Matters

As you can see the example above, we only care about moving speed, not transformed size, so Keith explain it as Depth correction.

So we need to scale up if it's below the display plane or vice versa.
He didn't mention about how the value of scale is calculated. (because it is maybe too simple?) and this is a poor explanation from me.

                      /‖    ⤒
                     / ‖
                    /  ‖
                  |/   ‖
                  |    ‖
                 /|⤒   ‖    n
                / |    ‖
               /  |m   ‖
              /   |    ‖
perspective) .____|⤓___‖   ⤓
                  |
                  |    ↑ real position
                  ↑ display plane

             ⇤ p⇥ ⇤ k ⇥


so we can see two triangles:

                    m                         n
  small :  tan θ = ---      large :  tan θ = ----
                    p                        p+k

   or

  p : (p+k) = m : n

and the scale amount we need is transforming from `m` to `n` (real size)
i.e)   `n / m` is the one.
           n     (p+k)
  scale = --- = ------
           m       p

so if we set p(perspective) as 1px and
 if k(negate of translateZ)  is 1px (negate of -1px)

          (1 + 1)
  scale = -------   = 2
             1

So we can control the parallax speed ( which is 1/scale ) with p and k !!

Trouble shootings

Height Calculation wrong!

If seeing the screen capture below, we will find that the scroll
had not stopped up to the where article ended and - even worth -
scrolling kept going beyond the background as well.

Wrong Scroll Position on Edge

but there is no problem on Firefox 97.0 (64-bit)

Why is this happening?
Explanation on Keith's article

However, In my case, the calculation is wrong vertically not horizontally, my similar solution is done by adding perspective-origin and transform-origin as below.

.css-parallax-toplevel {
    /* .. snip .. */
    /* v fix wrong calculation visual size(height) of background
     *   on webkit based browsers.
     */
    perspective-origin: center bottom;
    /* .. snip again .. */
}

.css-parallax-layer {
    /* .. snip .. */

    /* v fix wrong calculation visual size(height) of background
     *   on webkit based browsers.
     */
    transform-origin: center bottom; /* X-axis, Y-axis per each */
    /* .. snip again .. */
}

keep origin on X-axis center but bottom on Y-axis.

More caveat and bugs explained

Unfortunately I don't have any iOS products, MS Windows either.

maybe I should go Apple centre or JB hi-fi for checking those??

However, Keith mentioned about some trouble shooting on different web browsers.

please find more information Here.

Problem on Vivaldi (Work In Progress)

Blurred Text on Vivaldi

I haven't found working around yet.
But If you select the text, it shows correctly.
(so maybe using javascript to select individually? nah... I guess that a bug report is required.)

Problem on FF(Firefox) for mobile (Work In Progress)

Bottom Menu always revealed on FF Mobile

This bug prevents for user to see content at the bottom which is,
in my opinion, serious problem.
but there is no working around, I think bug report required.

Bug Reported:
https://bugzilla.mozilla.org/show_bug.cgi?id=1764498

Bug with `meta viewport ... initial-scale=1`

If you are seeing the site with Desktop Mode, there is no problem on Chrome.

However on Mobile Mode, it looks like below.
Brave mobile also does the same miscalculation.

Right hand side cropped on Chrome Mobile

Solution

remove any line like below

    <meta name="viewport" content="width=device-width, height=device-height, viewport-fit=contain, initial-scale=1">

and add your own text level. My testing values are shown below so far:

 /* increase the font size on portrait mode on mobile */
@media only screen and (pointer: coarse) and (orientation: portrait)
       and (max-width: 992px) {
    html, body {
        font-size: 3.5vw;
    }
}

/* but increase not too much on landscape mode on mobile */
@media only screen and (pointer: coarse)  and (orientation: landscape)
       and (max-width: 992px) {
    html, body {
        font-size: 2vw;
    }
}

Explanation

only screen is used to be ignored on older browsers
If screen size is equal or less than medium, scale the font-size as 3.5vw.
(which is maximum value for chrome on android so far)
but, on landscape mode -- viewport normally wider -- use less scaling: 2vw.
(pointer: coarse) is used to detect mobile device.
and please don't forget to use all the font size by using rem or em

Conclusion

quick wrapping up

pros: the effect is smoother than javascript version.
cons: hard to debug if something goes wrong. (typo, misunderstanding)

I found that this parallax effects is still useful for basic website. And as mobile device is getting faster and more features,
the effect techniques are also applicative on
mobile device as well.

However, I also found that if user made mistake on css or applying on html elements,
the user are unable to get information where the mistake is blocking the effects.
so IMHO, this is where widget or or even javascript helper function required.

Thank you for reading!

[Short Prog] Week Number Getter - Raku - Type Constraint

Myoungjin Jeon — Sun, 08 Aug 2021 11:39:00 +0000

my previous original programme to show week number of given date looks like

multi sub MAIN ( Int $year, Int $month, Int $day ) {
    say Date.new( :$year, :$month, :$day ).week-number();
}

If we don't use any data type in the parameter, you need to make sure all variables are suitable for the function. if there are many functions, it might be frustrating!!
It is safe to believe that type checking at "entrance" of a programme (which especially needs I/O or user input) is a great way to make the routines inside the function is easy to implement.
But wait... are year, month and day Integer exactly??

USING subset

raku provide a way to make your own type from existing one.

subset Natural of UInt  where 0 < *;

We just create a Natural number type from existing UInt (Unsigned Int)

Year is okay with just Natural type. but let's make others.

subset Month of Natural where * < 13;
subset Day of Natural   where * < 32;

Does it sound correct? some might say "day is depends on the Month value".
but which is sadly up to your routines inside the function or Library which you are using.

So now our new MAIN function looks like

multi sub MAIN ( Natural $year, Month $month, Day $day ) {
    say Date.new( :$year, :$month, :$day ).week-number();
}

and my full programme looks like

subset Natural of UInt  where 0 < *;
subset Month of Natural where * < 13;
subset Day of Natural   where * < 32;

sub cutoff-last-two-chars ( Str $i is rw        # warning: side effects
                            where $i.chars > 1 ) {

    my $last-two-chars := $i.substr-rw( *-2, * );
    my $ret = $last-two-chars;
    $last-two-chars = ""; # remove them from the string
    return $ret;
}

multi sub MAIN ( Natural \yyyymmdd ) {
    my $yyyymmdd = yyyymmdd;
    my UInt ( $year, $month, $day );
    $day   = (cutoff-last-two-chars $yyyymmdd).UInt;
    $month = (cutoff-last-two-chars $yyyymmdd).UInt;
    $year  = $yyyymmdd.UInt;

    samewith( $year, $month, $day );
}

multi sub MAIN ( Natural $year, Month $month, Day $day ) {
    say Date.new( :$year, :$month, :$day ).week-number();
}

One more thing : Don't be too strict

the way to get last two digit from user input has been slightly changed. but look at the signature:

sub cutoff-last-two-chars ( Str $i is rw        # warning: side effects
                            where $i.chars > 1 ) {
   ...

"$i.chars > 1" check the $i has two or more than 2 characters so that we can get expected result from a string. however this could be resulted in runtime exception:
let's check in Raku's REPL

> my $test = "804";
804
> cutoff-last-two-chars($test)
04
> cutoff-last-two-chars($test)
Constraint type check failed in binding to parameter '$i'; expected anonymous constraint to be met but got Str ("8")
  in sub cutoff-last-two-chars at <unknown file> line 1
  in block <unit> at <unknown file> line 1

>

you can see the errors which is unexpected because we only wanted to make the function perfect and safe but we also make our "programme itself" unsafe in the end.

You can check each variable before calling cutoff-last-two-chars to make the programme detect problem and finish it nicely. but.. this make programme only more complicated.
So there is another solution for this. As I mentioned before, check user input at the entrance of the programme.

multi sub MAIN ( Natural \yyyymmdd where yyyymmdd > 10100 ) {
    my $yyyymmdd = yyyymmdd;
    ...

and you can remove the constraint from the cutoff-last-two-digits function or keep. It depends on your decision. but IMHO in script language world, less constraints means more performance!
So, please don't be too strict!

That's all for today! 🤩

[Short Prog] Week Number Getter

Myoungjin Jeon — Thu, 05 Aug 2021 07:55:23 +0000

The one way to store my weekly documents in a directory or a weekly task in a spreadsheet is to store them into a separate directory (or a sheet) by weekly basis. and I used the week number because it has shorter name than using period notation like (08.02-08.08).
I scanned some invoices and name it in sort of "20210805.Chicken.pdf" then I move them into appropriate "week -number-ed" directory.
then I realised that there might be some automatic way to put them into matched weekly directory.

How to get week number in Raku

I'm a raku user. and I could make it a simple terminal interface programme like below.

#!/usr/bin/env raku
multi sub MAIN ( Int $year, Int $month, Int $day ) {
    say Date.new( :$year, :$month, :$day ).week-number();
}

> chmod u+x week-number.raku
> week-number.raku 2021 8 4
31

I think it's pretty straight forward if get used to some syntax.

If you want to use a single text like "20210804"
I could add one more multi sub for the MAIN()

sub cut-off-last-two-digits( @i ) returns Int {
    # warning: side effect
    ( @i.pop, @i.pop ).reverse.join.Int
}

multi sub MAIN ( Int \yyyymmdd ) {
    my @i = yyyymmdd.comb;

    my ( $year, $month, $day );

    $day   = cut-off-last-two-digits @i;
    $month = cut-off-last-two-digits @i;
    $year  = @i.join.Int;

    if (( $year, $month, $day )>>.defined).any == False {
        die "check your input: {yyyymmdd}";
    }
    samewith( $year, $month, $day );
}

multi sub MAIN ( Int $year, Int $month, Int $day ) {
    say Date.new( :$year, :$month, :$day ).week-number();
}

Perl5 Version

I searched the internet and I used DateTime module to implement.
but I guess DateTime is quite heavy module. because perl is normally very very fast but this programme isn't.

#!/usr/bin/env perl
use strict; use warnings;
use v5.26;
use DateTime;
use File::Basename;

our $PROG = $0;

my @parsed;
my ( $year, $month, $day );

use enum qw(F_YEAR F_MONTH F_DAY);

sub usage {
    print <<  'END_OF_USAGE';
$PROG <YYYYMMDD>
  OR
$PROG <YYYY> <MM> <DD>
END_OF_USAGE
}

if ( @ARGV == 1 ) {
    # parse as YYYYMMDD
    my $str = $ARGV[0];
    @parsed = $str =~ /^(\d+)(\d\d)(\d\d)$/;
} elsif ( @ARGV == 3 ) {
    @parsed = @ARGV;
} else {
    usage();
    exit 1;
}

( $year, $month, $day ) = @parsed[F_YEAR, F_MONTH, F_DAY];

my $dt = DateTime->new( year     => $year,
                       month    => $month,
                       day      => $day );

print $dt->week_number();

Haskell Version

I still hate some part of code and there is no proper way to handle errors but it is working fast. so I'm going to stick with this programme for a while.

> stack new week-number

app/Main.hs

module Main where

import System.Environment
import Lib

main :: IO ()
main = do
  args <- getArgs -- note: args :: [String]
  putStrLn (case args of
              yyyymmdd:[] ->
                weekNumberStringFromString yyyymmdd
              y:m:d:[] ->
                let y' = (read y :: Integer)
                    m' = (read m :: Int)
                    d' = (read d :: Int)
                in
                  weekNumberStringFromGregorian y' m' d'
              _ ->
                unlines
                [ "usage:"
                , "week-number: <yyyymmdd>"
                , "  or"
                , "week-number: <yyyy> <m> <d>" ] )

src/Lib.hs

module Lib
  ( weekNumberStringFromString
  , weekNumberStringFromGregorian
    ) where

import qualified Data.Time as DT

weekNumberStringFromString :: String -> String
weekNumberStringFromString yyyymmdd =
  let ut = DT.parseTimeOrError
           True DT.defaultTimeLocale "%Y%m%d" yyyymmdd  :: DT.UTCTime
  in
    DT.formatTime DT.defaultTimeLocale "%V" ut

weekNumberStringFromGregorian :: Integer -> Int -> Int -> String
weekNumberStringFromGregorian y m d =
  ( DT.formatTime DT.defaultTimeLocale "%V" ) $ DT.fromGregorian y m d

> stack build
> stack install
> week-number-exe 2021 8 4
31

so now I need to make some script go through the file
and get the date information from the file name and move them into
right place.

Okay. That's all today.

Weekly Challenge #088 Task #2 :: {Off The Challenge}

Myoungjin Jeon — Mon, 30 Nov 2020 04:58:18 +0000

I checked other's code after finishing my solutions, and I found that -- again -- many creative solution are waiting for me.

some solution shows that

read top of the matrix
cut top of the matrix
turning matrix count clock wise
until matrix exists go for another round.

This is simple and elegant solution I believe. and this is best solution in Raku. because Raku generally doesn't like many flow control and variables.

Here is the Code from juliodcs @ PWC

So I follow the step and make another solution for Haskell Task #2

import Data.List (groupBy, transpose, unfoldr)
import Data.Maybe (catMaybes)

{- tested with:
echo "[a b c d][e f g h][i j k l]" | runhaskell ch-2.hs
echo "[1 2 3][4 5 6][7 8 9]" | runhaskell ch-2.hs
echo "[a b][c d][e f]" | runhaskell ch-2.hs
-}

getMatrixFromStdin :: IO [[String]]
getMatrixFromStdin =
  ( map words
    . filter ((0/=).length)             -- 5. (after 3) there is some empty row
    . map (filter (`notElem` "[]"))     -- 4. '[', ']' is not used
    . lines                             -- 3. devide it into rows
    . unlines                           -- 2. make it "]\n"
    . groupBy (\_ b -> b/= ']') )       -- 1. devide row by "]"
  `fmap` getContents

cutTopAndRotateCCW :: [[String]] -> Maybe [[String]]
cutTopAndRotateCCW mat
  | length mat <= 1 = Nothing
  | otherwise = Just $ ( reverse . transpose . drop 1 ) mat

getSpiralAarray :: [[String]] -> [String]
getSpiralAarray mat =
  foldr1 (++)
  ( unfoldr (\m ->
                 case m of
                   Nothing -> Nothing
                   Just m' -> case (cutTopAndRotateCCW m') of
                               Nothing   -> Just (topOf m', Nothing)
                               Just  m'' -> Just (topOf m', Just m''))
      (Just mat) )
  where topOf m = head m

main = do
  getSpiralAarray `fmap` getMatrixFromStdin
  >>= print

This is elegant solution. but I'm just curious how fast in real world? this solution definitely interpreted faster than my previous solution because it is just simpler in length of code.

So I run 100 times for same matrix with each solution.

Firstly, I complied the code

> ghc -O2 ch-2.hs
> ghc -O2 ch-2a.hs

Secondly, I prepare the matrix by using Raku (100x100 matrix)

> my $fh = open "test.txt", :ra; my $a = 1; (^100).map( { $fh.say((^100).map( { $a++ } )) } ); close $fh;

Finally, compare them

original solution

time for i in (seq 1 100); cat haskell/test.txt | ./haskell/ch-2 > /dev/null; end

________________________________________________________
Executed in    2.97 secs   fish           external 
   usr time    2.71 secs   50.90 millis    2.66 secs 
   sys time    0.36 secs   76.69 millis    0.29 secs

new simple solution

time for i in (seq 1 100); cat haskell/test.txt | ./haskell/ch-2a > /dev/null; end

________________________________________________________
Executed in    6.41 secs   fish           external 
   usr time    6.06 secs   42.69 millis    6.02 secs 
   sys time    0.45 secs   75.69 millis    0.37 secs

But if the matrix is simpler, less difference expected.

Raku Has Different Story

This Link a solution from feng-chang @ PWC
and the speed is fascinating.

time cat ~/my.github/pwc-by-me/088/haskell/test.txt | raku spiral-test.feng-chang.raku > /dev/null

________________________________________________________
Executed in  620.94 millis    fish           external 
   usr time  845.44 millis    0.00 micros  845.44 millis 
   sys time   47.49 millis  1321.00 micros   46.17 millis

my solution is much slower than that. 😂

time cat ~/my.github/pwc-by-me/088/haskell/test.txt | raku ~/my.github/pwc-by-me/088/raku/ch-2.raku ^/dev/null > /dev/null
time cat 100x100.txt | raku ~/my.github/pwc-by-me/088/raku/ch-2.raku > /dev/null                                                       2116ms  Mon 30 Nov 2020 21:07:20
Input: (Ctrl-D or Ctrl-Z to finish to input.)

________________________________________________________
Executed in    2.04 secs   fish           external 
   usr time    2.58 secs  1042.00 micros    2.58 secs 
   sys time    0.08 secs  129.00 micros    0.08 secs

But frankly speaking, I'm not very satisfied with the result. Raku is still mystery for me. but it is worth to learn.
If looking at the history of the common-lisp, we can see well-designed language will survive eventually!!!

Thank you!! That's all for today.

Weekly Challenge #088 Task #2 :: (Perl, Raku and More)

Myoungjin Jeon — Sun, 29 Nov 2020 11:44:04 +0000

TASK #2 › Spiral Matrix

Submitted by: Mohammad S Anwar

You are given m x n matrix of positive integers.

Write a script to print spiral matrix as list.

Example 1:

Input:
    [ 1, 2, 3 ]
    [ 4, 5, 6 ]
    [ 7, 8, 9 ]
Ouput:
    [ 1, 2, 3, 6, 9, 8, 7, 4, 5 ]

Example 2:

Input:
    [  1,  2,  3,  4 ]
    [  5,  6,  7,  8 ]
    [  9, 10, 11, 12 ]
    [ 13, 14, 15, 16 ]
Output:
    [ 1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10 ]

Imperative approach (Perl, Golang, Common-lisp)

When I finished the common-lisp solution, I think this approach is better because there is no worry about side effect and no more manipulating data during the process.

To do get a spiral array from a matrix, we need to know how to read outside cells around the matrix.
Let's go as if there is no offset to get inside cells by going through spiral way.

North Segment

To be fair, nothing to say much of this one
because it is natural way to read a row(array)
this is a perl code.

push @spiralArray, @mat[0] # reading top(first) of the matrix

East Segment

also has natural way to read column, but the cell rightmost on the top of matrix is already read. so we need to skip the cell.
Firstly let's look into golang code because it is good language for imperative approach.

...
if num_rows > 1 {
    for r := 1; r <= row_end; r++ {
        sarr = append(sarr, mat[r][col_end])
    }
}
...

and common-lisp code might be

...
   (let ((east-side (loop for r from (1+ o) upto row-end
                           collect (aref mat r col-end))))
     (when (not (null east-side))
       (nconc sarray east-side)
...

Common-lisp has nice macro for loop, very impressive every time I discover something more.

But I applied some different method in Perl,

...
    push @spiral_array,
      map { $_->[$col_end] } @mat[ $o + 1 .. $row_end ];
...

Yeah... I know. it look weird. I'm obsessed with map in this period. but in Raku, we can write much better. below code is pseudo code but it seems alright.

 @spiral-array.append( @matrix[ 1 .. $row_end; $col_end] )

I think this is really really cool. handy and straightforward!!

South Segment

south one is little more different, because the cell in the right most at the bottom is already scanned before. we need to omit those again. and also we need to reverse the order of occurrence of the cells

...
    # south
    if ( $num_cols > 1 ) {
        push @spiral_array,
          @{$mat[$row_end]}  # bottom
            [ reverse 1 .. ($col_end -1) ]; # reverse order as well
...

West Segment

last one has shortest member due to other segment are greed so they all get what they could.

...
    # west
      if ( $num_rows > 2 ) {
          push @spiral_array,
            map { $_->[$o] } reverse @mat[ $o + 1 .. $row_end - 1 ];
      }
...

How to go inside Onion 🧅 (matrix)??

I applied offset variable which is grows every time we are done to read one layer of matrix and go inside the matrix. and numbers of rows and numbers of columns also reduced along with offset variable.

...
    for ( my $o = 0; $num_rows > 0 && $num_cols > 0; ++$o ) {
        my ($row_end, $col_end) = map { $o + $_ -1 } $num_rows, $num_cols;
    ... snip ...
       # go inner matrix
        $num_rows -= 2;
        $num_cols -= 2;
    }
...

And also we need to change the code to work with offset variable and num_rows and num_cols! so I leave the full code of the function called "getSpiralArrayFromMatrixRef()"

sub getSpiralArrayFromMatrixRef ($) {
    my @mat = @{$_[0]}; # copy

    my $num_rows = scalar @mat;
    my $num_cols = scalar @{$mat[0]};

    my @spiral_array;
    for ( my $o = 0; $num_rows > 0 && $num_cols > 0; ++$o ) {
        my ($row_end, $col_end) = map { $o + $_ -1 } $num_rows, $num_cols;

        # north
        push @spiral_array, @{$mat[$o]}[$o .. $col_end];
        # east
        if ( $num_rows > 1 ) {
            push @spiral_array,
              map { $_->[$col_end] } @mat[ $o + 1 .. $row_end ];
            # south
            if ( $num_cols > 1 ) {
                push @spiral_array,
                  @{$mat[$row_end]}[ reverse $o .. ($col_end -1) ];
                # west
                if ( $num_rows > 2 ) {
                    push @spiral_array,
                      map { $_->[$o] } reverse @mat[ $o + 1 .. $row_end - 1 ];
                }
            }
        }
        # go inner matrix
        $num_rows -= 2;
        $num_cols -= 2;
    }

    @spiral_array
}

A bit Functional Approach (Raku, Haskell)

In Raku, I made a function called peel-off which read outside of matrix in clockwise and return it with inner matrix

sub peel-off( @a ) {
    my ( $re, $ce ) = @a.end, @a[0].end;

    my @inside  = @a[ 1 .. $re.pred; 1 .. $ce.pred ] // Empty;
    @inside .= rotor($ce.pred).map(*.Array) if @inside; 
    my @outside = @a[ 0; * ];                           # outside of top

    for ( [ 1 .. $re;     $ce         ],                # outside of right
          [ $re;          $ce.pred,
                          $ce.pred.
                           pred ... 0 ],                # outside of bottom
          [ $re.pred,
            $re.pred.
             pred ... 1;   0         ]  )               # outside of left
    -> ( $rr, $cr ) {
        last unless all( $rr.elems.so, $cr.elems.so );  # out of range
        @outside.append: @a[$rr[*]; $cr[*]];
    }

    @inside, @outside
}

Raku works quite well with range in a matrix, so I use a for loop to iterate the row and column range for each segment. and basically this was my first solution. and I need to go inside by using repeat .. while loop

my ( $in, $out );
repeat {
    ( $in, $out ) = peel-off( @mat );
    @spiral.append: |$out;
    @mat = |$in;

} while ( @mat[0] andthen { .elems > 0} );

It works as I expected without many debugging.

In Haskell, I could use more higher order function called unfoldr

getSpiralAarray :: [[String]] -> [String]
getSpiralAarray mat =
  foldr1 (++)
  ( unfoldr (\m ->
                 case m of
                   Nothing -> Nothing
                   Just m' -> case (getInnerMatrix m') of
                                Left  _   -> Just (outOf m', Nothing)
                                Right m'' -> Just (outOf m', Just m''))
      (Just mat) )
  where outOf m = readAroundMatrixCW m

and I make a function for reading outside of matrix and another one for get inner matrix separately

getInnerMatrix :: [[String]] -> Either String [[String]]
getInnerMatrix m
  | length m <= 1 = Left "Too Short In Row"
  | otherwise = mapCutColumns [] getShorterInRows
    where
      mapCutColumns acc [] = Right acc
      mapCutColumns acc (r:rs) =
        case getShorterInCols r of
          Nothing -> Left "Too Short In Column"
          Just r' -> mapCutColumns (acc ++ [r']) rs
      getShorterInRows = (init.tail) m -- cut top and bottom
      getShorterInCols row =
        if (length row) <= 1 then Nothing
        else Just $ (init.tail) row

(init.tail) composition works like @a[1..$#a] in Perl
this code is not efficient probably, but I think it is easier to debug. Debugging in Haskell is not easy, IMHO. Especially it is not when debugging a pure function.

and To reading outside...

readAroundMatrixCW :: [[String]] -> [String]
readAroundMatrixCW [] = []
readAroundMatrixCW m =
  foldr1 (++) $
  getNorth
  : case findEast of
      Nothing -> []
      Just  e -> e
        : case findSouth of
            Nothing -> []
            Just  s -> s
              : case findWest of
                  Nothing -> []
                  Just  w -> [w]
  where
... snip ...

I skipped the where part for blog purpose. main different thing is that I need to specify the every return value in branch. and I'm still happy with that. This kind of practice helps a lot when creating a function in Perl as well.

Elm Solution

After noticing there is some chance to produce unnecessary data, I made another type of solution in Elm(basically function programming language). I confessed that it is hardest to debug. because it is not handy to access the element in the list in Elm. perhaps I need to zip the each row number or column number along with the data but I just use drop, take and "head" composition.
code below is for reading west segment in Elm.

...
        west  = {-if L.isEmpty south then []
                else-} -- already checked previously
                if nr <= 2 then []
                else mat
                    |> L.drop (o+1)
                    |> L.take (nr-2)
                    |> L.reverse
                    |> L.filterMap (L.drop o >> L.head)
...

But I really enjoyed the syntax |> because it makes more readable for most of programmer even if this is a functional programming language!!! we don't need to read from bottom to top anymore!!
>> is an composition operator (which is same as . in Haskell) but applying order is left from right as the arrow direction indicate. so << has the normal composition way as . does.

Okay. That's all for this week.
Please don't forget the visit~~!!
🐪PWC🦋

I'll have my holiday for challenge. I need to do something more important things in my life.
and I'll come back next year!!! 👋
say $_ for "Merry Christmas", "and", "Happy New Year!!";

$Myoungjin_JEON=@@=qw^rekcaH lreP rehtonA tsuJ^;$|++;{$i=$like=pop@@;unshift@@,$i;$~=18-length$i;print"\r[","~"x abs,(scalar reverse$i),"~"x($~-abs),"]"and select$good,$day,$mate,1/$~for 0..$~,-$~+1..-1;redo}

Weekly Challenge #087 Task #1 :: (Perl, Raku)

Myoungjin Jeon — Sun, 22 Nov 2020 10:56:59 +0000

TASK #1 › Longest Consecutive Sequence

Submitted by: Mohammad S Anwar

You are given an unsorted array of integers @N.

Write a script to find the longest consecutive sequence. Print 0 if none sequence found.

Example 1:

Input: @N = (100, 4, 50, 3, 2)
Output: (2, 3, 4)

Example 2:

Input: @N = (20, 30, 10, 40, 50)
Output: 0

Example 3:

Input: @N = (20, 19, 9, 11, 10)
Output: (9, 10, 11)

Perl Solution

Imperative Approach

I've done the same task with common lisp and golang, then I guess that I naturally follow the same logic I used in both language.

sort the number

compare between consecutive member in the list

concatenate the list if they are right next to each other

if not, start a new sequence

and I need to add handy dummy member at the tail of the list

here is the code.

use strict; use warnings;
use v5.26;

# note: no sanity check !!
my @sorted = sort { $a <=> $b } @ARGV;
push @sorted, $sorted[-1]+2; # dummy

my @longest_seq_list = ();
my $longest_size = 0;

my $prev = shift @sorted;
my @curr_seq = ($prev);

for my $curr (@sorted) {
    if ( $curr - $prev == 1 ) {
        push @curr_seq, ($curr);        # concat. current seq
    } elsif ( $curr == $prev ) {        # skip
    } else {                            # update longest
        my $curr_size = scalar @curr_seq;
        if ( $curr_size > $longest_size ) {
            $longest_size = $curr_size;
            @longest_seq_list = ( [ @curr_seq ] );
        } elsif ( $curr_size == $longest_size ) {
            push @longest_seq_list, [ @curr_seq ];
        }
        @curr_seq = ($curr);
    }
    $prev = $curr;
}

if ( $longest_size > 0 ) {
    say "longest size: ".$longest_size;
    say "total ".(scalar @longest_seq_list)." sequencies found.";
    for my $seq (@longest_seq_list) {
        say "[", join(", ", @$seq), "]";
    }
}

It is simple challenge, so I tried learn more about raku today.

Raku Solution

Sorting

Easy!, and we don't need to add 'sort( $^a <=> $^b )' because @n are all already IntStr instance.

unit sub MAIN (*@n where { @n ~~ Int, @n.elems > 0 } );
@n.sort.say

Produce

as we go through the list, we can produce the trace of our data.
the simple example of produce is that maximum value at each step.

> my @n = 3, 2, 4, 5, 9;
[3 2 4 5 9]
> @n.produce( -> \a, \b { max( a, b) } )
(3 3 4 5 9)

but I need some more information to keep at every step and decided to keep a list of numbers as we go.

> @n = -3, 1, 3, 2, -2, 4, 6, 7, -1, 4
> @n.sort.map({[$_]})
([-3] [-2] [-1] [1] [2] [3] [4] [4] [6] [7])

and if a and b is consecutive write down the linked numbers or start over new one.

...
(@n.sort.map({[$_]})).
produce( ->  \a, \b {
                 b.first - a.tail == 1
                 ?? a.append(b.first).clone
                 !! b.clone
           } ).say
...

and result looks like:

([-4] [-4 -3] [-4 -3 -2] [-4 -3 -2 -1] [1] [1 2] [1 2 3] [1 2 3 4] [6] [6 7])

Now classify the number by length and grep the element has maximum size and say!

...
classify( {.elems} ).
max.
value.
map( *.say );
...

Final Code

unit sub MAIN (*@n where { @n ~~ Int, @n.elems > 0 } );
(@n.sort.map({[$_]})).
produce( ->  \a, \b {
                 b.first - a.tail == 1
                 ?? a.append(b.first).clone
                 !! b.clone
           } ).
classify( {.elems} ).
max.
value.
map( *.say );

Happy Coding!!
I spent too much time on common-lisp and golang.
I'm so sorry to say that I'll skip blog about task #2.

May Perl and Raku be with you!!
🐪PWC🦋

Weekly Challenge #086 Task #2 :: (Raku)

Myoungjin Jeon — Fri, 13 Nov 2020 11:41:48 +0000

TASK #2 › Sudoku Puzzle

Submitted by: Mohammad S Anwar

You are given Sudoku puzzle (9x9).

Write a script to complete the puzzle and must respect the following rules:
a) Each row must have the numbers 1-9 occuring just once.
b) Each column must have the numbers 1-9 occuring just once.
c) The numbers 1-9 must occur just once in each of the 9 sub-boxes (3x3) of the grid.

Example:

[ _ _ _ 2 6 _ 7 _ 1 ]
[ 6 8 _ _ 7 _ _ 9 _ ]
[ 1 9 _ _ _ 4 5 _ _ ]
[ 8 2 _ 1 _ _ _ 4 _ ]
[ _ _ 4 6 _ 2 9 _ _ ]
[ _ 5 _ _ _ 3 _ 2 8 ]
[ _ _ 9 3 _ _ _ 7 4 ]
[ _ 4 _ _ 5 _ _ 3 6 ]
[ 7 _ 3 _ 1 8 _ _ _ ]

Output:

[ 4 3 5 2 6 9 7 8 1 ]
[ 6 8 2 5 7 1 4 9 3 ]
[ 1 9 7 8 3 4 5 6 2 ]
[ 8 2 6 1 9 5 3 4 7 ]
[ 3 7 4 6 8 2 9 1 5 ]
[ 9 5 1 7 4 3 6 2 8 ]
[ 5 1 9 3 2 6 8 7 4 ]
[ 2 4 8 9 5 7 1 3 6 ]
[ 7 6 3 4 1 8 2 5 9 ]

As the above puzzle respect the 3 rules including 9-sub-boxes as shown below:

[ 4 3 5 ] [ 2 6 9 ] [ 7 8 1 ]
[ 6 8 2 ] [ 5 7 1 ] [ 4 9 3 ]
[ 1 9 7 ] [ 8 3 4 ] [ 5 6 2 ]

[ 8 2 6 ] [ 1 9 5 ] [ 3 4 7 ]
[ 3 7 4 ] [ 6 8 2 ] [ 9 1 5 ]
[ 9 5 1 ] [ 7 4 3 ] [ 6 2 8 ]

[ 5 1 9 ] [ 3 2 6 ] [ 8 7 4 ]
[ 2 4 8 ] [ 9 5 7 ] [ 1 3 6 ]
[ 7 6 3 ] [ 4 1 8 ] [ 2 5 9 ]

What a interesting Task It is!!!

Well.. the method I used is simple as below

We'll check row by row ...

collect the numbers at which I can use each cell by removing numbers that already used (1) at the row, (2) at the same column, (3) in the same area

try one of those candidates but also remember any possible candidates.

as we go through the row, if failed go back to the cell at rightmost which has some candidates and choose another one and regenerate numbers on the right hand side

when succeed to fill up the all slots, go next rows.

If we failed, go above row again to see there are other choice.

Eh... Not very simple. is it? 😂 It is a basically brute-force solution.

Entry Point(check row by row)

A loop is used to check row by row (go up or down depends on success of fill up all slots)

...
    loop ( $r = 0; 0 <= $r < 9; ) {
        # note: $r can be increased or decreased
        if @rc[$r].defined {
            # already exists: we get here when lower case is failed
            # so try next case at $r
            ....
        }
        else {
            @rc[$r] = row-candidates.new( :$r,
                                          :base(@canvas.clone));
        }

        if my $snp = @rc[$r].snapshot { # possible so far
            @canvas[$r] = $snp;
            ++$r;                       # going next row
        }
        else {
            # there is no more alternative case for current row
            # go higher row and try next candidate if any
            @rc[$r] = Nil;
            @canvas = ( @rc[--$r] andthen .base
                                  orelse    Nil );  # when $r < 0
        }
    }
    if $r < 9 {
        say "Not Possible";
        exit 1;
    }

    say "all good:" if $d;
    .say for @canvas;

So when we are out of loop and $r is not last number (8)
we are unable to find the solution otherwise print out the solution

Filtering Numbers

To access area in 2 dimensional matrix, Raku provides very handy syntax 🥰

Simplest one is first, To check whole row at 0

> my @mat = <1 2 3>, <4 5 6>, <7 8 9>;
> @mat[0]
(1 2 3)

To get all elements at the column of 1 ...

> @mat[*;1]
(2 5 8)

To get all elements in the Area Grid(rule (c)) ...
if we name each grid like below

A B C
D E F
G H I

To get elements in "H", we are some range which is
row: 6 ~ 8, column : 3 ~ 6

# random example
> for ^9 { @mat[$_] = [ (1..9).pick(9) ] }
> @mat
> .say for @mat
[4 5 6 2 9 1 8 7 3]
[4 5 7 6 8 1 9 3 2]
[4 7 8 2 5 6 3 9 1]
[1 8 4 7 5 6 2 9 3]
[4 3 7 1 5 6 9 2 8]
[2 1 6 4 3 5 9 7 8]
[2 9 6 8 5 3 4 7 1]
[3 6 8 4 7 5 1 9 2]
[4 5 6 2 9 7 1 8 3]
> @mat[6..^9;3..^6]
(8 5 3 4 7 5 2 9 7)

But, please note that following is not working properly (this is the part I was struggling to debug 😱

> my $row-range = 6..^9;
6..^9
> my $col-range = 3..^6;
3..^6
> @mat[$row-range;$col-range]
(3) # ????

We have to do like below !!!

> @mat[$row-range[*];$col-range[*]]
(2 8 3 1 6 2 4 6 3)

Removing numbers

Set and SetHash used here. It was very handy

> (1..9) (-) (3,4,5)
Set(1 2 6 7 8 9)

But wait, I found another problem.

Unexpected Class: IntStr

When you get arguments from command line. or mix up the number and string in the list, Raku save values in integer value in IntStr class

> my @a = <1 2 3 4 5 6 _>
[1 2 3 4 5 6 _]
> @a.raku
[IntStr.new(1, "1"), IntStr.new(2, "2"), IntStr.new(3, "3"), IntStr.new(4, "4"), IntStr.new(5, "5"), IntStr.new(6, "6"), "_"]

This is why code below is not working !!! 👿

@a (-) (1,2,3)
Set(1 2 3 4 5 6 _)

So I had to fix by changing them in the same class. I used Str class here

> my @a = <1 2 3 4 5 6 _>>>.Str;
[1 2 3 4 5 6 _]
> @a.raku
["1", "2", "3", "4", "5", "6", "_"]
> @a (-) ('1'..'3')
Set(4 5 6 _)

Back to the Future

To record where I need to go back when met the road end, A hash used. the key is row number(index) in "Str", the value will be the possible candidates(SetHash) which looks like below(pseudo code)

> my $slots = { "a row number" => ('1'..'3').Set }
{a row number => Set(1 2 3)}

and used .grab to choose one of them randomly. (snipped code)

...
       with $!cnd andthen $!cnd.sort.tail { # cnd -> candidates
            # .key: column num; .value: candidates(SetHash)
            my $n = .value.grab(1);                     # grab a candidate
            my $i = $!slt.first(.key, :k);
...

grab() will reduce the the SetHash as well. it was handy for me.

Final Code

It is long long solution. so, I'll leave the full code here for anyone interested. I didn't want to use class at first because IMHO -- in most of case -- reviewers had hard time to see the flow of the code written in OOP. OOP is necessary. but sometimes it only makes us hard to read the code.
I was really longing for the Perl accepting one of popular modules like Moose, Mouse, Moo, .. etc, however, in about 10 years later, now I can see this is maybe why Perl didn't really adopt a modern way to making a class.
In short, OOP paradigm is not really for everyone (or every case).

However, I decided to use class in this solution. otherwise I need to use another kind of container related to "A" row information.

#!/usr/bin/env raku

# test with:
# raku ch-2.raku --debug=False  # otherwise it will show debug output as well.
# example is built-in this case for (maybe) easier review

# note: this is a non-recursive implementaion
#       entry point is localted in MAIN()

class row-candidates {
    has ( Hash $!cnd, Int $!r );        # candidates, row number
    has Set ( $!nar, @!nac, @!naa );    # N/A(na) number in (r)ow, (c)olumn
                                        # and (a)rea

    has Array ( $.base,                 # base  for all rows
                $!drf,                  # draft for current row only
                $!slt,                  # slots (where we need to fill up)
                $!cur, );               # current values in slots

    submethod BUILD (:$r, :$base where { 0 <= $r < 9 }) {
        $!r = $r;
        if $d {
            say "base matrix for row[$r]:";
            .say for $base.Array
        }

        $!base = $base.clone;           # copy whole matrix.
        my \ro = $!base[$!r]>>.Str;     # : orginally IntStr,
                                        # which makes Set or SetHash compare
                                        # with Set of Int
                                        # please also refer NOTE1.
                                        # IntStr is sometimes very annoying :(

        my $rgr = do given $!r div 3 { 3* $_ ..^ 3* $_.succ };  # rows in the
                                                                # same area

        # generate unavailable number for row, column*s* area*s*)
        $!nar = ro.Set;
        for ^9 { @!nac[$_] = $!base[*;$_]>>.Str.Set }
        for ^3 {
            my $rgc = (3* $_) ..^ (3* $_.succ);
            @!naa[$_] = $!base[$rgr[*];$rgc[*]]>>.Str.Set;      # [*] is must!!!
            #@!naa[$_].raku.say;
        }
        # copy draft from base
        $!drf = ro.clone.Array;
        $!slt = $!drf.grep({$_ eq '_'}, :k).Array;      # register slots as idx
        $!cur = (Nil xx $!slt).Array;                   # prepare spaces

        # and fill up the slots with available numbers for the first time
        self.fill-slots;
    }

    method fill-slots {
        # NOTE1 $!nar stored as .Str so (1..9) must be all .Str
        my $avn = (('1'..'9') ∖ $!nar).SetHash; # available numbers in row
        my $avn0 = $avn; # backup

        # find the the column number where we start to fill up
        # (where no current value is set at rightmost) or // zero
        loop ( my $si = ($!cur.first({.defined}, :end, :k) andthen .succ) // 0;
               $si < $!slt.elems; ) {
            my $c = $!slt[$si];
            my $an = $c div 3; # area number ( 0 | 1 | 2 )
            my $avn1 = ( [∖] $avn,              # (+) available numbers in row
                         $!cur.grep({.defined}),# (-) remove number used one
                         @!naa[$an],            # (-) numbers used in area
                         @!nac[$c],             # (-) numbers used in column
                       ).SetHash;
            if $d {
                say "[$!r;$c] si: $si, c: $c; area num: $an";
                say "[$!r:$c] avn: $avn, naa: @!naa[$an], nac: @!nac[$c]";
                say "[$!r;$c]:{self.snapshot(:force)}: "~
                "cur => {$!cur.map({.defined??$_!!'?'})} avn' => $avn1";
            }

            if $avn1.elems.so {
                my $n = $avn1.grab(1);          # note: returned as Seq
                $!cur[$si] = $n[0];             # -> so take first elem
                $!cnd{$c} = $avn1.clone         # update candidates
                          if $avn1.elems.so;
                $avn ∖=  $n;                    # reduce avaiable num
                ++$si;
            }
            else {
                my $i;
                if $!cnd andthen .elems.not     # no more candis: failed
                    or ( $i = self!forward_ )
                       !~~ any(Str,Int) {       # forward_ will return index
                                                # or Nil when failed to forward_
                    Nil.return;
                }

                $si = 1 + $i;
                # reset available numbers
                $avn = $avn0;
            }
        }
        if $d {
            say "[$!r] all filled up:";
            say self.snapshot;
            if $!cnd andthen .elems.so {
                say "... still have candiates: {$!cnd.raku}";
            }
            else {
                say "... but this is last case of row $!r";
            }
        }
        True # succeed to fill up
    }

    method snapshot (Bool :$force = False) {
        my $dup = $!drf.clone;
        if $force.not and
           $!cur.grep({.defined}).elems != $!slt.elems {
            Nil.return;
        }
        else {
            $dup[|$!slt] = $!cur.map({$_//'?'}).Array;
        }
        $dup
    }

    # forward_: try to set up next possible case
    method !forward_ {

        # find the slot has candidates at rightmost
        with $!cnd andthen .sort.tail {
            # .key: column num; .value: candidates(SetHash)
            my $n = .value.grab(1);                     # grab a candidate
            my $i = $!slt.first(.key, :k);
            my $o = $!cur[$i];
            $!cur[$i] = $n[0];                          # put into current value
            $!cur[$i.succ ..*] = Nil,Nil...*;           # undefine values
            $!cnd{.key}:delete if .value.elems.not;     # remove empty info
            say "[$!r;{.key}] change $o to $n"~
            " and rest candidatess: {$!cnd.raku}" if $d;

            $i.return                                   # return changed index
                                                        # in $!cur
        }
        Nil
    }

    method forward {
        self!forward_
        andthen {
            self.fill-slots.
            return  # repect the return value from fill-slots()
        }
        Nil
    }
}
our $d is export;

sub MAIN ( Bool :$debug = True ) {
    $d = $debug;
    my @s =
    #0 1 2 3 4 5 6 7 8
    <_ _ _ 2 6 _ 7 _ 1>,
    <6 8 _ _ 7 _ _ 9 _>,
    <1 9 _ _ _ 4 5 _ _>,
    <8 2 _ 1 _ _ _ 4 _>,
    <_ _ 4 6 _ 2 9 _ _>,
    <_ 5 _ _ _ 3 _ 2 8>,
    <_ _ 9 3 _ _ _ 7 4>,
    <_ 4 _ _ 5 _ _ 3 6>,
    <7 _ 3 _ 1 8 _ _ _>;

    my Int $r = 0;
    my @canvas = @s.Array;
    my @rc;

    #################
    ## entry point ##
    #################
    loop ( $r = 0; 0 <= $r < 9; ) {
        # note: $r can be increased or decreased
        if @rc[$r].defined {
            # already exists: we get here when lower case is failed
            # so try next case at $r
            @rc[$r].forward orelse {
                # go higher if failed
                @rc[$r] = Nil;  # remove all row candiates
                @canvas = (@rc[--$r] andthen .base.Array) // @s.Array;
                next;
            }
        }
        else {
            @rc[$r] = row-candidates.new( :$r,
                                          :base(@canvas.clone));
        }

        if my $snp = @rc[$r].snapshot { # possible so far
            @canvas[$r] = $snp;
            ++$r;                       # going next row
        }
        else {
            # there is no more alternative case for current row
            # go higher row and try next candidate if any
            @rc[$r] = Nil;
            @canvas = ( @rc[--$r] andthen .base
                                  orelse    Nil );  # when $r < 0
        }
    }
    if $r < 9 {
        say "Not Possible";
        exit 1;
    }

    say "all good:" if $d;
    .say for @canvas;
}

Summer is coming in Sydney, I'm getting busier. so maybe I am not able to blog or write more code in other languages as I did before. but I'll try my best !!

Thank you for reading ~~ !!!
Take care and Peace!
If you have a time, please visit at 🐪PWC🦋.

DEV Community: Myoungjin Jeon

Let's Fold a Tree

folding-tree?

Credit Update

How to use (test)

Module FoldTree

foldt

unionSort

pairs

foldt examples

sumOfMultiples

the origin of foldt - prime numbers

What we can do more?

Foot Notes

Grep with Head Line

No Head Line in grep search

Headline is helpful

Quick Solution for single use

More Serious Approach

Fish shell solution

Perl Solution

parsing options in perl

requirement for system programming

Python Solution (as a newbie)

credit:

Where I found difficulty

Wrapping Up

pipe and shell's power

parsing option is easier with modules

Suggestion after post

Fish Shell Function

My PATH has so duplicated paths

My duplicated PATH env.

Starting making block of code (function)

Add A function in your fish shell permanently

~/.config/functions/fish/append_to_path.fish

Combinations in Haskell

There was war between my favourite languages ...

Combinations in Haskell Series

Same Theory; Different Implementation

Module Begins

Original Version (scanl)

Pure Implementation Without Scanl (SingleStep)

With Two Steps

combinations variant from each implementation

combinationsWith

Benchmark

Choose Default allCombinations and combinations

Benchmark with Go

Credit

Go Built-in Benchmark and Test

File Name with surfix "_test.go"

Package name as "main"

Importing "testing" module

Any Function has prefix "Benchmark"

Issues

warming up code

code after another

outro code for last test

Css Parallax Effect revised in 2022

Credit Information

My first css parallax example

The Parallax Effects solely by CSS

Css Transformation

But Size Matters

Trouble shootings

Height Calculation wrong!

More caveat and bugs explained

Problem on Vivaldi (Work In Progress)

Problem on FF(Firefox) for mobile (Work In Progress)

Bug with meta viewport ... initial-scale=1

Solution

Explanation

Conclusion

[Short Prog] Week Number Getter - Raku - Type Constraint

USING subset

One more thing : Don't be too strict

[Short Prog] Week Number Getter

How to get week number in Raku

Perl5 Version

Bug with `meta viewport ... initial-scale=1`