import std.algorithm : map;
import std.bigint;
import std.range;
import std.stdio;

BigInt factorial(BigInt n) {
    if (n == 0) return BigInt(1);
    BigInt res = 1;
    while (n > 0) {
        res *= n--;
    }
    return res;
}

BigInt lah(BigInt n, BigInt k) {
    if (k == 1) return factorial(n);
    if (k == n) return BigInt(1);
    if (k > n) return BigInt(0);
    if (k < 1 || n < 1) return BigInt(0);
    return (factorial(n) * factorial(n - 1)) / (factorial(k) * factorial(k - 1)) / factorial(n - k);
}

auto max(R)(R r) if (isInputRange!R) {
    alias T = ElementType!R;
    T v = T.init;

    while (!r.empty) {
        if (v < r.front) {
            v = r.front;
        }
        r.popFront;
    }

    return v;
}

void main() {
    writeln("Unsigned Lah numbers: L(n, k):");
    write("n/k ");
    foreach (i; 0..13) {
        writef("%10d ", i);
    }
    writeln();
    foreach (row; 0..13) {
        writef("%-3d", row);
        foreach (i; 0..row+1) {
            auto l = lah(BigInt(row), BigInt(i));
            writef("%11d", l);
        }
        writeln();
    }
    writeln("\nMaximum value from the L(100, *) row:");
    auto lambda = (int a) => lah(BigInt(100), BigInt(a));
    writeln(iota(0, 100).map!lambda.max);
}


func fact(n) =>
    n is 0 ? 1 : (n^-1..<0).Fold(1, (acc, val) => acc * val)

func lah(n, k) {
    return fact(n) when k is 1
    return 1 when k == n
    return 0 when k > n || k < 1 || n < 1
    (fact(n) * fact(n - 1)) / (fact(k) * fact(k - 1)) / fact(n - k)
}

print("Unsigned Lah numbers: L(n, k):");
print("n/k ", terminator: "");
(0..12).ForEach(i => i >> "{0,10} ".Format >> print(terminator: ""))
print("")
(0..12).ForEach(row => {
    row >> "{0,-3}".Format >> print(terminator: "")
    (0..row).ForEach(i => lah(row, i) >> "{0,11}".Format >> print(terminator: ""))
    print("")
})


USING: combinators combinators.short-circuit formatting infix io
kernel locals math math.factorials math.ranges prettyprint
sequences ;
IN: rosetta-code.lah-numbers

! Yes, Factor can do infix arithmetic with local variables!
! This is a good use case for it.

INFIX:: (lah) ( n k -- m )
    ( factorial(n) * factorial(n-1) ) /
    ( factorial(k) * factorial(k-1) ) / factorial(n-k) ;

:: lah ( n k -- m )
    {
        { [ k 1 = ] [ n factorial ] }
        { [ k n = ] [ 1 ] }
        { [ k n > ] [ 0 ] }
        { [ k 1 < n 1 < or ] [ 0 ] }
        [ n k (lah) ]
    } cond ;

"Unsigned Lah numbers: n k lah:" print
"n\\k" write 13 dup [ "%11d" printf ] each-integer nl

<iota> [
    dup dup "%-2d " printf [0,b] [
        lah "%11d" printf
    ] with each nl
] each nl

"Maximum value from the 100 _ lah row:" print
100 [0,b] [ 100 swap lah ] map supremum .


function factorial( n as uinteger ) as ulongint
    if n = 0 then return 1
    return n*factorial(n-1)
end function

function s_Lah( n as uinteger, k as uinteger ) as ulongint
    if n = k then return 1
    if n = 0 orelse k = 0 then return 0
    if k = 1 then return factorial(n)
    return ((-1)^n)*(factorial(n)*factorial(n - 1))/(factorial(k)*factorial(k - 1))/factorial(n - k)
end function

function u_Lah( n as uinteger, k as uinteger ) as ulongint
    return abs(s_Lah(n,k))
end function

function padto( i as ubyte, j as integer ) as string
    return wspace(i-len(str(j)))+str(j)
end function

print "Unsiged Lah numbers"
print
dim as string outstr = "   k"
for k as integer =0 to 12
    outstr += padto(12, k)
next k
print outstr
print " n"
for n as integer = 0 to 12
    outstr = padto(2, n)+"  "
    for k as integer  = 0 to n
        outstr += padto(12, u_Lah(n, k))
    next k
    print outstr
next n


package main

import (
    "fmt"
    "math/big"
)

func main() {
    limit := 100
    last := 12
    unsigned := true
    l := make([][]*big.Int, limit+1)
    for n := 0; n <= limit; n++ {
        l[n] = make([]*big.Int, limit+1)
        for k := 0; k <= limit; k++ {
            l[n][k] = new(big.Int)
        }
        l[n][n].SetInt64(int64(1))
        if n != 1 {
            l[n][1].MulRange(int64(2), int64(n))
        }
    }
    var t big.Int
    for n := 1; n <= limit; n++ {
        for k := 1; k <= n; k++ {
            t.Mul(l[n][1], l[n-1][1])
            t.Quo(&t, l[k][1])
            t.Quo(&t, l[k-1][1])
            t.Quo(&t, l[n-k][1])
            l[n][k].Set(&t)
            if !unsigned && (n%2 == 1) {
                l[n][k].Neg(l[n][k])
            }
        }
    }
    fmt.Println("Unsigned Lah numbers: l(n, k):")
    fmt.Printf("n/k")
    for i := 0; i <= last; i++ {
        fmt.Printf("%10d ", i)
    }
    fmt.Printf("\n--")
    for i := 0; i <= last; i++ {
        fmt.Printf("-----------")
    }
    fmt.Println()
    for n := 0; n <= last; n++ {
        fmt.Printf("%2d ", n)
        for k := 0; k <= n; k++ {
            fmt.Printf("%10d ", l[n][k])
        }
        fmt.Println()
    }
    fmt.Println("\nMaximum value from the l(100, *) row:")
    max := new(big.Int).Set(l[limit][0])
    for k := 1; k <= limit; k++ {
        if l[limit][k].Cmp(max) > 0 {
            max.Set(l[limit][k])
        }
    }
    fmt.Println(max)
    fmt.Printf("which has %d digits.\n", len(max.String()))
}


import Text.Printf (printf)
import Control.Monad (when)

factorial :: Integral n => n -> n
factorial 0 = 1
factorial n = product [1..n]

lah :: Integral n => n -> n -> n
lah n k
  | k == 1 = factorial n
  | k == n = 1
  | k > n  = 0
  | k < 1 || n < 1 = 0
  | otherwise = f n `div` f k `div` factorial (n - k)
      where
        f = (*) =<< (^ 2) . factorial . pred

printLah :: (Word, Word) -> IO ()
printLah (n, k) = do
  when (k == 0) (printf "\n%3d" n)
  printf "%11d" (lah n k)

main :: IO ()
main = do
  printf "Unsigned Lah numbers: L(n, k):\nn/k"
  mapM_ (printf "%11d") zeroToTwelve
  mapM_ printLah $ (,) <$> zeroToTwelve <*> zeroToTwelve
  printf "\nMaximum value from the L(100, *) row:\n%d\n"
    (maximum $ lah 100 <$> ([0..100] :: [Integer]))
  where zeroToTwelve = [0..12]


NB. use:   k lah n
lah=: ! :(!&<: * %&!~)&x:  NB. `%~' is shorter than `*inv'

