Rosetta Code

Kronecker product: Difference between revisions

Page Discussion

Kronecker product (view source)

Revision as of 15:18, 28 April 2024

10,077 bytes added ,  1 month ago
Added Yabasic
(Added Yabasic)
 
(10 intermediate revisions by 7 users not shown)
Line 1,076:
</pre>
 
=={{header|BQNBASIC}}==
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">arraybase 1
dim a(2, 2)
a[1,1] = 1 : a[1,2] = 2 : a[2,1] = 3 : a[2,2] = 4
dim b(2, 2)
b[1,1] = 0 : b[1,2] = 5 : b[2,1] = 6 : b[2,2] = 7
call kronecker_product(a, b)
 
print
dim x(3, 3)
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
dim y(3, 4)
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
call kronecker_product(x, y)
end
 
subroutine kronecker_product(a, b)
ua1 = a[?][]
ua2 = a[][?]
 
ub1 = b[?][]
ub2 = b[][?]
 
for i = 1 to ua1
for k = 1 to ub1
print "[";
for j = 1 to ua2
for l = 1 to ub2
print rjust(a[i, j] * b[k, l], 2);
if j = ua1 and l = ub2 then
print "]"
else
print " ";
endif
next
next
next
next
end subroutine</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">print
dim a(2, 2)
a(1,1) = 1 : a(1,2) = 2 : a(2,1) = 3 : a(2,2) = 4
dim b(2, 2)
b(1,1) = 0 : b(1,2) = 5 : b(2,1) = 6 : b(2,2) = 7
kronecker_product(a, b)
 
print
dim a(3, 3)
a(1,1) = 0 : a(1,2) = 1 : a(1,3) = 0
a(2,1) = 1 : a(2,2) = 1 : a(2,3) = 1
a(3,1) = 0 : a(3,2) = 1 : a(3,3) = 0
dim b(3, 4)
b(1,1) = 1 : b(1,2) = 1 : b(1,3) = 1 : b(1,4) = 1
b(2,1) = 1 : b(2,2) = 0 : b(2,3) = 0 : b(2,4) = 1
b(3,1) = 1 : b(3,2) = 1 : b(3,3) = 1 : b(3,4) = 1
kronecker_product(a, b)
end
 
sub kronecker_product(a, b)
local i, j, k, l
ua1 = arraysize(a(), 1)
ua2 = arraysize(a(), 2)
ub1 = arraysize(b(), 1)
ub2 = arraysize(b(), 2)
 
for i = 1 to ua1
for k = 1 to ub1
print "[";
for j = 1 to ua2
for l = 1 to ub2
print a(i, j) * b(k, l) using "##";
if j = ua1 and l = ub2 then
print "]"
else
print " ";
endif
next
next
next
next
end sub</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
=={{header|BQN}}==
<syntaxhighlight lang="bqn">KProd ← ∾·<⎉2 ×⌜</syntaxhighlight>
 
Line 1,509 ⟶ 1,603:
| 0 0 0 0 1 0 0 1 0 0 0 0|
| 0 0 0 0 1 1 1 1 0 0 0 0|
</pre>
 
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
// Kronecker product. Nigel Galloway: August 31st., 2023
open MathNet.Numerics
open MathNet.Numerics.LinearAlgebra
let m1,m2,m3,m4=matrix [[1.0;2.0];[3.0;4.0]],matrix [[0.0;5.0];[6.0;7.0]],matrix [[0.0;1.0;0.0];[1.0;1.0;1.0];[0.0;1.0;0.0]],matrix [[1.0;1.0;1.0;1.0];[1.0;0.0;0.0;1.0];[1.0;1.0;1.0;1.0]]
printfn $"{(m1.KroneckerProduct m2).ToMatrixString()}"
printfn $"{(m3.KroneckerProduct m4).ToMatrixString()}"
</syntaxhighlight>
{{out}}
<pre>
0 5 0 10
6 7 12 14
0 15 0 20
18 21 24 28
 
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
</pre>
 
Line 1,749 ⟶ 1,870:
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Kronecker_product}}
 
'''Solution'''
 
Kronecker product is an intrinsec operation in Fōrmulæ
 
