Kronecker product: Difference between revisions

Added solution for Action!
(Added solution for Action!)
Line 261:
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|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}}
<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(2*w*h)
RETURN (m)
 
PTR FUNC Create(BYTE w,h INT ARRAY a)
Matrix POINTER m
 
m=CreateEmpty(w,h)
MoveBlock(m.data,a,2*w*h)
RETURN (m)
 
PROC Destroy(Matrix POINTER m)
Free(m.data,2*m.width*m.height)
Free(m,MATRIX_SIZE)
RETURN
 
PTR FUNC Product(Matrix POINTER m1,m2)
Matrix POINTER m
BYTE x1,x2,y1,y2,i1,i2,i
INT 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 PrintMatrix(Matrix POINTER m BYTE x,y,colw)
BYTE i,j
CHAR ARRAY tmp(10)
INT ARRAY d
 
d=m.data
FOR j=0 TO m.height-1
DO
Position(x,y+j)
IF j=0 THEN
Put($11)
ELSEIF j=m.height-1 THEN
Put($1A)
ELSE
Put($7C)
FI
 
FOR i=0 TO m.width-1
DO
StrI(d(j*m.width+i),tmp)
Position(x+1+(i+1)*colw+i-tmp(0),y+j)
Print(tmp)
OD
Position(x+1+m.width*colw+(m.width-1),y+j)
IF j=0 THEN
Put($05)
ELSEIF j=m.height-1 THEN
Put($03)
ELSE
Put($7C)
FI
OD
RETURN
 
PROC Test1()
Matrix POINTER m1,m2,m3
INT ARRAY a1=[1 2 3 4],a2=[0 5 6 7]
m1=Create(2,2,a1)
m2=Create(2,2,a2)
m3=Product(m1,m2)
 
PrintMatrix(m1,0,2,1)
Position(5,3) Put('x)
PrintMatrix(m2,6,2,1)
Position(11,3) Put('=)
PrintMatrix(m3,12,1,2)
 
Destroy(m1)
Destroy(m2)
Destroy(m3)
RETURN
 
PROC Test2()
Matrix POINTER m1,m2,m3
INT ARRAY a1=[0 1 0 1 1 1 0 1 0],
a2=[1 1 1 1 1 0 0 1 1 1 1 1]
 
m1=Create(3,3,a1)
m2=Create(4,3,a2)
m3=Product(m1,m2)
 
PrintMatrix(m1,0,7,1)
Position(7,8) Put('x)
PrintMatrix(m2,8,7,1)
Position(17,8) Put('=)
PrintMatrix(m3,2,11,1)
 
Destroy(m1)
Destroy(m2)
Destroy(m3)
RETURN
 
PROC Main()
 
AllocInit(0)
Put(125) ;clear the screen
Test1()
Test2()
RETURN</lang>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Kronecker_product.png Screenshot from Atari 8-bit computer]
<pre>
┌ 0 5 0 10┐
┌1 2┐ ┌0 5┐ │ 6 7 12 14│
└3 4┘x└6 7┘=│ 0 15 0 20│
└18 21 24 28┘
 
 
┌0 1 0┐ ┌1 1 1 1┐
│1 1 1│x│1 0 0 1│=
└0 1 0┘ └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│
│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>
 
Anonymous user