Rosetta Code

Kronecker product: Difference between revisions

Page Discussion

Kronecker product (view source)

Revision as of 19:47, 13 June 2023

1,233 bytes removed ,  11 months ago
→‎{{header|REXX}}: refurbished
(→‎{{header|REXX}}: refurbished)
Line 3,501:
=={{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. */
▲callCall makeMat 'A', aMat 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*/
callCall showMat what, size; return▼
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
▲ bMat= 3x4 1 1 cp=cp+1 1 1 0 0 1 1 1 1 1 /* column of " B " product " " " */
xy=x*y
x.what.rp.cp=xy /* element of product */
▲ @.what.#.##=xy; w= max(w, length(xy) )
▲ end End /* cB */
▲ end End /* cA */
End /* rB */
End /* rA */
Return
/*--------------------------------------------------------------------*/
showmat:
Parse Arg what,size .
Parse Var size rows 'X' cols
z='+'
b6=left('',6)
Say ''
▲ Say 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 do r=1 for row; */ _= '│' /* 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 say $ $ _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}}==
Walterpachl
2,289

edits

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