Kronecker product based fractals: Difference between revisions

Added FreeBASIC
(Added FreeBASIC)
 
(42 intermediate revisions by 18 users not shown)
Line 1:
{{task|Fractals}}
 
This task is based on   [[Kronecker product| Kronecker product]]   of two matrices. If your
This task is based on   [[Kronecker product| Kronecker product]]   of two matrices.
language has no a built-in function for such product then you need to implement it first.<br>
 
If your language has no a built-in function for such product then you need to implement it first.
 
The essence of fractals is self-replication (at least, self-similar replications).
 
So, using n times self-product of the matrix (filled with 0/1) we will have a fractal of the n-th order.<br><br>
So, using &nbsp; '''n''' &nbsp; times self-product of the matrix &nbsp; (filled with '''0'''/'''1''') &nbsp; we will have a fractal of the &nbsp; '''n'''<sup>th</sup> &nbsp; order.
Actually, "self-product" is a Kronecker power of the matrix. In other words: for a matrix '''M''' and a power '''n''' create a function like '''matkronpow(M, n)''', which returns MxMxMx... (n times product).<br>
 
A formal recurrent <i>algorithm</i> of creating Kronecker power of a matrix is the following:<br>
Actually, "self-product" is a Kronecker power of the matrix.
<b>Algorithm:</b>
 
In other words: for a matrix &nbsp; '''M''' &nbsp; and a power &nbsp; '''n''' &nbsp; create a function like &nbsp; '''matkronpow(M, n)''',
<br>which returns &nbsp; M<small>x</small>M<small>x</small>M<small>x</small>... &nbsp; ('''n''' &nbsp; times product).
 
A formal recurrent <i>algorithm</i> of creating Kronecker power of a matrix is the following:
 
 
;Algorithm:
<ul>
<li>Let M is an initial matrix, and Rn is a resultant block matrix of the Kronecker power, where n is the power (a.k.a. order).</li>
Line 15 ⟶ 26:
Even just looking at the resultant matrix you can see what will be plotted.<br>
There are virtually infinitely many fractals of this type. You are limited only by your creativity and
the power of your computer.<br>
 
 
;Task:
Using [[Kronecker_product| Kronecker product]] implement and show two popular and well-known fractals, i.e.:
Line 21 ⟶ 34:
* [[wp:Sierpinski carpet| Sierpinski carpet fractal]].
 
 
<br>The last one ([[Sierpinski carpet| Sierpinski carpet]]) is already here on RC, but built using different approaches.<br>
The last one ([[Sierpinski carpet| Sierpinski carpet]]) is already here on RC, but built using different approaches.<br>
 
 
;Test cases:
These 2 fractals (each order/power 4 at least) should be built using the following 2 simple matrices:
<pre>
|0 1 0| and |1 1 1|
|1 1 1| |1 0 1|
|0 1 0| |1 1 1|
</pre>
 
;Note:
* Output could be a graphical or ASCII-art representation, but if an order is set > 4 then printing is not suitable.
Line 34 ⟶ 51:
* It would be nice to see one additional fractal of your choice, e.g., based on using a single (double) letter(s) of an alphabet, any sign(s) or already made a resultant matrix of the Kronecker product.
 
 
<br>See implementations and results below in JavaScript, PARI/GP and R languages. They have additional samples of "H", "+" and checkerboard fractals.
See implementations and results below in JavaScript, PARI/GP and R languages. They have additional samples of "H", "+" and checkerboard fractals.
<br><br>
 
=={{header|11l}}==
{{trans|Nim}}
 
<syntaxhighlight lang="11l">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)))</syntaxhighlight>
 
{{out}}
The same as in Nim solution.
 
=={{header|Action!}}==
The user must type in the monitor the following command after compilation and before running the program!<pre>SET EndProg=*</pre>
{{libheader|Action! Tool Kit}}
<syntaxhighlight lang="action!">CARD EndProg ;required for ALLOCATE.ACT
 
INCLUDE "D2:ALLOCATE.ACT" ;from the Action! Tool Kit. You must type 'SET EndProg=*' from the monitor after compiling, but before running this program!
 
DEFINE PTR="CARD"
DEFINE MATRIX_SIZE="4"
TYPE Matrix=[
BYTE width,height
PTR data]
 
PTR FUNC CreateEmpty(BYTE w,h)
Matrix POINTER m
 
m=Alloc(MATRIX_SIZE)
m.width=w
m.height=h
m.data=Alloc(w*h)
RETURN (m)
 
PTR FUNC Create(BYTE w,h BYTE ARRAY a)
Matrix POINTER m
 
m=CreateEmpty(w,h)
MoveBlock(m.data,a,w*h)
RETURN (m)
 
PROC Destroy(Matrix POINTER m)
Free(m.data,m.width*m.height)
Free(m,MATRIX_SIZE)
RETURN
 
