package kronecker;

/**
 * Defines a function to calculate the Kronecker product of two
 * rectangular matrices and tests it with two examples.
 */
public class Product {
  /**
   * Find the Kronecker product of the arguments.
   * @param a The first matrix to multiply.
   * @param b The second matrix to multiply.
   * @return A new matrix: the Kronecker product of the arguments.
   */
  public static int[][] product(final int[][] a, final int[][] b) {
    // Create matrix c as the matrix to fill and return.
    // The length of a matrix is its number of rows.
    final int[][] c = new int[a.length*b.length][];
    // Fill in the (empty) rows of c.
    // The length of each row is the number of columns.
    for (int ix = 0; ix < c.length; ix++) {
      final int num_cols = a[0].length*b[0].length;
      c[ix] = new int[num_cols];
    }
    // Now fill in the values: the products of each pair.
    // Go through all the elements of a.
    for (int ia = 0; ia < a.length; ia++) {
      for (int ja = 0; ja < a[ia].length; ja++) {
        // For each element of a, multiply it by all the elements of b.
        for (int ib = 0; ib < b.length; ib++) {
          for (int jb = 0; jb < b[ib].length; jb++) {
             c[b.length*ia+ib][b[ib].length*ja+jb] = a[ia][ja] * b[ib][jb];
          }
        }
      }
    }

    // Return the completed product matrix c.
    return c;
  }

  /**
   * Print an integer matrix, lining up the columns by the width
   * of the longest printed element.
   * @param m The matrix to print.
   */
  public static void print_matrix(final int[][] m) {
    // Printing the matrix neatly is the most complex part.
    // For clean formatting, convert each number to a string
    // and find length of the longest of these strings.
    // Build a matrix of these strings to print later.
    final String[][] sts = new String[m.length][];
    int max_length = 0;  // Safe, since all lengths are positive here.
    for (int im = 0; im < m.length; im++) {
      sts[im] = new String[m[im].length];
      for (int jm = 0; jm < m[im].length; jm++) {
        final String st = String.valueOf(m[im][jm]);
        if (st.length() > max_length) {
          max_length = st.length();
        }
        sts[im][jm] = st;
      }
    }

    // Now max_length holds the length of the longest string.
    // Build a format string to right justify the strings in a field
    // of this length.
    final String format = String.format("%%%ds", max_length);
    for (int im = 0; im < m.length; im++) {
      System.out.print("|");
      // Stop one short to avoid a trailing space.
      for (int jm = 0; jm < m[im].length - 1; jm++) {
        System.out.format(format, m[im][jm]);
        System.out.print(" ");
      }
      System.out.format(format, m[im][m[im].length - 1]);
      System.out.println("|");
    }
  }

  /**
   * Run a test by printing the arguments, computing their
   * Kronecker product, and printing it.
   * @param a The first matrix to multiply.
   * @param b The second matrix to multiply.
   */
  private static void test(final int[][] a, final int[][] b) {
    // Print out matrices and their product.
    System.out.println("Testing Kronecker product");
    System.out.println("Size of matrix a: " + a.length + " by " + a[0].length);
    System.out.println("Matrix a:");
    print_matrix(a);
    System.out.println("Size of matrix b: " + b.length + " by " + b[0].length);
    System.out.println("Matrix b:");
    print_matrix(b);
    System.out.println("Calculating matrix c as Kronecker product");
    final int[][] c = product(a, b);
    System.out.println("Size of matrix c: " + c.length + " by " + c[0].length);
    System.out.println("Matrix c:");
    print_matrix(c);
  }

  /**
   * Create the matrices for the first test and run the test.
   */
  private static void test1() {
    // Test 1: Create a and b.
    final int[][] a = new int[2][];  // 2 by 2
    a[0] = new int[]{1, 2};
    a[1] = new int[]{3, 4};
    final int[][] b = new int[2][];  // 2 by 2
    b[0] = new int[]{0, 5};
    b[1] = new int[]{6, 7};
    // Run the test.
    test(a, b);
  }

  /**
   * Create the matrices for the first test and run the test.
   */
  private static void test2() {
    // Test 2: Create a and b.
    final int[][] a = new int[3][];  // 3 by 3
    a[0] = new int[]{0, 1, 0};
    a[1] = new int[]{1, 1, 1};
    a[2] = new int[]{0, 1, 0};
    final int[][] b = new int[3][];  // 3 by 4
    b[0] = new int[]{1, 1, 1, 1};
    b[1] = new int[]{1, 0, 0, 1};
    b[2] = new int[]{1, 1, 1, 1};
    // Run the test.
    test(a, b);
  }

  /**
   * Run the program to run the two tests.
   * @param args Command line arguments (not used).
   */
  public static void main(final String[] args) {
    // Test the product method.
    test1();
    test2();
  }

}