NB. wory_lah translates lah to algebraic English.
Monad =: :[:  NB. permit only a y argument
Dyad =: [: :  NB. require x and y arguments
but_1st =: &
decrement =: <: Monad

NB. ! means either factorial or combinations (just as - means negate or subtract)
factorial =: ! Monad
combinations =: ! Dyad

into =: *inv Dyad
times =: *  Dyad
extend_precision =: x: Monad
wordy_lah =: ((combinations but_1st decrement) times (into but_1st factorial))but_1st extend_precision Dyad


import java.math.BigInteger;
import java.util.HashMap;
import java.util.Map;

public class LahNumbers {

    public static void main(String[] args) {
        System.out.println("Show the unsigned Lah numbers up to n = 12:");
        for ( int n = 0 ; n <= 12 ; n++ ) {
            System.out.printf("%5s", n);
            for ( int k = 0 ; k <= n ; k++ ) {
                System.out.printf("%12s", lahNumber(n, k));
            }
            System.out.printf("%n");
        }

        System.out.println("Show the maximum value of L(100, k):");
        int n = 100;
        BigInteger max = BigInteger.ZERO;
        for ( int k = 0 ; k <= n ; k++ ) {
            max = max.max(lahNumber(n, k));
        }
        System.out.printf("%s", max);
    }

    private static Map<String,BigInteger> CACHE = new HashMap<>();

    private static BigInteger lahNumber(int n, int k) {
        String key = n + "," + k;
        if ( CACHE.containsKey(key) ) {
            return CACHE.get(key);
        }

        //  L(n,0) = 0;
        BigInteger result;
        if ( n == 0 && k == 0 ) {
            result = BigInteger.ONE;
        }
        else if ( k == 0 ) {
            result = BigInteger.ZERO;
        }
        else if ( k > n ) {
            result = BigInteger.ZERO;
        }
        else if ( n == 1 && k == 1 ) {
            result = BigInteger.ONE;
        }
        else {
            result = BigInteger.valueOf(n-1+k).multiply(lahNumber(n-1,k)).add(lahNumber(n-1,k-1));
        }

        CACHE.put(key, result);

        return result;
    }

}


## Generic functions

def factorial: reduce range(2;.+1) as $i (1; . * $i);

# nCk assuming n >= k
def binomial($n; $k):
  if $k > $n / 2 then binomial($n; $n-$k)
  else (reduce range($k+1; $n+1) as $i (1; . * $i)) as $numerator
  | reduce range(1;1+$n-$k) as $i ($numerator; . / $i)
  end;

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

def max(s): reduce s as $x (-infinite; if $x > . then $x else . end);

def lah($n; $k; $signed):
    if $n == $k then 1
    elif $n == 0 or $k == 0 or $k > $n then 0
    elif $k == 1 then $n|factorial
    else
       (binomial($n; $k) * binomial($n - 1; $k - 1) * (($n - $k)|factorial)) as $unsignedvalue
        | if $signed and ($n % 1 == 1)
          then -$unsignedvalue
          else $unsignedvalue
          end
    end;

def lah($n; $k): lah($n;$k;false);


using Combinatorics

function lah(n::Integer, k::Integer, signed=false)
    if n == 0 || k == 0 || k > n
        return zero(n)
    elseif n == k
        return one(n)
    elseif k == 1
        return factorial(n)
    else
        unsignedvalue = binomial(n, k) * binomial(n - 1, k - 1) * factorial(n - k)
        if signed && isodd(n)
            return -unsignedvalue
        else
            return unsignedvalue
        end
    end
end

function printlahtable(kmax)
    println("  ", mapreduce(i -> lpad(i, 12), *, 0:kmax))

    sstring(n, k) = begin i = lah(n, k); lpad(k > n && i == 0 ? "" : i, 12) end

    for n in 0:kmax
        println(rpad(n, 2) * mapreduce(k -> sstring(n, k), *, 0:kmax))
    end
end

printlahtable(12)

println("\nThe maxiumum of lah(100, _) is: ", maximum(k -> lah(BigInt(100), BigInt(k)), 1:100))


import java.math.BigInteger

fun factorial(n: BigInteger): BigInteger {
    if (n == BigInteger.ZERO) return BigInteger.ONE
    if (n == BigInteger.ONE) return BigInteger.ONE
    var prod = BigInteger.ONE
    var num = n
    while (num > BigInteger.ONE) {
        prod *= num
        num--
    }
    return prod
}

fun lah(n: BigInteger, k: BigInteger): BigInteger {
    if (k == BigInteger.ONE) return factorial(n)
    if (k == n) return BigInteger.ONE
    if (k > n) return BigInteger.ZERO
    if (k < BigInteger.ONE || n < BigInteger.ONE) return BigInteger.ZERO
    return (factorial(n) * factorial(n - BigInteger.ONE)) / (factorial(k) * factorial(k - BigInteger.ONE)) / factorial(n - k)
}

fun main() {
    println("Unsigned Lah numbers: L(n, k):")
    print("n/k ")
    for (i in 0..12) {
        print("%10d ".format(i))
    }
    println()
    for (row in 0..12) {
        print("%-3d".format(row))
        for (i in 0..row) {
            val l = lah(BigInteger.valueOf(row.toLong()), BigInteger.valueOf(i.toLong()))
            print("%11d".format(l))
        }
        println()
    }
    println("\nMaximum value from the L(100, *) row:")
    println((0..100).map { lah(BigInteger.valueOf(100.toLong()), BigInteger.valueOf(it.toLong())) }.max())
}


import math, strutils
import bignum

func lah[T: int | Int](n, k: T; signed = false): T =
  if n == 0 or k == 0 or k > n: return when T is int: 0 else: newInt(0)
  if n == k: return when T is int: 1 else: newInt(1)
  if k == 1: return fac(n)
  result = binom(n, k) * binom(n - 1, k - 1) * fac(n - k)
  if signed and (n and 1) != 0: result = -result

proc printLahTable(kmax: int) =
  stdout.write "  "
  for k in 0..kmax:
    stdout.write ($k).align(12)
  stdout.write('\n')
  for n in 0..kmax:
    stdout.write ($n).align(2)
    for k in 0..n:
      stdout.write ($lah(n, k)).align(12)
    stdout.write('\n')

printLahTable(12)

var maxval = newInt(0)
let n = newInt(100)
for k in newInt(0)..newInt(100):
  let val = lah(n, k)
  if val > maxval: maxval = val
echo "\nThe maximum value of lah(100, k) is ", maxval


use strict;
use warnings;
use feature 'say';
use ntheory qw(factorial);
use List::Util qw(max);

sub Lah {
    my($n, $k) = @_;
    return factorial($n) if $k == 1;
    return 1 if $k == $n;
    return 0 if $k > $n;
    return 0 if $k < 1 or $n < 1;
    (factorial($n) * factorial($n - 1)) / (factorial($k) * factorial($k - 1)) / factorial($n - $k)
}

my $upto = 12;
my $mx   = 1 + length max map { Lah(12,$_) } 0..$upto;

say 'Unsigned Lah numbers:  L(n, k):';
print 'n\k' . sprintf "%${mx}s"x(1+$upto)."\n", 0..1+$upto;

for my $row (0..$upto) {
    printf '%-3d', $row;
    map { printf "%${mx}d", Lah($row, $_) } 0..$row;
    print "\n";
}

say "\nMaximum value from the L(100, *) row:";
say max map { Lah(100,$_) } 0..100;


with javascript_semantics
include mpfr.e

constant lim = 100,
         lim1 = lim+1,
         last = 12
sequence l = repeat(0,lim1)
for n=1 to lim1 do
    l[n] = mpz_inits(lim1)
    mpz_set_si(l[n][n],1)
    if n!=2 then
        mpz_fac_ui(l[n][2],n-1)
    end if
end for
mpz {t, m100} = mpz_inits(2)
for n=1 to lim do
    for k=1 to n do
        mpz_mul(t,l[n+1][2],l[n][2])
        mpz_fdiv_q(t, t, l[k+1][2])
        mpz_fdiv_q(t, t, l[k][2])
        mpz_fdiv_q(l[n+1][k+1], t, l[n-k+1][2])
    end for
end for
printf(1,"Unsigned Lah numbers: l(n, k):\n n   k:")
for i=0 to last do
    printf(1,"%6d     ", i)
end for
printf(1,"\n---    %s\n",repeat('-',last*11+6))
for n=0 to last do
    printf(1,"%2d ", n)
    for k=1 to n+1 do
        printf(1,"%10s ",{mpz_get_str(l[n+1][k])})
    end for
    printf(1,"\n")
end for
for k=1 to lim1 do
    mpz l100k = l[lim1][k]
    if mpz_cmp(l100k,m100) > 0 then
        mpz_set(m100,l100k)
    end if
end for
printf(1,"\nThe maximum l(100,k): %s\n",shorten(mpz_get_str(m100)))


(de fact (N)
   (if (=0 N)
      1
      (* N (fact (dec N))) ) )
(de lah (N K)
   (cond
      ((=1 K) (fact N))
      ((= N K) 1)
      ((> K N) 0)
      ((or (> 1 N) (> 1 K)) 0)
      (T
         (/
            (* (fact N) (fact (dec N)))
            (* (fact K) (fact (dec K)))
            (fact (- N K)) ) ) ) )
(prin (align -12 "n/k"))
(apply tab (range 0 12) (need 13 -11))
(for A (range 0 12)
   (prin (align -2 A))
   (for B (range 0 A)
      (prin (align 11 (lah A B))) )
   (prinl) )
(prinl "Maximum value from the L(100, *) row:")
(maxi '((N) (lah 100 N)) (range 0 100))
(prinl @@)


% Reference: https://en.wikipedia.org/wiki/Lah_number#Identities_and_relations

:- dynamic unsigned_lah_number_cache/3.

unsigned_lah_number(N, N, 1):-!.
unsigned_lah_number(_, 0, 0):-!.
unsigned_lah_number(N, K, 0):-
	K > N,
	!.
unsigned_lah_number(N, K, L):-
	unsigned_lah_number_cache(N, K, L),
	!.
unsigned_lah_number(N, K, L):-
	N1 is N - 1,
	K1 is K - 1,
	unsigned_lah_number(N1, K, L1),
	unsigned_lah_number(N1, K1, L2),
	!,
	L is (N1 + K) * L1 + L2,
	assertz(unsigned_lah_number_cache(N, K, L)).

print_unsigned_lah_numbers(N):-
	between(1, N, K),
	unsigned_lah_number(N, K, L),
	writef('%11r', [L]),
	fail.
print_unsigned_lah_numbers(_):-
	nl.

print_unsigned_lah_numbers:-
	between(1, 12, N),
	print_unsigned_lah_numbers(N),
	fail.
print_unsigned_lah_numbers.

max_unsigned_lah_number(N, Max):-
    aggregate_all(max(L), (between(1, N, K), unsigned_lah_number(N, K, L)), Max).

main:-
	writeln('Unsigned Lah numbers up to L(12,12):'),
	print_unsigned_lah_numbers,
	writeln('Maximum value of L(n,k) where n = 100:'),
	max_unsigned_lah_number(100, M),
	writeln(M).


def factorial(n):
    if n == 0:
        return 1
    res = 1
    while n > 0:
        res *= n
        n -= 1
    return res

def lah(n,k):
    if k == 1:
        return factorial(n)
    if k == n:
        return 1
    if k > n:
        return 0
    if k < 1 or n < 1:
        return 0
    return (factorial(n) * factorial(n - 1)) / (factorial(k) * factorial(k - 1)) / factorial(n - k)

def main():
    print "Unsigned Lah numbers: L(n, k):"
    print "n/k ",
    for i in xrange(13):
        print "%11d" % i,
    print
    for row in xrange(13):
        print "%-4d" % row,
        for i in xrange(row + 1):
            l = lah(row, i)
            print "%11d" % l,
        print
    print "\nMaximum value from the L(100, *) row:"
    maxVal = max([lah(100, a) for a in xrange(100)])
    print maxVal

main()


  [ table ]                     is !        (   n --> n )
  1
  101 times
    [ dup ' ! put
      i^ 1+ * ]
  drop

  [ 2dup = iff [ 2drop 1 ] done
    2dup * 0 = iff * done
    dup 1 = iff [ drop ! ] done
    2dup - ! unrot
    dup !
    swap 1 - ! *
    swap dup !
    swap 1 - ! *
    swap /
    swap / ]                    is lah      (   n --> n )

  [ dip number$
    over size -
    space swap of
    swap join echo$ ]           is justify  ( n n -->   )

  [ table ]                     is colwidth (   n --> n )
  13 times
   [ 12 i^ lah number$
     size 2 + ' colwidth put ]

  say "  k| "
  13 times
    [ i^ dup colwidth justify ] cr
  say " n |"
  char - 115 of echo$ cr
  13 times
    [ i^ dup
      dup 2 justify say " | "
      1+ times
        [ dup i^ lah
          i^ colwidth justify ]
      drop cr ]
  cr
  0
  101 times
    [ 100 i^ lah
      2dup < iff nip else drop ]
  echo


Lah_numbers <- function(n, k, type = "unsigned") {

    if (n == k)
      return(1)

    if (n == 0 | k == 0)
      return(0)

    if (k == 1)
      return(factorial(n))

    if (k > n)
      return(NA)

    if (type == "unsigned")
      return((factorial(n) * factorial(n - 1)) / (factorial(k) * factorial(k - 1)) / factorial(n - k))

    if (type == "signed")
      return(-1 ** n * (factorial(n) * factorial(n - 1)) / (factorial(k) * factorial(k - 1)) / factorial(n - k))
  }

#demo
Table <- matrix(0 , 13, 13, dimnames = list(0:12, 0:12))

for (n in 0:12) {
  for (k in 0:12) {
    Table[n + 1, k + 1] <- Lah_numbers(n, k, type = "unsigned")
  }
}

Table


constant @factorial = 1, |[\*] 1..*;

sub Lah (Int \n, Int \k) {
    return @factorial[n] if k == 1;
    return 1 if k == n;
    return 0 if k > n;
    return 0 if k < 1 or n < 1;
    (@factorial[n] * @factorial[n - 1]) / (@factorial[k] * @factorial[k - 1]) / @factorial[n - k]
}

my $upto = 12;

my $mx = (1..$upto).map( { Lah($upto, $_) } ).max.chars;

put 'Unsigned Lah numbers:  L(n, k):';
put 'n\k', (0..$upto)».fmt: "%{$mx}d";

for 0..$upto -> $row {
    $row.fmt('%-3d').print;
    put (0..$row).map( { Lah($row, $_) } )».fmt: "%{$mx}d";
}

say "\nMaximum value from the L(100, *) row:";
say (^100).map( { Lah 100, $_ } ).max;


/*REXX pgm computes & display (unsigned) Stirling numbers of the 3rd kind (Lah numbers).*/
parse arg lim .                                  /*obtain optional argument from the CL.*/
if lim=='' | lim==","  then lim= 12              /*Not specified?  Then use the default.*/
olim= lim                                        /*save     the original value of  LIM. */
lim= abs(lim)                                    /*only use the absolute value of  LIM. */
numeric digits max(9, 4*lim)                     /*(over) specify maximum number in grid*/
max#.= 0
!.=.
@.=                                              /* [↓]  calculate values for the grid. */
        do   n=0  to  lim;   nm= n - 1
          do k=0  to  lim;   km= k - 1
          if k==1               then do;  @.n.k= !(n); call maxer; iterate;  end
          if k==n               then do;  @.n.k= 1   ;             iterate;  end
          if k>n | k==0 | n==0  then do;  @.n.k= 0   ;             iterate;  end
          @.n.k = (!(n) * !(nm)) % (!(k) * !(km)) % !(n-k)  /*calculate a # in the grid.*/
          call maxer                                        /*find    max #  "  "    "  */
          end   /*k*/
        end     /*n*/

        do k=0  for lim+1                        /*find max column width for each column*/
        max#.a= max#.a + length(max#.k)
        end   /*k*/
                                                 /* [↓]  only show the maximum value ?  */
w= length(max#.b)                                /*calculate max width of all numbers.  */
if olim<0  then do;  say 'The maximum value  (which has '      w      " decimal digits):"
                     say max#.b                  /*display maximum number in the grid.  */
                     exit                        /*stick a fork in it,  we're all done. */
                end                              /* [↑]  the 100th row is when LIM is 99*/
wi= max(3, length(lim+1) )                       /*the maximum width of the grid's index*/
say 'row'  center('columns', max(9, max#.a + lim), '═')    /*display header of the grid.*/

        do r=0  for lim+1;   $=                  /* [↓]  display the grid to the term.  */
          do c=0  for lim+1  until c>=r          /*build a row of grid, 1 col at a time.*/
          $= $  right(@.r.c, length(max#.c) )    /*append a column to a row of the grid.*/
          end   /*c*/
        say right(r,wi)  strip(substr($,2), 'T') /*display a single row of the grid.    */
        end     /*r*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!: parse arg z; if !.z\==. then return !.z; !=1; do f=2  to z; !=!*f; end; !.z=!; return !
maxer:   max#.k= max(max#.k, @.n.k);        max#.b= max(max#.b, @.n.k);           return


def fact(n) = n.zero? ? 1 :  1.upto(n).inject(&:*)

def lah(n, k)
  case k
    when 1 then fact(n)
    when n then 1
    when (..1),(n..) then 0
    else n<1 ? 0 : (fact(n)*fact(n-1)) / (fact(k)*fact(k-1)) / fact(n-k)
  end
end

r = (0..12)
puts "Unsigned Lah numbers: L(n, k):"
puts "n/k #{r.map{|n| "%11d" % n}.join}"

r.each do |row|
  print "%-4s" % row
  puts "#{(0..row).map{|col| "%11d" % lah(row,col)}.join}"
end

puts "\nMaximum value from the L(100, *) row:";
puts (1..100).map{|a| lah(100,a)}.max


; Compute the Unsigned Lah number L(n, k).
(define lah
  (lambda (n k)
    (/ (/ (* (fact n) (fact (1- n))) (* (fact k) (fact (1- k)))) (fact (- n k)))))

; Procedure to compute factorial.
(define fact
  (lambda (n)
    (if (<= n 0)
      1
      (* n (fact (1- n))))))

; Generate a table of the Unsigned Lah numbers L(n, k) up to L(12, 12).
(printf "The Unsigned Lah numbers L(n, k) up to L(12, 12):~%")
(printf "n\\k~10d" 1)
(do ((k 2 (1+ k)))
    ((> k 12))
  (printf " ~10d" k))
(newline)
(do ((n 1 (1+ n)))
    ((> n 12))
  (printf "~2d" n)
  (do ((k 1 (1+ k)))
      ((> k n))
    (printf " ~10d" (lah n k)))
  (newline))

; Find the maximum value of L(n, k) where n = 100.
(printf "~%The maximum value of L(n, k) where n = 100:~%")
(let ((max 0))
  (do ((k 1 (1+ k)))
      ((> k 100))
    (let ((val (lah 100 k)))
      (when (> val max) (set! max val))))
  (printf "~d~%" max))


func lah(n, k) {
    stirling3(n, k)
    #binomial(n-1, k-1) * n!/k!     # alternative formula
}

const r = (0..12)

var triangle = r.map {|n| 0..n -> map {|k| lah(n, k) } }
var widths   = r.map {|n| r.map {|k| (triangle[k][n] \\ 0).len }.max }

say ('n\k ', r.map {|n| "%*s" % (widths[n], n) }.join(' '))

r.each {|n|
    var str = ('%-3s ' % n)
    str += triangle[n].map_kv {|k,v| "%*s" % (widths[k], v) }.join(' ')
    say str
}

with (100) {|n|
    say "\nMaximum value from the L(#{n}, *) row:"
    say { lah(n, _) }.map(^n).max
}


import BigInt
import Foundation

@inlinable
public func factorial<T: BinaryInteger>(_ n: T) -> T {
  guard n != 0 else {
    return 1
  }

  return stride(from: n, to: 0, by: -1).reduce(1, *)
}

@inlinable
public func lah<T: BinaryInteger>(n: T, k: T) -> T {
  if k == 1 {
    return factorial(n)
  } else if k == n {
    return 1
  } else if k > n {
    return 0
  } else if k < 1 || n < 1 {
    return 0
  } else {
    let a = (factorial(n) * factorial(n - 1))
    let b = (factorial(k) * factorial(k - 1))
    let c = factorial(n - k)

    return a / b / c
  }
}

print("Unsigned Lah numbers: L(n, k):")
print("n\\k", terminator: "")

for i in 0...12 {
  print(String(format: "%10d", i), terminator: " ")
}

print()

for row in 0...12 {
  print(String(format: "%-2d", row), terminator: "")

  for i in 0...row {
    lah(n: BigInt(row), k: BigInt(i)).description.withCString {str in
      print(String(format: "%11s", str), terminator: "")
    }
  }

  print()
}

let maxLah = (0...100).map({ lah(n: BigInt(100), k: BigInt($0)) }).max()!

print("Maximum value from the L(100, *) row: \(maxLah)")


proc prod {from to} {
    set r 1
    if {$from <= $to} {
        set r $from
        while {[incr from] <= $to} {
            set r [expr {$r * $from}]
        }
    }
    return $r
}

proc US3 {n k} {
    if {$n < 0 || $k < 0} {
        error "US3(): negative arg ($n,$k)"
    }
    ## L(0,0) = 1
    ## L(n,0) = 0       if 0 < n
    ## L(0,k) = 0       if 0 < k
    ## L(n,k) = 0       if n < k
    ## L(n,n) = 1
    if {$n == $k} {
        return 1
    }
    if {$n == 0 || $k == 0} {
        return 0
    }
    if {$n < $k} {
        return 0
    }

    set nk [list $n $k]
    if {[info exists ::US3cache($nk)]} {
        return      $::US3cache($nk)
    }
    if {$k == 1} {
        ## L(n,1) = n!
        set r [prod 2 $n]
    } else {
        ## k > 1
        ## L(n,k) = L(n,k-1) * (n - (k-1)) / ((k-1)*k)
        set k1 [expr {$k - 1}]
        set r  [expr {([US3 $n $k1] * ($n - $k1)) / ($k * $k1)}]
    }
    set ::US3cache($nk) $r
}

proc main {} {
    puts "Unsigned Lah numbers L(n,k):"
    set max  12                 ;# last n,k to print
    set L    10                 ;# space to use for 1 number
    set minn  1                 ;# first row to print
    set mink  1                 ;# first column to print
    puts -nonewline "n\\k"
    for {set n $minn} {$n <= $max} {incr n} {
        puts -nonewline " [format %${L}d $n]"
    }
    puts ""
    for {set n $minn} {$n <= $max} {incr n} {
        puts -nonewline [format %3d $n]
        for {set k $mink} {$k <= $n} {incr k} {
            puts -nonewline " [format %${L}s [US3 $n $k]]"
        }
        puts ""
    }
    set n 100
    puts "The maximum value of L($n, k) = "
    set maxv  0
    set maxk -1
    for {set k 0} {$k <= $n} {incr k} {
        set v [US3 $n $k]
        if {$v > $maxv} {
            set maxv $v
            set maxk $k
        }
    }
    puts $maxv
    puts "([string length $maxv] digits, k=$maxk)"
}
main


' Lah numbers - VBScript - 04/02/2021

    Function F(i,n)
        Dim c: c=CCur(i): If n>Len(c) Then F=Space(n-Len(c))&c Else F=c
    End Function 'F

    Function Fact(ByVal n)
        Dim res
        If n=0 Then
            Fact = 1
        Else
            res = 1
            While n>0
                res = res*n
                n = n-1
            Wend
            Fact = res
        End If
    End Function 'Fact

    Function Lah(n, k)
        If k=1 Then
            Lah = Fact(n)
        ElseIf k=n Then
            Lah = 1
        ElseIf k>n Then
            Lah=0
        ElseIf k < 1 Or n < 1 Then
            Lah = 0
        Else
            Lah = (Fact(n) * Fact(n-1)) / (Fact(k) * Fact(k-1)) / Fact(n-k)
        End If
    End Function 'Lah

    Sub Main()
        ns=12: p=10
        WScript.Echo "Unsigned Lah numbers: Lah(n,k):"
        buf = "n/k "
        For k=1 To ns
           buf = buf & F(k,p) & " "
        Next 'k
        WScript.Echo buf
        For n=1 To ns
           buf = F(n,3) & " "
            For k=1 To n
                l = Lah(n,k)
                buf = buf & F(l,p) & " "
            Next 'k
            WScript.Echo buf
        Next 'n
    End Sub 'Main

    Main()


Imports System.Numerics

Module Module1

    Function Factorial(n As BigInteger) As BigInteger
        If n = 0 Then
            Return 1
        End If

        Dim res As BigInteger = 1
        While n > 0
            res *= n
            n -= 1
        End While
        Return res
    End Function

    Function Lah(n As BigInteger, k As BigInteger) As BigInteger
        If k = 1 Then
            Return Factorial(n)
        End If
        If k = n Then
            Return 1
        End If
        If k > n Then
            Return 0
        End If
        If k < 1 OrElse n < 1 Then
            Return 0
        End If
        Return (Factorial(n) * Factorial(n - 1)) / (Factorial(k) * Factorial(k - 1)) / Factorial(n - k)
    End Function

    Sub Main()
        Console.WriteLine("Unsigned Lah numbers: L(n, k):")
        Console.Write("n/k ")
        For Each i In Enumerable.Range(0, 13)
            Console.Write("{0,10} ", i)
        Next
        Console.WriteLine()

        For Each row In Enumerable.Range(0, 13)
            Console.Write("{0,-3}", row)
            For Each i In Enumerable.Range(0, row + 1)
                Dim l = Lah(row, i)
                Console.Write("{0,11}", l)
            Next
            Console.WriteLine()
        Next
        Console.WriteLine()

        Console.WriteLine("Maximum value from the L(100, *) row:")
        Dim maxVal = Enumerable.Range(0, 100).Select(Function(a) Lah(100, a)).Max
        Console.WriteLine(maxVal)
    End Sub

End Module


import math.big

fn main() {
    limit := 100
    last := 12
    unsigned := true
    mut l := [][]big.Integer{len: limit+1}
    for n := 0; n <= limit; n++ {
        l[n] = []big.Integer{len: limit+1}
        for k := 0; k <= limit; k++ {
            l[n][k] = big.zero_int
        }
        l[n][n]= big.integer_from_int(1)
        if n != 1 {
            l[n][1]= big.integer_from_int(n).factorial()
        }
    }
    mut t := big.zero_int
    for n := 1; n <= limit; n++ {
        for k := 1; k <= n; k++ {
            t = l[n][1] * l[n-1][1]
            t /= l[k][1]
            t /= l[k-1][1]
            t /= l[n-k][1]
            l[n][k] = t
            if !unsigned && (n%2 == 1) {
                l[n][k] = l[n][k].neg()
            }
        }
    }
    println("Unsigned Lah numbers: l(n, k):")
    print("n/k")
    for i := 0; i <= last; i++ {
        print("${i:10} ")
    }
    print("\n--")
    for i := 0; i <= last; i++ {
        print("-----------")
    }
    println('')
    for n := 0; n <= last; n++ {
        print("${n:2} ")
        for k := 0; k <= n; k++ {
            print("${l[n][k]:10} ")
        }
        println('')
    }
    println("\nMaximum value from the l(100, *) row:")
    mut max := l[limit][0]
    for k := 1; k <= limit; k++ {
        if l[limit][k] > max {
            max = l[limit][k]
        }
    }
    println(max)
    println("which has ${max.str().len} digits.")
}


import "/fmt" for Fmt

var fact = Fn.new  { |n|
    if (n < 2) return 1
    var fact = 1
    for (i in 2..n) fact = fact * i
    return fact
}

var lah = Fn.new { |n, k|
    if (k == 1) return fact.call(n)
    if (k == n) return 1
    if (k > n) return 0
    if (k < 1 || n < 1) return 0
    return (fact.call(n) * fact.call(n-1)) / (fact.call(k) * fact.call(k-1)) / fact.call(n-k)
}

System.print("Unsigned Lah numbers: l(n, k):")
System.write("n/k")
for (i in 0..12) System.write("%(Fmt.d(10, i)) ")
System.print("\n" + "-" * 145)
for (n in 0..12) {
    System.write("%(Fmt.d(2, n)) ")
    for (k in 0..n) System.write("%(Fmt.d(10, lah.call(n, k))) ")
    System.print()
}


uint64 factorial(uint8 n) {
  uint64 res = 1;
  if (n == 0) return res;
  while (n > 0) res *= n--;
  return res;
}

uint64 lah(uint8 n, uint8 k) {
  if (k == 1) return factorial(n);
  if (k == n) return 1;
  if (k > n)  return 0;
  if (k < 1 || n < 1) return 0;
  return (factorial(n) * factorial(n - 1)) / (factorial(k) * factorial(k - 1)) / factorial(n - k);
}

void main() {
  uint8 row, i;

  print("Unsigned Lah numbers: L(n, k):\n");
  print("n/k ");
  for (i = 0; i < 13; i++) {
   print("%10d ", i);
  }
  print("\n");
  for (row = 0; row < 13; row++) {
    print("%-3d", row);
    for (i = 0; i < row + 1; i++) {
      uint64 l = lah(row, i);
      print("%11lld", l);
    }
    print("\n");
  }
}


fcn lah(n,k,fact=fcn(n){ [1..n].reduce('*,1) }){
   if(n==k)	  return(1);
   if(k==1)	  return(fact(n));
   if(n<1 or k<1) return(0);
   (fact(n)*fact(n - 1)) /(fact(k)*fact(k - 1)) /fact(n - k)
}


F gen_kolakoski(s, n)
   [Int] seq
   V i = 0
   L seq.len < n
      V next = s[i % s.len]
      seq [+]= [next] * (I i >= seq.len {next} E seq[i])
      i++
   R seq[0 .< n]

F is_possible_kolakoski(s)
   [Int] r
   V i = 0
   L i < s.len
      V count = 1
      L(j) i + 1 .< s.len
         I s[j] != s[i]
            L.break
         count++
      r.append(count)
      i += count

   L(i) 0 .< r.len
      I r[i] != s[i]
         R 0B
   R 1B

L(s) [[1, 2],
      [2, 1],
      [1, 3, 1, 2],
      [1, 3, 2, 1]]
   V kol = gen_kolakoski(s, I s.len > 2 {30} E 20)
   print(‘Starting with: ’s":\nKolakoski sequence: "kol"\nPossibly kolakoski? "is_possible_kolakoski(kol))


kolakoski: function [a, length][
    result: array.of: length 0
    i: new 0
    k: new 0

    loop.forever a 'x [
        result\[i]: x
        if result\[k] > 1 [
            loop 1..dec result\[k] 'j [
                inc 'i
                if i = length -> return result
                result\[i]: result\[i-1]
            ]
        ]
        inc 'i
        if i = length -> return result
        inc 'k
    ]
    return result
]

possibleKolakoski?: function [seq][
    prev: seq\0
    count: new 1
    rle: new []

    loop 1..dec size seq 'i [
        if? seq\[i] = prev -> inc 'count
        else [
            'rle ++ count
            count: new 1
            prev: seq\[i]
        ]
    ]

    loop.with:'i rle 'val [
        if val <> seq\[i] -> return false
    ]
    return true
]

Seqs: [[1 2] [2 1] [1 3 1 2] [1 3 2 1]]
Lens: [20 20 30 30]

loop couple Seqs Lens 'c [
    generated: kolakoski c\0 c\1
    print ["First" c\1 "members of the sequence generated by" c\0 ":"]
    print generated
    print ["Possible Kolakoski sequence?" possibleKolakoski? generated]
    print ""
]


#include <stdio.h>
#include <stdlib.h>

#define TRUE 1
#define FALSE 0

typedef int bool;

int next_in_cycle(int *c, int len, int index) {
    return c[index % len];
}

void kolakoski(int *c, int *s, int clen, int slen) {
    int i = 0, j, k = 0;
    while (TRUE) {
        s[i] = next_in_cycle(c, clen, k);
        if (s[k] > 1) {
            for (j = 1; j < s[k]; ++j) {
                if (++i == slen) return;
                s[i] = s[i - 1];
            }
        }
        if (++i == slen) return;
        k++;
    }
}

bool possible_kolakoski(int *s, int len) {
    int i, j = 0, prev = s[0], count = 1;
    int *rle = calloc(len, sizeof(int));
    bool result = TRUE;
    for (i = 1; i < len; ++i) {
        if (s[i] == prev) {
            count++;
        }
        else {
            rle[j++] = count;
            count = 1;
            prev = s[i];
        }
    }
    /* no point adding final 'count' to rle as we're not going to compare it anyway */
    for (i = 0; i < j; i++) {
        if (rle[i] != s[i]) {
           result = FALSE;
           break;
        }
    }
    free(rle);
    return result;
}

void print_array(int *a, int len) {
    int i;
    printf("[");
    for (i = 0; i < len; ++i) {
       printf("%d", a[i]);
       if (i < len - 1) printf(", ");
    }
    printf("]");
}

int main() {
    int i, clen, slen, *s;
    int c0[2] = {1, 2};
    int c1[2] = {2, 1};
    int c2[4] = {1, 3, 1, 2};
    int c3[4] = {1, 3, 2, 1};
    int *cs[4] = {c0, c1, c2, c3};
    bool p;
    int clens[4] = {2, 2, 4, 4};
    int slens[4] = {20, 20, 30, 30};
    for (i = 0; i < 4; ++i) {
        clen = clens[i];
        slen = slens[i];
        s = calloc(slen, sizeof(int));
        kolakoski(cs[i], s, clen, slen);
        printf("First %d members of the sequence generated by ", slen);
        print_array(cs[i], clen);
        printf(":\n");
        print_array(s, slen);
        printf("\n");
        p = possible_kolakoski(s, slen);
        printf("Possible Kolakoski sequence? %s\n\n", p ? "True" : "False");
        free(s);
    }
    return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;

namespace KolakoskiSequence {
    class Crutch {
        public readonly int len;
        public int[] s;
        public int i;

        public Crutch(int len) {
            this.len = len;
            s = new int[len];
            i = 0;
        }

        public void Repeat(int count) {
            for (int j = 0; j < count; j++) {
                if (++i == len) return;
                s[i] = s[i - 1];
            }
        }
    }

    static class Extension {
        public static int NextInCycle(this int[] self, int index) {
            return self[index % self.Length];
        }

        public static int[] Kolakoski(this int[] self, int len) {
            Crutch c = new Crutch(len);

            int k = 0;
            while (c.i < len) {
                c.s[c.i] = self.NextInCycle(k);
                if (c.s[k] > 1) {
                    c.Repeat(c.s[k] - 1);
                }
                if (++c.i == len) return c.s;
                k++;
            }
            return c.s;
        }

        public static bool PossibleKolakoski(this int[] self) {
            int[] rle = new int[self.Length];
            int prev = self[0];
            int count = 1;
            int pos = 0;
            for (int i = 1; i < self.Length; i++) {
                if (self[i] == prev) {
                    count++;
                }
                else {
                    rle[pos++] = count;
                    count = 1;
                    prev = self[i];
                }
            }
            // no point adding final 'count' to rle as we're not going to compare it anyway
            for (int i = 0; i < pos; i++) {
                if (rle[i] != self[i]) {
                    return false;
                }
            }
            return true;
        }

        public static string AsString(this int[] self) {
            StringBuilder sb = new StringBuilder("[");
            int count = 0;
            foreach (var item in self) {
                if (count > 0) {
                    sb.Append(", ");
                }
                sb.Append(item);
                count++;
            }
            return sb.Append("]").ToString();
        }
    }

    class Program {
        static void Main(string[] args) {
            int[][] ias = {
                new int[]{1, 2},
                new int[]{2, 1},
                new int[]{1, 3, 1, 2},
                new int[]{1, 3, 2, 1}
            };
            int[] lens = { 20, 20, 30, 30 };

            for (int i = 0; i < ias.Length; i++) {
                int len = lens[i];
                int[] kol = ias[i].Kolakoski(len);

                Console.WriteLine("First {0} members of the sequence by {1}: ", len, ias[i].AsString());
                Console.WriteLine(kol.AsString());
                Console.WriteLine("Possible Kolakoski sequence? {0}", kol.PossibleKolakoski());
                Console.WriteLine();
            }
        }
    }
}


#include <iostream>
#include <vector>

using Sequence = std::vector<int>;

std::ostream& operator<<(std::ostream& os, const Sequence& v) {
  os << "[ ";
  for (const auto& e : v) {
    std::cout << e << ", ";
  }
  os << "]";
  return os;
}

int next_in_cycle(const Sequence& s, size_t i) {
  return s[i % s.size()];
}

Sequence gen_kolakoski(const Sequence& s, int n) {
  Sequence seq;
  for (size_t i = 0; seq.size() < n; ++i) {
    const int next = next_in_cycle(s, i);
    Sequence nv(i >= seq.size() ? next : seq[i], next);
    seq.insert(std::end(seq), std::begin(nv), std::end(nv));
  }
  return { std::begin(seq), std::begin(seq) + n };
}

bool is_possible_kolakoski(const Sequence& s) {
  Sequence r;
  for (size_t i = 0; i < s.size();) {
    int count = 1;
    for (size_t j = i + 1; j < s.size(); ++j) {
      if (s[j] != s[i]) break;
      ++count;
    }
    r.push_back(count);
    i += count;
  }
  for (size_t i = 0; i < r.size(); ++i) if (r[i] != s[i]) return false;
  return true;
}

int main() {
  std::vector<Sequence> seqs = {
    { 1, 2 },
    { 2, 1 },
    { 1, 3, 1, 2 },
    { 1, 3, 2, 1 }
  };
  for (const auto& s : seqs) {
    auto kol = gen_kolakoski(s, s.size() > 2 ? 30 : 20);
    std::cout << "Starting with: " << s << ": " << std::endl << "Kolakoski sequence: "
      << kol << std::endl << "Possibly kolakoski? " << is_possible_kolakoski(kol) << std::endl;
  }
  return 0;
}


import std.stdio;

void repeat(int count, void delegate(int) action) {
    for (int i=0; i<count; i++) {
        action(i);
    }
}

T nextInCycle(T)(T[] self, int index) {
    return self[index % self.length];
}

T[] kolakoski(T)(T[] self, int len) {
    T[] s;
    s.length = len;
    int i;
    int k;
    while (i<len) {
        s[i] = self.nextInCycle(k);
        if (s[k] > 1) {
            repeat(s[k] - 1,
                (int j) {
                    if (++i == len) return;
                    s[i] = s[i-1];
                }
            );
        }
        if (++i == len) return s;
        k++;
    }
    return s;
}

bool possibleKolakoski(T)(T[] self) {
    auto len = self.length;
    T[] rle;
    auto prev = self[0];
    int count = 1;
    foreach (i; 1..len) {
        if (self[i] == prev) {
            count++;
        } else {
            rle ~= count;
            count = 1;
            prev = self[i];
        }
    }
    // no point adding final 'count' to rle as we're not going to compare it anyway
    foreach (i; 0..rle.length) {
        if (rle[i] != self[i]) {
            return false;
        }
    }
    return true;
}

void main() {
    auto ias = [[1,2],[2,1],[1,3,1,2],[1,3,2,1]];
    auto lens = [20,20,30,30];

    foreach (i,ia; ias) {
        auto len = lens[i];
        auto kol = ia.kolakoski(len);
        writeln("First ", len, " members of the sequence generated by ", ia, ":");
        writeln(kol);
        write("Possible Kolakoski sequence? ");
        if (kol.possibleKolakoski) {
            writeln("Yes");
        } else {
            writeln("no");
        }
        writeln;
    }
}


package main

import "fmt"

func nextInCycle(c []int, index int) int {
    return c[index % len(c)]
}

func kolakoski(c []int, slen int) []int {
    s := make([]int, slen)
    i, k := 0, 0
    for {
        s[i] = nextInCycle(c, k)
        if s[k] > 1 {
            for j := 1; j < s[k]; j++ {
                i++
                if i == slen {
                    return s
                }
                s[i] = s[i - 1]
            }
        }
        i++
        if i == slen {
            return s
        }
        k++
    }
}

func possibleKolakoski(s []int) bool {
    slen := len(s)
    rle := make([]int, 0, slen)
    prev := s[0]
    count := 1
    for i := 1; i < slen; i++ {
        if s[i] == prev {
            count++
        } else {
            rle = append(rle, count)
            count = 1
            prev = s[i]
        }
    }
    // no point adding final 'count' to rle as we're not going to compare it anyway
    for i := 0; i < len(rle); i++ {
        if rle[i] != s[i] {
            return false
        }
    }
    return true
}

func printInts(ia []int, suffix string) {
    fmt.Print("[")
    alen := len(ia)
    for i := 0; i < alen; i++ {
        fmt.Print(ia[i])
        if i < alen - 1 {
            fmt.Print(", ")
        }
    }
    fmt.Printf("]%s\n", suffix)
}

func main() {
    ias := make([][]int, 4)
    ias[0] = []int{1, 2}
    ias[1] = []int{2, 1}
    ias[2] = []int{1, 3, 1, 2}
    ias[3] = []int{1, 3, 2, 1}
    slens := []int{20, 20, 30, 30}
    for i, ia := range ias {
        slen := slens[i]
        kol := kolakoski(ia, slen)
        fmt.Printf("First %d members of the sequence generated by ", slen)
        printInts(ia, ":")
        printInts(kol, "")
        p := possibleKolakoski(kol)
        poss := "Yes"
        if !p {
            poss = "No"
        }
        fmt.Println("Possible Kolakoski sequence?", poss, "\n")
    }
}


V a1 = [[1, 2], [3, 4]]
V b1 = [[0, 5], [6, 7]]

V a2 = [[0, 1, 0], [1, 1, 1], [0, 1, 0]]
V b2 = [[1, 1, 1, 1], [1, 0, 0, 1], [1, 1, 1, 1]]

F kronecker(matrix1, matrix2)
   [[Int]] final_list
   [Int] sub_list
   V count = matrix2.len

   L(elem1) matrix1
      V counter = 0
      V check = 0
      L check < count
         L(num1) elem1
            L(num2) matrix2[counter]
               sub_list.append(num1 * num2)
         counter++
         final_list.append(sub_list)
         sub_list.drop()
         check++

   R final_list

V result1 = kronecker(a1, b1)
L(elem) result1
   print(elem)

print(‘’)

V result2 = kronecker(a2, b2)
L(elem) result2
   print(elem)


import Data.List (group)
import Control.Monad (forM_)

replicateAtLeastOne :: Int -> a -> [a]
replicateAtLeastOne n x = x : replicate (n-1) x

zipWithLazy :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWithLazy f ~(x:xs) ~(y:ys) = f x y : zipWithLazy f xs ys

kolakoski :: [Int] -> [Int]
kolakoski items = s
  where s = concat $ zipWithLazy replicateAtLeastOne s $ cycle items

rle :: Eq a => [a] -> [Int]
rle = map length . group

sameAsRleUpTo :: Int -> [Int] -> Bool
sameAsRleUpTo n s = r == take (length r) prefix
  where prefix = take n s
        r = init $ rle prefix

main :: IO ()
main = forM_ [([1, 2], 20),
              ([2, 1], 20),
              ([1, 3, 1, 2], 30),
              ([1, 3, 2, 1], 30)]
        $ \(items, n) -> do
          putStrLn $ "First " ++ show n ++ " members of the sequence generated by " ++ show items ++ ":"
          let s = kolakoski items
          print $ take n s
          putStrLn $ "Possible Kolakoski sequence? " ++ show (sameAsRleUpTo n s)
          putStrLn ""


NB. cyclic

create_cycle_=: 3 :0
 I=: 0
 A=: y
 N=: # A
)

next_cycle_=: 3 :0
 r=. A {~ N | I
 I=: >: I
 r
)

NB. kolakoski

kolakoski =: 30&$: :(dyad define) NB. TERMS kolakoski ALPHABET
 c=. y conew'cycle'
 s=. i. 0
 term=. 0
 while. x > # s do.
  s=. (, ([: #~ next__c)`(term&{ # next__c)@.(term < #)) s
  term=. >: term
 end.
 s
)

test=: (({.~ #) -: ]) }:@:(#;.1~ (1 , 2&(~:/\)))


*        Kronecker product         06/04/2017
KRONECK  CSECT
         USING  KRONECK,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R1,1               first example
         BAL    R14,PRODUCT        call product(a1,b1)
         BAL    R14,PRINT          call print(r)
         XPRNT  =C'---',3          separator
         LA     R1,2               second example
         BAL    R14,PRODUCT        call product(a2,b2)
         BAL    R14,PRINT          call print(r)
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
*------- ----   ----------------------------------------
PRODUCT  EQU    *                  product(o)
         STC    R1,OO              store o
       IF CLI,OO,EQ,X'01' THEN     if o=1 then
         MVC    MM(8),DIM1           (m,n)=hbound(a1) (p,q)=hbound(b1)
         LA     R1,A1                @a1
         LA     R2,B1                @b1
       ELSE     ,                  else
         MVC    MM(8),DIM2           (m,n)=hbound(a2) (p,q)=hbound(b2)
         LA     R1,A2                @a2
         LA     R2,B2                @b2
       ENDIF    ,                  endif
         ST     R1,ADDRA           [email protected]
         ST     R2,ADDRB           [email protected]
         LH     R1,MM              m
         MH     R1,PP              p
         STH    R1,RI              ri=m*p
         LH     R2,NN              n
         MH     R2,QQ              *q
         STH    R2,RJ              rj=n*q
         LA     R6,1               i=1
       DO WHILE=(CH,R6,LE,MM)      do i=1 to m
         LA     R7,1                 j=1
       DO WHILE=(CH,R7,LE,NN)        do j=1 to n
         LA     R8,1                   k=1
       DO WHILE=(CH,R8,LE,PP)          do k=1 to p
         LA     R9,1                     l=1
       DO WHILE=(CH,R9,LE,QQ)            do l=1 to q
         LR     R1,R6                      i
         BCTR   R1,0
         MH     R1,NN                      *hbound(a,2)
         AR     R1,R7                      j
         BCTR   R1,0
         SLA    R1,2
         L      R4,ADDRA                   @a
         L      R2,0(R4,R1)                r2=a(i,j)
         LR     R1,R8                      k
         BCTR   R1,0
         MH     R1,QQ                      *hbound(b1,2)
         AR     R1,R9                      l
         BCTR   R1,0
         SLA    R1,2
         L      R4,ADDRB                   @b
         L      R3,0(R4,R1)                r3=b(k,l)
         LR     R5,R2                      r2
         MR     R4,R3                      *r3
         LR     R0,R5                      r0=a(i,j)*b(k,l)
         LR     R1,R6                      i
         BCTR   R1,0                       i-1
         MH     R1,PP                      *p
         AR     R1,R8                      r1=p*(i-1)+k
         LR     R2,R7                      j
         BCTR   R2,0                       j-1
         MH     R2,QQ                      *q
         AR     R2,R9                      r2=q*(j-1)+l
         BCTR   R1,0
         MH     R1,=AL2(NR)                *nr
         AR     R1,R2                      r1=r1+r2
         SLA    R1,2
         ST     R0,R-4(R1)                 r(p*(i-1)+k,q*(j-1)+l)=r0
         LA     R9,1(R9)                   l++
       ENDDO    ,                        enddo l
         LA     R8,1(R8)                 k++
       ENDDO    ,                      enddo k
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         BR     R14                return
*------- ----   ----------------------------------------
PRINT    EQU    *                  print
         LA     R6,1               i
       DO WHILE=(CH,R6,LE,RI)      do i=1 to ri
         MVC    PG,=CL80' '          init buffer
         LA     R10,PG               pgi=0
         LA     R7,1                 j
       DO WHILE=(CH,R7,LE,RJ)        do j=1 to rj
         LR     R1,R6                  i
         BCTR   R1,0
         MH     R1,=AL2(NR)            *nr
         AR     R1,R7                  +j
         SLA    R1,2
         L      R2,R-4(R1)             r(i,j)
         XDECO  R2,XDEC                edit
         MVC    0(ND,R10),XDEC+12-ND   output
         LA     R10,ND(R10)            pgi=pgi+nd
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo j
         BR     R14                return
*        ----   ----------------------------------------
NR       EQU    32                 dim result max
ND       EQU    3                  digits to print
A1       DC     F'1',F'2'              a1(2,2)
         DC     F'3',F'4'
B1       DC     F'0',F'5'              b1(2,2)
         DC     F'6',F'7'
DIM1     DC     H'2',H'2',H'2',H'2'    dim a1 , dim b1
A2       DC     F'0',F'1',F'0'         a2(3,3)
         DC     F'1',F'1',F'1'
         DC     F'0',F'1',F'0'
B2       DC     F'1',F'1',F'1',F'1'    b2(3,4)
         DC     F'1',F'0',F'0',F'1'
         DC     F'1',F'1',F'1',F'1'
DIM2     DC     H'3',H'3',H'3',H'4'    dim a2 , dim b2
ADDRA    DS     A                  @a
ADDRB    DS     A                  @b
RI       DS     H                  ri
RJ       DS     H                  rj
MM       DS     H                  m
NN       DS     H                  n
PP       DS     H                  p
QQ       DS     H                  q
OO       DS     X                  o
PG       DS     CL80               buffer
XDEC     DS     CL12
         LTORG
R        DS     (NR*NR)F           r(nr,nr)
         YREGS
         END    KRONECK


with Ada.Text_IO;
with Ada.Integer_Text_IO;

procedure Kronecker_Product is
   type Matrix is array (Positive range <>, Positive range <>) of Integer;

   function "*"(Left, Right : in Matrix) return Matrix is
      result : Matrix
        (1 .. Left'Length(1) * Right'Length(1),
         1 .. Left'Length(2) * Right'Length(2));
      LI : Natural := 0;
      LJ : Natural := 0;
   begin
      for I in 0 .. result'Length(1) - 1 loop
         for J in 0 .. result'Length(2) - 1 loop
            result (I + 1, J + 1) :=
              Left(Left'First(1) + (LI), Left'First(2) + (LJ))
              * Right
                (Right'First(1) + (I mod Right'Length(1)),
                 Right'First(2) + (J mod Right'Length(2)));
            if (J+1) mod Right'Length(2) = 0 then
               LJ := LJ + 1;
            end if;
         end loop;
         if (I+1) mod Right'Length(1) = 0 then
            LI := LI + 1;
         end if;
         LJ := 0;
      end loop;
      return result;
   end "*";

   Left1   : constant Matrix := ((1, 2), (3, 4));
   Right1  : constant Matrix := ((0, 5), (6, 7));
   result1 : constant Matrix := Left1 * Right1;
   Left2   : constant Matrix := ((0, 1, 0), (1, 1, 1), (0, 1, 0));
   Right2  : constant Matrix := ((1, 1, 1, 1), (1, 0, 0, 1), (1, 1, 1, 1));
   result2 : constant Matrix := Left2 * Right2;
begin
   for I in result1'Range(1) loop
      for J in result1'Range(2) loop
         Ada.Integer_Text_IO.Put(Ada.Text_IO.Standard_Output, result1(I, J));
      end loop;
      Ada.Text_IO.New_Line;
   end loop;

   Ada.Text_IO.New_Line;

   for I in result2'Range(1) loop
      for J in result2'Range(2) loop
         Ada.Integer_Text_IO.Put(Ada.Text_IO.Standard_Output, result2(I, J));
      end loop;
      Ada.Text_IO.New_Line;
   end loop;
end Kronecker_Product;


import java.util.Arrays;

public class Kolakoski {
    private static class Crutch {
        final int len;
        int[] s;
        int i;

        Crutch(int len) {
            this.len = len;
            s = new int[len];
            i = 0;
        }

        void repeat(int count) {
            for (int j = 0; j < count; j++) {
                if (++i == len) return;
                s[i] = s[i - 1];
            }
        }
    }

    private static int nextInCycle(final int[] self, int index) {
        return self[index % self.length];
    }

    private static int[] kolakoski(final int[] self, int len) {
        Crutch c = new Crutch(len);

        int k = 0;
        while (c.i < len) {
            c.s[c.i] = nextInCycle(self, k);
            if (c.s[k] > 1) {
                c.repeat(c.s[k] - 1);
            }
            if (++c.i == len) return c.s;
            k++;
        }
        return c.s;
    }

    private static boolean possibleKolakoski(final int[] self) {
        int[] rle = new int[self.length];
        int prev = self[0];
        int count = 1;
        int pos = 0;
        for (int i = 1; i < self.length; i++) {
            if (self[i] == prev) {
                count++;
            } else {
                rle[pos++] = count;
                count = 1;
                prev = self[i];
            }
        }
        // no point adding final 'count' to rle as we're not going to compare it anyway
        for (int i = 0; i < pos; i++) {
            if (rle[i] != self[i]) {
                return false;
            }
        }
        return true;
    }

    public static void main(String[] args) {
        int[][] ias = new int[][]{
            new int[]{1, 2},
            new int[]{2, 1},
            new int[]{1, 3, 1, 2},
            new int[]{1, 3, 2, 1}
        };
        int[] lens = new int[]{20, 20, 30, 30};

        for (int i=0; i<ias.length; i++) {
            int len = lens[i];
            int[] kol = kolakoski(ias[i], len);

            System.out.printf("First %d members of the sequence generated by %s: \n", len, Arrays.toString(ias[i]));
            System.out.printf("%s\n", Arrays.toString(kol));
            System.out.printf("Possible Kolakoski sequence? %s\n\n", possibleKolakoski(kol));
        }
    }
}


BEGIN
    # multiplies in-place the elements of the matrix a by the scaler b #
    OP *:= = ( REF[,]INT a, INT b )REF[,]INT:
    BEGIN
        FOR i FROM 1 LWB a TO 1 UPB a DO
            FOR j FROM 2 LWB a TO 2 UPB a DO
                a[ i, j ] *:= b
            OD
        OD;
        a
    END # *:= # ;
    # returns the Kronecker Product of the two matrices a and b #
    # the result will have lower bounds of 1                    #
    PRIO X = 6;
    OP   X = ( [,]INT a, b )[,]INT:
    BEGIN
        # normalise the matrices to have lower bounds of 1 #
        [,]INT l = a[ AT 1, AT 1 ];
        [,]INT r = b[ AT 1, AT 1 ];
        # construct the result #
        INT r 1 size = 1 UPB r;
        INT r 2 size = 2 UPB r;
        [ 1 : 1 UPB l * 1 UPB r, 1 : 2 UPB l * 2 UPB r ]INT k;
        FOR i FROM 1 LWB l TO 1 UPB l DO
            FOR j FROM 2 LWB l TO 2 UPB l DO
                ( k[ 1 + ( ( i - 1 ) * r 1 size ) : i * r 1 size
                   , 1 + ( ( j - 1 ) * r 2 size ) : j * r 2 size
                   ] := r
                ) *:= l[ i, j ]
            OD
        OD;
        k
    END # X # ;
    # prints matrix a with the specified field width #
    PROC print matrix = ( [,]INT a, INT field width )VOID:
    FOR i FROM 1 LWB a TO 1 UPB a DO
        FOR j FROM 2 LWB a TO 2 UPB a DO
            print( ( " ", whole( a[ i, j ], field width ) ) )
        OD;
        print( ( newline ) )
    OD # print matrix # ;
    # task test cases #
    print matrix( [,]INT( ( 1, 2 )
                        , ( 3, 4 )
                        )
                X [,]INT( ( 0, 5 )
                        , ( 6, 7 )
                        )
                , -2
                );
    print( ( newline ) );
    print matrix( [,]INT( ( 0, 1, 0 )
                        , ( 1, 1, 1 )
                        , ( 0, 1, 0 )
                        )
                X [,]INT( ( 1, 1, 1, 1 )
                        , ( 1, 0, 0, 1 )
                        , ( 1, 1, 1, 1 )
                        )
                , -1
                )
END


function kolakoski(vec, len)
    seq = Vector{Int}()
    k = 0
    denom = length(vec)
    while length(seq) < len
        n = vec[k % denom + 1]
        k += 1
        seq = vcat(seq, repeat([n], k > length(seq) ? n : seq[k]))
    end
    seq[1:len]
end

function iskolakoski(seq)
    count = 1
    rle = Vector{Int}()
    for i in 2:length(seq)
        if seq[i] == seq[i - 1]
            count += 1
        else
            push!(rle, count)
            count = 1
        end
    end
    rle == seq[1:length(rle)]
end

const tests = [[[1, 2], 20],[[2, 1] ,20], [[1, 3, 1, 2], 30], [[1, 3, 2, 1], 30]]

for t in tests
    vec, n = t[1], t[2]
    seq = kolakoski(vec, n)
    println("Kolakoski from $(vec): first $n numbers are $seq.")
    println("\t\tDoes this look like a Kolakoski sequence? ", iskolakoski(seq) ? "Yes" : "No")
end


// Version 1.2.41

fun IntArray.nextInCycle(index: Int) = this[index % this.size]

fun IntArray.kolakoski(len: Int): IntArray {
    val s = IntArray(len)
    var i = 0
    var k = 0
    while (true) {
        s[i] = this.nextInCycle(k)
        if (s[k] > 1) {
            repeat(s[k] - 1) {
                if (++i == len) return s
                s[i] = s[i - 1]
            }
        }
        if (++i == len) return s
        k++
    }
}

fun IntArray.possibleKolakoski(): Boolean {
    val len = this.size
    val rle = mutableListOf<Int>()
    var prev = this[0]
    var count = 1
    for (i in 1 until len) {
        if (this[i] == prev) {
            count++
        }
        else {
            rle.add(count)
            count = 1
            prev = this[i]
        }
    }
    // no point adding final 'count' to rle as we're not going to compare it anyway
    for (i in 0 until rle.size) {
        if (rle[i] != this[i]) return false
    }
    return true
}

fun main(args: Array<String>) {
    val ias = listOf(
        intArrayOf(1, 2), intArrayOf(2, 1),
        intArrayOf(1, 3, 1, 2), intArrayOf(1, 3, 2, 1)
    )
    val lens = intArrayOf(20, 20, 30, 30)
    for ((i, ia) in ias.withIndex()) {
        val len = lens[i]
        val kol = ia.kolakoski(len)
        println("First $len members of the sequence generated by ${ia.asList()}:")
        println(kol.asList())
        val p = kol.possibleKolakoski()
        println("Possible Kolakoski sequence? ${if (p) "Yes" else "No"}\n")
    }
}


------------ KRONECKER PRODUCT OF TWO MATRICES -------------

-- kprod :: [[Num]] -> [[Num]] -> [[Num]]
on kprod(xs, ys)
    script concatTranspose
        on |λ|(m)
            map(my concat, my transpose(m))
        end |λ|
    end script

    script
        -- Multiplication by N over a list of lists
        -- f :: [[Num]] -> Num -> [[Num]]
        on f(mx, n)
            script go
                on product(a, b)
                    a * b
                end product

                on |λ|(xs)
                    map(curry(product)'s |λ|(n), xs)
                end |λ|
            end script

            map(go, mx)
        end f

        on |λ|(zs)
            map(curry(f)'s |λ|(ys), zs)
        end |λ|
    end script

    concatMap(concatTranspose, map(result, xs))
end kprod

--------------------------- TEST ---------------------------
on run
    unlines(map(show, ¬
        kprod({{1, 2}, {3, 4}}, ¬
            {{0, 5}, {6, 7}}))) & ¬
        linefeed & linefeed & ¬
        unlines(map(show, ¬
            kprod({{0, 1, 0}, {1, 1, 1}, {0, 1, 0}}, ¬
                {{1, 1, 1, 1}, {1, 0, 0, 1}, {1, 1, 1, 1}})))
end run

-------------------- GENERIC FUNCTIONS ---------------------

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
    if length of xs > 0 and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to length of xs
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    concat(map(f, xs))
end concatMap

-- curry :: (Script|Handler) -> Script
on curry(f)
    script
        on |λ|(a)
            script
                on |λ|(b)
                    |λ|(a, b) of mReturn(f)
                end |λ|
            end script
        end |λ|
    end script
end curry

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- show :: a -> String
on show(e)
    set c to class of e
    if c = list then
        script serialized
            on |λ|(v)
                show(v)
            end |λ|
        end script

        "{" & intercalate(", ", map(serialized, e)) & "}"
    else if c = record then
        script showField
            on |λ|(kv)
                set {k, v} to kv
                k & ":" & show(v)
            end |λ|
        end script

        "{" & intercalate(", ", ¬
            map(showField, zip(allKeys(e), allValues(e)))) & "}"
    else if c = date then
        ("date \"" & e as text) & "\""
    else if c = text then
        "\"" & e & "\""
    else
        try
            e as text
        on error
            ("«" & c as text) & "»"
        end try
    end if
end show

-- transpose :: [[a]] -> [[a]]
on transpose(xss)
    script column
        on |λ|(_, iCol)
            script row
                on |λ|(xs)
                    item iCol of xs
                end |λ|
            end script

            map(row, xss)
        end |λ|
    end script

    map(column, item 1 of xss)
end transpose

-- unlines :: [String] -> String
on unlines(xs)
    intercalate(linefeed, xs)
end unlines


function next_in_cycle(c,length,index)
    local pos = index % length
    return c[pos]
end

function kolakoski(c,s,clen,slen)
    local i = 0
    local k = 0

    while true do
        s[i] = next_in_cycle(c,clen,k)
        if s[k] > 1 then
            for j=1,s[k]-1 do
                i = i + 1
                if i == slen then
                    return nil
                end
                s[i] = s[i - 1]
            end
        end
        i = i + 1
        if i == slen then
            return nil
        end
        k = k + 1
    end
    return nil
end

function possible_kolakoski(s,length)
    local j = 0
    local prev = s[0]
    local count = 1
    local rle = {}
    local result = "True"

    for i=0,length do
        rle[i] = 0
    end

    for i=1,length-1 do
        if s[i] == prev then
            count = count + 1
        else
            rle[j] = count
            j = j + 1
            count = 1
            prev = s[i]
        end
    end

    -- no point adding the final 'count' to rle as we're not going to compare it anyway
    for i=0,j-1 do
        if rle[i] ~= s[i] then
            result = "False"
            break
        end
    end

    return result
end

function print_array(a)
    io.write("[")
    for i=0,#a do
        if i>0 then
            io.write(", ")
        end
        io.write(a[i])
    end
    io.write("]")
end

-- main
local c0 =    {[0]=1,  [1]=2}
local c1 =    {[0]=2,  [1]=1}
local c2 =    {[0]=1,  [1]=3,  [2]=1,  [3]=2}
local c3 =    {[0]=1,  [1]=3,  [2]=2,  [3]=1}

local cs =    {[0]=c0, [1]=c1, [2]=c2, [3]=c3}
local clens = {[0]=2,  [1]=2,  [2]=4,  [3]=4}
local slens = {[0]=20, [1]=20, [2]=30, [3]=30}

for i=0,3 do
    local clen = clens[i]
    local slen = slens[i]
    local s = {}

    for j=0,slen-1 do
        s[j] = 0
    end

    kolakoski(cs[i],s,clen,slen)
    io.write(string.format("First %d members of the sequence generated by ", slen))
    print_array(cs[i])
    print(":")
    print_array(s)
    print()

    local p = possible_kolakoski(s,slen)
    print(string.format("Possible Kolakoski sequence? %s", p))

    print()
end


define :matrix [X][
    print: [
        result: ""
        loop this\X 'arr [
            result: result ++ "[" ++
                        (join.with:" " map to [:string] arr 'item -> pad item 3) ++
                    "]\n"
        ]
        return result
    ]
]

kroneckerProduct: function [a,b][
    M: size a\X, N: size first a\X
    P: size b\X, Q: size first b\X
    result: to :matrix @[new array.of:M*P array.of:N*Q 0]

    loop 0..dec M 'i [
        loop 0..dec N 'j [
            loop 0..dec P 'k [
                loop 0..dec Q 'l [
                    result\X\[k + i * P]\[l + j * Q]: a\X\[i]\[j] * b\X\[k]\[l]
                ]
            ]
        ]
    ]
    return result
]

A1: to :matrix [[[1 2] [3 4]]]
B1: to :matrix [[[0 5] [6 7]]]

print "Matrix A:"
print A1

print "Matrix B:"
print B1

print "Kronecker Product:"
print kroneckerProduct A1 B1

A2: to :matrix [[[0 1 0] [1 1 1] [0 1 0]]]
B2: to :matrix [[[1 1 1 1] [1 0 0 1] [1 1 1 1]]]

print "Matrix A:"
print A2

print "Matrix B:"
print B2

print "Kronecker Product:"
print kroneckerProduct A2 B2


# syntax: GAWK -f KRONECKER_PRODUCT.AWK
BEGIN {
    A[++a] = "1 2" ; B[++b] = "0 5"
    A[++a] = "3 4" ; B[++b] = "6 7"
    main("sample 1",1234)
    A[++a] = "0 1 0" ; B[++b] = "1 1 1 1"
    A[++a] = "1 1 1" ; B[++b] = "1 0 0 1"
    A[++a] = "0 1 0" ; B[++b] = "1 1 1 1"
    main("sample 2",3)
    exit(0)
}
function main(desc,option) {
#
# option: allows complete flexibility of output; they may be combined
#   1  show A and B matrix
#   2  show A x B
#   3  show product
#   4  show Arow,Acol x Brow,Bcol
#
    printf("%s\n\n",desc)
    if (option ~ /[1234]/) {
      a_rows = show_array(A,"A",option)
      b_rows = show_array(B,"B",option)
      if (option ~ /2/) { prn("A x B",2) }
      if (option ~ /3/) { prn("Product",3) }
      if (option ~ /4/) { prn("Arow,Acol x Brow,Bcol",4) }
    }
    else {
      print("nothing to print")
    }
    print("")
    a = b = 0 # reset
    delete A
    delete B
}
function prn(desc,option,  a_cols,b_cols,w,x,y,z,AA,BB) {
    printf("%s:\n",desc)
    for (w=1; w<=a_rows; w++) {
      a_cols = split(A[w],AA," ")
      for (x=1; x<=b_rows; x++) {
        b_cols = split(B[x],BB," ")
        printf("[ ")
        for (y=1; y<=a_cols; y++) {
          for (z=1; z<=b_cols; z++) {
            if (option ~ /2/) { printf("%sx%s ",AA[y],BB[z]) }
            if (option ~ /3/) { printf("%2s ",AA[y] * BB[z]) }
            if (option ~ /4/) { printf("%s,%sx%s,%s ",w,y,x,z) }
          }
        }
        printf("]\n")
      }
    }
}
function show_array(arr,desc,option,  i,n) {
    for (i in arr) {
      n++
    }
    if (option ~ /1/) {
      printf("Matrix %s:\n",desc)
      for (i=1; i<=n; i++) {
        printf("[ %s ]\n",arr[i])
      }
    }
    return(n)
}


ClearAll[KolakoskiGen]
KolakoskiGen[start_List, its_Integer] := Module[{c, s, k, cnext, sk},
  s = {};
  k = 1;
  c = start;
  Do[
   cnext = First[c];
   c = RotateLeft[c];
   AppendTo[s, cnext];
   sk = s[[k]];
   If[sk > 1,
    s = Join[s, ConstantArray[cnext, sk - 1]]
    ];
   k += 1;
   ,
   {its}
   ];
  s
  ]

run = Take[KolakoskiGen[{1, 2}, 20], 20]
check = Length /@ Split[%];
check === Take[run, Length[check]]

run = Take[KolakoskiGen[{2, 1}, 20], 20]
check = Length /@ Split[%];
check === Take[run, Length[check]]

run = Take[KolakoskiGen[{1, 3, 1, 2}, 30], 30]
check = Length /@ Split[%];
check === Take[run, Length[check]]


template nextInCycle(a: openArray[int]; index: Natural): int =
  a[index mod a.len]

#---------------------------------------------------------------------------------------------------

func kolakoski(a: openArray[int]; length: Positive): seq[int] =

  result.setLen(length)
  var i, k = 0

  while true:
    result[i] = a.nextInCycle(k)
    if result[k] > 1:
      for j in 1..<result[k]:
        inc i
        if i == length: return
        result[i] = result[i - 1]
    inc i
    if i == length: return
    inc k

#---------------------------------------------------------------------------------------------------

func possibleKolakoski(a: openArray[int]): bool =

  var
    rle: seq[int]
    prev = a[0]
    count = 1

  for i in 1..a.high:
    if a[i] == prev:
      inc count
    else:
      rle.add count
      count = 1
      prev = a[i]

  # No point adding final 'count' to rle as we're not going to compare it anyway.
  for i, val in rle:
    if val != a[i]: return false

  result = true

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  import sequtils, strformat

  const
    Ias = [@[1, 2], @[2, 1], @[1, 3, 1, 2], @[1, 3, 2, 1]]
    Lengths = [20, 20, 30, 30]

  for (length, ia) in zip(Lengths, Ias):
    let kol = ia.kolakoski(length)
    echo &"First {length} members of the sequence generated by {($ia)[1..^1]}:"
    echo ($kol)[1..^1]
    let s = if kol.possibleKolakoski(): "Yes" else: "No"
    echo "Possible Kolakoski sequence? " & s & '\n'


sub kolakoski {
    my($terms,@seed) = @_;
    my @k;
    my $k = $seed[0] == 1 ? 1 : 0;
    if ($k == 1) { @k = (1, split //, (($seed[1]) x $seed[1])) }
    else         { @k = ($seed[0]) x $seed[0] }
    do {
        $k++;
        push @k, ($seed[$k % @seed]) x $k[$k];
    } until $terms <= @k;
    @k[0..$terms-1]
}

sub rle {
    (my $string = join '', @_) =~ s/((.)\2*)/length $1/eg;
    split '', $string
}

for ([20,1,2], [20,2,1], [30,1,3,1,2], [30,1,3,2,1]) {
    $terms = shift @$_;
    print "\n$terms members of the series generated from [@$_] is:\n";
    print join(' ', @kolakoski = kolakoski($terms, @$_)) . "\n";
    $status = join('', @rle = rle(@kolakoski)) eq join('', @kolakoski[0..$#rle]) ? 'True' : 'False';
    print "Looks like a Kolakoski sequence?: $status\n";
}


#include<stdlib.h>
#include<stdio.h>

int main(){

	char input[100],output[100];
	int i,j,k,l,rowA,colA,rowB,colB,rowC,colC,startRow,startCol;
	double **matrixA,**matrixB,**matrixC;

	printf("Enter full path of input file : ");
	fscanf(stdin,"%s",input);

	printf("Enter full path of output file : ");
	fscanf(stdin,"%s",output);

	FILE* inputFile = fopen(input,"r");

	fscanf(inputFile,"%d%d",&rowA,&colA);

	matrixA = (double**)malloc(rowA * sizeof(double*));

	for(i=0;i<rowA;i++){
		matrixA[i] = (double*)malloc(colA*sizeof(double));
		for(j=0;j<colA;j++){
			fscanf(inputFile,"%lf",&matrixA[i][j]);
		}
	}

	fscanf(inputFile,"%d%d",&rowB,&colB);

	matrixB = (double**)malloc(rowB * sizeof(double*));

	for(i=0;i<rowB;i++){
		matrixB[i] = (double*)malloc(colB*sizeof(double));
		for(j=0;j<colB;j++){
			fscanf(inputFile,"%lf",&matrixB[i][j]);
		}
	}

	fclose(inputFile);

	rowC = rowA*rowB;
	colC = colA*colB;

	matrixC = (double**)malloc(rowC*sizeof(double*));

	for(i=0;i<rowA*rowB;i++){
		matrixC[i] = (double*)malloc(colA*colB*sizeof(double));
	}

	for(i=0;i<rowA;i++){
		for(j=0;j<colA;j++){
			startRow = i*rowB;
			startCol = j*colB;
			for(k=0;k<rowB;k++){
				for(l=0;l<colB;l++){
					matrixC[startRow+k][startCol+l] = matrixA[i][j]*matrixB[k][l];
				}
			}
		}
	}

	FILE* outputFile = fopen(output,"w");

	for(i=0;i<rowC;i++){
		for(j=0;j<colC;j++){
			fprintf(outputFile,"%lf\t",matrixC[i][j]);
		}
		fprintf(outputFile,"\n");
	}

	fclose(outputFile);

	printf("\n\n\nKronecker product of the two matrices written to %s.",output);
}


with javascript_semantics
function kolakoski(sequence cycle, integer n)
    sequence s = {}
    integer k = 1
    while length(s)<n do
        integer c = cycle[mod(k-1,length(cycle))+1]
        s &= repeat(c,iff(k>length(s)?c:s[k]))
        k += 1
    end while
    s = s[1..n]
    return s
end function

function possible_kolakoski(sequence s)
    integer count = 1
    sequence rle = {}
    for i=2 to length(s) do
        if s[i]==s[i-1] then
            count += 1
        else
            rle &= count
            count = 1
        end if
    end for
    -- (final count probably incomplete, so ignore it)
    return rle = s[1..length(rle)]
end function

constant cycles = {{1,2},20,
                   {2,1},20,
                   {1,3,1,2},30,
                   {1,3,2,1},30}

for i=1 to length(cycles) by 2 do
    {sequence c, integer n} = cycles[i..i+1]
    sequence s = kolakoski(c,n)
    printf(1,"First %d members of the sequence generated by %s\n", {n,sprint(c)})
    ?s
    bool p = possible_kolakoski(s)
    printf(1,"Possible Kolakoski sequence? %s\n\n", {iff(p ? "Yes" : "No")})
end for


using System;
using System.Collections;
using System.Collections.Generic;
using static System.Linq.Enumerable;

public static class KroneckerProduct
{
    public static void Main() {
        int[,] left = { {1, 2}, {3, 4} };
        int[,] right = { {0, 5}, {6, 7} };
        Print(Multiply(left, right));

        left = new [,] { {0, 1, 0}, {1, 1, 1}, {0, 1, 0} };
        right = new [,] { {1, 1, 1, 1}, {1, 0, 0, 1}, {1, 1, 1, 1} };
        Print(Multiply(left, right));
    }

    static int[,] Multiply(int[,] left, int[,] right) {
        (int lRows, int lColumns) = (left.GetLength(0), left.GetLength(1));
        (int rRows, int rColumns) = (right.GetLength(0), right.GetLength(1));
        int[,] result = new int[lRows * rRows, lColumns * rColumns];

        foreach (var (r, c) in from r in Range(0, lRows) from c in Range(0, lColumns) select (r, c)) {
            Copy(r * rRows, c * rColumns, left[r, c]);
        }
        return result;

        void Copy(int startRow, int startColumn, int multiplier) {
            foreach (var (r, c) in from r in Range(0, rRows) from c in Range(0, rColumns) select (r, c)) {
                result[startRow + r, startColumn + c] = right[r, c] * multiplier;
            }
        }
    }

    static void Print(int[,] matrix) {
        (int rows, int columns) = (matrix.GetLength(0), matrix.GetLength(1));
        int width = matrix.Cast<int>().Select(LengthOf).Max();
        for (int row = 0; row < rows; row++) {
            Console.WriteLine("| " + string.Join(" ", Range(0, columns).Select(column => (matrix[row, column] + "").PadLeft(width, ' '))) + " |");
        }
        Console.WriteLine();
    }

    private static int LengthOf(int i) {
        if (i < 0) return LengthOf(-i) + 1;
        int length = 0;
        while (i > 0) {
            length++;
            i /= 10;
        }
        return length;
    }

}


import itertools

def cycler(start_items):
	return itertools.cycle(start_items).__next__

def _kolakoski_gen(start_items):
    s, k = [], 0
    c = cycler(start_items)
    while True:
        c_next = c()
        s.append(c_next)
        sk = s[k]
        yield sk
        if sk > 1:
            s += [c_next] * (sk - 1)
        k += 1

def kolakoski(start_items=(1, 2), length=20):
    return list(itertools.islice(_kolakoski_gen(start_items), length))

def _run_len_encoding(truncated_series):
    return [len(list(group)) for grouper, group in itertools.groupby(truncated_series)][:-1]

def is_series_eq_its_rle(series):
    rle = _run_len_encoding(series)
    return (series[:len(rle)] == rle) if rle else not series

if __name__ == '__main__':
    for start_items, length in [((1, 2), 20), ((2, 1), 20),
                                ((1, 3, 1, 2), 30), ((1, 3, 2, 1), 30)]:
        print(f'\n## {length} members of the series generated from {start_items} is:')
        s = kolakoski(start_items, length)
        print(f'  {s}')
        ans = 'YES' if is_series_eq_its_rle(s) else 'NO'
        print(f'  Does it look like a Kolakoski sequence: {ans}')


sub kolakoski (*@seed) {
    my $k = @seed[0] == 1 ?? 1 !! 0;
    my @k = flat @seed[0] == 1 ?? (1, @seed[1] xx @seed[1]) !! @seed[0] xx @seed[0],
      { $k++; @seed[$k % @seed] xx @k[$k] } … *
}

sub rle (*@series) { @series.join.subst(/((.)$0*)/, -> { $0.chars }, :g).comb».Int }

# Testing
for [1, 2], 20,
    [2, 1], 20,
    [1, 3, 1, 2], 30,
    [1, 3, 2, 1], 30
  -> @seed, $terms {
    say "\n## $terms members of the series generated from { @seed.perl } is:\n   ",
    my @kolakoski = kolakoski(@seed)[^$terms];
    my @rle = rle @kolakoski;
    say "   Looks like a Kolakoski sequence?: ", @rle[*] eqv @kolakoski[^@rle];
}


#include <cassert>
#include <iomanip>
#include <iostream>
#include <vector>

template <typename scalar_type> class matrix {
public:
    matrix(size_t rows, size_t columns)
        : rows_(rows), columns_(columns), elements_(rows * columns) {}
    matrix(size_t rows, size_t columns,
        const std::initializer_list<std::initializer_list<scalar_type>>& values)
        : rows_(rows), columns_(columns), elements_(rows * columns) {
        assert(values.size() <= rows_);
        size_t i = 0;
        for (const auto& row : values) {
            assert(row.size() <= columns_);
            std::copy(begin(row), end(row), &elements_[i]);
            i += columns_;
        }
    }
    size_t rows() const { return rows_; }
    size_t columns() const { return columns_; }

    const scalar_type& operator()(size_t row, size_t column) const {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[row * columns_ + column];
    }
    scalar_type& operator()(size_t row, size_t column) {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[row * columns_ + column];
    }
private:
    size_t rows_;
    size_t columns_;
    std::vector<scalar_type> elements_;
};

// See https://en.wikipedia.org/wiki/Kronecker_product
template <typename scalar_type>
matrix<scalar_type> kronecker_product(const matrix<scalar_type>& a,
                                      const matrix<scalar_type>& b) {
    size_t arows = a.rows();
    size_t acolumns = a.columns();
    size_t brows = b.rows();
    size_t bcolumns = b.columns();
    matrix<scalar_type> c(arows * brows, acolumns * bcolumns);
    for (size_t i = 0; i < arows; ++i)
        for (size_t j = 0; j < acolumns; ++j)
            for (size_t k = 0; k < brows; ++k)
                for (size_t l = 0; l < bcolumns; ++l)
                    c(i*brows + k, j*bcolumns + l) = a(i, j) * b(k, l);
    return c;
}

template <typename scalar_type>
void print(std::wostream& out, const matrix<scalar_type>& a) {
    const wchar_t* box_top_left = L"\x250c";
    const wchar_t* box_top_right = L"\x2510";
    const wchar_t* box_bottom_left = L"\x2514";
    const wchar_t* box_bottom_right = L"\x2518";
    const wchar_t* box_vertical = L"\x2502";
    const wchar_t nl = L'\n';
    const wchar_t space = L' ';
    const int width = 2;

    size_t rows = a.rows(), columns = a.columns();
    std::wstring spaces((width + 1) * columns, space);
    out << box_top_left << spaces << box_top_right << nl;
    for (size_t row = 0; row < rows; ++row) {
        out << box_vertical;
        for (size_t column = 0; column < columns; ++column)
            out << std::setw(width) << a(row, column) << space;
        out << box_vertical << nl;
    }
    out << box_bottom_left << spaces << box_bottom_right << nl;
}

void test1() {
    matrix<int> matrix1(2, 2, {{1,2}, {3,4}});
    matrix<int> matrix2(2, 2, {{0,5}, {6,7}});
    std::wcout << L"Test case 1:\n";
    print(std::wcout, kronecker_product(matrix1, matrix2));
}

void test2() {
    matrix<int> matrix1(3, 3, {{0,1,0}, {1,1,1}, {0,1,0}});
    matrix<int> matrix2(3, 4, {{1,1,1,1}, {1,0,0,1}, {1,1,1,1}});
    std::wcout << L"Test case 2:\n";
    print(std::wcout, kronecker_product(matrix1, matrix2));
}

int main() {
    std::wcout.imbue(std::locale(""));
    test1();
    test2();
    return 0;
}


def create_generator(ar)
  Enumerator.new do |y|
    cycle = ar.cycle
    s = []
    loop do
      t = cycle.next
      s.push(t)
      v = s.shift
      y << v
      (v-1).times{s.push(t)}
    end
  end
end

def rle(ar)
  ar.slice_when{|a,b| a != b}.map(&:size)
end

[[20, [1,2]],
 [20, [2,1]],
 [30, [1,3,1,2]],
 [30, [1,3,2,1]]].each do |num,ar|
  puts "\nFirst #{num} of the sequence generated by #{ar.inspect}:"
  p res = create_generator(ar).take(num)
  puts "Possible Kolakoski sequence? #{res.join.start_with?(rle(res).join)}"
end


use itertools::Itertools;

fn get_kolakoski_sequence(iseq: &[usize], size: &usize) -> Vec<usize> {
    assert!(*size > 0);
    assert!(!iseq.is_empty());

    let mut kseq: Vec<usize> = Vec::default();

    // create an itertor which keeps repeating the initial sequence infinitely
    let repeater = iseq.iter().cloned().cycle();

    // push the very first element, repeated as many times as the number
    kseq.extend_from_slice(&vec![*iseq.get(0).unwrap()].repeat(*iseq.get(0).unwrap()));

    //start cycling throught the initial sequence, but skip the very first one
    for (k_counter, elem) in repeater.enumerate().skip(1) {
        // push the given element
        kseq.push(elem);

        // and repeat the current element as many times
        // as it's needed based on the previous elements
        kseq.extend_from_slice(&vec![elem].repeat(*kseq.get(k_counter).unwrap() - 1));

        // finish generation when the Kolakoski sequence has reached the given length
        if kseq.len() >= *size {
            break;
        }
    }

    // truncate it as it might have more elements than needed
    kseq[0..*size].to_vec()
}

fn is_kolakoski(kseq: &[usize]) -> bool {
    assert!(!kseq.is_empty());

    // calculate the RLE
    let rle: Vec<usize> = kseq
        .iter()
        .batching(|it| {
            it.next()
                .map(|v| it.take_while_ref(|&v2| v2 == v).count() + 1)
        })
        .collect();

    rle.iter().zip(kseq).filter(|&(a, b)| a == b).count() == rle.len()
}

fn main() {
    let lengths = vec![20, 20, 30, 30];
    let seqs = vec![vec![1, 2], vec![2, 1], vec![1, 3, 1, 2], vec![1, 3, 2, 1]];

    for (seq, length) in seqs.iter().zip(&lengths) {
        let kseq = get_kolakoski_sequence(&seq, length);

        println!("Starting sequence: {:?}", seq);
        println!("Kolakoski sequence: {:?}", kseq);
        println!("Possible Kolakoski sequence? {:?}", is_kolakoski(&kseq));
    }
}


func create_generator(arr) {
    Enumerator({|f|
        var s = []
        var i = 0
        loop {
            var t = arr[i++ % arr.len]
            s << t
            f(var v = s.shift)
            s << (v-1).of(t)...
        }
    })
}

var tests = [
    [20, [1,2]],
    [20, [2,1]],
    [30, [1,3,1,2]],
    [30, [1,3,2,1]]
]

for num,arr in (tests) {
    say "\nFirst #{num} of the sequence generated by #{arr}:"
    var res = create_generator(arr).first(num)
    var rle = res.run_length.map{.tail}
    say "#{res}\nPossible Kolakoski sequence? #{res.first(rle.len) == rle}"
}


import std.stdio, std.outbuffer;

alias Matrix = uint[][];

string toString(Matrix m) {
    auto ob = new OutBuffer();
    foreach(row; m) {
        //The format specifier inside the %(...%) is
        //automatically applied to each element of a range
        //Thus prints each line flanked by |
        ob.writefln("|%(%2d %)|", row);
    }
    return ob.toString;
}

Matrix kronecker(Matrix m1, Matrix m2) {
    Matrix p = new uint[][m1.length*m2.length];
    foreach(r1i, r1; m1) {
        foreach(r2i, r2; m2) {
            auto rp = new uint[r1.length*r2.length];
            foreach(c1i, e1; r1) {
                    foreach(c2i, e2; r2) {
                        rp[c1i*r2.length+c2i] = e1*e2;
                    }
            }
            p[r1i*m2.length+r2i] = rp;
        }
    }
    return p;
}

void sample(Matrix m1, Matrix m2) {
    auto res = kronecker(m1, m2);
    writefln("Matrix A:\n%s\nMatrix B:\n%s\nA (X) B:\n%s", m1.toString, m2.toString, res.toString);
}

void main() {
    Matrix A = [[1,2],[3,4]];
    Matrix B = [[0,5],[6,7]];

    sample(A,B);

    Matrix C =
    [[0,1,0],
     [1,1,1],
     [0,1,0]];
    Matrix D =
    [[1,1,1,1],
     [1,0,0,1],
     [1,1,1,1]];

    sample(C,D);
}


Imports System.Runtime.CompilerServices
Imports System.Text

Module Module1

    Class Crutch
        Public ReadOnly len As Integer
        Public s() As Integer
        Public i As Integer

        Public Sub New(len As Integer)
            Me.len = len
            s = New Integer(len - 1) {}
            i = 0
        End Sub

        Public Sub Repeat(count As Integer)
            For j = 1 To count
                i += 1
                If i = len Then
                    Return
                End If
                s(i) = s(i - 1)
            Next
        End Sub
    End Class

    <Extension()>
    Public Function NextInCycle(self As Integer(), index As Integer) As Integer
        Return self(index Mod self.Length)
    End Function

    <Extension()>
    Public Function Kolakoski(self As Integer(), len As Integer) As Integer()
        Dim c As New Crutch(len)

        Dim k = 0
        While c.i < len
            c.s(c.i) = self.NextInCycle(k)
            If c.s(k) > 1 Then
                c.Repeat(c.s(k) - 1)
            End If
            c.i += 1
            If c.i = len Then
                Return c.s
            End If
            k += 1
        End While

        Return c.s
    End Function

    <Extension()>
    Public Function PossibleKolakoski(self As Integer()) As Boolean
        Dim rle(self.Length) As Integer
        Dim prev = self(0)
        Dim count = 1
        Dim pos = 0
        For i = 2 To self.Length
            If self(i - 1) = prev Then
                count += 1
            Else
                rle(pos) = count
                pos += 1

                count = 1
                prev = self(i - 1)
            End If
        Next
        REM no point adding final 'count' to rle as we're not going to compare it anyway
        For i = 1 To pos
            If rle(i - 1) <> self(i - 1) Then
                Return False
            End If
        Next
        Return True
    End Function

    <Extension()>
    Public Function AsString(self As Integer()) As String
        Dim sb As New StringBuilder("[")
        Dim it = self.GetEnumerator()
        If it.MoveNext Then
            sb.Append(it.Current)
        End If
        While it.MoveNext
            sb.Append(", ")
            sb.Append(it.Current)
        End While
        Return sb.Append("]").ToString
    End Function

    Sub Main()
        Dim ias()() As Integer = {New Integer() {1, 2}, New Integer() {2, 1}, New Integer() {1, 3, 1, 2}, New Integer() {1, 3, 2, 1}}
        Dim lens() As Integer = {20, 20, 30, 30}

        For i = 1 To ias.Length
            Dim len = lens(i - 1)
            Dim kol = ias(i - 1).Kolakoski(len)

            Console.WriteLine("First {0} members of the sequence by {1}: ", len, ias(i - 1).AsString)
            Console.WriteLine(kol.AsString)
            Console.WriteLine("Possible Kolakoski sequence? {0}", kol.PossibleKolakoski)
            Console.WriteLine()
        Next
    End Sub

End Module


USING: kernel math.matrices.extras prettyprint ;

{ { 1 2 } { 3 4 } }
{ { 0 5 } { 6 7 } }
{ { 0 1 0 } { 1 1 1 } { 0 1 0 } }
{ { 1 1 1 1 } { 1 0 0 1 } { 1 1 1 1 } }
[ kronecker-product . ] [email protected]


      MODULE ARRAYMUSH	!A rather small collection.
       CONTAINS		!For the specific problem only.
        SUBROUTINE KPRODUCT(A,B,AB)	!AB = Kronecker product of A and B, both two-dimensional arrays.
Considers the arrays to be addressed as A(row,column), despite any storage order arrangements.        .
Creating array AB to fit here, adjusting the caller's array AB, may not work on some compilers.
         INTEGER A(:,:),B(:,:)		!Two-dimensional arrays, lower bound one.
         INTEGER, ALLOCATABLE:: AB(:,:)	!To be created to fit.
         INTEGER R,RA,RB,C,CA,CB,I	!Assistants.
          RA = UBOUND(A,DIM = 1)	!Ascertain the upper bounds of the incoming arrays.
          CA = UBOUND(A,DIM = 2)	!Their lower bounds will be deemed one,
          RB = UBOUND(B,DIM = 1)	!And the upper bound as reported will correspond.
          CB = UBOUND(B,DIM = 2)	!UBOUND(A) would give an array of two values, RA and CA, more for higher dimensionality.
          WRITE (6,1) "A",RA,CA,"B",RB,CB,"A.k.B",RA*RB,CA*CB	!Announce.
    1     FORMAT (3(A," is ",I0,"x",I0,1X))	!Three sets of sizes.
          IF (ALLOCATED(AB)) DEALLOCATE(AB)	!Discard any lingering storage.
          ALLOCATE (AB(RA*RB,CA*CB))		!Obtain the exact desired size.
          R = 0		!Syncopation: start the row offset.
          DO I = 1,RA	!Step down the rows of A.
            C = 0		!For each row, start the column offset.
            DO J = 1,CA		!Step along the columns of A.
              AB(R + 1:R + RB,C + 1:C + CB) = A(I,J)*B	!Place a block of B values.
              C = C + CB		!Advance a block of columns.
            END DO		!On to the next column of A.
            R = R + RB		!Advance a block of rows.
          END DO	!On to the next row of A.
        END SUBROUTINE KPRODUCT	!No tests for bad parameters, or lack of storage...

        SUBROUTINE SHOW(F,A)	!Write array A in row,column order.
         INTEGER F	!Output file unit number.
         INTEGER A(:,:)	!The 2-D array, lower bound one.
         INTEGER R	!The row stepper.
          DO R = 1,UBOUND(A,DIM = 1)	!Each row gets its own line.
            WRITE (F,1) A(R,:)		!Write all the columns of that row.
    1       FORMAT (666I3)		!This suffices for the example.
          END DO			!On to the next row.
        END SUBROUTINE SHOW	!WRITE (F,*) A or similar would show A as if transposed.
      END MODULE ARRAYMUSH	!That was simple enough.

      PROGRAM POKE
      USE ARRAYMUSH
      INTEGER A(2,2),B(2,2)		!First test: square arrays.
      INTEGER, ALLOCATABLE:: AB(:,:)	!To be created for each result.
      INTEGER C(3,3),D(3,4)		!Second test: some rectilinearity.
      DATA A/1,3, 2,4/,B/0,6, 5,7/	!Furrytran uses "column-major" order for successive storage elements.
      DATA C/0,1,0, 1,1,1, 0,1,0/	!So, the first three values go down the rows of the first column.
      DATA D/1,1,1, 1,0,1, 1,0,1, 1,1,1/!And then follow the values for the next column, etc.

      WRITE (6,*) "First test..."
      CALL KPRODUCT(A,B,AB)
      CALL SHOW (6,AB)

      WRITE (6,*)
      WRITE (6,*) "Second test..."
      CALL KPRODUCT(C,D,AB)
      CALL SHOW (6,AB)

      END


fn next_in_cycle(c []int, index int) int {
    return c[index % c.len]
}

fn kolakoski(c []int, slen int) []int {
    mut s := []int{len: slen}
    mut i, mut k := 0, 0
    for {
        s[i] = next_in_cycle(c, k)
        if s[k] > 1 {
            for j := 1; j < s[k]; j++ {
                i++
                if i == slen {
                    return s
                }
                s[i] = s[i - 1]
            }
        }
        i++
        if i == slen {
            return s
        }
        k++
    }
    return s
}

fn possible_kolakoski(s []int) bool {
    slen := s.len
    mut rle := []int{len: 0, cap:slen}
    mut prev := s[0]
    mut count := 1
    for i in 1..slen {
        if s[i] == prev {
            count++
        } else {
            rle << count
            count = 1
            prev = s[i]
        }
    }
    // no point adding final 'count' to rle as we're not going to compare it anyway
    for i in 0..rle.len {
        if rle[i] != s[i] {
            return false
        }
    }
    return true
}

fn print_ints(ia []int, suffix string) {
    print("[")
    alen := ia.len
    for i in 0.. alen {
        print(ia[i])
        if i < alen - 1 {
            print(", ")
        }
    }
    println("]$suffix")
}

fn main() {
    mut ias := [][]int{len: 4}
    ias[0] = [1, 2]
    ias[1] = [2, 1]
    ias[2] = [1, 3, 1, 2]
    ias[3] = [1, 3, 2, 1]
    slens := [20, 20, 30, 30]
    for i, ia in ias {
        slen := slens[i]
        kol := kolakoski(ia, slen)
        print("First $slen members of the sequence generated by ")
        print_ints(ia, ":")
        print_ints(kol, "")
        p := possible_kolakoski(kol)
        mut poss := "Yes"
        if !p {
            poss = "No"
        }
        println("Possible Kolakoski sequence? $poss \n")
    }
}


var kolakoski = Fn.new { |c, slen|
    var s = List.filled(slen, 0)
    var i = 0
    var k = 0
    while (true) {
        s[i] = c[k % c.count]
        if (s[k] > 1) {
            for (j in 1...s[k]) {
                i = i + 1
                if (i == slen) return s
                s[i] = s[i-1]
            }
        }
        i = i + 1
        if (i == slen) return s
        k = k + 1
    }
}

var possibleKolakoski = Fn.new { |s|
    var slen = s.count
    var rle = []
    var prev = s[0]
    var count = 1
    for (i in 1...slen) {
        if (s[i] == prev) {
            count = count + 1
        } else {
            rle.add(count)
            count = 1
            prev = s[i]
        }
    }
    // no point adding final 'count' to rle as we're not going to compare it anyway
    for (i in 0...rle.count) {
        if (rle[i] != s[i]) return false
    }
    return true
}

var ias = [
    [1, 2],
    [2, 1],
    [1, 3, 1, 2],
    [1 ,3, 2, 1]
]
var slens = [20, 20, 30, 30]
var i = 0
for (ia in ias) {
    var slen = slens[i]
    var kol = kolakoski.call(ia, slen)
    System.write("First %(slen) members of the sequence generated by ")
    System.print("%(ia):")
    System.print("%(kol)")
    var p = possibleKolakoski.call(kol)
    var poss = p ? "Yes" : "No"
    System.print("Possible Kolakoski sequence? %(poss)\n")
    i = i + 1
}


' version 06-04-2017
' compile with: fbc -s console

Sub kronecker_product(a() As Long, b() As Long, frmt As String = "#")

    Dim As Long i, j, k, l
    Dim As Long la1 = LBound(a, 1) : Dim As Long ua1 = UBound(a, 1)
    Dim As Long la2 = LBound(a, 2) : Dim As Long ua2 = UBound(a, 2)
    Dim As Long lb1 = LBound(b, 1) : Dim As Long ub1 = UBound(b, 1)
    Dim As Long lb2 = LBound(b, 2) : Dim As Long ub2 = UBound(b, 2)

    For i = la1 To ua1
        For k = lb1 To ub1
            Print "[";
            For j = la2 To ua2
                For l = lb2 To ub2
                    Print Using frmt; a(i, j) * b(k, l);
                    If j = ua1 And l = ub2 Then
                        Print "]"
                    Else
                        Print " ";
                    End If
                Next
            Next
        Next
    Next

End Sub

' ------=< MAIN >=-----

Dim As Long a(1 To 2, 1 To 2) = {{1, 2}, _
                                 {3, 4}}
Dim As Long b(1 To 2, 1 To 2) = {{0, 5}, _
                                 {6, 7}}
kronecker_product(a(), b(), "##")

Print
Dim As Long x(1 To 3, 1 To 3) = {{0, 1, 0}, _
                                 {1, 1, 1}, _
                                 {0, 1, 0}}
Dim As Long y(1 To 3, 1 To 4) = {{1, 1, 1, 1}, _
                                 {1, 0, 0, 1}, _
                                 {1, 1, 1, 1}}
kronecker_product(x(), y())

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


fcn kolakoski(start_items=List(1,2), length=20){  //-->List
   Walker.tweak(fcn(s,rk,cw){	// infinite iterator
      s.append( c_next:=cw() );
      sk:=s[rk.inc()];		// inc returns previous value, ie k++
      if(sk>1) s.extend((List.createLong(sk - 1,c_next)));  // list of sk cn's
      sk		// where we are in s, not end of s
   }.fp(List(), Ref(0), Walker.cycle(start_items).next) )
   .walk(length);	// iterate length times, return list
}


a = [[1,2],[3,4]]
b = [[0,5],[6,7]]
println[formatProd[a,b]]

c = [[0,1,0],[1,1,1],[0,1,0]]
d = [[1,1,1,1],[1,0,0,1],[1,1,1,1]]
println[formatProd[c,d]]

formatProd[a,b] := formatTable[[[formatMatrix[a], "\u2297", formatMatrix[b], "=", formatMatrix[KroneckerProduct[a,b]]]]]

KroneckerProduct[a, b] :=
{
   [m,n] = a.dimensions[]
   [p,q] = b.dimensions[]
   rows = m p
   cols = n q
   n = new array[[rows, cols], 0]
   for i=0 to rows-1
      for j=0 to cols-1
         [email protected]@j = [email protected](i div p)@(j div q) * [email protected](i mod p)@(j mod q)

   return n
}


package main

import (
    "fmt"
    "strings"
)

type uintMatrix [][]uint

func (m uintMatrix) String() string {
    var max uint
    for _, r := range m {
        for _, e := range r {
            if e > max {
                max = e
            }
        }
    }
    w := len(fmt.Sprint(max))
    b := &strings.Builder{}
    for _, r := range m {
        fmt.Fprintf(b, "|%*d", w, r[0])
        for _, e := range r[1:] {
            fmt.Fprintf(b, " %*d", w, e)
        }
        fmt.Fprintln(b, "|")
    }
    return b.String()
}

func kronecker(m1, m2 uintMatrix) uintMatrix {
    p := make(uintMatrix, len(m1)*len(m2))
    for r1i, r1 := range m1 {
        for r2i, r2 := range m2 {
            rp := make([]uint, len(r1)*len(r2))
            for c1i, e1 := range r1 {
                for c2i, e2 := range r2 {
                    rp[c1i*len(r2)+c2i] = e1 * e2
                }
            }
            p[r1i*len(m2)+r2i] = rp
        }
    }
    return p
}

func sample(m1, m2 uintMatrix) {
    fmt.Println("m1:")
    fmt.Print(m1)
    fmt.Println("m2:")
    fmt.Print(m2)
    fmt.Println("m1 ⊗ m2:")
    fmt.Print(kronecker(m1, m2))
}

func main() {
    sample(uintMatrix{
        {1, 2},
        {3, 4},
    }, uintMatrix{
        {0, 5},
        {6, 7},
    })
    sample(uintMatrix{
        {0, 1, 0},
        {1, 1, 1},
        {0, 1, 0},
    }, uintMatrix{
        {1, 1, 1, 1},
        {1, 0, 0, 1},
        {1, 1, 1, 1},
    })
}