PTR FUNC Product(Matrix POINTER m1,m2)
Matrix POINTER m
BYTE x1,x2,y1,y2
INT i1,i2,i
BYTE ARRAY a1,a2,a
 
m=CreateEmpty(m1.width*m2.width,m1.height*m2.height)
a1=m1.data
a2=m2.data
a=m.data
i=0
FOR y1=0 TO m1.height-1
DO
FOR y2=0 TO m2.height-1
DO
FOR x1=0 TO m1.width-1
DO
FOR x2=0 TO m2.width-1
DO
i1=y1*m1.width+x1
i2=y2*m2.width+x2
a(i)=a1(i1)*a2(i2)
i==+1
OD
OD
OD
OD
RETURN (m)
 
PROC DrawMatrix(Matrix POINTER m INT x,y)
INT i,j
BYTE ARRAY d
 
d=m.data
FOR j=0 TO m.height-1
DO
FOR i=0 TO m.width-1
DO
IF d(j*m.width+i) THEN
Plot(x+i,y+j)
FI
OD
OD
RETURN
 
PROC DrawFractal(BYTE ARRAY a BYTE w,h INT x,y BYTE n)
Matrix POINTER m1,m2,m3
BYTE i
m1=Create(w,h,a)
m2=Create(w,h,a)
FOR i=1 TO n
DO
m3=Product(m1,m2)
IF i<n THEN
Destroy(m1)
m1=m3 m3=0
FI
OD
 
DrawMatrix(m3,x,y)
 
Destroy(m1)
Destroy(m2)
Destroy(m3)
RETURN
 
PROC Main()
BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6
BYTE ARRAY a=[0 1 0 1 1 1 0 1 0],
b=[1 1 1 1 0 1 1 1 1],
c=[1 0 1 0 1 0 1 0 1]
 
Graphics(8+16)
AllocInit(0)
Color=1
COLOR1=$0C
COLOR2=$02
 
DrawFractal(a,3,3,12,55,3)
DrawFractal(b,3,3,120,55,3)
DrawFractal(c,3,3,226,55,3)
 
DO UNTIL CH#$FF OD
CH=$FF
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Kronecker_product_based_fractals.png Screenshot from Atari 8-bit computer]
 
=={{header|Ada}}==
{{libheader|SDLAda}} Using multiplication function from Kronecker product.
<syntaxhighlight lang="ada">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;</syntaxhighlight>
 
=={{header|ALGOL 68}}==
<syntaxhighlight lang="algol68">
BEGIN # Kronecker product based fractals - translated from the Kotlin sample #
 
MODE MATRIX = FLEX[ 1 : 0, 1 : 0 ]INT;
 
PROC kronecker product = ( MATRIX a in, b in )MATRIX:
BEGIN
MATRIX a = a in[ AT 0, AT 0 ], b = b in[ AT 0, AT 0 ];
INT m = 1 UPB a + 1, n = 2 UPB a + 1;
INT p = 1 UPB b + 1, q = 2 UPB b + 1;
INT rtn = m * p, ctn = n * q;
[ 0 : rtn - 1, 0 : ctn - 1 ]INT r;
FOR i FROM 0 TO rtn - 1 DO FOR j FROM 0 TO ctn - 1 DO r[ i, j ] := 0 OD OD;
FOR i FROM 0 TO m - 1 DO
FOR j FROM 0 TO n - 1 DO
FOR k FROM 0 TO p - 1 DO
FOR l FROM 0 TO q - 1 DO
r[ p * i + k, q * j + l ] := a[ i, j ] * b[ k, l ]
OD
OD
OD
OD;
r
END # kronecker product # ;
 
PROC kronecker power = ( MATRIX a, INT n )MATRIX:
BEGIN
MATRIX pow := a;
FOR i TO n - 1 DO pow := kronecker product( pow, a ) OD;
pow
END # kronecker power # ;
 
PROC print matrix = ( STRING text, MATRIX m )VOID:
BEGIN
print( ( text, " fractal :", newline ) );
FOR i FROM 1 LWB m TO 1 UPB m DO
FOR j FROM 2 LWB m TO 2 UPB m DO
print( ( IF m[ i, j ] = 1 THEN "*" ELSE " " FI ) )
OD;
print( ( newline ) )
OD;
print( ( newline ) )
END # print matrix # ;
 
MATRIX a := MATRIX( ( 0, 1, 0 )
, ( 1, 1, 1 )
, ( 0, 1, 0 )
);
print matrix( "Vicsek", kronecker power( a, 4 ) );
 
a := MATRIX( ( 1, 1, 1 )
, ( 1, 0, 1 )
, ( 1, 1, 1 )
);
print matrix( "Sierpinski carpet", kronecker power( a, 4 ) )
END
</syntaxhighlight>
{{out}}
Same as the Kotlin sample.
 
=={{header|C}}==
Line 42 ⟶ 403:
 