// matkronprod.js
// Prime function:
// mkp arrow function: Return the Kronecker product of the a and b matrices.
// Note: both a and b must be matrices, i.e., 2D rectangular arrays.
mkp=(a,b)=>a.map(a=>b.map(b=>a.map(y=>b.map(x=>r.push(y*x)),t.push(r=[]))),t=[])&&t;
// Helper functions:
// Log title and matrix mat to console
function matl2cons(title,mat) {console.log(title); console.log(mat.join`\n`)}
// Print title to document
function pttl2doc(title) {document.write(''+title+'
')}
// Print title and matrix mat to document
function matp2doc(title,mat) {
  document.write(''+title+':
');
  for (var i = 0; i < mat.length; i++) {
    document.write('  '+mat[i].join(' ')+'
');
  }
}


def kprod(a; b):

  # element-wise multiplication of a matrix by a number, "c"
  def multiply(c): map( map(. * c) );

  # "right" should be a vector with the same length as the input
  def laminate(right):
    [range(0; right|length) as $i
    | (.[$i] + [right[$i]]) ];

  # "matrix" and the input matrix should have the same number of rows
  def addblock(matrix):
    reduce (matrix|transpose)[] as $v (.; laminate($v));

  (a[0]|length) as $m
  | reduce range(0; a|length) as $i ([];
      . + reduce range(0; $m) as $j ([];
        addblock( b | multiply(a[$i][$j]) ) ));


# v0.6

# Julia has a builtin kronecker product function
a = [1 2; 3 4]
b = [0 5; 6 7]
k = kron(a, b)
println("$a × $b =")
for row in 1:size(k)[1]
    println(k[row,:])
end
println()

a = [0 1 0; 1 1 1; 0 1 0]
b = [1 1 1 1; 1 0 0 1; 1 1 1 1]
k = kron(a, b)
println("$a × $b =")
for row in 1:size(k)[1]
    println(k[row,:])
end


// version 1.1.2 (JVM)

typealias Matrix = Array<IntArray>

fun kroneckerProduct(a: Matrix, b: Matrix): Matrix {
    val m = a.size
    val n = a[0].size
    val p = b.size
    val q = b[0].size
    val rtn = m * p
    val ctn = n * q
    val r: Matrix = Array(rtn) { IntArray(ctn) } // all elements zero by default
    for (i in 0 until m)
        for (j in 0 until n)
            for (k in 0 until p)
                for (l in 0 until q)
                    r[p * i + k][q * j + l] = a[i][j] * b[k][l]
    return r
}

fun printMatrix(text: String, m: Matrix) {
    println(text)
    for (i in 0 until m.size) println(m[i].contentToString())
    println()
}

fun printAll(a: Matrix, b: Matrix, r: Matrix) {
    printMatrix("Matrix A:", a)
    printMatrix("Matrix B:", b)
    printMatrix("Kronecker product:", r)
}

fun main(args: Array<String>) {
    var a: Matrix
    var b: Matrix
    var r: Matrix
    a = arrayOf(
        intArrayOf(1, 2),
        intArrayOf(3, 4)
    )
    b = arrayOf(
        intArrayOf(0, 5),
        intArrayOf(6, 7)
    )
    r = kroneckerProduct(a, b)
    printAll(a, b, r)

    a = arrayOf(
        intArrayOf(0, 1, 0),
        intArrayOf(1, 1, 1),
        intArrayOf(0, 1, 0)
    )
    b = arrayOf(
        intArrayOf(1, 1, 1, 1),
        intArrayOf(1, 0, 0, 1),
        intArrayOf(1, 1, 1, 1)
    )
    r = kroneckerProduct(a, b)
    printAll(a, b, r)
}


import strutils

type Matrix[M, N: static Positive; T: SomeNumber] = array[M, array[N, T]]

func kroneckerProduct[M, N, P, Q: static int; T: SomeNumber](
  a: Matrix[M, N, T], b: Matrix[P, Q, T]): Matrix[M * P, N * Q, T] =
  for i in 0..<M:
    for j in 0..<N:
      for k in 0..<P:
        for l in 0..<Q:
          result[i * P + k][j * Q + l] = a[i][j] * b[k][l]

proc `$`(m: Matrix): string =
  for row in m:
    result.add '['
    let length = result.len
    for val in row:
      result.addSep(" ", length)
      result.add ($val).align(2)
    result.add "]\n"

when isMainModule:

  const
    A1: Matrix[2, 2, int] = [[1, 2], [3, 4]]
    B1: Matrix[2, 2, int] = [[0, 5], [6, 7]]

  echo "Matrix A:\n", A1
  echo "Matrix B:\n", B1
  echo "Kronecker product:\n", kroneckerProduct(A1, B1)

  const
    A2: Matrix[3, 3, int] = [[0, 1, 0], [1, 1, 1], [0, 1, 0]]
    B2: Matrix[3, 4, int] = [[1, 1, 1, 1], [1, 0, 0, 1], [1, 1, 1, 1]]

  echo "Matrix A:\n", A2
  echo "Matrix B:\n", B2
  echo "Kronecker product:\n", kroneckerProduct(A2, B2)


\\ Print title and matrix mat rows. 4/17/16 aev
matprows(title,mat)={print(title); for(i=1,#mat[,1], print(mat[i,]))}
\\
\\ Create and return the Kronecker product of the a and b matrices. 4/17/16 aev
matkronprod(a,b,pflg=0)={
my(m=#a[,1],n=#a[1,],p=#b[,1],q=#b[1,],r,rtn,ctn);
rtn=m*p; ctn=n*q;
if(pflg,print(" *** Kronecker product - a: ",m," x ",n," b: ",p," x ",q," result r: ",rtn," x ",ctn));
r=matrix(rtn,ctn);
for(i=1,m, for(j=1,n, for(k=1,p, for(l=1,q,
    r[p*(i-1)+k,q*(j-1)+l]=a[i,j]*b[k,l];
))));\\all4fend
if(pflg,print(r)); return(r);
}
{\\ Requireq tests:
my(a,b,r);
\\ Sample 1
a=[1,2;3,4];
b=[0,5;6,7];
r=matkronprod(a,b);
matprows("Sample 1 result:",r);
\\ Sample 2
a=[0,1,0;1,1,1;0,1,0];
b=[1,1,1,1;1,0,0,1;1,1,1,1];
r=matkronprod(a,b);
matprows("Sample 2 result:",r);
}


function kronecker(sequence a, b)
    integer ar = length(a),
            ac = length(a[1]),
            br = length(b),
            bc = length(b[1])
    sequence res = repeat(repeat(0,ac*bc),ar*br)
    for ia=1 to ar do
        integer i0 = (ia-1)*br
        for ja=1 to ac do
            integer j0 = (ja-1)*bc
            for ib=1 to br do
                integer i = i0+ib
                for jb=1 to bc do
                    integer j = j0+jb
                    res[i,j] = a[ia,ja]*b[ib,jb]
                end for
            end for
        end for
    end for
    return res
end function

constant a = {{1,2},
              {3,4}},
         b = {{0,5},
              {6,7}},
         c = {{0,1,0},
              {1,1,1},
              {0,1,0}},
         d = {{1,1,1,1},
              {1,0,0,1},
              {1,1,1,1}}

pp(kronecker(a,b),{pp_Nest,1,pp_IntFmt,"%2d"})
pp(kronecker(c,d),{pp_Nest,1})


array kronecker(array matrix1, array matrix2) {
	array final_list = ({});
	array sub_list = ({});

	int count = sizeof(matrix2);

	foreach(matrix1, array elem1) {
		int counter = 0;
		int check = 0;
		while (check < count) {
			foreach(elem1, int num1) {
				foreach(matrix2[counter], int num2) {
					sub_list = Array.push(sub_list, num1 * num2);
				}
			}
		counter += 1;
		final_list = Array.push(final_list, sub_list);
		sub_list = ({});
		check += 1;
		}
	}

	return final_list;
}

int main() {
	//Sample 1
	array(array(int)) a1 = ({ ({1, 2}), ({3, 4}) });
	array(array(int)) b1 = ({ ({0, 5}), ({6, 7}) });

	//Sample 2
	array(array(int)) a2 = ({ ({0, 1, 0}), ({1, 1, 1}), ({0, 1, 0}) });
	array(array(int)) b2 = ({ ({1, 1, 1, 1}), ({1, 0, 0, 1}), ({1, 1, 1, 1}) });

	array result1 = kronecker(a1, b1);
	for (int i = 0; i < sizeof(result1); i++) {
		foreach(result1[i], int result) {
			write((string)result + " ");
		}
		write("\n");
	}

	write("\n");

	array result2 = kronecker(a2, b2);
	for (int i = 0; i < sizeof(result2); i++) {
		foreach(result2[i], int result) {
			write((string)result + " ");
		}
		write("\n");
	}

	return 0;
}


EnableExplicit
DataSection
  Matrix_A_B_Dimension_Bsp1:
  Data.i 2,2,?MatrixA_Werte_Bsp1,2,2,?MatrixB_Werte_Bsp1

  Matrix_A_B_Dimension_Bsp2:
  Data.i 3,3,?MatrixA_Werte_Bsp2,3,4,?MatrixB_Werte_Bsp2

  MatrixA_Werte_Bsp1:
  Data.i 1,2,3,4

  MatrixA_Werte_Bsp2:
  Data.i 0,1,0,1,1,1,0,1,0

  MatrixB_Werte_Bsp1:
  Data.i 0,5,6,7

  MatrixB_Werte_Bsp2:
  Data.i 1,1,1,1,1,0,0,1,1,1,1,1
EndDataSection

Define.i ma, na, mb, nb, adr1, adr2, i, j, k, l
Define mk$

Gosub Bsp1_Matrix_A_B : Gosub LoadMatrix : Gosub Bsp2_Matrix_A_B : Gosub LoadMatrix : End

LoadMatrix:
Read.i ma
Read.i na
Read.i adr1
Read.i mb
Read.i nb
Read.i adr2

Dim mxa.i(ma,na)
Dim mxb.i(mb,nb)
NewMap mxc.i()

For i=1 To ma
  For j=1 To na
    mxa(i,j)=PeekI(adr1)
    adr1+SizeOf(Integer)
  Next
Next

For i=1 To mb
  For j=1 To nb
    mxb(i,j)=PeekI(adr2)
    adr2+SizeOf(Integer)
  Next
Next

OpenConsole("Kronecker product")
PrintN("Matrix A:")
For i=1 To ma ; Zeile
  Print("|")
  For j=1 To na ; Spalte
    Print(RSet(Str(mxa(i,j)),2," ")+" ")
  Next
  PrintN("|")
Next
PrintN("")

PrintN("Matrix B:")
For i=1 To mb ; Zeile
  Print("|")
  For j=1 To nb ; Spalte
    Print(RSet(Str(mxb(i,j)),2," ")+" ")
  Next
  PrintN("|")
Next
PrintN("")

PrintN("Matrix C=AxB")
For i=1 To ma ; Zeile MA
  For j=1 To na ; Spalte MA
    For k=1 To mb ; Zeile MB
      For l=1 To nb ; Spalte MB
        mxc(Str(i)+","+Str(j)+","+Str(k)+","+Str(l))=mxa(i,j)*mxb(k,l)
      Next
    Next
  Next
Next

For i=1 To ma ; Zeile MA
  For k=1 To mb; Zeile MB
    Print("|")
    For j=1 To na ; Spalte MA
      For l=1 To nb ; Spalte MB
        mk$=Str(i)+","+Str(j)+","+Str(k)+","+Str(l)
        If FindMapElement(mxc(),mk$)
          Print(RSet(Str(mxc()),2," ")+" ")
        EndIf
      Next
    Next
    PrintN("|")
  Next
Next
PrintN("Press return") : Input()
Return

Bsp1_Matrix_A_B:
  Restore Matrix_A_B_Dimension_Bsp1
Return

Bsp2_Matrix_A_B:
  Restore Matrix_A_B_Dimension_Bsp2
Return


#!/usr/bin/env python3

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

# Sample 2
a2 = [[0, 1, 0], [1, 1, 1], [0, 1, 0]]
b2 = [[1, 1, 1, 1], [1, 0, 0, 1], [1, 1, 1, 1]]

def kronecker(matrix1, matrix2):
    final_list = []
    sub_list = []

    count = len(matrix2)

    for elem1 in matrix1:
        counter = 0
        check = 0
        while check < count:
            for num1 in elem1:
                for num2 in matrix2[counter]:
                    sub_list.append(num1 * num2)
            counter += 1
            final_list.append(sub_list)
            sub_list = []
            check +=1

    return final_list

# Result 1
result1 = kronecker(a1, b1)
for elem in result1:
    print(elem)

print("")

# Result 2
result2 = kronecker(a2, b2)
for elem in result2:
    print(elem)


## Sample using:
a <- matrix(c(1,1,1,1), ncol=2, nrow=2, byrow=TRUE);
b <- matrix(c(0,1,1,0), ncol=2, nrow=2, byrow=TRUE);
a %x% b


#lang typed/racket/base

(require math/array
         math/matrix
         racket/match)

(define-type (M A) (Matrix A))

(define #:forall (A B C) (general-⊗ [m1 : (M A)] [m2 : (M B)] [× : (A B -> C)]) : (M C)
  (match-let* ((`(#(,rs1 ,cs1) . #(,rs2 ,cs2)) (cons (array-shape m1) (array-shape m2)))
               (rs (* rs1 rs2))
               (cs (* cs1 cs2)))
    (for*/matrix: rs cs ((r (in-range rs)) (c (in-range cs))) : C
      (let-values (((rq rr) (quotient/remainder r rs2))
                   ((cq cr) (quotient/remainder c cs2)))
        (× (array-ref m1 (vector rq cq)) (array-ref m2 (vector rr cr)))))))

;; Narrow to Number
(define (Kronecker-product [m1 : (M Number)] [m2 : (M Number)]) (general-⊗ m1 m2 *))

;; ---------------------------------------------------------------------------------------------------
(module+ test
  (Kronecker-product (matrix [[1 2]
                              [3 4]])
                     (matrix [[0 5]
                              [6 7]]))

  (Kronecker-product (matrix [[0 1 0]
                              [1 1 1]
                              [0 1 0]])
                     (matrix [[1 1 1 1]
                              [1 0 0 1]
                              [1 1 1 1]])))


/*REXX program calculates the   Kronecker product   of   two arbitrary size   matrices. */
w= 0                                             /*W:  max width of any matrix element. */
     aMat= 2x2  1 2 3 4                          /*define  A  matrix size  and elements.*/
     bMat= 2x2  0 5 6 7                          /*   "    B     "     "    "     "     */
call makeMat 'A', aMat                           /*construct   A   matrix from elements.*/
call makeMat 'B', bMat                           /*    "       B      "     "     "     */
call KronMat 'Kronecker product'                 /*calculate the  Kronecker  product.   */
w= 0;      say;     say copies('░', 55);   say   /*display a fence between the 2 outputs*/
     aMat= 3x3  0 1 0 1 1 1 0 1 0                /*define  A  matrix size  and elements.*/
     bMat= 3x4  1 1 1 1 1 0 0 1 1 1 1 1          /*   "    B     "     "    "     "     */
call makeMat 'A', aMat                           /*construct   A   matrix from elements.*/
call makeMat 'B', bMat                           /*    "       B      "     "     "     */
call KronMat 'Kronecker product'                 /*calculate the  Kronecker  product.   */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
KronMat: parse arg what;                  parse var  @.a.shape   aRows aCols
         #= 0;                            parse var  @.b.shape   bRows bCols
               do       rA=1  for aRows
                 do     rB=1  for bRows;  #= #+1;          ##= 0;      _=
                   do   cA=1  for aCols;  x= @.a.rA.cA
                     do cB=1  for bCols;  y= @.b.rB.cB;    ##= ##+1;   xy= x*y;    _= _ xy
                     @.what.#.##=xy;      w= max(w, length(xy) )
                     end   /*cB*/
                   end     /*cA*/
                 end       /*rB*/
               end         /*rA*/
         call showMat what, aRows*bRows || 'X' || aRows*bCols;         return
/*──────────────────────────────────────────────────────────────────────────────────────*/
makeMat: parse arg what, size elements;   arg , row 'X' col .;       @.what.shape=row  col
         #=0;    do   r=1  for row               /* [↓]  bump item#; get item; max width*/
                   do c=1  for col;  #= #+1;  _= word(elements, #);   w= max(w, length(_))
                   @.what.r.c=_
                   end   /*c*/                   /* [↑] define an element of WHAT matrix*/
                 end     /*r*/
         call showMat what, size;         return
/*──────────────────────────────────────────────────────────────────────────────────────*/
showMat: parse arg what, size .;  z= '┌';  parse var  size  row  "X"  col;   $=left('', 6)
         say;                             say $ copies('═',7) "matrix" what  copies('═',7)
              do   r=1  for row;  _= '│'                  /*start with long vertical bar*/
                do c=1  for col;  _=_  right(@.what.r.c, w);  if r==1  then z=z left('',w)
                end   /*c*/
              if r==1  then do; z=z '┐';  say $ $ z;  end /*show the top part of matrix.*/
              say $ $ _ '│'                               /*append a long vertical bar. */
              end     /*r*/
         say $ $ translate(z, '└┘', "┌┐");   return       /*show the bot part of matrix.*/


# Project : Kronecker product

a = [[1, 2], [3, 4]]
b = [[0, 5], [6, 7]]
la1 = 1
ua1 = 2
la2 = 1
ua2 = 2
lb1 = 1
ub1 = 2
lb2 = 1
ub2 = 2
kroneckerproduct(a,b)
see nl

la1 = 1
ua1 = 3
la2 = 1
ua2 = 3
lb1 = 1
ub1 = 3
lb2 = 1
ub2 = 3
x = [[0, 1, 0], [1, 1, 1], [0, 1, 0]]
y = [[1, 1, 1, 1], [1, 0, 0, 1], [1, 1, 1, 1]]
kroneckerproduct(x, y)

func kroneckerproduct(a,b)

for i = la1 to ua1
      for k = lb1 to ub1
            see "["
            for j = la2 to ua2
                 for l = lb2 to ub2
                       see a[i][j] * b[k][l]
                       if j = ua1 and l = ub2
                          see "]" + nl
                       else
                          see " "
                       ok
                 next
            next
      next
next


fn main() {

    let mut a = vec![vec![1., 2.], vec![3., 4.]];
    let mut b = vec![vec![0., 5.], vec![6., 7.]];

    let mut a_ref = &mut a;
    let a_rref = &mut a_ref;

    let mut b_ref = &mut b;
    let b_rref = &mut b_ref;

    let ab = kronecker_product(a_rref, b_rref);

    println!("Kronecker product of\n");
    for i in a {
        println!("{:?}", i);
    }
    println!("\nand\n");
    for i in b {
        println!("{:?}", i);
    }
    println!("\nis\n");
    for i in ab {
        println!("{:?}", i);
    }

    println!("\n\n");

    let mut a = vec![vec![0., 1., 0.],
                    vec![1., 1., 1.],
                    vec![0., 1., 0.]];
    let mut b = vec![vec![1., 1., 1., 1.],
                    vec![1., 0., 0., 1.],
                    vec![1., 1., 1., 1.]];

    let mut a_ref = &mut a;
    let a_rref = &mut a_ref;

    let mut b_ref = &mut b;
    let b_rref = &mut b_ref;

    let ab = kronecker_product(a_rref, b_rref);

    println!("Kronecker product of\n");
    for i in a {
        println!("{:?}", i);
    }
    println!("\nand\n");
    for i in b {
        println!("{:?}", i);
    }
    println!("\nis\n");
    for i in ab {
        println!("{:?}", i);
    }

    println!("\n\n");

}

fn kronecker_product(a: &mut Vec<Vec<f64>>, b: &mut Vec<Vec<f64>>) -> Vec<Vec<f64>> {
    let m = a.len();
    let n = a[0].len();
    let p = b.len();
    let q = b[0].len();
    let rtn = m * p;
    let ctn = n * q;

    let mut r = zero_matrix(rtn, ctn);

    for i in 0..m {
        for j in 0..n {
            for k in 0..p {
                for l in 0..q {
                    r[p * i + k][q * j + l] = a[i][j] * b[k][l];
                }
            }
        }
    }
    r
}

fn zero_matrix(rows: usize, cols: usize) -> Vec<Vec<f64>> {
    let mut matrix = Vec::with_capacity(cols);
    for _ in 0..rows {
        let mut col: Vec<f64> = Vec::with_capacity(rows);
        for _ in 0..cols {
            col.push(0.0);
        }
        matrix.push(col);
    }
    matrix
}


 object KroneckerProduct
{
  /**Get the dimensions of the input matrix*/
  def getDimensions(matrix : Array[Array[Int]]) : (Int,Int) = {
    val dimensions = matrix.map(x => x.size)
    (dimensions.size, dimensions(0))
  }

  /**Compute the Kronecker product between 2 input matrixes and return the result as a matrix*/
  def kroneckerProduct(matrix1 : Array[Array[Int]], matrix2 : Array[Array[Int]]) : Array[Array[Int]] = {
    val (r1,c1) = getDimensions(matrix1)
    val (r2,c2) = getDimensions(matrix2)

    val res = Array.ofDim[Int](r1*r2, c1*c2)

    for(
      i <- 0 until r1;
      j <- 0 until c1;
      k <- 0 until r2;
      l <- 0 until c2
    ){
      res(r2 * i + k)(c2 * j + l) = matrix1(i)(j) * matrix2(k)(l)
    }

    res
  }

  def main(args: Array[String]): Unit = {
    val m1 = Array(Array(1, 2), Array(3, 4))
    val m2 = Array(Array(0, 5), Array(6, 7))
    println(kroneckerProduct(m1,m2).map(_.mkString("|")).mkString("\n"))

    println("----------")

    val m3 = Array(Array(0, 1, 0), Array(1, 1, 1), Array(0, 1, 0))
    val m4 = Array(Array(1, 1, 1, 1), Array(1, 0, 0, 1), Array(1, 1, 1, 1))
    println(kroneckerProduct(m3,m4).map(_.mkString("|")).mkString("\n"))
  }

}


BEGIN

    PROCEDURE OUTMATRIX(A, W); INTEGER ARRAY A; INTEGER W;
    BEGIN
        INTEGER I, J;
        INTEGER LA1, UA1;
        INTEGER LA2, UA2;

        LA1 := LOWERBOUND(A, 1); UA1 := UPPERBOUND(A, 1);
        LA2 := LOWERBOUND(A, 2); UA2 := UPPERBOUND(A, 2);

        FOR I := LA1 STEP 1 UNTIL UA1 DO
        BEGIN
            OUTTEXT("[");
            FOR J := LA2 STEP 1 UNTIL UA2 DO
            BEGIN
                IF NOT (J = LA2) THEN OUTCHAR(' ');
                OUTINT(A(I, J), W)
            END;
            OUTTEXT("]");
            OUTIMAGE
        END
    END OUTMATRIX;

    PROCEDURE KRONECKERPRODUCT(A, B, C); INTEGER ARRAY A, B, C;
    BEGIN
        INTEGER I, J, K, L, CI, CJ;
        INTEGER LA1, UA1;
        INTEGER LA2, UA2;
        INTEGER LB1, UB1;
        INTEGER LB2, UB2;

        LA1 := LOWERBOUND(A, 1); UA1 := UPPERBOUND(A, 1);
        LA2 := LOWERBOUND(A, 2); UA2 := UPPERBOUND(A, 2);
        LB1 := LOWERBOUND(B, 1); UB1 := UPPERBOUND(B, 1);
        LB2 := LOWERBOUND(B, 2); UB2 := UPPERBOUND(B, 2);

        CI := 1;
        FOR I := LA1 STEP 1 UNTIL UA1 DO
            FOR K := LB1 STEP 1 UNTIL UB1 DO
            BEGIN
                CJ := 1;
                FOR J := LA2 STEP 1 UNTIL UA2 DO
                    FOR L := LB2 STEP 1 UNTIL UB2 DO
                    BEGIN
                        C(CI, CJ) := A(I, J) * B(K, L);
                        CJ := CJ + 1
                    END;
                CI := CI + 1
            END
    END KRONECKERPRODUCT;

    ! --- EXAMPLE 1 --- ;
    BEGIN
        INTEGER ARRAY A(1:2, 1:2);
        INTEGER ARRAY B(1:2, 1:2);
        INTEGER ARRAY C(1:4, 1:4);

        ! {{1, 2}, {3, 4}} ;

        A(1, 1) := 1;
        A(1, 2) := 2;

        A(2, 1) := 3;
        A(2, 2) := 4;

        ! {{0, 5}, {6, 7}} ;

        B(1, 1) := 0;
        B(1, 2) := 5;

        B(2, 1) := 6;
        B(2, 2) := 7;

        OUTMATRIX(A, 2); OUTTEXT("   *"); OUTIMAGE;
        OUTMATRIX(B, 2); OUTTEXT("   ="); OUTIMAGE;

        KRONECKERPRODUCT(A, B, C);

        OUTMATRIX(C, 2); OUTIMAGE

        ! OUTPUT:

        ! [ 0  5  0 10]
        ! [ 6  7 12 14]
        ! [ 0 15  0 20]
        ! [18 21 24 28] ;

    END EXAMPLE 1;

    ! --- EXAMPLE 2 --- ;
    BEGIN
        INTEGER ARRAY X(1:3, 1:3);
        INTEGER ARRAY Y(1:3, 1:4);
        INTEGER ARRAY C(1:9, 1:12);

        ! {{0, 1, 0}, {1, 1, 1}, {0, 1, 0}} ;

        X(1,1) := 0;
        X(1,2) := 1;
        X(1,3) := 0;

        X(2,1) := 1;
        X(2,2) := 1;
        X(2,3) := 1;

        X(3,1) := 0;
        X(3,2) := 1;
        X(3,3) := 0;

       ! {{1, 1, 1, 1}, {1, 0, 0, 1}, {1, 1, 1, 1}} ;

        Y(1,1) := 1;
        Y(1,2) := 1;
        Y(1,3) := 1;
        Y(1,4) := 1;

        Y(2,1) := 1;
        Y(2,2) := 0;
        Y(2,3) := 0;
        Y(2,4) := 1;

        Y(3,1) := 1;
        Y(3,2) := 1;
        Y(3,3) := 1;
        Y(3,4) := 1;

        OUTIMAGE;

        OUTMATRIX(X, 1); OUTTEXT("   *"); OUTIMAGE;
        OUTMATRIX(Y, 1); OUTTEXT("   ="); OUTIMAGE;

        KRONECKERPRODUCT(X, Y, C);

        OUTMATRIX(C, 1); OUTIMAGE;

        ! OUTPUT:

        ! [0 0 0 0 1 1 1 1 0 0 0 0]
        ! [0 0 0 0 1 0 0 1 0 0 0 0]
        ! [0 0 0 0 1 1 1 1 0 0 0 0]
        ! [1 1 1 1 1 1 1 1 1 1 1 1]
        ! [1 0 0 1 1 0 0 1 1 0 0 1]
        ! [1 1 1 1 1 1 1 1 1 1 1 1]
        ! [0 0 0 0 1 1 1 1 0 0 0 0]
        ! [0 0 0 0 1 0 0 1 0 0 0 0]
        ! [0 0 0 0 1 1 1 1 0 0 0 0] ;

    END EXAMPLE 2;
END


// the iterative version is derived from the javascript one here:
(
f = { |a, b|
	var m = a.size;
	var n = a[0].size;
	var p = b.size;
	var q = b[0].size;
	var rtn = m * p;
	var ctn = n * q;
	var res = { 0.dup(ctn) }.dup(rtn);
	m.do { |i|
		n.do { |j|
			p.do { |k|
				q.do { |l|
					res[p*i+k][q*j+l] = a[i][j] * b[k][l];
				}
			}
		}
	};
	res
};
)

// Like APL/J, SuperCollider has applicative operators, so here is a shorter version.
// the idea is to first replace every element of b with its product with all of a
// and then reshape the matrix appropriately
// note that +++ is lamination: [[1, 2, 3], [4, 5, 6]] +++ [100, 200] returns [ [ 1, 2, 3, 100 ], [ 4, 5, 6, 200 ] ].

(
f = { |a, b|
	a.collect { |x|
		x.collect { |y| b * y }.reduce('+++')
	}.reduce('++')
}
)

// or shorter:
(a *.2 b).collect(_.reduce('+++')).reduce('++')


func kronecker(m1: [[Int]], m2: [[Int]]) -> [[Int]] {
  let m = m1.count
  let n = m1[0].count
  let p = m2.count
  let q = m2[0].count
  let rtn = m * p
  let ctn = n * q

  var res = Array(repeating: Array(repeating: 0, count: ctn), count: rtn)

  for i in 0..<m {
    for j in 0..<n {
      for k in 0..<p {
        for l in 0..<q {
          res[p * i + k][q * j + l] = m1[i][j] * m2[k][l]
        }
      }
    }
  }

  return res
}

func printMatrix<T>(_ matrix: [[T]]) {
  guard !matrix.isEmpty else {
    print()

    return
  }

  let rows = matrix.count
  let cols = matrix[0].count

  for i in 0..<rows {
    for j in 0..<cols {
      print(matrix[i][j], terminator: " ")
    }

    print()
  }
}

func printProducts(a: [[Int]], b: [[Int]]) {
  print("Matrix A:")
  printMatrix(a)
  print("Matrix B:")
  printMatrix(b)
  print("kronecker a b:")
  printMatrix(kronecker(m1: a, m2: b))
  print()
}

let a = [
  [1, 2],
  [3, 4]
]

let b = [
  [0, 5],
  [6, 7]
]

printProducts(a: a, b: b)

let a2 = [
  [0, 1, 0],
  [1, 1, 1],
  [0, 1, 0]
]

let b2 = [
  [1, 1, 1, 1],
  [1, 0, 0, 1],
  [1, 1, 1, 1]
]

printProducts(a: a2, b: b2)


# some helpers for matrices in nice string form:
proc parse_matrix {s} {
    split [string trim $s] \n
}

proc print_matrix {m} {
    foreach row $m {
        puts [join [lmap x $row {format %3s $x}]]
    }
}

# obvious imperative version using [foreach]
proc kroenecker {A B} {
    foreach arow $A {
        foreach brow $B {
            set row {}
            foreach a $arow {
                foreach b $brow {
                    lappend row [expr {$a * $b}]
                }
            }
            lappend result $row
        }
    }
    return $result
}

proc lolcat {args} {    ;# see https://wiki.tcl.tk/41507
    concat {*}[uplevel 1 lmap $args]
}

# more compact but obtuse, using [lmap] and [lolcat]
proc kroenecker {A B} {
    lolcat arow $A {
        lmap brow $B {
            lolcat a $arow {
                lmap b $brow {
                    expr {$a * $b}
                }
            }
        }
    }
}

# demo:
set inputs {
    {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}
}

foreach {a b} $inputs {
    set a [parse_matrix $a]
    set b [parse_matrix $b]
    print_matrix [kroenecker $a $b]
    puts ""
}


' Kronecker product - 05/04/2017
dim a(),b(),r()

sub kroneckerproduct '(a,b)
    m=ubound(a,1): n=ubound(a,2)
    p=ubound(b,1): q=ubound(b,2)
    rtn=m*p
    ctn=n*q
    redim r(rtn,ctn)
    for i=1 to m
        for j=1 to n
            for k=1 to p
                for l=1 to q
                    r(p*(i-1)+k,q*(j-1)+l)=a(i,j)*b(k,l)
    next: next: next: next
end sub 'kroneckerproduct

sub printmatrix(text,m,w)
    wscript.stdout.writeline text
    select case m
        case "a": ni=ubound(a,1): nj=ubound(a,2)
        case "b": ni=ubound(b,1): nj=ubound(b,2)
        case "r": ni=ubound(r,1): nj=ubound(r,2)
    end select
    for i=1 to ni
        for j=1 to nj
            select case m
                case "a": k=a(i,j)
                case "b": k=b(i,j)
                case "r": k=r(i,j)
            end select
            wscript.stdout.write right(space(w)&k,w)
        next
        wscript.stdout.writeline
    next
end sub 'printmatrix

sub printall(w)
    printmatrix "matrix a:", "a", w
    printmatrix "matrix b:", "b", w
    printmatrix "kronecker product:", "r", w
end sub 'printall

sub main()
    xa=array( 1, 2, _
              3, 4)
    redim a(2,2)
    k=0: for i=1 to ubound(a,1): for j=1 to ubound(a,1)
        a(i,j)=xa(k): k=k+1
    next:next
    xb=array( 0, 5, _
              6, 7)
    redim b(2,2)
    k=0: for i=1 to ubound(b,1): for j=1 to ubound(b,1)
        b(i,j)=xb(k): k=k+1
    next:next
    kroneckerproduct
    printall 3

    xa=array( 0, 1, 0, _
              1, 1, 1, _
              0, 1, 0)
    redim a(3,3)
    k=0: for i=1 to ubound(a,1): for j=1 to ubound(a,1)
        a(i,j)=xa(k): k=k+1
    next:next
    xb=array( 1, 1, 1, 1, _
              1, 0, 0, 1, _
              1, 1, 1, 1)
    redim b(3,4)
    k=0: for i=1 to ubound(b,1): for j=1 to ubound(b,1)
        b(i,j)=xb(k): k=k+1
    next:next
    kroneckerproduct
    printall 2
end sub 'main

main


import "/fmt" for Fmt
import "/matrix" for Matrix

var a1 = [
    [1, 2],
    [3, 4]
]

var a2 =  [
    [0, 5],
    [6, 7]
]

var a3 = [
    [0, 1, 0],
    [1, 1, 1],
    [0, 1, 0]
]

var a4 = [
    [1, 1, 1, 1],
    [1, 0, 0, 1],
    [1, 1, 1, 1]
]

var m1 = Matrix.new(a1)
var m2 = Matrix.new(a2)
Fmt.mprint(m1.kronecker(m2), 2, 0)
System.print()
var m3 = Matrix.new(a3)
var m4 = Matrix.new(a4)
Fmt.mprint(m3.kronecker(m4), 2, 0)


var [const] GSL=Import.lib("zklGSL");    // libGSL (GNU Scientific Library)
fcn kronecker(A,B){
   m,n, p,q := A.rows,A.cols, B.rows,B.cols;
   r:=GSL.Matrix(m*p, n*q);
   foreach i,j,k,l in (m,n,p,q){ r[p*i + k, q*j + l]=A[i,j]*B[k,l] }
   r
}


F kroneckerProduct(a, b)
   V m = a.len
   V n = a[0].len
   V p = b.len
   V q = b[0].len
   V result = [[0] * (n * q)] * (m * p)
   L(i) 0 .< m
      L(j) 0 .< n
         L(k) 0 .< p
            L(l) 0 .< q
               result[i * p + k][j * q + l] = a[i][j] * b[k][l]
   R result

F kroneckerPower(m, n)
   V result = m
   L 2..n
      result = kroneckerProduct(result, m)
   R result

F to_str(m)
   V result = ‘’
   L(row) m
      L(val) row
         result ‘’= I val == 0 {‘  ’} E ‘ *’
      result ‘’= "\n"
   R result

V a1 = [[0, 1, 0], [1, 1, 1], [0, 1, 0]]
print(‘Vicsek fractal:’)
print(to_str(kroneckerPower(a1, 4)))
print()
V a2 = [[1, 1, 1], [1, 0, 1], [1, 1, 1]]
print(‘Sierpinski carpet fractal:’)
print(to_str(kroneckerPower(a2, 4)))


with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;
with SDL.Events.Mice;

procedure Kronecker_Fractals is

   Width  : constant := 800;
   Height : constant := 800;
   Order  : constant := 6;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;

   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 "*";

   function "**" (Base : Matrix; Exp : Positive) return Matrix is
      (case Exp is
         when 1      => Base,
         when 2      => Base * Base,
         when others => Base * Base ** (Exp - 1));

   procedure Draw_Matrix (LX, LY : Integer; M : Matrix) is
      use SDL.C;
   begin
      for Y in M'Range (1) loop
         for X in M'Range (2) loop
            if M (Y, X) /= 0 then
               Renderer.Draw (Point => (int (LX + X), int (LY + Y)));
            end if;
         end loop;
      end loop;
   end Draw_Matrix;

   type Fractals is (Cross, H, X, Sierpinski, U);
   Base : Fractals := Fractals'First;

   M : constant array (Fractals) of Matrix (1 .. 3, 1 .. 3) :=
     (Cross      => ((0, 1, 0), (1, 1, 1), (0, 1, 0)),
      H          => ((1, 0, 1), (1, 1, 1), (1, 0, 1)),
      X          => ((1, 0, 1), (0, 1, 0), (1, 0, 1)),
      Sierpinski => ((1, 1, 1), (1, 0, 1), (1, 1, 1)),
      U          => ((1, 0, 1), (1, 0, 1), (1, 1, 1)));

   procedure Draw is
   begin
      Renderer.Set_Draw_Colour ((0, 0, 0, 255));
      Renderer.Fill (Rectangle => (0, 0, Width, Height));

      Renderer.Set_Draw_Colour (Colour => (0, 220, 0, 255));
      Draw_Matrix (10, 10, M (Base) ** Order);
      Window.Update_Surface;
      Base := (if Base = Fractals'Last
                    then Fractals'First
                    else Fractals'Succ (Base));
   end Draw;

   procedure Event_Loop is
      use type SDL.Events.Event_Types;
      Event : SDL.Events.Events.Events;
   begin
      loop
         SDL.Events.Events.Wait (Event);
         case Event.Common.Event_Type is
            when SDL.Events.Quit             => return;
            when SDL.Events.Mice.Button_Down => Draw;
            when others                      => null;
         end case;
      end loop;
   end Event_Loop;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Kronecker fractals (Click to cycle)",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);

   Draw;
   Event_Loop;
   Window.Finalize;
   SDL.Finalise;
end Kronecker_Fractals;


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

typedef struct{
    int row, col;
}cell;

int ROW,COL,SUM=0;

unsigned long raiseTo(int base,int power){
    if(power==0)
        return 1;
    else
        return base*raiseTo(base,power-1);
}

cell* kroneckerProduct(char* inputFile,int power){
    FILE* fp = fopen(inputFile,"r");

    int i,j,k,l;
    unsigned long prod;
    int** matrix;
    cell *coreList,*tempList,*resultList;

    fscanf(fp,"%d%d",&ROW,&COL);

    matrix = (int**)malloc(ROW*sizeof(int*));

    for(i=0;i<ROW;i++){
        matrix[i] = (int*)malloc(COL*sizeof(int));
        for(j=0;j<COL;j++){
            fscanf(fp,"%d",&matrix[i][j]);
            if(matrix[i][j]==1)
                SUM++;
        }
    }

    coreList = (cell*)malloc(SUM*sizeof(cell));
    resultList = (cell*)malloc(SUM*sizeof(cell));

    k = 0;

    for(i=0;i<ROW;i++){
        for(j=0;j<COL;j++){
            if(matrix[i][j]==1){
                coreList[k].row = i+1;
                coreList[k].col = j+1;
                resultList[k].row = i+1;
                resultList[k].col = j+1;
                k++;
            }
        }
    }

    prod = k;

    for(i=2;i<=power;i++){
        tempList = (cell*)malloc(prod*k*sizeof(cell));

        l = 0;

        for(j=0;j<prod;j++){
            for(k=0;k<SUM;k++){
                tempList[l].row = (resultList[j].row-1)*ROW + coreList[k].row;
                tempList[l].col = (resultList[j].col-1)*COL + coreList[k].col;
                l++;
            }
        }

        free(resultList);

        prod *= k;

        resultList = (cell*)malloc(prod*sizeof(cell));

        for(j=0;j<prod;j++){
            resultList[j].row = tempList[j].row;
            resultList[j].col = tempList[j].col;
        }
        free(tempList);
    }

    return resultList;
}

int main(){
    char fileName[100];
    int power,i,length;

    cell* resultList;

    printf("Enter input file name : ");
    scanf("%s",fileName);

    printf("Enter power : ");
    scanf("%d",&power);

    resultList = kroneckerProduct(fileName,power);

    initwindow(raiseTo(ROW,power),raiseTo(COL,power),"Kronecker Product Fractal");

    length = raiseTo(SUM,power);

    for(i=0;i<length;i++){
        putpixel(resultList[i].row,resultList[i].col,15);
    }

    getch();

    closegraph();

    return 0;
}


#include <cassert>
#include <vector>

#include <QImage>

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;
}

bool kronecker_fractal(const char* fileName, const matrix<unsigned char>& m, int order) {
    matrix<unsigned char> result = m;
    for (int i = 0; i < order; ++i)
        result = kronecker_product(result, m);

    size_t height = result.rows();
    size_t width = result.columns();
    size_t bytesPerLine = 4 * ((width + 3)/4);
    std::vector<uchar> imageData(bytesPerLine * height);

    for (size_t i = 0; i < height; ++i)
        for (size_t j = 0; j < width; ++j)
            imageData[i * bytesPerLine + j] = result(i, j);

    QImage image(&imageData[0], width, height, bytesPerLine, QImage::Format_Indexed8);
    QVector<QRgb> colours(2);
    colours[0] = qRgb(0, 0, 0);
    colours[1] = qRgb(255, 255, 255);
    image.setColorTable(colours);
    return image.save(fileName);
}

int main() {
    matrix<unsigned char> matrix1(3, 3, {{0,1,0}, {1,1,1}, {0,1,0}});
    matrix<unsigned char> matrix2(3, 3, {{1,1,1}, {1,0,1}, {1,1,1}});
    matrix<unsigned char> matrix3(2, 2, {{1,1}, {0,1}});
    kronecker_fractal("vicsek.png", matrix1, 5);
    kronecker_fractal("sierpinski_carpet.png", matrix2, 5);
    kronecker_fractal("sierpinski_triangle.png", matrix3, 8);
    return 0;
}


USING: io kernel math math.matrices.extras sequences ;

: mat-kron-pow ( m n -- m' )
    1 - [ dup kronecker-product ] times ;

: print-fractal ( m -- )
    [ [ 1 = "*" " " ? write ] each nl ] each ;

{ { 0 1 0 } { 1 1 1 } { 0 1 0 } }
{ { 1 1 1 } { 1 0 1 } { 1 1 1 } }
{ { 0 1 1 } { 0 1 0 } { 1 1 0 } }
[ 3 mat-kron-pow print-fractal ] [email protected]


program Kron_frac
  implicit none

  interface
    function matkronpow(M, n) result(Mpowern)
      integer, dimension(:,:), intent(in) :: M
      integer, intent(in) :: n
      integer, dimension(size(M, 1)**n, size(M,2)**n) :: Mpowern
    end function matkronpow

    function kron(A, B) result(M)
      integer, dimension(:,:), intent(in) :: A, B
      integer, dimension(size(A,1)*size(B,1), size(A,2)*size(B,2)) :: M
    end function kron

    subroutine write2file(M, filename)
      integer, dimension(:,:), intent(in) :: M
      character(*), intent(in) :: filename
    end subroutine write2file
  end interface

  integer, parameter :: n = 4
  integer, dimension(3,3) :: Vicsek, Sierpinski
  integer, dimension(4,4) :: Hadamard
  integer, dimension(3**n, 3**n) :: fracV, fracS
  integer, dimension(4**n, 4**n) :: fracH

  Vicsek = reshape( (/0, 1, 0,&
                      1, 1, 1,&
                      0, 1, 0/),&
                    (/3,3/) )

  Sierpinski = reshape( (/1, 1, 1,&
                          1, 0, 1,&
                          1, 1, 1/),&
                          (/3,3/) )

  Hadamard = transpose(reshape( (/ 1, 0, 1, 0,&
                         1, 0, 0, 1,&
                         1, 1, 0, 0,&
                         1, 1, 1, 1/),&
                         (/4,4/) ))

  fracV = matkronpow(Vicsek, n)
  fracS = matkronpow(Sierpinski, n)
  fracH = matkronpow(Hadamard, n)

  call write2file(fracV, 'Viczek.txt')
  call write2file(fracS, 'Sierpinski.txt')
  call write2file(fracH, 'Hadamard.txt')

end program

function matkronpow(M, n) result(Mpowern)
interface
function kron(A, B) result(M)
  integer, dimension(:,:), intent(in) :: A, B
  integer, dimension(size(A,1)*size(B,1), size(A,2)*size(B,2)) :: M
  end function kron
end interface

  integer, dimension(:,:), intent(in) :: M
  integer, intent(in) :: n
  integer, dimension(size(M, 1)**n, size(M,2)**n) :: Mpowern
  integer, dimension(:,:), allocatable :: work1, work2
  integer :: icount

  if (n <= 1) then
     Mpowern = M
  else
    allocate(work1(size(M,1), size(M,2)))
    work1 = M
    do icount = 2,n
      allocate(work2(size(M,1)**icount, size(M,2)**icount))
      work2 = kron(work1, M)
      deallocate(work1)
      allocate(work1(size(M,1)**icount, size(M,2)**icount))
      work1 = work2
      deallocate(work2)
    end do
    Mpowern = work1
    deallocate(work1)
  end if

end function matkronpow

function kron(A, B) result(M)
  integer, dimension(:,:), intent(in) :: A, B
  integer, dimension(size(A,1)*size(B,1), size(A,2)*size(B,2)) :: M
  integer :: ia, ja, ib, jb, im, jm

  do ja = 1, size(A, 2)
    do ia = 1, size(A, 1)
      do jb = 1, size(B, 2)
        do ib = 1, size(B, 1)
          im = (ia - 1)*size(B, 1) + ib
          jm = (ja - 1)*size(B, 2) + jb
          M(im, jm) = A(ia, ja) * B(ib, jb)
        end do
      end do
    end do
  end do

end function kron

subroutine write2file(M, filename)
  integer, dimension(:,:), intent(in) :: M
  character(*), intent(in) :: filename
  integer :: ii, jj
  integer, parameter :: fi = 10

  open(fi, file=filename, status='replace')

  do ii = 1,size(M, 1)
    do jj = 1,size(M,2)
      if (M(ii,jj) == 0) then
        write(fi, '(A)', advance='no') ' '
      else
        write(fi, '(A)', advance='no') '*'
      end if
    end do
    write(fi, '(A)') ' '
  end do

  close(fi)

end subroutine write2file


## KPF.gp 4/8/17 aev
## Plotting 3 KPF pictures.
## dat-files are PARI/GP generated output files:
#cd 'C:\gnupData'

##PKF1 from PARI/GP created file pkf1.dat
ttl = "Vicsec fractal"; clr = '"blue"'; filename = "pkf1";
load "plotff.gp"

##PKF2 from PARI/GP created file pkf2.dat
ttl = "Sierpinski carpet fractal"; clr = '"navy"';filename = "pkf2";
load "plotff.gp"

##PKF3 from PARI/GP created file pkf3.dat
ttl = "Sierpinski triangle fractal"; clr = '"dark-green"'; filename = "pkf3";
load "plotff.gp"


package main

import "fmt"

type matrix [][]int

func (m1 matrix) kroneckerProduct(m2 matrix) matrix {
    m := len(m1)
    n := len(m1[0])
    p := len(m2)
    q := len(m2[0])
    rtn := m * p
    ctn := n * q
    r := make(matrix, rtn)
    for i := range r {
        r[i] = make([]int, ctn) // all elements zero by default
    }
    for i := 0; i < m; i++ {
        for j := 0; j < n; j++ {
            for k := 0; k < p; k++ {
                for l := 0; l < q; l++ {
                    r[p*i+k][q*j+l] = m1[i][j] * m2[k][l]
                }
            }
        }
    }
    return r
}

func (m matrix) kroneckerPower(n int) matrix {
    pow := m
    for i := 1; i < n; i++ {
        pow = pow.kroneckerProduct(m)
    }
    return pow
}

func (m matrix) print(text string) {
    fmt.Println(text, "fractal :\n")
    for i := range m {
        for j := range m[0] {
            if m[i][j] == 1 {
                fmt.Print("*")
            } else {
                fmt.Print(" ")
            }
        }
        fmt.Println()
    }
    fmt.Println()
}

func main() {
    m1 := matrix{{0, 1, 0}, {1, 1, 1}, {0, 1, 0}}
    m1.kroneckerPower(4).print("Vivsek")

    m2 := matrix{{1, 1, 1}, {1, 0, 1}, {1, 1, 1}}
    m2.kroneckerPower(4).print("Sierpinski carpet")
}


{-# LANGUAGE OverloadedStrings #-}
import Reflex
import Reflex.Dom
import Data.Map as DM (Map, fromList)
import Data.Text (Text, pack)
import Data.List (transpose)

-- Show Vicsek and Sierpinski Carpet fractals
main :: IO ()
main = mainWidget $ do
  elAttr "h1" ("style" =: "color:black") $ text "Kroneker Product Based Fractals"
  elAttr "a" ("href" =: "http://rosettacode.org/wiki/Kronecker_product_based_fractals#Haskell") $ text "Rosetta Code / Kroneker product based fractals / Haskell"

  -- Show a Vicsek fractal
  el "br" $ return ()
  elAttr "h2" ("style" =: "color:brown") $ text "Vicsek Fractal"
  showFractal [[0, 1, 0] ,[1, 1, 1] ,[0, 1, 0] ]

  -- Show a Sierpinski Carpet fractal
  el "br" $ return ()
  elAttr "h2" ("style" =: "color:brown") $ text "Sierpinski Carpet Fractal"
  showFractal [[1, 1, 1] ,[1, 0, 1] ,[1, 1, 1] ]

-- Size in pixels of an individual cell
cellSize :: Int
cellSize = 8

-- Given a "seed" matrix, generate and display a fractal.
showFractal :: MonadWidget t m => [[Int]] -> m ()
showFractal seed = do
  let boardAttrs w h =
         fromList [ ("width" , pack $ show $ w * cellSize)
                  , ("height", pack $ show $ h * cellSize)
                  ]
      fractals = iterate (kronekerProduct seed) seed
      shown = fractals !! 3 -- the fourth fractal (starting from 0)
      w = length $ head shown
      h = length shown
  elSvgns "svg" (constDyn $ boardAttrs w h) $ showMatrix shown

-- Compute the Kroneker product of two matrices.
kronekerProduct :: Num a => [[a]] -> [[a]] -> [[a]]
kronekerProduct xs ys =
    let m0 = flip $ fmap.fmap.(*)
        m1 = flip $ fmap.fmap.m0
    in concat $ fmap (fmap concat.transpose) $ m1 xs ys

-- Show an entire matrix
showMatrix :: MonadWidget t m => [[Int]] -> m ()
showMatrix m = mapM_ showRow $ zip [0..] m

-- Show a single horizontal row of a matrix
showRow :: MonadWidget t m => (Int,[Int]) -> m ()
showRow (x,r) = mapM_ (showCell x) $ zip [0..] r

-- Show a circle in a box moved to the correct location on screen
showCell :: MonadWidget t m => Int -> (Int,Int) -> m ()
showCell x (y,on) =
  let boxAttrs (x,y) = -- Place box on screen
        fromList [ ("transform",
                    pack $    "scale (" ++ show cellSize ++ ", " ++ show cellSize ++ ") "
                           ++ "translate (" ++ show x ++ ", " ++ show y ++ ")"
                   )
                 ]

      cellAttrs = -- Draw circle in box.
        fromList [ ( "cx",      "0.5")
                 , ( "cy",      "0.5")
                 , ( "r",       "0.45")
                 , ( "style",   "fill:green")
                 ]

  in if (on==1) then  -- Only draw circle for elements containing 1
       elSvgns "g"  (constDyn $ boxAttrs (x,y)) $
         elSvgns "circle" (constDyn $ cellAttrs) $
           return ()
     else
       return ()

-- Wrapper around elDynAttrNS'
elSvgns :: MonadWidget t m => Text -> Dynamic t (Map Text Text) -> m a -> m a
elSvgns t m ma = do
    (el, val) <- elDynAttrNS' (Just "http://www.w3.org/2000/svg") t m ma
    return val


package kronecker;

/**
 * Uses the Kronecker product powers of two rectangular matrices
 * to generate fractals and tests it with three examples.
 */
public class ProductFractals {
  /**
   * Find the Kronecker product of the arguments.
   * @param a The first matrix to multiply.
   * @param b The second matrix to multiply.
   * @return A new matrix: the Kronecker product of the arguments.
   */
  public static int[][] product(final int[][] a, final int[][] b) {
    // Create matrix c as the matrix to fill and return.
    // The length of a matrix is its number of rows.
    final int[][] c = new int[a.length*b.length][];
    // Fill in the (empty) rows of c.
    // The length of each row is the number of columns.
    for (int ix = 0; ix < c.length; ix++) {
      final int num_cols = a[0].length*b[0].length;
      c[ix] = new int[num_cols];
    }
    // Now fill in the values: the products of each pair.
    // Go through all the elements of a.
    for (int ia = 0; ia < a.length; ia++) {
      for (int ja = 0; ja < a[ia].length; ja++) {
        // For each element of a, multiply it by all the elements of b.
        for (int ib = 0; ib < b.length; ib++) {
          for (int jb = 0; jb < b[ib].length; jb++) {
             c[b.length*ia+ib][b[ib].length*ja+jb] = a[ia][ja] * b[ib][jb];
          }
        }
      }
    }

    // Return the completed product matrix c.
    return c;
  }

  /**
   * Print an image obtained from an integer matrix, using the specified
   * characters to indicate non-zero and zero elements.
   * @param m The matrix to print.
   * @param nz The character to print for a non-zero element.
   * @param z The character to print for a zero element.
   */
  public static void show_matrix(final int[][] m, final char nz, final char z) {
    for (int im = 0; im < m.length; im++) {
      for (int jm = 0; jm < m[im].length; jm++) {
        System.out.print(m[im][jm] == 0 ? z : nz);
      }
      System.out.println();
    }
  }

  /**
   * Compute the specified Kronecker product power
   * of the matrix and return  it.
   * @param m The matrix to raise to the power.
   * @param n The power to which to raise the matrix.
   * @return A new matrix containing the resulting power.
   */
  public static int[][] power(final int[][] m, final int n) {
    // Start with m itself as the first power.
    int[][] m_pow = m;
    // Start the iteration with 1, not 0,
    // since we already have the first power.
    for (int ix = 1; ix < n; ix++) {
      m_pow = product(m, m_pow);
    }
    return m_pow;
  }

  /**
   * Run a test by computing the specified Kronecker product power
   * of the matrix and printing matrix and power.
   * @param m The base matrix raise to the power.
   * @param n The power to which to raise the matrix.
   */
  private static void test(final int[][] m, final int n) {
    System.out.println("Test matrix");
    show_matrix(m, '*', ' ');
    final int[][] m_pow = power(m, n);
    System.out.println("Matrix power " + n);
    show_matrix(m_pow, '*', ' ');
  }

  /**
   * Create the matrix for the first test and run the test.
   */
  private static void test1() {
    // Create the matrix.
    final int[][] m = {{0, 1, 0},
                       {1, 1, 1},
                       {0, 1, 0}};
    // Run the test.
    test(m, 4);
  }

  /**
   * Create the matrix for the second test and run the test.
   */
  private static void test2() {
    // Create the matrix.
    final int[][] m = {{1, 1, 1},
                       {1, 0, 1},
                       {1, 1, 1}};
    // Run the test.
    test(m, 4);
  }

  /**
   * Create the matrix for the second test and run the test.
   */
  private static void test3() {
    // Create the matrix.
    final int[][] m = {{1, 0, 1},
                       {1, 0, 1},
                       {0, 1, 0}};
    // Run the test.
    test(m, 4);
  }

  /**
   * Run the program to run the three tests.
   * @param args Command line arguments (not used).
   */
  public static void main(final String[] args) {
    // Test the product fractals.
    test1();
    test2();
    test3();
  }

}


// KPF.js 6/23/16 aev
// HFJS: Plot any matrix mat (filled with 0,1)
function pmat01(mat, color) {
  // DCLs
  var cvs = document.getElementById('canvId');
  var ctx = cvs.getContext("2d");
  var w = cvs.width; var h = cvs.height;
  var m = mat[0].length; var n = mat.length;
  // Cleaning canvas and setting plotting color
  ctx.fillStyle="white"; ctx.fillRect(0,0,w,h);
  ctx.fillStyle=color;
  // MAIN LOOP
  for(var i=0; i<m; i++) {
    for(var j=0; j<n; j++) {
      if(mat[i][j]==1) { ctx.fillRect(i,j,1,1)};
    }//fend j
  }//fend i
}//func end
// Prime functions:
// Create Kronecker product based fractal matrix rm from matrix m (order=ord)
function ckpbfmat(m,ord) {
  var rm=m;
  for(var i=1; i<ord; i++) {rm=mkp(rm,m)};
  //matpp2doc('R 4 ordd',rm,'*'); // ASCII "plotting" - if you wish to try.
  return(rm);
}
// Create and plot Kronecker product based fractal from matrix m (filled with 0/1)
function cpmat(m,ord,color) {
  var kpr;
  kpr=ckpbfmat(m,ord);
  pmat01(kpr,color);
}
// Fractal matrix "pretty" printing to document.
// mat should be filled with 0 and 1; chr is a char substituting 1.
function matpp2doc(title,mat,chr) {
  var i,j,re='',e; var m=mat.length; var n=mat[0].length;
  document.write('  '+title+':
');
  for(var i=0; i<m; i++) {
    for(var j=0; j<n; j++) {
      e=' '; if(mat[i][j]==1) {e=chr}; re+=e;
    }//fend j
    document.write('  '+re+'
'); re='';
  }//fend i
  document.write('
');
}
// mkp function (exotic arrow function): Return the Kronecker product
// of the a and b matrices
mkp=(a,b)=>a.map(a=>b.map(b=>a.map(y=>b.map(x=>r.push(y*x)),t.push(r=[]))),t=[])&&t;


function matkronpow(M::Matrix, n::Int)
    P = copy(M)
    for i in 1:n P = kron(P, M) end
    return P
end

function fracprint(M::Matrix)
    for i in 1:size(M, 1)
        for j in 1:size(M, 2)
            print(M[i, j] == 1 ? '*' : ' ')
        end
        println()
    end
end

M = [0 1 0; 1 1 1; 0 1 0]
matkronpow(M, 3) |> fracprint

M = [1 1 1; 1 0 1; 1 1 1]
matkronpow(M, 3) |> fracprint


// version 1.2.31

typealias Matrix = Array<IntArray>

fun kroneckerProduct(a: Matrix, b: Matrix): Matrix {
    val m = a.size
    val n = a[0].size
    val p = b.size
    val q = b[0].size
    val rtn = m * p
    val ctn = n * q
    val r: Matrix = Array(rtn) { IntArray(ctn) } // all elements zero by default
    for (i in 0 until m)
        for (j in 0 until n)
            for (k in 0 until p)
                for (l in 0 until q)
                    r[p * i + k][q * j + l] = a[i][j] * b[k][l]
    return r
}

fun kroneckerPower(a: Matrix, n: Int): Matrix {
    var pow = a.copyOf()
    for (i in 1 until n) pow = kroneckerProduct(pow, a)
    return pow
}

fun printMatrix(text: String, m: Matrix) {
    println("$text fractal :\n")
    for (i in 0 until m.size) {
        for (j in 0 until m[0].size) {
            print(if (m[i][j] == 1) "*" else " ")
        }
        println()
    }
    println()
}

fun main(args: Array<String>) {
    var a = arrayOf(
        intArrayOf(0, 1, 0),
        intArrayOf(1, 1, 1),
        intArrayOf(0, 1, 0)
    )
    printMatrix("Vicsek", kroneckerPower(a, 4))

    a = arrayOf(
        intArrayOf(1, 1, 1),
        intArrayOf(1, 0, 1),
        intArrayOf(1, 1, 1)
    )
    printMatrix("Sierpinski carpet", kroneckerPower(a, 4))
}


function prod( a, b )
    local rt, l = {}, 1
    for m = 1, #a do
        for p = 1, #b do
            rt[l] = {}
            for n = 1, #a[m] do
                for q = 1, #b[p] do
                    table.insert( rt[l], a[m][n] * b[p][q] )
                end
            end
            l = l + 1
        end
    end
    return rt
end
function love.load()
    wid, hei = love.graphics.getWidth(), love.graphics.getHeight()
    canvas = love.graphics.newCanvas( wid, hei )
    mA = { {0,1,0}, {1,1,1}, {0,1,0} }; mB = { {1,0,1}, {0,1,0}, {1,0,1} }
    mC = { {1,1,1}, {1,0,1}, {1,1,1} }; mD = { {1,1,1}, {0,1,0}, {1,1,1} }
end
function drawFractals( m )
    love.graphics.setCanvas( canvas )
    love.graphics.clear()
    love.graphics.setColor( 255, 255, 255 )
    for j = 1, #m do
        for i = 1, #m[j] do
            if m[i][j] == 1 then
                love.graphics.points( i * .1, j * .1 )
            end
        end
    end
    love.graphics.setCanvas()
end
function love.keypressed( key, scancode, isrepeat )
    local t = {}
    if key == "a" then
        print( "Build Vicsek fractal I" ); t = mA
    elseif key == "b" then
        print( "Build Vicsek fractal II" ); t = mB
    elseif key == "c" then
        print( "Sierpinski carpet fractal" ); t = mC
    elseif key == "d" then
        print( "Build 'H' fractal" ); t = mD
    else return
    end
    for i = 1, 3 do t = prod( t, t ) end
    drawFractals( t )
end
function love.draw()
    love.graphics.draw( canvas )
end


import sequtils

type Matrix[T] = seq[seq[T]]

func kroneckerProduct[T](a, b: Matrix[T]): Matrix[T] =
  result = newSeqWith(a.len * b.len, newSeq[T](a[0].len * b[0].len))
  let m = a.len
  let n = a[0].len
  let p = b.len
  let q = b[0].len
  for i in 0..<m:
    for j in 0..<n:
      for k in 0..<p:
        for l in 0..<q:
          result[i * p + k][j * q + l] = a[i][j] * b[k][l]

func kroneckerPower(m: Matrix; n: int): Matrix =
  result = m
  for i in 2..n:
    result = kroneckerProduct(result, m)

func `$`(m: Matrix): string =
  for row in m:
    for val in row:
      result.add if val == 0: "  " else: " *"
    result.add '\n'

type B = range[0..1]

const A1: Matrix[B] = @[@[B 0, 1, 0], @[B 1, 1, 1], @[B 0, 1, 0]]
echo "Vicsek fractal:\n", A1.kroneckerPower(4)
echo ""
const A2: Matrix[B] = @[@[B 1, 1, 1], @[B 1, 0, 1], @[B 1, 1, 1]]
echo "Sierpinski carpet fractal:\n", A2.kroneckerPower(4)


\\ Build block matrix applying Kronecker product to the special matrix m
\\ (n times to itself). Then plot Kronecker fractal. 4/25/2016 aev
pkronfractal(m,n=2,clr)={
  my(r=m);
  for(i=1,n, r=matkronprod(r,m));
  iPlotmat(r,clr);
}
\\Requireq tests:
{\\ Vicsek fractal: VicsekFractalgp.png
  my(M=[0,1,0;1,1,1;0,1,0]); print(" *** Vicsek fractal, order 4:");
  pkronfractal(M,4,6);
}
{\\ Sierpinski carpet fractal:  SierpCarpetFractalgp.png
  my(M=[1,1,1;1,0,1;1,1,1]); print(" *** Sierpinski carpet fractal, order 4:");
  pkronfractal(M,4,5);
}
{\\ Sierpinski triangle fractal:  SierpTriFractalgp.png
  my(M=[1,1;0,1]); print(" *** Sierpinski triangle fractal, order 7:");
  pkronfractal(M,7,6);
}


use Imager;
use Math::Cartesian::Product;

sub kronecker_product {
    our @a; local *a = shift;
    our @b; local *b = shift;
    my @c;
    cartesian {
        my @cc;
        cartesian {
            push @cc, $_[0] * $_[1];
        } [@{$_[0]}], [@{$_[1]}];
        push @c, [@cc];
    } [@a], [@b];
    @c
}

sub kronecker_fractal {
    my($order, @pattern) = @_;
    my @kronecker = @pattern;
    @kronecker = kronecker_product(\@kronecker, \@pattern) for 0..$order-1;
    @kronecker
}

@vicsek = ( [0, 1, 0], [1, 1, 1], [0, 1, 0] );
@carpet = ( [1, 1, 1], [1, 0, 1], [1, 1, 1] );
@six    = ( [0,1,1,1,0], [1,0,0,0,1], [1,0,0,0,0], [1,1,1,1,0], [1,0,0,0,1], [1,0,0,0,1], [0,1,1,1,0] );

for (['vicsek', \@vicsek, 4],
     ['carpet', \@carpet, 4],
     ['six',    \@six,    3]) {
    ($name, $shape, $order) = @$_;
    @img = kronecker_fractal( $order, @$shape );
    $png = Imager->new(xsize => 1[email protected]{$img[0]}, ysize => 1+@img);
    cartesian {
        $png->setpixel(x => $_[0], y => $_[1], color => $img[$_[1]][$_[0]] ? [255, 255, 32] : [16, 16, 16]);
    } [0[email protected]{$img[0]}-1], [0..$#img];
    $png->write(file => "run/kronecker-$name-perl6.png");
}


function kronecker(sequence a, b)
    integer ar = length(a),
            ac = length(a[1]),
            br = length(b),
            bc = length(b[1])
    sequence res = repeat(repeat(0,ac*bc),ar*br)
    for ia=1 to ar do
        integer i0 = (ia-1)*br
        for ja=1 to ac do
            integer j0 = (ja-1)*bc
            for ib=1 to br do
                integer i = i0+ib
                for jb=1 to bc do
                    integer j = j0+jb
                    res[i,j] = a[ia,ja]*b[ib,jb]
                end for
            end for
        end for
    end for
    return res
end function

function kroneckern(sequence m, integer n)
    sequence res = m
    for i=2 to n do
        res = kronecker(res,m)
    end for
    return res
end function

procedure show(sequence m)
    for i=1 to length(m) do
        string s = repeat(' ',length(m[i]))
        for j=1 to length(s) do
            if m[i][j] then s[j] = '#' end if
        end for
        puts(1,s&"\n")
    end for
    puts(1,"\n")
end procedure

constant vicsek = {{0,1,0},
                   {1,1,1},
                   {0,1,0}},
         siercp = {{1,1,1},
                   {1,0,1},
                   {1,1,1}},
         xxxxxx = {{0,1,1},
                   {0,1,0},
                   {1,1,0}}

show(kroneckern(vicsek,4))
show(kroneckern(siercp,4))
show(kroneckern(xxxxxx,4))


import os
from PIL import Image

def imgsave(path, arr):
    w, h = len(arr), len(arr[0])
    img = Image.new('1', (w, h))
    for x in range(w):
        for y in range(h):
            img.putpixel((x, y), arr[x][y])
    img.save(path)

def get_shape(mat):
    return len(mat), len(mat[0])

def kron(matrix1, matrix2):
    """
    Calculate the kronecker product of two matrices
    """
    final_list = []

    count = len(matrix2)

    for elem1 in matrix1:
        for i in range(count):
            sub_list = []
            for num1 in elem1:
                for num2 in matrix2[i]:
                    sub_list.append(num1 * num2)
            final_list.append(sub_list)

    return final_list

def kronpow(mat):
    """
    Generate an arbitrary number of kronecker powers
    """
    matrix = mat
    while True:
        yield matrix
        matrix = kron(mat, matrix)

def fractal(name, mat, order=6):
    """
    Save fractal as jpg to 'fractals/name'
    """
    path = os.path.join('fractals', name)
    os.makedirs(path, exist_ok=True)

    fgen = kronpow(mat)
    print(name)
    for i in range(order):
        p = os.path.join(path, f'{i}.jpg')
        print('Calculating n =', i, end='\t', flush=True)

        mat = next(fgen)
        imgsave(p, mat)

        x, y = get_shape(mat)
        print('Saved as', x, 'x', y, 'image', p)

test1 = [
    [0, 1, 0],
    [1, 1, 1],
    [0, 1, 0]
]

test2 = [
    [1, 1, 1],
    [1, 0, 1],
    [1, 1, 1]
]

test3 = [
    [1, 0, 1],
    [0, 1, 0],
    [1, 0, 1]
]

fractal('test1', test1)
fractal('test2', test2)
fractal('test3', test3)


## Generate and plot Kronecker product based fractals. aev 8/12/16
## gpKronFractal(m, n, pf, clr, ttl, dflg=0, psz=600):
## Where: m - initial matrix (filled with 0/1); n - order of the fractal;
## pf - plot file name (without extension); clr - color; ttl - plot title;
## dflg - writing dump file flag (0/1); psz - picture size.
gpKronFractal <- function(m, n, pf, clr, ttl, dflg=0, psz=600) {
  cat(" *** START:", date(), "n=", n, "clr=", clr, "psz=", psz, "\n");
  cat(" *** Plot file -", pf, "\n");
  r <- m;
  for(i in 1:n) {r = r%x%m};
  plotmat(r, pf, clr, ttl, dflg, psz);
  cat(" *** END:", date(), "\n");
}

## Required tests:
# 1. Vicsek Fractal
M <- matrix(c(0,1,0,1,1,1,0,1,0), ncol=3, nrow=3, byrow=TRUE);
gpKronFractal(M, 4, "VicsekFractalR","red", "Vicsek Fractal n=4")
# 2. Sierpinski carpet fractal
M <- matrix(c(1,1,1,1,0,1,1,1,1), ncol=3, nrow=3, byrow=TRUE);
gpKronFractal(M, 4, "SierpinskiCarpetFR", "maroon", "Sierpinski carpet fractal n=4")

# 3. Plus sign fractal
M <- matrix(c(1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,0,1,1,1,1,0,0,0,0,0,1,1,1,1,
+0,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1), ncol=7, nrow=7, byrow=TRUE);
gpKronFractal(M, 3, "PlusSignFR", "maroon", "Plus sign fractal, n=3")

# Also, try these 3. I bet you've never seen them before.
# 4. Wider Sierpinski carpet fractal (a.k.a. Sierpinski carpet mutant)
# Note: If your computer is not super fast it could take a lot of time.
#       Use dump flag = 1, to save generated fractal.
#M <- matrix(c(1,1,1,1,1,1,0,0,0,1,1,0,0,0,1,1,0,0,0,1,1,1,1,1,1), ncol=5,
#+nrow=5, byrow=TRUE);
#gpKronFractal(M, 4, "SierpinskiCarpetFw", "brown", "Wider Sierpinski carpet fractal n=4", 1)
# 5. "H" fractal (Try all other letters in the alphabet...)
#M <- matrix(c(1,1,1,1,1,1,1,1,0,0,0,0,0,1,1,1,1,0,1,1,1,1,1,1,0,1,1,1,1,1,1,
#+0,1,1,1,1,0,0,0,0,0,1,1,1,1,1,1,1,1), ncol=7, nrow=7, byrow=TRUE);
#gpKronFractal(M, 3, "HFR", "maroon", "'H' fractal n=3", 1)
# 6. Chessboard fractal.
#M <- matrix(c(1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,
#     0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1), ncol=8, nrow=8, byrow=TRUE);
#gpKronFractal(M, 2, "ChessBrdFractalR","black", "Chessboard Fractal, n=2")


sub kronecker-product ( @a, @b ) { (@a X @b).map: { (.[0].list X* .[1].list).Array } }

sub kronecker-fractal ( @pattern, $order = 4 ) {
    my @kronecker = @pattern;
    @kronecker = kronecker-product(@kronecker, @pattern) for ^$order;
    @kronecker
}

use Image::PNG::Portable;

#Task requirements
my @vicsek = ( [0, 1, 0], [1, 1, 1], [0, 1, 0] );
my @carpet = ( [1, 1, 1], [1, 0, 1], [1, 1, 1] );
my @six    = ( [0,1,1,1,0], [1,0,0,0,1], [1,0,0,0,0], [1,1,1,1,0], [1,0,0,0,1], [1,0,0,0,1], [0,1,1,1,0] );

for  'vicsek', @vicsek, 4,
     'carpet', @carpet, 4,
     'six',    @six,    3
  -> $name,    @shape,  $order {
    my @img = kronecker-fractal( @shape, $order );
    my $png = Image::PNG::Portable.new: :width(@img[0].elems), :height(@img.elems);
    (^@img[0]).race(:12batch).map: -> $x {
        for ^@img -> $y {
            $png.set: $x, $y, |( @img[$y;$x] ?? <255 255 32> !! <16 16 16> );
        }
    }
    $png.write: "kronecker-{$name}-perl6.png";
}


/*REXX program calculates the   Kronecker product   of   two arbitrary size   matrices. */
parse arg pGlyph .                               /*obtain optional argument from the CL.*/
if pGlyph=='' | pGlyph==","  then pGlyph= '█'    /*Not specified?  Then use the default.*/
if length(pGlyph)==2  then pGlyph= x2c(pGlyph)   /*Plot glyph is 2 chars?   Hexadecimal.*/
if length(pGlyph)==3  then pGlyph= d2c(pGlyph)   /*  "    "    " 3   "      Decimal.    */
       aMat= 3x3  0 1 0 1 1 1 0 1 0              /*define  A  matrix size  and elements.*/
       bMat= 3x3  1 1 1 1 0 1 1 1 1              /*   "    B     "     "    "     "     */
call makeMat 'A', aMat                           /*construct   A   matrix from elements.*/
call makeMat 'B', bMat                           /*    "       B      "     "     "     */
call KronMat 'Kronecker product'                 /*calculate the  Kronecker  product.   */
call showMat 'Kronecker product', result         /*display   the  Kronecker  product.   */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
KronMat: parse arg what;              #= 0;           parse var  @.a.shape  aRows  aCols
                                                      parse var  @.b.shape  bRows  bCols
           do       rA=1  for aRows
             do     rB=1  for bRows;  #= # + 1;       ##= 0;         _=
               do   cA=1  for aCols;  x= @.a.rA.cA
                 do cB=1  for bCols;  y= @.b.rB.cB;   ##= ## + 1;   xy= x * y;     _= _ xy
                 @.what.#.##= xy
                 end   /*cB*/
               end     /*cA*/
             end       /*rB*/
           end         /*rA*/;        return aRows * aRows   ||   'X'   ||   bRows * bRows
/*──────────────────────────────────────────────────────────────────────────────────────*/
makeMat: parse arg what, size elements;   arg , row 'X' col .;      @.what.shape= row  col
         #=0;    do   r=1  for row               /* [↓]  bump item#; get item; max width*/
                   do c=1  for col;   #= # + 1;        @.what.r.c= word(elements, #)
                   end   /*c*/                   /* [↑] define an element of WHAT matrix*/
                 end     /*r*/;           return
/*──────────────────────────────────────────────────────────────────────────────────────*/
showMat: parse arg what, size .;   parse var size  row  'X'  col   /*obtain mat name, sz*/
                     do    r=1  for row;    $=                     /*build row by row.  */
                        do c=1  for col;    $= $ || @.what.r.c     /*  "   col  " col.  */
                        end   /*c*/
                     $= translate($, pGlyph, 10)                   /*change──►plot glyph*/
                     say strip($, 'T')                             /*display line──►term*/
                     end     /*r*/;       return


use std::{
    fmt::{Debug, Display, Write},
    ops::Mul,
};

// Rust has (almost) no built-in support for multi-dimensional arrays or so.
// Let's make a basic one ourselves for our use cases.

#[derive(Clone, Debug)]
pub struct Mat<T> {
    col_count: usize,
    row_count: usize,
    items: Vec<T>,
}

impl<T> Mat<T> {
    pub fn from_vec(items: Vec<T>, col_count: usize, row_count: usize) -> Self {
        assert_eq!(items.len(), col_count * row_count, "mismatching dimensions");

        Self {
            col_count,
            row_count,
            items,
        }
    }

    pub fn row_count(&self) -> usize {
        self.row_count
    }

    pub fn col_count(&self) -> usize {
        self.col_count
    }

    pub fn iter(&self) -> impl Iterator<Item = &T> {
        self.items.iter()
    }

    pub fn row_iter(&self, row: usize) -> impl Iterator<Item = &T> {
        assert!(row < self.row_count, "index out of bounds");
        let start = row * self.col_count;
        self.items[start..start + self.col_count].iter()
    }

    pub fn col_iter(&self, col: usize) -> impl Iterator<Item = &T> {
        assert!(col < self.col_count, "index out of bounds");
        self.items.iter().skip(col).step_by(self.col_count)
    }
}

impl<T: Display> Display for Mat<T> {
    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
        // Compute the width of the widest item first
        let mut len = 0usize;
        let mut buf = String::new();
        for item in (0..self.row_count).flat_map(|row| self.row_iter(row)) {
            buf.clear();
            write!(buf, "{}", item)?;
            len = std::cmp::max(len, buf.chars().count());
        }

        // Then render the matrix with proper padding

        len += 1; // To separate cells
        let width = len * self.col_count + 1;
        writeln!(f, "┌{:width$}┐", "", width = width)?;

        for row in (0..self.row_count).map(|row| self.row_iter(row)) {
            write!(f, "│")?;

            for item in row {
                write!(f, "{:>width$}", item, width = len)?;
            }

            writeln!(f, " │")?;
        }

        write!(f, "└{:width$}┘", "", width = width)
    }
}

// Rust standard libraries have no graphics support. If we want to render
// an image, we can write, e.g., a PPM file.

impl<T> Mat<T> {
    pub fn write_ppm(
        &self,
        f: &mut dyn std::io::Write,
        rgb: impl Fn(&T) -> (u8, u8, u8),
    ) -> std::io::Result<()> {
        let bytes = self
            .iter()
            .map(rgb)
            .flat_map(|(r, g, b)| {
                use std::iter::once;
                once(r).chain(once(g)).chain(once(b))
            })
            .collect::<Vec<u8>>();

        write!(f, "P6\n{} {}\n255\n", self.col_count, self.row_count)?;
        f.write_all(&bytes)
    }
}

mod kronecker {

    use super::Mat;
    use std::ops::Mul;

    // Look ma, no numbers! We can combine anything with Mul (see later)

    pub fn product<T, U>(a: &Mat<T>, b: &Mat<U>) -> Mat<<T as Mul<U>>::Output>
    where
        T: Clone + Mul<U>,
        U: Clone,
    {
        let row_count = a.row_count() * b.row_count();
        let col_count = a.col_count() * b.col_count();
        let mut items = Vec::with_capacity(row_count * col_count);

        for i in 0..a.row_count() {
            for k in 0..b.row_count() {
                for a_x in a.row_iter(i) {
                    for b_x in b.row_iter(k) {
                        items.push(a_x.clone() * b_x.clone());
                    }
                }
            }
        }

        Mat::from_vec(items, col_count, row_count)
    }

    pub fn power<T>(m: &Mat<T>, n: u32) -> Mat<T>
    where
        T: Clone + Mul<T, Output = T>,
    {
        match n {
            0 => m.clone(),
            _ => (1..n).fold(product(&m, &m), |result, _| product(&result, &m)),
        }
    }
}

// Here we make a char-like type with Mul implementation.
// We can do fancy things with that later.

#[derive(Clone, Copy, Debug, PartialEq, Eq, PartialOrd, Ord)]
struct Char(char);

impl Char {
    fn space() -> Self {
        Char(' ')
    }

    fn is_space(&self) -> bool {
        self.0 == ' '
    }
}

impl Display for Char {
    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
        Display::fmt(&self.0, f)
    }
}

impl Mul for Char {
    type Output = Self;

    #[allow(clippy::suspicious_arithmetic_impl)]
    fn mul(self, rhs: Self) -> Self {
        if self.is_space() || rhs.is_space() {
            Char(' ')
        } else {
            self
        }
    }
}

fn main() -> std::io::Result<()> {

    // Vicsek rendered in numbers

    #[rustfmt::skip]
    let vicsek = Mat::<u8>::from_vec(vec![
        0, 1, 0,
        1, 1, 1,
        0, 1, 0,
    ], 3, 3);

    println!("{}", vicsek);
    println!("{}", kronecker::power(&vicsek, 3));

    // We could render something by mapping the numbers to
    // something else. But we could compute with something
    // else directly, right?
    let s = Char::space();
    let b = Char('\u{2588}');

    #[rustfmt::skip]
    let sierpienski = Mat::from_vec(vec![
        b, b, b,
        b, s, b,
        b, b, b,
    ], 3, 3);

    println!("{}", sierpienski);
    println!("{}", kronecker::power(&sierpienski, 3));

    #[rustfmt::skip]
    let matrix = Mat::from_vec(vec![
        s, s, b, s, s,
        s, b, b, b, s,
        b, s, b, s, b,
        s, s, b, s, s,
        s, b, s, b, s,
    ], 5, 5,);

    println!("{}", kronecker::power(&matrix, 1));

    // This is nicer as an actual image
    kronecker::power(&matrix, 4).write_ppm(
        &mut std::fs::OpenOptions::new()
            .write(true)
            .create(true)
            .truncate(true)
            .open("kronecker_power.ppm")?,
        |&item| {
            if item.is_space() {
                (0, 0, 32)
            } else {
                (192, 192, 0)
            }
        },
    )
}


func kronecker_product (a, b) { a ~X b -> map { _[0] ~X* _[1] } }

func kronecker_fractal(pattern, order=4) {
    var kronecker = pattern
    { kronecker = kronecker_product(kronecker, pattern) } * order
    return kronecker
}

var vicsek = [[0,1,0], [1,1,1], [0,1,0]]
var carpet = [[1,1,1], [1,0,1], [1,1,1]]
var six    = [[0,1,1,1,0], [1,0,0,0,1], [1,0,0,0,0],
              [1,1,1,1,0], [1,0,0,0,1], [1,0,0,0,1], [0,1,1,1,0]]

require("Imager")

for name,shape,order in [
    [:vicsek, vicsek, 4],
    [:carpet, carpet, 4],
    [:six,    six,    3],
] {
    var pat = kronecker_fractal(shape, order)
    var img = %O<Imager>.new(xsize => pat[0].len, ysize => pat.len)
    for x,y in (^pat[0].len ~X ^pat.len) {
        img.setpixel(x => x, y => y, color => (pat[y][x] ? <255 255 32> : <16 16 16>))
    }
    img.write(file => "kronecker-#{name}-sidef.png")
}


import "/matrix" for Matrix

var kroneckerPower = Fn.new { |m, n|
    var pow = m.copy()
    for (i in 1...n) pow = pow.kronecker(m)
    return pow
}

var printMatrix = Fn.new { |text, m|
    System.print("%(text) fractal :\n")
    for (i in 0...m.numRows) {
        for (j in 0...m.numCols) {
            System.write((m[i][j] == 1) ? "*" : " ")
        }
        System.print()
    }
    System.print()
}

var m = Matrix.new([ [0, 1, 0], [1, 1, 1], [0, 1, 0] ])
printMatrix.call("Vicsek", kroneckerPower.call(m, 4))
m = Matrix.new([ [1, 1, 1], [1, 0, 1], [1, 1, 1] ])
printMatrix.call("Sierpinski carpet", kroneckerPower.call(m, 4))


var [const] GSL=Import.lib("zklGSL");    // libGSL (GNU Scientific Library)
fcn kronecker(A,B){  //--> new Matrix
   m,n, p,q := A.rows,A.cols, B.rows,B.cols;
   r:=GSL.Matrix(m*p, n*q);
   foreach i,j,k,l in (m,n,p,q){ r[p*i + k, q*j + l]=A[i,j]*B[k,l] }
   r
}

fcn kfractal(M,n,fname){
   R:=M;
   do(n){ R=kronecker(R,M) }
   r,c,img := R.rows, R.cols, PPM(r,c,0xFFFFFF);    // white canvas
   foreach i,j in (r,c){ if(R[i,j]) img[i,j]=0x00FF00 } // green dots
   println("%s: %dx%d with %,d points".fmt(fname,R.rows,R.cols,
        R.pump(0,Ref(0).inc,Void.Filter).value)); // count 1s in fractal matrix
   img.writeJPGFile(fname);
}


T S_of_n_creator
   Int n
   i = 0
   [Int] sample

   F (n)
      .n = n

   F ()(item)
      .i++
      I .i <= .n
         .sample.append(item)
      E I random:(.i) < .n
         .sample[random:(.n)] = item

V binarr = [0] * 10
V items = Array(0..9)
print(‘Single run samples for n = 3:’)
V s_of_n = S_of_n_creator(3)
L(item) items
   s_of_n(item)
   print(‘  Item: #. -> sample: #.’.format(item, s_of_n.sample))

L 100000
   s_of_n = S_of_n_creator(3)
   L(item) items
      s_of_n(item)
   L(s) s_of_n.sample
      binarr[s]++
print("\nTest item frequencies for 100000 runs:\n  "(enumerate(binarr).map((i, x) -> ‘#.:#.’.format(i, x)).join("\n  ")))


generic
   Sample_Size: Positive;
   type Item_Type is private;
package S_Of_N_Creator is

   subtype Index_Type is Positive range 1 .. Sample_Size;
   type Item_Array is array (Index_Type) of Item_Type;

   procedure Update(New_Item: Item_Type);
   function Result return Item_Array;

end S_Of_N_Creator;


      HIMEM = PAGE + 20000000

      PRINT "Single run samples for n = 3:"
      SofN% = FNs_of_n_creator(3)
      FOR I% = 0 TO 9
        !^a%() = FN(SofN%)(I%)
        PRINT " For item " ; I% " sample(s) = " FNshowarray(a%(), I%+1)
      NEXT

      DIM cnt%(9)
      PRINT '"Digit counts after 100000 runs:"
      FOR rep% = 1 TO 100000
        IF (rep% MOD 1000) = 0 PRINT ; rep% ; CHR$(13) ;
        F% = FNs_of_n_creator(3)
        FOR I% = 0 TO 9
          !^a%() = FN(F%)(I%)
        NEXT
        cnt%(a%(1)) += 1 : cnt%(a%(2)) += 1 : cnt%(a%(3)) += 1
      NEXT
      FOR digit% = 0 TO 9
        PRINT " " ; digit% " : " ; cnt%(digit%)
      NEXT
      END

      REM Dynamically creates this function:
      REM DEF FNfunction(item%) : PRIVATE samples%(), index%
      REM DIM samples%(n%) : = FNs_of_n(item%, samples%(), index%)
      DEF FNs_of_n_creator(n%)
      LOCAL p%, f$
      f$ = "(item%) : " + CHR$&0E + " samples%(), index% : " + \
      \    CHR$&DE + " samples%(" + STR$(n%) + ") : = " + \
      \    CHR$&A4 + "s_of_n(item%, samples%(), index%)"
      DIM p% LEN(f$) + 4 : $(p%+4) = f$ : !p% = p%+4
      = p%

      DEF FNs_of_n(D%, s%(), RETURN I%)
      LOCAL N%
      N% = DIM(s%(),1)
      I% += 1
      IF I% <= N% THEN
        s%(I%) = D%
      ELSE
        IF RND(I%) <= N% s%(RND(N%)) = D%
      ENDIF
      = !^s%()

      DEF FNshowarray(a%(), n%)
      LOCAL i%, a$
      a$ = "["
      IF n% > DIM(a%(),1) n% = DIM(a%(),1)
      FOR i% = 1 TO n%
        a$ += STR$(a%(i%)) + ", "
      NEXT
      = LEFT$(LEFT$(a$)) + "]"


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

struct s_env {
    unsigned int n, i;
    size_t size;
    void *sample;
};

void s_of_n_init(struct s_env *s_env, size_t size, unsigned int n)
{
    s_env->i = 0;
    s_env->n = n;
    s_env->size = size;
    s_env->sample = malloc(n * size);
}

void sample_set_i(struct s_env *s_env, unsigned int i, void *item)
{
    memcpy(s_env->sample + i * s_env->size, item, s_env->size);
}

void *s_of_n(struct s_env *s_env, void *item)
{
    s_env->i++;
    if (s_env->i <= s_env->n)
        sample_set_i(s_env, s_env->i - 1, item);
    else if ((rand() % s_env->i) < s_env->n)
        sample_set_i(s_env, rand() % s_env->n, item);
    return s_env->sample;
}

int *test(unsigned int n, int *items_set, unsigned int num_items)
{
    int i;
    struct s_env s_env;
    s_of_n_init(&s_env, sizeof(items_set[0]), n);
    for (i = 0; i < num_items; i++) {
        s_of_n(&s_env, (void *) &items_set[i]);
    }
    return (int *)s_env.sample;
}

int main()
{
    unsigned int i, j;
    unsigned int n = 3;
    unsigned int num_items = 10;
    unsigned int *frequencies;
    int *items_set;
    srand(time(NULL));
    items_set = malloc(num_items * sizeof(int));
    frequencies = malloc(num_items * sizeof(int));
    for (i = 0; i < num_items; i++) {
        items_set[i] = i;
        frequencies[i] = 0;
    }
    for (i = 0; i < 100000; i++) {
        int *res = test(n, items_set, num_items);
        for (j = 0; j < n; j++) {
            frequencies[res[j]]++;
        }
	free(res);
    }
    for (i = 0; i < num_items; i++) {
        printf(" %d", frequencies[i]);
    }
    puts("");
    return 0;
}


#include <iostream>
#include <functional>
#include <vector>
#include <cstdlib>
#include <ctime>

template <typename T>
std::function<std::vector<T>(T)> s_of_n_creator(int n) {
  std::vector<T> sample;
  int i = 0;
  return [=](T item) mutable {
    i++;
    if (i <= n) {
      sample.push_back(item);
    } else if (std::rand() % i < n) {
      sample[std::rand() % n] = item;
    }
    return sample;
  };
}

int main() {
  std::srand(std::time(NULL));
  int bin[10] = {0};
  for (int trial = 0; trial < 100000; trial++) {
    auto s_of_n = s_of_n_creator<int>(3);
    std::vector<int> sample;
    for (int i = 0; i < 10; i++)
      sample = s_of_n(i);
    for (int s : sample)
      bin[s]++;
  }
  for (int x : bin)
    std::cout << x << std::endl;
  return 0;
}


(defn s-of-n-fn-creator [n]
  (fn [[sample iprev] item]
    (let [i (inc iprev)]
      (if (<= i n)
        [(conj sample item) i]
        (let [r (rand-int i)]
          (if (< r n)
            [(assoc sample r item) i]
            [sample i]))))))

(def s-of-3-fn (s-of-n-fn-creator 3))

(->> #(reduce s-of-3-fn [[] 0] (range 10))
    (repeatedly 100000)
    (map first)
    flatten
    frequencies
    sort
    println)


s_of_n_creator = (n) ->
  arr = []
  cnt = 0
  (elem) ->
    cnt += 1
    if cnt <= n
      arr.push elem
    else
      pos = Math.floor(Math.random() * cnt)
      if pos < n
        arr[pos] = elem
    arr.sort()

sample_size = 3
range = [0..9]
num_trials = 100000

counts = {}

for digit in range
  counts[digit] = 0

for i in [1..num_trials]
  s_of_n = s_of_n_creator(sample_size)
  for digit in range
    sample = s_of_n(digit)
  for digit in sample
    counts[digit] += 1

for digit in range
  console.log digit, counts[digit]


(defun s-n-creator (n)
  (let ((sample (make-array n :initial-element nil))
        (i 0))
    (lambda (item)
      (if (<= (incf i) n)
          (setf (aref sample (1- i)) item)
        (when (< (random i) n)
          (setf (aref sample (random n)) item)))
      sample)))

(defun algorithm-s ()
  (let ((*random-state* (make-random-state t))
        (frequency (make-array '(10) :initial-element 0)))
    (loop repeat 100000
          for s-of-n = (s-n-creator 3)
          do (flet ((s-of-n (item)
                      (funcall s-of-n item)))
               (map nil
                    (lambda (i)
                      (incf (aref frequency i)))
                    (loop for i from 0 below 9
                          do (s-of-n i)
                          finally (return (s-of-n 9))))))
    frequency))

(princ (algorithm-s))


import std.stdio, std.random;

auto sofN_creator(in int n) {
    size_t i;
    int[] sample;

    return (in int item) {
        i++;
        if (i <= n)
            sample ~= item;
        else if (uniform01 < (double(n) / i))
            sample[uniform(0, n)] = item;
        return sample;
    };
}

void main() {
    enum nRuns = 100_000;
    size_t[10] bin;

    foreach (immutable trial; 0 .. nRuns) {
        immutable sofn = sofN_creator(3);
        int[] sample;
        foreach (immutable item; 0 .. bin.length)
            sample = sofn(item);
        foreach (immutable s; sample)
            bin[s]++;
    }
    writefln("Item counts for %d runs:\n%s", nRuns, bin);
}


import system'dynamic;
import extensions;
import system'routines;
import system'collections;

extension algorithmOp
{
    s_of_n()
    {
        var counter := new Integer();
        var n := self;

        ^ new ArrayList().mixInto(new
        {
            eval(i)
            {
                counter.append:1;

                if (__target.Length < n)
                {
                    __target.append:i
                }
                else
                {
                    if(randomGenerator.nextInt:counter < n)
                        { __target[randomGenerator.nextInt:n] := i }
                };

                ^ __target.Value
            }
        })
    }
}

public program()
{
    var bin := Array.allocate(10).populate:(n => new Integer());
    for(int trial := 0, trial < 10000, trial += 1)
    {
        var s_of_n := 3.s_of_n();

        for(int n := 0, n < 10, n += 1)
        {
            var sample := s_of_n.eval:n;

            if (n == 9)
                { sample.forEach:(i){ bin[i].append:1 } }
        }
    };

    console.printLine:bin.readChar()
}


defmodule Knuth do
  def s_of_n_creator(n), do: {n, 1, []}

  def s_of_n({n, i, ys}, x) do
    cond do
      i <= n -> {n, i+1, [x|ys]}

      :rand.uniform(i) <= n ->
        {n, i+1, List.replace_at(ys, :rand.uniform(n)-1, x)}

      true -> {n, i+1, ys}
    end
  end
end

results = Enum.reduce(1..100000, %{}, fn _, freq ->
  {_, _, xs} = Enum.reduce(1..10, Knuth.s_of_n_creator(3), fn x, s ->
    Knuth.s_of_n(s, x)
  end)
  Enum.reduce(xs, freq, fn x, freq ->
    Map.put(freq, x, (freq[x] || 0) + 1)
  end)
end)

IO.inspect results


let N=System.Random 23 //Nigel Galloway: August 7th., 2018
let s_of_n_creator i = fun g->Seq.fold(fun (n:_[]) g->if N.Next()%(g+1)>i-1 then n else n.[N.Next()%i]<-g;n) (Array.ofSeq (Seq.take i g)) (Seq.skip i g)
let s_of_n<'n> = s_of_n_creator 3
printfn "using an input array -> %A" (List.init 100000 (fun _->s_of_n [|0..9|]) |> Array.concat |> Array.countBy id |> Array.sort)
printfn "using an input list  -> %A" (List.init 100000 (fun _->s_of_n [0..9]) |> Array.concat |> Array.countBy id |> Array.sort)


package main

import (
    "fmt"
    "math/rand"
    "time"
)

func sOfNCreator(n int) func(byte) []byte {
    s := make([]byte, 0, n)
    m := n
    return func(item byte) []byte {
        if len(s) < n {
            s = append(s, item)
        } else {
            m++
            if rand.Intn(m) < n {
                s[rand.Intn(n)] = item
            }
        }
        return s
    }
}

func main() {
    rand.Seed(time.Now().UnixNano())
    var freq [10]int
    for r := 0; r < 1e5; r++ {
        sOfN := sOfNCreator(3)
        for d := byte('0'); d < '9'; d++ {
            sOfN(d)
        }
        for _, d := range sOfN('9') {
            freq[d-'0']++
        }
    }
    fmt.Println(freq)
}


import Control.Monad.Random
import Control.Monad.State
import qualified Data.Map as M
import System.Random

-- s_of_n_creator :: Int -> a -> RandT StdGen (State (Int, [a])) [a]
s_of_n_creator :: Int -> a -> StateT (Int, [a]) (Rand StdGen) [a]
s_of_n_creator n v = do
  (i, vs) <- get
  let i' = i + 1
  if i' <= n
    then do
      let vs' = v : vs
      put (i', vs')
      pure vs'
    else do
      j <- getRandomR (1, i')
      if j > n
        then do
          put (i', vs)
          pure vs
        else do
          k <- getRandomR (0, n - 1)
          let (f, (_ : b)) = splitAt k vs
              vs' = v : f ++ b
          put (i', vs')
          pure vs'

sample :: Int -> Rand StdGen [Int]
sample n =
  let s_of_n = s_of_n_creator n
   in snd <$> execStateT (traverse s_of_n [0 .. 9 :: Int]) (0, [])

incEach :: (Ord a, Num b) => M.Map a b -> [a] -> M.Map a b
incEach m ks = foldl (\m' k -> M.insertWith (+) k 1 m') m ks

sampleInc :: Int -> M.Map Int Double -> Rand StdGen (M.Map Int Double)
sampleInc n m = do
  s <- sample n
  pure $ incEach m s

main :: IO ()
main = do
  let counts = M.empty :: M.Map Int Double
      n = 100000
  gen <- getStdGen
  counts <- evalRandIO $ foldM (\c _ -> sampleInc 3 c) M.empty [1 .. n]
  print (fmap (/ n) counts)


import Utils

procedure main(A)
    freq := table(0)
    every 1 to (\A[2] | 100000)\1 do {
        s_of_n := s_of_n_creator(\A[1] | 3)
        every sample := s_of_n(0 to 9)
        every freq[!sample] +:= 1
        }
    every write(i := 0 to 9,": ",right(freq[i],6))
end

procedure s_of_n_creator(n)
    items := []
    itemCnt := 0.0
    return makeProc {
               repeat {
                   item := (items@&source)[1]
                   itemCnt +:= 1
                   if *items < n then put(items, item)
                   else if ?0 < (n/itemCnt) then ?items := item
                   }
               }
end


s_of_n_creator=: 1 :0
  ctx=: conew&'inefficient' m
  s_of_n__ctx
)

coclass'inefficient'
  create=:3 :0
    N=: y
    ITEMS=: ''
    K=:0
  )

  s_of_n=:3 :0
    K=: K+1
    if. N>:#ITEMS do.
      ITEMS=: ITEMS,y
    else.
      if. (N%K)>?0 do.
        ITEMS=: ((<<<?N){ITEMS),y
      else.
        ITEMS
      end.
    end.
  )


import java.util.*;

class SOfN<T> {
    private static final Random rand = new Random();

    private List<T> sample;
    private int i = 0;
    private int n;

    public SOfN(int _n) {
        n = _n;
        sample = new ArrayList<T>(n);
    }

    public List<T> process(T item) {
        if (++i <= n) {
            sample.add(item);
        } else if (rand.nextInt(i) < n) {
            sample.set(rand.nextInt(n), item);
        }
        return sample;
    }
}

public class AlgorithmS {
    public static void main(String[] args) {
        int[] bin = new int[10];
        for (int trial = 0; trial < 100000; trial++) {
            SOfN<Integer> s_of_n = new SOfN<Integer>(3);
            for (int i = 0; i < 9; i++) s_of_n.process(i);
            for (int s : s_of_n.process(9)) bin[s]++;
        }
        System.out.println(Arrays.toString(bin));
    }
}


V p = [1 = 0]
V lvl = [[1]]

F path(n)
   I !n
      R [Int]()
   L n !C :p
      [Int] q
      L(x) :lvl[0]
         L(y) path(x)
            I !(x + y C :p)
               :p[x + y] = x
               q.append(x + y)
      :lvl[0] = q

   R path(:p[n]) [+] [n]

F tree_pow(x, n)
   T Ty = T(x)
   V (r, p) = ([0 = Ty(1), 1 = x], 0)
   L(i) path(n)
      r[i] = r[i - p] * r[p]
      p = i
   R r[n]

F show_pow_i(x, n)
   print("#.: #.\n#.^#. = #.\n".format(n, path(n), x, n, tree_pow(BigInt(x), n)))

F show_pow_f(x, n)
   print("#.: #.\n#.^#. = #.6\n".format(n, path(n), x, n, tree_pow(x, n)))

L(x) 18
   show_pow_i(2, x)
show_pow_i(3, 191)
show_pow_f(1.1, 81)


using Printf

function makesofn(n::Integer)
    buf = Vector{typeof(n)}(0)
    i = 0
    return function sofn(item)
        i += 1
        if i ≤ n
            push!(buf, item)
        else
            j = rand(1:i)
            if j ≤ n buf[j] = item end
        end
        return buf
    end
end

nhist = zeros(Int, 10)
for _ in 1:10^5
    kas = makesofn(3)
    for j in 0:8 kas(j) end
    for k in kas(9) nhist[k+1] += 1 end
end

println("Simulating sof3(0:9) 100000 times:")
for (i, c) in enumerate(nhist)
    @printf("%5d → %5d\n", i-1, c)
end


// version 1.2.51

import java.util.Random

val rand = Random()

class SOfN<T>(val n: Int) {
    private val sample = ArrayList<T>(n)
    private var i = 0

    fun process(item: T): List<T> {
        if (++i <= n)
            sample.add(item)
        else if (rand.nextInt(i) < n)
            sample[rand.nextInt(n)] = item
        return sample
    }
}

fun main(args: Array<String>) {
    val bin = IntArray(10)
    (1..100_000).forEach {
        val sOfn = SOfN<Int>(3)
        for (d in 0..8) sOfn.process(d)
        for (s in sOfn.process(9)) bin[s]++
    }
    println(bin.contentToString())
}


ClearAll[sofncreator]
sofncreator[n_] := Module[{sample, i},
  sample = {};
  i = 0;
  Return[
   Function[{item},
    i++;
    If[i <= n,
     AppendTo[sample, item]
     ,
     If[RandomInteger[{1, i}] <= n,
      sample[[RandomInteger[{1, n}]]] = item
      ]
     ];
    sample
    ]
   ]
  ]
bin = ConstantArray[0, 10];
items = Range[10];
sofn = sofncreator[3];
Do[
 sample = sofn[item];
 Print["  Item: ", item, " -> sample: " , sample]
 ,
 {item, items}
 ]
Do[
  sofn = sofncreator[3];
  Do[
   sample = sofn[item]
   ,
   {item, items}
   ];
  Do[
   bin[[s]] += 1
   ,
   {s, sample}
   ]
  ,
  {trial, 100000}
  ];
{Range[Length[bin]], bin} // Transpose // Grid


import random

func sOfNCreator[T](n: Positive): proc(item: T): seq[T] =
  var sample = newSeqOfCap[T](n)
  var i = 0

  result = proc(item: T): seq[T] =
             inc i
             if i <= n:
               sample.add(item)
             elif rand(1..i) <= n:
               sample[rand(n - 1)] = item
             sample

when isMainModule:

  randomize()

  echo "Digits counts for 100_000 runs:"
  var hist: array[10, Natural]
  for _ in 1..100_000:
    let sOfN = sOfNCreator[Natural](3)
    for i in 0..8:
      discard sOfN(i)
    for val in sOfN(9):
      inc hist[val]

  for n, count in hist:
    echo n, ": ", count


#import <Foundation/Foundation.h>

typedef NSArray *(^SOfN)(id);

SOfN s_of_n_creator(int n) {
  NSMutableArray *sample = [[NSMutableArray alloc] initWithCapacity:n];
  __block int i = 0;
  return [^(id item) {
    i++;
    if (i <= n) {
      [sample addObject:item];
    } else if (rand() % i < n) {
      sample[rand() % n] = item;
    }
    return sample;
  } copy];
}

int main(int argc, const char *argv[]) {
  @autoreleasepool {

    NSCountedSet *bin = [[NSCountedSet alloc] init];
    for (int trial = 0; trial < 100000; trial++) {
      SOfN s_of_n = s_of_n_creator(3);
      NSArray *sample;
      for (int i = 0; i < 10; i++)
        sample = s_of_n(@(i));
      [bin addObjectsFromArray:sample];
    }
    NSLog(@"%@", bin);

  }
  return 0;
}