'''Test case 1'''
 
[[File:Fōrmulæ - Kronecker product 01.png]]
 
[[File:Fōrmulæ - Kronecker product 02.png]]
 
'''Test case 2'''
 
[[File:Fōrmulæ - Kronecker product 03.png]]
 
[[File:Fōrmulæ - Kronecker product 04.png]]
 
A function to calculate the Kronecker product can also be written:
 
[[File:Fōrmulæ - Kronecker product 05.png]]
 
[[File:Fōrmulæ - Kronecker product 06.png]]
 
[[File:Fōrmulæ - Kronecker product 02.png]]
 
=={{header|Go}}==
Line 2,742 ⟶ 2,887:
0 0 0 0 1 0 0 1 0 0 0 0
0 0 0 0 1 1 1 1 0 0 0 0</pre>
 
=={{header|Maxima}}==
There is a built-in function kronecker autoloaded from linearalgebra package.
 
Here comes a naive implementation.
<syntaxhighlight lang="maxima">
 
/* Function to map first, second and so on, over a list of lists without recurring corresponding built-in functions */
auxkron(n,lst):=makelist(lst[k][n],k,1,length(lst));
 
/* Function to subdivide a list into lists of equal lengths */
lst_equally_subdivided(lst,n):=if mod(length(lst),n)=0 then makelist(makelist(lst[i],i,j,j+n-1),j,1,length(lst)-1,n);
 
/* Kronecker product implementation */
alternative_kronecker(MatA,MatB):=block(auxlength:length(first(args(MatA))),makelist(i*args(MatB),i,flatten(args(MatA))),
makelist(apply(matrix,%%[i]),i,1,length(%%)),
lst_equally_subdivided(%%,auxlength),
makelist(map(args,%%[i]),i,1,length(%%)),
makelist(auxkron(j,%%),j,1,auxlength),
makelist(apply(append,%%[i]),i,1,length(%%)),
apply(matrix,%%),
transpose(%%),
args(%%),
makelist(apply(append,%%[i]),i,1,length(%%)),
apply(matrix,%%));
</syntaxhighlight>
 
Another implementation that does not make use of auxkron
<syntaxhighlight lang="maxima">
altern_kronecker(MatA,MatB):=block(auxlength:length(first(args(MatA))),
makelist(i*args(MatB),i,flatten(args(MatA))),
makelist(apply(matrix,%%[i]),i,1,length(%%)),
lst_equally_subdivided(%%,auxlength),
makelist(apply(addcol,%%[i]),i,1,length(%%)),
map(args,%%),
apply(append,%%),
apply(matrix,%%));
</syntaxhighlight>
{{out}}<pre>
A:matrix([0,1,0],[1,1,1],[0,1,0])$
B:matrix([1,1,1,1],[1,0,0,1],[1,1,1,1])$
 
C:matrix([1,2],[3,4])$
D:matrix([0,5],[6,7])$
 
alternative_kronecker(A,B);
/* matrix(
[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]
) */
 
alternative_kronecker(C,D);
/* matrix(
[0, 5, 0, 10],
[6, 7, 12, 14],
[0, 15, 0, 20],
[18, 21, 24, 28]
) */
 
/* altern_kronecker gives the same outputs */
</pre>
 
=={{header|Nim}}==
Line 2,843 ⟶ 3,056:
0 0 0 0 1 0 0 1 0 0 0 0
0 0 0 0 1 1 1 1 0 0 0 0</syntaxhighlight>
 
=={{header|ooRexx}}==
{{trans|REXX}}
<syntaxhighlight lang="oorexx">/*REXX program multiplies two matrices together, */
/* displays the matrices and the result. */
Signal On syntax
amat=2x2 1 2 3 4 /* define A matrix size and elements */
bmat=2x2 0 5 6 7 /* " B " " " " */
a=.matrix~new('A',2,2,1 2 3 4) /* create matrix A */
b=.matrix~new('B',2,2,0 5 6 7) /* create matrix B */
a~show
b~show
c=kronmat(a,b)
c~show
Say ''
Say copies('|',55)
Say ''
a=.matrix~new('A',3,3,0 1 0 1 1 1 0 1 0) /* create matrix A */
b=.matrix~new('B',3,4,1 1 1 1 1 0 0 1 1 1 1 1) /* create matrix B */
a~show
b~show
c=kronmat(a,b)
c~show
Exit
 