Thus this implementation treats the initial matrix as a [https://en.wikipedia.org/wiki/Sparse_matrix Sparse matrix]. Doing so cuts down drastically on the required storage and number of operations. The graphical part needs the [http://www.cs.colorado.edu/~main/bgi/cs1300/ WinBGIm] library.
<syntaxhighlight lang="c">
<lang C>
#include<graphics.h>
#include<stdlib.h>
Line 48 ⟶ 409:
 
typedef struct{
int row, col;
}cell;
 
Line 54 ⟶ 415:
 
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++;
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++;
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;
}
</syntaxhighlight>
</lang>
 
=={{header|C++}}==
{{libheader|Qt}}
This program produces image files in PNG format. The C++ code from [[Kronecker product| Kronecker product]] is reused here.
<syntaxhighlight lang="cpp">#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;
}</syntaxhighlight>
 
{{out}}
[[Media:Kronecker fractals sierpinski carpet.png]]<br>
[[Media:Kronecker fractals sierpinski triangle.png]]<br>
[[Media:Kronecker fractals vicsek.png]]
 
=={{header|Factor}}==
{{works with|Factor|0.99 2020-01-23}}
<lang factor>USING: io kernel math math.matrices sequences ;
<syntaxhighlight lang="factor">USING: io kernel math math.matrices.extras sequences ;
 
: mat-kron-pow ( m n -- m' ) 1 - [ dup kron ] times ;
1 - [ dup kronecker-product ] times ;
 
: print-fractal ( m -- )
Line 170 ⟶ 629:
{ { 1 1 1 } { 1 0 1 } { 1 1 1 } }
{ { 0 1 1 } { 0 1 0 } { 1 1 0 } }
[ 3 mat-kron-pow print-fractal ] tri@</langsyntaxhighlight>
Output shown at order 4 and 25% font size.
{{out}}
Line 418 ⟶ 877:
** ** ** ** ** ** ** **
</pre>
 
=={{header|Fortran}}==
A Fortran 90 implementation. Uses dense matrices and dynamic allocation for working arrays.
<syntaxhighlight lang="fortran">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
</syntaxhighlight>
 
{{out}}
<pre style="font-size:5pt">
*
***
*
* * *
*********
* * *
*
***
*
* * *
*** *** ***
* * *
* * * * * * * * *
***************************
* * * * * * * * *
* * *
*** *** ***
* * *
*
***
*
* * *
*********
* * *
*
***
*
* * *
*** *** ***
* * *
* * * * * * * * *
********* ********* *********
* * * * * * * * *
* * *
*** *** ***
* * *
* * * * * * * * *
*** *** *** *** *** *** *** *** ***
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
*********************************************************************************
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
*** *** *** *** *** *** *** *** ***
* * * * * * * * *
* * *
*** *** ***
* * *
* * * * * * * * *
********* ********* *********
* * * * * * * * *
* * *
*** *** ***
* * *
*
***
*
* * *
*********
* * *
*
***
*
* * *
*** *** ***
* * *
* * * * * * * * *
***************************
* * * * * * * * *
* * *
*** *** ***
* * *
*
***
*
* * *
*********
* * *
*
***
*
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
* * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * *
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
********* ****************** ****************** *********
* ** ** * * ** ** ** ** ** * * ** ** ** ** ** * * ** ** *
********* ****************** ****************** *********
*** *** *** ****** *** *** ****** *** *** ***
* * * * * * * ** * * * * * * ** * * * * * * *
*** *** *** ****** *** *** ****** *** *** ***
********* ****************** ****************** *********
* ** ** * * ** ** ** ** ** * * ** ** ** ** ** * * ** ** *
********* ****************** ****************** *********
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
* * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * *
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
*************************** ***************************
* ** ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** ** *
*************************** ***************************
*** ****** ****** *** *** ****** ****** ***
* * * ** * * ** * * * * * * ** * * ** * * *
*** ****** ****** *** *** ****** ****** ***
*************************** ***************************
* ** ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** ** *
*************************** ***************************
********* ********* ********* *********
* ** ** * * ** ** * * ** ** * * ** ** *
********* ********* ********* *********
*** *** *** *** *** *** *** ***
* * * * * * * * * * * * * * * *
*** *** *** *** *** *** *** ***
********* ********* ********* *********
* ** ** * * ** ** * * ** ** * * ** ** *
********* ********* ********* *********
*************************** ***************************
* ** ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** ** *
*************************** ***************************
*** ****** ****** *** *** ****** ****** ***
* * * ** * * ** * * * * * * ** * * ** * * *
*** ****** ****** *** *** ****** ****** ***
*************************** ***************************
* ** ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** ** *
*************************** ***************************
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
* * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * *
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
********* ****************** ****************** *********
* ** ** * * ** ** ** ** ** * * ** ** ** ** ** * * ** ** *
********* ****************** ****************** *********
*** *** *** ****** *** *** ****** *** *** ***
* * * * * * * ** * * * * * * ** * * * * * * *
*** *** *** ****** *** *** ****** *** *** ***
********* ****************** ****************** *********
* ** ** * * ** ** ** ** ** * * ** ** ** ** ** * * ** ** *
********* ****************** ****************** *********
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
* * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * *
*** ****** ****** ****** ****** ****** ****** ****** ****** ***
*********************************************************************************
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
*********************************************************************************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** **************** **************** ****************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** **************** **************** ****************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * ** * * * * * * ** * * *
** ** ** ** ** ** ** **
**** ******** **** **** ******** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******************************** ********************************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * ** * * ** * * ** * * * * * * ** * * ** * * ** * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** ******** ******** ******** **** **** ******** ******** ******** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************************************************************** ****************************************************************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** **************** **************** ****************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** **************** **************** ****************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * ** * * * * * * ** * * *
** ** ** ** ** ** ** **
**** ******** **** **** ******** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******************************** ********************************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * ** * * ** * * ** * * * * * * ** * * ** * * ** * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** ******** ******** ******** **** **** ******** ******** ******** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************************************************************** ****************************************************************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** **************** **************** ****************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * * * * * ** * * * * * * *
** ** ** ** ** ** ** **
**** **** **** ******** **** **** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** ** ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** ******************************** ****************
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
** ** ** ** ** ** ** **
**** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * *
* * * ** * * * * * * ** * * *
** ** ** ** ** ** ** **
**** ******** **** **** ******** ****
* * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** *
** ** ** ** ** ** ** **
******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******************************** ********************************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** ******** ******** ******** ******** ******** ******** ******** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
********************************************************************************************************************************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** **************** **************** **************** **************** **************** **************** ****************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * ** * * * * * * ** * * * * * * ** * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** ******** **** **** ******** **** **** ******** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** * * ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** * * ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**************** ******************************** ******************************** ******************************** ****************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * ** * * * * * * ** * * * * * * ** * * * * * * ** * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** ******** **** **** ******** **** **** ******** **** **** ******** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** * * ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******************************** ******************************** ******************************** ********************************
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
**** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ****
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** * * ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ******** ********
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** *
** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
****************************************************************************************************************************************************************************************************************************************************************
 
</pre>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vbnet">Type Matrix
As Integer x
As Integer y
As Integer Ptr Dato
End Type
 
Function kroneckerProduct(a As Matrix, b As Matrix) As Matrix
Dim As Integer m = a.x, n = a.y
Dim As Integer p = b.x, q = b.y
Dim As Matrix r
r.x = m * p
r.y = n * q
r.dato = Callocate(r.x * r.y, Sizeof(Integer))
Dim As Integer i, j, k, l
For i = 0 To m - 1
For j = 0 To n - 1
For k = 0 To p - 1
For l = 0 To q - 1
r.dato[(p * i + k) * r.y + (q * j + l)] = a.dato[i * a.y + j] * b.dato[k * b.y + l]
Next
Next
Next
Next
Return r
End Function
 
Function kroneckerPower(a As Matrix, n As Integer) As Matrix
Dim As Matrix pow = a
For i As Integer = 1 To n - 1
pow = kroneckerProduct(pow, a)
Next
Return pow
End Function
 
Sub printMatrix(text As String, m As Matrix)
Dim As Integer i, j
Print text & " fractal:"
For i = 0 To m.x - 1
For j = 0 To m.y - 1
Print Iif(m.dato[i * m.y + j] = 1, "*", " ");
Next
Print
Next
Print
End Sub
 
Dim As Matrix a = Type(3, 3, Callocate(9, Sizeof(Integer)))
a.dato[0] = 0: a.dato[1] = 1: a.dato[2] = 0
a.dato[3] = 1: a.dato[4] = 1: a.dato[5] = 1
a.dato[6] = 0: a.dato[7] = 1: a.dato[8] = 0
printMatrix("Vicsek", kroneckerPower(a, 4))
 
a.dato[0] = 1: a.dato[1] = 1: a.dato[2] = 1
a.dato[3] = 1: a.dato[4] = 0: a.dato[5] = 1
a.dato[6] = 1: a.dato[7] = 1: a.dato[8] = 1
printMatrix("Sierpinski carpet", kroneckerPower(a, 4))
 
Sleep</syntaxhighlight>
{{out}}
<pre>Same as Kotlin entry.</pre>
 
=={{header|gnuplot}}==
Line 430 ⟶ 1,505:
[[File:pkf3.png|right|thumb|Output pkf3.png]]
 
<langsyntaxhighlight lang="gnuplot">
## KPF.gp 4/8/17 aev
## Plotting 3 KPF pictures.
Line 447 ⟶ 1,522:
ttl = "Sierpinski triangle fractal"; clr = '"dark-green"'; filename = "pkf3";
load "plotff.gp"
</syntaxhighlight>
</lang>
{{Output}}
<pre>
3 plotted files: pkf1.png, pkf2.png and pkf3.png.
</pre>
 
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Kronecker_product_based_fractals}}
 
'''Solution'''
 