kronmat: Procedure /* compute the Kronecker Product */
Use Arg a,b
rp=0 /* row of product */
Do ra=1 To a~rows
Do rb=1 To b~rows
rp=rp+1 /* row of product */
cp=0 /* column of product */
Do ca=1 To a~cols
x=a~element(ra,ca)
Do cb=1 To b~cols
y=b~element(rb,cb)
cp=cp+1 /* column of product */
xy=x*y
c.rp.cp=xy /* element of product */
End /* cb */
End /* ca */
End /* rb */
End /* ra */
mm=''
Do i=1 To a~rows*b~rows
Do j=1 To a~rows*b~cols
mm=mm C.i.j
End /*j*/
End /*i*/
c=.matrix~new('Kronecker product',a~rows*b~rows,a~rows*b~cols,mm)
Return c
/*--------------------------------------------------------------------*/
Exit:
Say arg(1)
Exit
Syntax:
Say 'Syntax raised in line' sigl
Say sourceline(sigl)
Say 'rc='rc '('errortext(rc)')'
Say '***** There was a problem!'
Exit
 
::class Matrix
/********************************************************************
* Matrix is implemented as an array of rows
* where each row is an arryay of elements.
********************************************************************/
::Attribute name
::Attribute rows
::Attribute cols
 
::Method init
expose m name rows cols
Use Arg name,rows,cols,elements
If words(elements)<>(rows*cols) Then Do
Say 'incorrect number of elements ('words(elements)')<>'||(rows*cols)
m=.nil
Return
End
m=.array~new
Do r=1 To rows
ro=.array~new
Do c=1 To cols
Parse Var elements e elements
ro~append(e)
End
m~append(ro)
End
 
::Method element /* get an element's value */
expose m
Use Arg r,c
ro=m[r]
Return ro[c]
 
::Method set /* set an element's value and return its previous */
expose m
Use Arg r,c,new
ro=m[r]
old=ro[c]
ro[c]=new
Return old
 
::Method show public /* display the matrix */
expose m name rows cols
z='+'
b6=left('',6)
Say ''
Say b6 copies('-',7) 'matrix' name copies('-',7)
w=0
Do r=1 To rows
ro=m[r]
Do c=1 To cols
x=ro[c]
w=max(w,length(x))
End
End
Say b6 b6 '+'copies('-',cols*(w+1)+1)'+' /* top border */
Do r=1 To rows
ro=m[r]
line='|' right(ro[1],w) /* element of first colsumn */ /* start with long vertical bar */
Do c=2 To cols /* loop for other columns */
line=line right(ro[c],w) /* append the elements */
End /* c */
Say b6 b6 line '|' /* append a long vertical bar. */
End /* r */
Say b6 b6 '+'copies('-',cols*(w+1)+1)'+' /* bottom border */
Return</syntaxhighlight>
{{out|output}}
<pre>
------- matrix A -------
+-----+
| 1 2 |
| 3 4 |
+-----+
 
------- matrix B -------
+-----+
| 0 5 |
| 6 7 |
+-----+
 
------- matrix Kronecker product -------
+-------------+
| 0 5 0 10 |
| 6 7 12 14 |
| 0 15 0 20 |
| 18 21 24 28 |
+-------------+
 
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
 
 
------- matrix A -------
+-------+
| 0 1 0 |
| 1 1 1 |
| 0 1 0 |
+-------+
 
------- matrix B -------
+---------+
| 1 1 1 1 |
| 1 0 0 1 |
| 1 1 1 1 |
+---------+
 