[[File:Fōrmulæ - Kronecker product based fractals 01.png]]
 
'''Test case 1. Vicsek fractal'''
 
Cross form
 
[[File:Fōrmulæ - Kronecker product based fractals 02.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 03.png]]
 
Saltire form
 
[[File:Fōrmulæ - Kronecker product based fractals 04.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 05.png]]
 
'''Test case 2. Sierpiński carpet fractal'''
 
[[File:Fōrmulæ - Kronecker product based fractals 06.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 07.png]]
 
'''Test case 3. Sierpiński triangle fractal'''
 
[[File:Fōrmulæ - Kronecker product based fractals 08.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 09.png]]
 
'''Test case 3. Other cases'''
 
[[File:Fōrmulæ - Kronecker product based fractals 10.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 11.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 12.png]]
 
[[File:Fōrmulæ - Kronecker product based fractals 13.png]]
 
'''Test case 4. Numbers between 0 and 1 can be used, to produce greyscale shades'''
 
[[File:Fōrmulæ - Kronecker product based fractals 14.png]]
 
(click or tap to see in real size)
 
[[File:Fōrmulæ - Kronecker product based fractals 15.png|256px]]
 
=={{header|Go}}==
{{trans|Kotlin}}
<syntaxhighlight lang="go">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")
}</syntaxhighlight>
 
{{out}}
<pre>
Same as Kotlin entry.
</pre>
 
Line 458 ⟶ 1,652:
This implementation compiles to javascript that runs in the browser using the [https://github.com/ghcjs/ghcjs ghcjs compiler ] . The [https://github.com/reflex-frp/reflex-dom reflex-dom ] library is used to help with svg rendering.
 
<langsyntaxhighlight lang="haskell">{-# LANGUAGE OverloadedStrings #-}
import Reflex
import Reflex.Dom
Line 541 ⟶ 1,735:
elSvgns t m ma = do
(el, val) <- elDynAttrNS' (Just "http://www.w3.org/2000/svg") t m ma
return val</langsyntaxhighlight>
 
Link to live demo: https://dc25.github.io/rosettaCode__Kronecker_product_based_fractals/ ( a little slow to load ).
 
=={{header|J}}==
 
Implementation:
 
<langsyntaxhighlight Jlang="j">V=: -.0 2 6 8 e.~i.3 3
S=: 4 ~:i.3 3
KP=: 1 3 ,/"2@(,/)@|: */
Line 554 ⟶ 1,749:
ascii_art=: ' *'{~]
 
KPfractal=:dyad def 'x&KP^:y,.1'</langsyntaxhighlight>
 
Task examples (order 4, 25% font size):
Line 727 ⟶ 1,922:
This implementation does not use sparse matrices since the powers involved do not exceed 4.
 
<syntaxhighlight lang="java">
<lang Java>
package kronecker;
 
Line 864 ⟶ 2,059:
 
}
</syntaxhighlight>
</lang>
 
{{Output}}
Line 1,137 ⟶ 2,332:
[[File:SierpCarpetFractaljs.png|200px|right|thumb|Output SierpCarpetFractaljs.png]]
[[File:CheckbrdFractaljs.png|200px|right|thumb|Output CheckbrdFractaljs.png]]
<langsyntaxhighlight lang="javascript">
// KPF.js 6/23/16 aev
// HFJS: Plot any matrix mat (filled with 0,1)
Line 1,186 ⟶ 2,381:
// 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;
</langsyntaxhighlight>
 
;Required tests:
<langsyntaxhighlight lang="html">
<!-- VicsekFractal.html -->
<html>
Line 1,201 ⟶ 2,396:
<canvas id="canvId" width="750" height="750" style="border: 1px outset;"></canvas>
</body></html>
</langsyntaxhighlight>
 
<langsyntaxhighlight lang="html">
<!-- SierpCarpetFractal.html -->
<html>
Line 1,215 ⟶ 2,410:
<canvas id="canvId" width="750" height="750" style="border: 1px outset;"></canvas>
</body></html>
</syntaxhighlight>
 
<langsyntaxhighlight lang="html">
<!-- Checkerboard.html -->
<html>
Line 1,228 ⟶ 2,424:
<canvas id="canvId" width="750" height="750" style="border: 1px outset;"></canvas>
</body></html>
</langsyntaxhighlight>
 
{{Output}}
Line 1,240 ⟶ 2,436:
{{works with|Julia|0.6}}
Julia has a builtin function `kron`:
<langsyntaxhighlight lang="julia">function matkronpow(M::Matrix, n::Int)
P = copy(M)
for i in 1:n P = kron(P, M) end
Line 1,259 ⟶ 2,455:
 
M = [1 1 1; 1 0 1; 1 1 1]
matkronpow(M, 3) |> fracprint</langsyntaxhighlight>
 
{{out}}
Line 1,427 ⟶ 2,623:
=={{header|Kotlin}}==
This reuses code from the [[Kronecker_product#Kotlin]] task.
<langsyntaxhighlight lang="scala">// version 1.2.31
 
typealias Matrix = Array<IntArray>
Line 1,478 ⟶ 2,674:
)
printMatrix("Sierpinski carpet", kroneckerPower(a, 4))
}</langsyntaxhighlight>
 
{{out}}
Line 1,653 ⟶ 2,849:
=={{header|Lua}}==
Needs L&Ouml;VE 2D Engine
<langsyntaxhighlight lang="lua">
function prod( a, b )
local rt, l = {}, 1
Line 1,706 ⟶ 2,902:
love.graphics.draw( canvas )
end
</syntaxhighlight>
</lang>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">m = {{0, 1, 0}, {1, 1, 1}, {0, 1, 0}};
ArrayPlot[KroneckerProduct[m, m, m, m]]
m = {{1, 1, 1}, {1, 0, 1}, {1, 1, 1}};
ArrayPlot[KroneckerProduct[m, m, m, m]]
m = {{0, 1, 1}, {1, 0, 1}, {1, 1, 0}};
ArrayPlot[KroneckerProduct[m, m, m, m]]</syntaxhighlight>
{{out}}
Outputs three graphical visualisations of the three 4th order products.
 
=={{header|Maxima}}==
Using function defined in Kronecker product task page. [[https://rosettacode.org/wiki/Kronecker_product#Maxima Kronecker Product]]
 
<syntaxhighlight lang="maxima">
pow_kron(matr,n):=block(MATR:copymatrix(matr),
for i from 1 thru n do MATR:altern_kronecker(matr,MATR),
MATR);
 
/* Examples (images are shown in format png)*/
/* A to generate Vicsek fractal */
/* B to generate Sierpinski carpet fractal */
A:matrix([0,1,0],[1,1,1],[0,1,0])$
B:matrix([1,1,1],[1,0,1],[1,1,1])$
 
/* Vicsek */
pow_kron(A,3)$
at(%,[0="",1="x"]);
 
/* Sierpinski carpet */
pow_kron(B,3)$
at(%,[0="",1="x"]);
</syntaxhighlight>
 
[[File:Vicsek.png|thumb|center]]
 
[[File:SierpinskiCarpet.png|thumb|center]]
 
=={{header|Nim}}==
{{trans|Kotlin}}
<syntaxhighlight lang="nim">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)</syntaxhighlight>
 
{{out}}
<pre>Vicsek fractal:
*
* * *
*
* * *
* * * * * * * * *
* * *
*
* * *
*
* * *
* * * * * * * * *
* * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * *
* * * * * * * * *
* * *
*
* * *
*
* * *
* * * * * * * * *
* * *
*
* * *
*
* * *
* * * * * * * * *
* * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * *
* * * * * * * * *
* * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * *
* * * * * * * * *
* * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * *
* * * * * * * * *
* * *
*
* * *
*
* * *
* * * * * * * * *
* * *
*
* * *
*
* * *
* * * * * * * * *
* * *
* * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * *
* * *
* * * * * * * * *
* * *
*
* * *
*
* * *
* * * * * * * * *
* * *
*
* * *
*
 
 
Sierpinski carpet fractal:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *</pre>
 
=={{header|PARI/GP}}==
Line 1,716 ⟶ 3,155:
[[File:SierpCarpetFractalgp.png|200px|right|thumb|Output SierpCarpetFractalgp.png]]
[[File:SierpTriFractalgp.png|200px|right|thumb|Output SierpTriFractalgp.png]]
<langsyntaxhighlight lang="parigp">
\\ Build block matrix applying Kronecker product to the special matrix m
\\ (n times to itself). Then plot Kronecker fractal. 4/25/2016 aev
Line 1,737 ⟶ 3,176:
pkronfractal(M,7,6);
}
</langsyntaxhighlight>
{{Output}}
<pre>
Line 1,750 ⟶ 3,189:
</pre>
 
=={{header|Perl 6}}==
{{trans|Raku}}
{{works with|Rakudo|2017.03}}
<syntaxhighlight lang="perl">use Imager;
use Math::Cartesian::Product;
 
sub kronecker_product {
<lang perl6>sub kronecker-product ( @a, @b ) { (@a X @b).map: { (.[0].list X* .[1].list).Array } }
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 {
sub kronecker-fractal ( @pattern, $order = 4 ) {
my($order, @pattern) = @_;
my @kronecker = @pattern;
@kronecker = kronecker-productkronecker_product(\@kronecker, \@pattern) for ^0..$order-1;
@kronecker
}
 
@vicsek = ( [0, 1, 0], [1, 1, 1], [0, 1, 0] );
use Image::PNG::Portable;
@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],
#Task requirements
['carpet', \@carpet, 4],
my @vicsek = ( [0, 1, 0], [1, 1, 1], [0, 1, 0] );
my @carpet = ( [1'six', 1, 1], [1, 0\@six, 1], [1, 1, 13] ); {
($name, $shape, $order) = @$_;
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] );
@img = kronecker_fractal( $order, @$shape );
 
$png = Imager->new(xsize => 1+@{$img[0]}, ysize => 1+@img);
for 'vicsek', @vicsek, 4,
cartesian {
'carpet', @carpet, 4,
$png->setpixel(x => $_[0], y => $_[1], color => $img[$_[1]][$_[0]] ? [255, 255, 32] : [16, 16, 16]);
'six', @six, 3
} [0..@{$img[0]}-1], [0..$#img];
-> $name, @shape, $order {
my @img$png->write(file => "run/kronecker-fractal( @shape, $order name-perl6.png");
}</syntaxhighlight>
my $png = Image::PNG::Portable.new: :width(@img[0].elems), :height(@img.elems);
See [https://github.com/SqrtNegInf/Rosettacode-Perl5-Smoke/blob/master/ref/kronecker-vicsek-perl6.png Kronecker-Vicsek], [https://github.com/SqrtNegInf/Rosettacode-Perl5-Smoke/blob/master/ref/kronecker-carpet-perl6.png Kronecker-Carpet] and [https://github.com/SqrtNegInf/Rosettacode-Perl5-Smoke/blob/master/ref/kronecker-six-perl6.png Kronecker-Six] images.
for ^@img[0] X ^@img -> ($x, $y) {
$png.set: $x, $y, |( @img[$y;$x] ?? <255 255 32> !! <16 16 16> );
}
$png.write: "kronecker-{$name}-perl6.png";
}</lang>
 
See [https://github.com/thundergnat/rc/blob/master/img/kronecker-vicsek-perl6.png Kronecker-Vicsek], [https://github.com/thundergnat/rc/blob/master/img/kronecker-carpet-perl6.png Kronecker-Carpet] and [https://github.com/thundergnat/rc/blob/master/img/kronecker-six-perl6.png Kronecker-Six] images.
 
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function kronecker(sequence a, b)
<span style="color: #008080;">function</span> <span style="color: #000000;">kronecker</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
integer ar = length(a),
<span style="color: #004080;">integer</span> <span style="color: #000000;">ar</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span>
ac = length(a[1]),
<span style="color: #000000;">ac</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]),</span>
br = length(b),
<span style="color: #000000;">br</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">),</span>
bc = length(b[1])
<span style="color: #000000;">bc</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
sequence res = repeat(repeat(0,ac*bc),ar*br)
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ac</span><span style="color: #0000FF;">*</span><span style="color: #000000;">bc</span><span style="color: #0000FF;">),</span><span style="color: #000000;">ar</span><span style="color: #0000FF;">*</span><span style="color: #000000;">br</span><span style="color: #0000FF;">)</span>
for ia=1 to ar do
<span style="color: #008080;">for</span> <span style="color: #000000;">ia</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">ar</span> <span style="color: #008080;">do</span>
integer i0 = (ia-1)*br
<span style="color: #004080;">integer</span> <span style="color: #000000;">i0</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">ia</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">br</span>
for ja=1 to ac do
<span style="color: #008080;">for</span> <span style="color: #000000;">ja</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">ac</span> <span style="color: #008080;">do</span>
integer j0 = (ja-1)*bc
<span style="color: #004080;">integer</span> <span style="color: #000000;">j0</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">ja</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">bc</span>
for ib=1 to br do
<span style="color: #008080;">for</span> <span style="color: #000000;">ib</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">br</span> <span style="color: #008080;">do</span>
integer i = i0+ib
<span style="color: #004080;">integer</span> <span style="color: #000000;">i</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">i0</span><span style="color: #0000FF;">+</span><span style="color: #000000;">ib</span>
for jb=1 to bc do
<span style="color: #008080;">for</span> <span style="color: #000000;">jb</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">bc</span> <span style="color: #008080;">do</span>
integer j = j0+jb
<span style="color: #004080;">integer</span> <span style="color: #000000;">j</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">j0</span><span style="color: #0000FF;">+</span><span style="color: #000000;">jb</span>
res[i,j] = a[ia,ja]*b[ib,jb]
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">ia</span><span style="color: #0000FF;">,</span><span style="color: #000000;">ja</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">ib</span><span style="color: #0000FF;">,</span><span style="color: #000000;">jb</span><span style="color: #0000FF;">]</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return res
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
 