------- matrix Kronecker product -------
+-------------------------+
| 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 |
+-------------------------+</pre>
 
 
=={{header|PARI/GP}}==
Line 3,501 ⟶ 3,894:
=={{header|REXX}}==
A little extra coding was added to make the matrix glyphs and elements alignment look nicer.
<syntaxhighlight lang="rexx">/*REXX program calculates the Kronecker product of two matrices. two arbitrary size matrices. */
w= 0 /* W: max width of any matrix element. */
aMatamat= 2x2 1 2 3 4 /* define A matrix size and elements. */
bMatbmat= 2x2 0 5 6 7 /* " " B " " " " */
callCall makeMat 'A', aMat amat /* construct A matrix from elements. */
callCall makeMat 'B', bMat bmat /* " " B " " " */
callCall KronMat 'Kronecker product' /* calculate the Kronecker product. */
Call showMat what,arows*brows||'X'||arows*bcols
w= 0; say; say copies('░', 55); say /*display a fence between the 2 outputs*/
Say ''
aMat= 3x3 0 1 0 1 1 1 0 1 0 /*define A matrix size and elements.*/
Say copies('|',55)
bMat= 3x4 1 1 1 1 1 0 0 1 1 1 1 1 /* " B " " " " */
Say ''
call makeMat 'A', aMat /*construct A matrix from elements.*/
callw=0 makeMat 'B', bMat /* W: max width " B " " " of any matrix element*/
call KronMat 'Kronecker product' amat=3x3 0 1 0 1 1 1 0 1 0 /*calculate the define KroneckerA matrix product.size and elements */
exitbmat=3x4 1 1 1 1 1 0 0 1 1 1 1 1 /* " B " " " " /*stick a fork in it, we're all done. */
Call makeMat 'A',amat /* construct A matrix from elements */
/*──────────────────────────────────────────────────────────────────────────────────────*/
KronMat:Call parsemakeMat arg'B',bmat what; /* " parse var @.a.shapeB aRows aCols" " " */
Call KronMat 'Kronecker product' /* calculate the Kronecker product */
#= 0; parse var @.b.shape bRows bCols
Call showMat what,arows*brows||'X'||arows*bcols
do rA=1 for aRows
Exit do rB=1 for bRows; #= #+1; /* stick a fork in it, we're all ##= 0; _=done*/
/*--------------------------------------------------------------------*/
do cA=1 for aCols; x= @.a.rA.cA
makemat:
do cB=1 for bCols; y= @.b.rB.cB; ##= ##+1; xy= x*y; _= _ xy
Parse Arg what,size elements /*elements: e.1.1 e.1.2 - e.rows cols*/
@.what.#.##=xy; w= max(w, length(xy) )
Parse Var size rows 'X' cols
end /*cB*/
x.what.shape=rows cols
end /*cA*/
n=0
end /*rB*/
Do r=1 To rows
end /*rA*/
Do c=1 To cols
call showMat what, aRows*bRows || 'X' || aRows*bCols; return
n=n+1
/*──────────────────────────────────────────────────────────────────────────────────────*/
element=word(elements,n)
makeMat: parse arg what, size elements; arg , row 'X' col .; @.what.shape=row col
w=max(w,length(element))
#=0; do r=1 for row /* [↓] bump item#; get item; max width*/
x.what.r.c=element
do c=1 for col; #= #+1; _= word(elements, #); w= max(w, length(_))
End
@.what.r.c=_
End
end /*c*/ /* [↑] define an element of WHAT matrix*/
Call showMat what,size
end /*r*/
Return
call showMat what, size; return
/*--------------------------------------------------------------------*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
kronmat: /* compute the Kronecker Product */
showMat: parse arg what, size .; z= '┌'; parse var size row "X" col; $=left('', 6)
Parse Arg what
say; say $ copies('═',7) "matrix" what copies('═',7)
Parse Var x.a.shape arows acols
do r=1 for row; _= '│' /*start with long vertical bar*/
Parse Var x.b.shape brows bcols
do c=1 for col; _=_ right(@.what.r.c, w); if r==1 then z=z left('',w)
rp=0 end /*c row of product */
Do ra=1 To arows
if r==1 then do; z=z '┐'; say $ $ z; end /*show the top part of matrix.*/
Do rb=1 To brows
say $ $ _ '│' /*append a long vertical bar. */
rp=rp+1 end /*r row of product */
cp=0 say $ $ translate(z, '└┘', "┌┐"); return /*show thecolumn of product bot part of matrix.*/</syntaxhighlight>
Do ca=1 To acols
x=x.a.ra.ca
Do cb=1 To bcols
y=x.b.rb.cb
cp=cp+1 /* column of product */
xy=x*y
x.what.rp.cp=xy /* element of product */
w=max(w,length(xy))
End /* cB */
End /* cA */
End /* rB */
End /* rA */
Return
/*--------------------------------------------------------------------*/
showmat:
Parse Arg what,size .
Parse Var size rows 'X' cols
z='+'
b6=left('',6)
Say ''
Say b6 copies('-',7) 'matrix' what copies('-',7)
Say b6 b6 '+'copies('-',cols*(w+1)+1)'+'
Do r=1 To rows
line='|' right(x.what.r.1,w) /* element of first column */ /* start with long vertical bar */
Do c=2 To cols /* loop for other columns */
line=line right(x.what.r.c,w) /* append the elements */
End /* c */
Say b6 b6 line '|' /* append a long vertical bar. */
End /* r */
Say b6 b6 '+'copies('-',cols*(w+1)+1)'+'
Return
</syntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
═══════------- matrix A ═══════-------
┌ ┐+-----+
│| 1 2 │|
│| 3 4 │|
└ ┘+-----+
 