function kroneckern(sequence m, integer n)
<span style="color: #008080;">function</span> <span style="color: #000000;">kroneckern</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
sequence res = m
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">m</span>
for i=2 to n do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
res = kronecker(res,m)
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">kronecker</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return res
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
 
procedure show(sequence m)
<span style="color: #008080;">procedure</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
for i=1 to length(m) do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
string s = repeat(' ',length(m[i]))
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]))</span>
for j=1 to length(s) do
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
if m[i][j] then s[j] = '#' end if
<span style="color: #008080;">if</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">'#'</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
puts(1,s&"\n")
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">&</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
puts(1,"\n")
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
end procedure
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
 
constant vicsek = {{0,1,0},
<span style="color: #008080;">constant</span> <span style="color: #000000;">vicsek</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
{1,1,1},
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
{0,1,0}},
<span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}},</span>
siercp = {{1,1,1},
<span style="color: #000000;">siercp</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
{1,0,1},
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
{1,1,1}},
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}},</span>
xxxxxx = {{0,1,1},
<span style="color: #000000;">xxxxxx</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
{0,1,0},
<span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
{1,1,0}}
<span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">}}</span>
 
show(kroneckern(vicsek,4))
<span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #000000;">kroneckern</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vicsek</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">))</span>
show(kroneckern(siercp,4))
<span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #000000;">kroneckern</span><span style="color: #0000FF;">(</span><span style="color: #000000;">siercp</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">))</span>
show(kroneckern(xxxxxx,4))</lang>
<span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #000000;">kroneckern</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xxxxxx</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">))</span>
<!--</syntaxhighlight>-->
Output same as Julia/Kotlin/Factor
 