═══════------- matrix B ═══════-------
┌ ┐+-----+
│| 0 5 │|
│| 6 7 │|
└ ┘+-----+
 
═══════------- matrix Kronecker product ═══════-------
┌ ┐+-------------+
│| 0 5 0 10 │|
│| 6 7 12 14 │|
│| 0 15 0 20 │|
│| 18 21 24 28 │|
└ ┘+-------------+
 
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
 
 
═══════------- matrix A ═══════-------
┌ ┐+-------+
│| 0 1 0 │|
│| 1 1 1 │|
│| 0 1 0 │|
└ ┘+-------+
 
═══════------- matrix B ═══════-------
┌ ┐+---------+
│| 1 1 1 1 │|
│| 1 0 0 1 │|
│| 1 1 1 1 │|
└ ┘+---------+
 
═══════------- matrix Kronecker product ═══════-------
┌ ┐+-------------------------+
│| 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 │|
└+-------------------------+ ┘</pre>
</pre>
 
=={{header|Ring}}==
Line 3,670 ⟶ 4,094:
≪ DUP SIZE LIST→ DROP 4 ROLL DUP SIZE LIST→ DROP → b p q a m n
≪ {} m p * + n q * + 0 CON
1 m p * '''FOR''' row
1 n q * '''FOR''' col
a {} row 1 - p / IP 1 + + col 1 - q / IP 1 + + GET
b {} row 1 - p MOD 1 + + col 1 - q MOD 1 + + GET
* {} row + col + SWAP PUT
'''NEXT NEXT'''
≫ ≫ '<span style="color:blue">KROKR</span>' STO
NEXT
====HP-49 version====
≫ ≫
≪ DUP SIZE LIST→ DROP 4 PICK SIZE LIST→ DROP → a b rb cb ra ca
´KROKR´ STO
≪ a SIZE b SIZE * 0 CON
0 ra 1 - '''FOR''' j
0 ca 1 - '''FOR''' k
{ 1 1 }
{ } j + k +
DUP2 ADD a SWAP GET UNROT
{ } ra + ca + * ADD
SWAP b * REPL
'''NEXT NEXT'''
≫ ≫ '<span style="color:blue">KROKR</span>' STO
 
[[1, 2], [3, 4]] [[0, 5], [6, 7]] <span style="color:blue">KROKR</span>
[[0, 1, 0], [1, 1, 1], [0, 1, 0]] [[1, 1, 1, 1], [1, 0, 0, 1], [1, 1, 1, 1]] <span style="color:blue">KROKR</span>
{{out}}
<pre>
Line 4,580 ⟶ 5,014:
{{libheader|Wren-matrix}}
The above module already includes a method to calculate the Kronecker product.
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Fmt
import "./matrix" for Matrix
 
var a1 = [
Jjuanhdez
2,136

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/344863...364046"