Line 1,843 ⟶ 3,295:
 
'''Using only python lists'''
<langsyntaxhighlight lang="python">import os
from PIL import Image
 
Line 1,930 ⟶ 3,382:
fractal('test2', test2)
fractal('test3', test3)
</syntaxhighlight>
</lang>
 
Because this is not very efficent/fast you should use scipy sparse matrices instead
<langsyntaxhighlight lang="python">import os
import numpy as np
from scipy.sparse import csc_matrix, kron
Line 2,006 ⟶ 3,458:
fractal('test1', test1)
fractal('test2', test2)
fractal('test3', test3)</langsyntaxhighlight>
 
=={{header|R}}==
Line 2,016 ⟶ 3,468:
[[File:PlusSignFR.png|200px|right|thumb|Output PlusSignFR.png]]
 
<syntaxhighlight lang="r">
<lang r>
## Generate and plot Kronecker product based fractals. aev 8/12/16
## gpKronFractal(m, n, pf, clr, ttl, dflg=0, psz=600):
Line 2,059 ⟶ 3,511:
# 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")
</langsyntaxhighlight>
 
{{Output}}
Line 2,085 ⟶ 3,537:
*** END: Fri Apr 07 09:31:07 2017
</pre>
 
=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2018.09}}
 
<syntaxhighlight lang="raku" line>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";
}</syntaxhighlight>
 
See [https://github.com/thundergnat/rc/blob/master/img/kronecker-vicsek-perl6.png Kronecker-Vicsek], [https://github.com/thundergnat/rc/blob/master/img/kronecker-carpet-perl6.png Kronecker-Carpet] and [https://github.com/thundergnat/rc/blob/master/img/kronecker-six-perl6.png Kronecker-Six] images.
 
=={{header|REXX}}==
This is a work-in-progress, this version shows the 1st order.
<langsyntaxhighlight lang="rexx">/*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 " " " */
Line 2,101 ⟶ 3,588:
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
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</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default input:}}
{{out}}
<pre>
███
Line 2,139 ⟶ 3,625:
███
</pre>
 
=={{header|Rust}}==
 
Because Rust lacks support for images, this sample contains a simple implementation of
[[Bitmap/Write a PPM file| writing PPM files]].
 
<syntaxhighlight lang="rust">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)
}
},
)
}
</syntaxhighlight>
 
=={{header|Sidef}}==
{{trans|Perl 6Raku}}
<langsyntaxhighlight lang="ruby">func kronecker_product (a, b) { a ~X b -> map { _[0] ~X* _[1] } }
 
func kronecker_fractal(pattern, order=4) {
Line 2,168 ⟶ 3,897:
}
img.write(file => "kronecker-#{name}-sidef.png")
}</langsyntaxhighlight>
Output images: [https://github.com/trizen/rc/blob/master/img/kronecker-carpet-sidef.png Kronecker Carpet], [https://github.com/trizen/rc/blob/master/img/kronecker-vicsek-sidef.png Kronecker Vicsek] and [https://github.com/trizen/rc/blob/master/img/kronecker-six-sidef.png Kronecker Six]
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-matrix}}
<syntaxhighlight lang="wren">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))</syntaxhighlight>
 
{{out}}
<pre>
Same as Kotlin entry.
</pre>
 
=={{header|zkl}}==
Uses Image Magick and
the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl
<langsyntaxhighlight lang="zkl">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;
Line 2,185 ⟶ 3,946:
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);
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">var [const] A=GSL.Matrix(3,3).set(0,1,0, 1,1,1, 0,1,0),
B=GSL.Matrix(3,3).set(1,1,1, 1,0,1, 1,1,1);
kfractal(A,4,"vicsek_k.jpg");
kfractal(B,4,"sierpinskiCarpet_k.jpg");</langsyntaxhighlight>
{{out}}
<pre>
2,122

edits