Kronecker product
You are encouraged to solve this task according to the task description, using any language you may know.
| This page uses content from Wikipedia. The original article was at Kronecker product. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |
- Task
Implement the Kronecker product of two matrices (arbitrary sized) resulting in a block matrix.
- Test cases
Show results for each of the following two samples:
Sample 1 (from Wikipedia):
│1 2│ x │0 5│ = │ 0 5 0 10│ │3 4│ │6 7│ │ 6 7 12 14│ │ 0 15 0 20│ │18 21 24 28│
Sample 2:
│0 1 0│ x │1 1 1 1│ = │0 0 0 0 1 1 1 1 0 0 0 0│
│1 1 1│ │1 0 0 1│ │0 0 0 0 1 0 0 1 0 0 0 0│
│0 1 0│ │1 1 1 1│ │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│
See implementations and results below in JavaScript and PARI/GP languages.
- Related task
360 Assembly
<lang 360asm>* Kronecker product 06/04/2017 KRONECK CSECT
USING KRONECK,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R1,1 first example
BAL R14,PRODUCT call product(a1,b1)
BAL R14,PRINT call print(r)
XPRNT =C'---',3 separator
LA R1,2 second example
BAL R14,PRODUCT call product(a2,b2)
BAL R14,PRINT call print(r)
L R13,4(0,R13) restore previous savearea pointer
LM R14,R12,12(R13) restore previous context
XR R15,R15 rc=0
BR R14 exit
- ------- ---- ----------------------------------------
PRODUCT EQU * product(o)
STC R1,OO store o
IF CLI,OO,EQ,X'01' THEN if o=1 then
MVC MM(8),DIM1 (m,n)=hbound(a1) (p,q)=hbound(b1)
LA R1,A1 @a1
LA R2,B1 @b1
ELSE , else
MVC MM(8),DIM2 (m,n)=hbound(a2) (p,q)=hbound(b2)
LA R1,A2 @a2
LA R2,B2 @b2
ENDIF , endif
ST R1,ADDRA addra=@a1
ST R2,ADDRB addrb=@b1
LH R1,MM m
MH R1,PP p
STH R1,RI ri=m*p
LH R2,NN n
MH R2,QQ *q
STH R2,RJ rj=n*q
LA R6,1 i=1
DO WHILE=(CH,R6,LE,MM) do i=1 to m
LA R7,1 j=1
DO WHILE=(CH,R7,LE,NN) do j=1 to n
LA R8,1 k=1
DO WHILE=(CH,R8,LE,PP) do k=1 to p
LA R9,1 l=1
DO WHILE=(CH,R9,LE,QQ) do l=1 to q
LR R1,R6 i
BCTR R1,0
MH R1,NN *hbound(a,2)
AR R1,R7 j
BCTR R1,0
SLA R1,2
L R4,ADDRA @a
L R2,0(R4,R1) r2=a(i,j)
LR R1,R8 k
BCTR R1,0
MH R1,QQ *hbound(b1,2)
AR R1,R9 l
BCTR R1,0
SLA R1,2
L R4,ADDRB @b
L R3,0(R4,R1) r3=b(k,l)
LR R5,R2 r2
MR R4,R3 *r3
LR R0,R5 r0=a(i,j)*b(k,l)
LR R1,R6 i
BCTR R1,0 i-1
MH R1,PP *p
AR R1,R8 r1=p*(i-1)+k
LR R2,R7 j
BCTR R2,0 j-1
MH R2,QQ *q
AR R2,R9 r2=q*(j-1)+l
BCTR R1,0
MH R1,=AL2(NR) *nr
AR R1,R2 r1=r1+r2
SLA R1,2
ST R0,R-4(R1) r(p*(i-1)+k,q*(j-1)+l)=r0
LA R9,1(R9) l++
ENDDO , enddo l
LA R8,1(R8) k++
ENDDO , enddo k
LA R7,1(R7) j++
ENDDO , enddo j
LA R6,1(R6) i++
ENDDO , enddo i
BR R14 return
- ------- ---- ----------------------------------------
PRINT EQU * print
LA R6,1 i
DO WHILE=(CH,R6,LE,RI) do i=1 to ri
MVC PG,=CL80' ' init buffer
LA R10,PG pgi=0
LA R7,1 j
DO WHILE=(CH,R7,LE,RJ) do j=1 to rj
LR R1,R6 i
BCTR R1,0
MH R1,=AL2(NR) *nr
AR R1,R7 +j
SLA R1,2
L R2,R-4(R1) r(i,j)
XDECO R2,XDEC edit
MVC 0(ND,R10),XDEC+12-ND output
LA R10,ND(R10) pgi=pgi+nd
LA R7,1(R7) j++
ENDDO , enddo j
XPRNT PG,L'PG print buffer
LA R6,1(R6) i++
ENDDO , enddo j
BR R14 return
- ---- ----------------------------------------
NR EQU 32 dim result max ND EQU 3 digits to print A1 DC F'1',F'2' a1(2,2)
DC F'3',F'4'
B1 DC F'0',F'5' b1(2,2)
DC F'6',F'7'
DIM1 DC H'2',H'2',H'2',H'2' dim a1 , dim b1 A2 DC F'0',F'1',F'0' a2(3,3)
DC F'1',F'1',F'1'
DC F'0',F'1',F'0'
B2 DC F'1',F'1',F'1',F'1' b2(3,4)
DC F'1',F'0',F'0',F'1'
DC F'1',F'1',F'1',F'1'
DIM2 DC H'3',H'3',H'3',H'4' dim a2 , dim b2 ADDRA DS A @a ADDRB DS A @b RI DS H ri RJ DS H rj MM DS H m NN DS H n PP DS H p QQ DS H q OO DS X o PG DS CL80 buffer XDEC DS CL12
LTORG
R DS (NR*NR)F r(nr,nr)
YREGS
END KRONECK</lang>
- Output:
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
AppleScript
<lang applescript>-- KRONECKER PRODUCT OF TWO MATRICES ------------------------------------------
-- kprod :: Num -> Num -> Num on kprod(xs, ys)
script concatTranspose
on lambda(m)
map(my concat, my transpose(m))
end lambda
end script
script
-- Multiplication by N over a list of lists
-- f :: Num -> Num -> Num
on f(mx, n)
script
on product(a, b)
a * b
end product
on lambda(xs)
map(curry(product)'s lambda(n), xs)
end lambda
end script
map(result, mx)
end f
on lambda(zs)
map(curry(f)'s lambda(ys), zs)
end lambda
end script
concatMap(concatTranspose, map(result, xs))
end kprod
-- TEST ----------------------------------------------------------------------- on run
unlines(map(show, ¬
kprod({{1, 2}, {3, 4}}, ¬
{{0, 5}, {6, 7}}))) & ¬
linefeed & linefeed & ¬
unlines(map(show, ¬
kprod({{0, 1, 0}, {1, 1, 1}, {0, 1, 0}}, ¬
{{1, 1, 1, 1}, {1, 0, 0, 1}, {1, 1, 1, 1}})))
end run
-- GENERIC FUNCTIONS ----------------------------------------------------------
-- concat :: a -> [a] | [String] -> String on concat(xs)
script append
on lambda(a, b)
a & b
end lambda
end script
if length of xs > 0 and class of (item 1 of xs) is string then
set unit to ""
else
set unit to {}
end if
foldl(append, unit, xs)
end concat
-- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs)
set lst to {}
set lng to length of xs
tell mReturn(f)
repeat with i from 1 to lng
set lst to (lst & lambda(contents of item i of xs, i, xs))
end repeat
end tell
return lst
end concatMap
-- curry :: (Script|Handler) -> Script on curry(f)
script
on lambda(a)
script
on lambda(b)
lambda(a, b) of mReturn(f)
end lambda
end script
end lambda
end script
end curry
-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- intercalate :: Text -> [Text] -> Text on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- map :: (a -> b) -> [a] -> [b] on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn
-- show :: a -> String on show(e)
set c to class of e
if c = list then
script serialized
on lambda(v)
show(v)
end lambda
end script
"{" & intercalate(", ", map(serialized, e)) & "}"
else if c = record then
script showField
on lambda(kv)
set {k, v} to kv
k & ":" & show(v)
end lambda
end script
"{" & intercalate(", ", ¬
map(showField, zip(allKeys(e), allValues(e)))) & "}"
else if c = date then
("date \"" & e as text) & "\""
else if c = text then
"\"" & e & "\""
else
try
e as text
on error
("«" & c as text) & "»"
end try
end if
end show
-- transpose :: a -> a on transpose(xss)
script column
on lambda(_, iCol)
script row
on lambda(xs)
item iCol of xs
end lambda
end script
map(row, xss)
end lambda
end script
map(column, item 1 of xss)
end transpose
-- unlines :: [String] -> String on unlines(xs)
intercalate(linefeed, xs)
end unlines</lang>
- Output:
{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}
FreeBASIC
<lang freebasic>' version 06-04-2017 ' compile with: fbc -s console
Sub kronecker_product(a() As Long, b() As Long, frmt As String = "#")
Dim As Long i, j, k, l Dim As Long la1 = LBound(a, 1) : Dim As Long ua1 = UBound(a, 1) Dim As Long la2 = LBound(a, 2) : Dim As Long ua2 = UBound(a, 2) Dim As Long lb1 = LBound(b, 1) : Dim As Long ub1 = UBound(b, 1) Dim As Long lb2 = LBound(b, 2) : Dim As Long ub2 = UBound(b, 2)
For i = la1 To ua1
For k = lb1 To ub1
Print "[";
For j = la2 To ua2
For l = lb2 To ub2
Print Using frmt; a(i, j) * b(k, l);
If j = ua1 And l = ub2 Then
Print "]"
Else
Print " ";
End If
Next
Next
Next
Next
End Sub
' ------=< MAIN >=-----
Dim As Long a(1 To 2, 1 To 2) = {{1, 2}, _
{3, 4}}
Dim As Long b(1 To 2, 1 To 2) = {{0, 5}, _
{6, 7}}
kronecker_product(a(), b(), "##")
Print Dim As Long x(1 To 3, 1 To 3) = {{0, 1, 0}, _
{1, 1, 1}, _
{0, 1, 0}}
Dim As Long y(1 To 3, 1 To 4) = {{1, 1, 1, 1}, _
{1, 0, 0, 1}, _
{1, 1, 1, 1}}
kronecker_product(x(), y())
' empty keyboard buffer While InKey <> "" : Wend Print : Print "hit any key to end program" Sleep End</lang>
- Output:
[ 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]
Haskell
<lang haskell>import Data.List (transpose)
kprod
:: Num a => a -> a -> a
kprod xs ys =
let f = fmap . fmap . (*) -- Multiplication by n over list of lists in (concat <$>) . transpose =<< fmap (`f` ys) <$> xs
main :: IO () main = do
mapM_ print $ kprod [[1, 2], [3, 4]] [[0, 5], [6, 7]]
putStrLn []
mapM_ print $
kprod
[[0, 1, 0], [1, 1, 1], [0, 1, 0]]
[[1, 1, 1, 1], [1, 0, 0, 1], [1, 1, 1, 1]]</lang>
- Output:
[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]
JavaScript
Imperative
Version #1.
<lang javascript>
// matkronprod.js
// Prime function:
// mkp arrow function: Return the Kronecker product of the a and b matrices.
// Note: both a and b must be matrices, i.e., 2D rectangular arrays.
mkp=(a,b)=>a.map(a=>b.map(b=>a.map(y=>b.map(x=>r.push(y*x)),t.push(r=[]))),t=[])&&t;
// Helper functions:
// Log title and matrix mat to console
function matl2cons(title,mat) {console.log(title); console.log(mat.join`\n`)}
// Print title to document
function pttl2doc(title) {document.write(''+title+'
')}
// Print title and matrix mat to document
function matp2doc(title,mat) {
document.write(''+title+':
');
for (var i = 0; i < mat.length; i++) {
document.write(' '+mat[i].join(' ')+'
');
}
} </lang>
- Required tests
<lang html> <html><head>
<title>Kronecker product: Sample 1 (from Wikipedia) and Sample 2</title>
<script src="matkronprod.js"></script>
<script>
var mr,ttl='Kronecker product of A and B matrices';
[ {a:[[1,2],[3,4]],b:[[0,5],[6,7]] },
{a:[[0,1,0],[1,1,1],[0,1,0]],b:[[1,1,1,1],[1,0,0,1],[1,1,1,1]] }
].forEach(m=>{
console.log(ttl); pttl2doc(ttl);
matl2cons('A',m.a); matp2doc('A',m.a);
matl2cons('B',m.b); matp2doc('B',m.b);
mr=mkp(m.a,m.b);
matl2cons('A x B',mr); matp2doc('A x B',mr);
})
</script>
</head><body></body> </html> </lang>
- Output:
Console and page results
Kronecker product of A and B matrices A 1,2 3,4 B 0,5 6,7 A x B 0,5,0,10 6,7,12,14 0,15,0,20 18,21,24,28 Kronecker product of A and B matrices A 0,1,0 1,1,1 0,1,0 B 1,1,1,1 1,0,0,1 1,1,1,1 A x B 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
Version #2.
This version is more understandable for sure.
<lang javascript> // matkronprod2.js // Prime function: // mkp2(): Return the Kronecker product of the a and b matrices // Note: both a and b must be matrices, i.e., 2D rectangular arrays. function mkp2(a,b) {
var m=a.length, n=a[0].length, p=b.length, q=b[0].length;
var rtn=m*p, ctn=n*q; var r=new Array(rtn);
for (var i=0; i<rtn; i++) {r[i]=new Array(ctn)
for (var j=0;j<ctn;j++) {r[i][j]=0}
}
for (var i=0; i<m; i++) {
for (var j=0; j<n; j++) {
for (var k=0; k<p; k++) {
for (var l=0; l<q; l++) {
r[p*i+k][q*j+l]=a[i][j]*b[k][l];
}}}}//all4forend
return(r);
}
// Helper functions:
// Log title and matrix mat to console
function matl2cons(title,mat) {console.log(title); console.log(mat.join`\n`)}
// Print title to document
function pttl2doc(title) {document.write(''+title+'
')}
// Print title and matrix mat to document
function matp2doc(title,mat) {
document.write(''+title+':
');
for (var i=0; i < mat.length; i++) {
document.write(' '+mat[i].join(' ')+'
');
}
} </lang>
- Required tests
<lang html> <html><head>
<title>Kronecker product v.2: Sample 1 (from Wikipedia) and Sample 2</title>
<script src="matkronprod2.js"></script>
<script>
var mr,ttl='Kronecker product of A and B matrices';
[ {a:[[1,2],[3,4]],b:[[0,5],[6,7]] },
{a:[[0,1,0],[1,1,1],[0,1,0]],b:[[1,1,1,1],[1,0,0,1],[1,1,1,1]] }
].forEach(m=>{
console.log(ttl); pttl2doc(ttl);
matl2cons('A',m.a); matp2doc('A',m.a);
matl2cons('B',m.b); matp2doc('B',m.b);
mr=mkp2(m.a,m.b);
matl2cons('A x B',mr); matp2doc('A x B',mr);
})
</script>
</head><body></body> </html> </lang>
- Output:
Console and page results
Output is identical to Version #1 above.
Functional
ES6
(As JavaScript is now widely embedded in non-browser contexts, a non-HTML string value is returned here, rather than invoking a DOM method, which will not always be available to a JavaScript interpreter) <lang javascript>(() => {
'use strict';
// GENERIC FUNCTIONS ------------------------------------------------------
// concat :: a -> [a] const concat = xs => [].concat.apply([], xs);
// concatMap :: (a -> [b]) -> [a] -> [b] const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
// 2 or more arguments
// curry :: Function -> Function
const curry = (f, ...args) => {
const go = xs => xs.length >= f.length ? (f.apply(null, xs)) :
function () {
return go(xs.concat([].slice.apply(arguments)));
};
return go([].slice.call(args, 1));
};
// map :: (a -> b) -> [a] -> [b] const map = curry((f, xs) => xs.map(f));
// show :: a -> String const show = x => JSON.stringify(x); //, null, 2);
// transpose :: a -> a const transpose = xs => xs[0].map((_, col) => xs.map(row => row[col]));
// unlines :: [String] -> String
const unlines = xs => xs.join('\n');
// KRONECKER PRODUCT OF TWO MATRICES --------------------------------------
// kprod :: Num -> Num -> Num const kprod = (xs, ys) => concatMap( m => map(concat, transpose(m)), map(map(f(ys)), xs) );
// (* n) mapped over each element in a matrix // f :: Num -> Num -> Num const f = curry((mx, n) => map(map(x => x * n), mx));
// TEST -------------------------------------------------------------------
return unlines(map(rows => unlines(map(show, rows)), [
kprod([
[1, 2],
[3, 4]
], [
[0, 5],
[6, 7]
]), [], // One empty output line
kprod([
[0, 1, 0],
[1, 1, 1],
[0, 1, 0]
], [
[1, 1, 1, 1],
[1, 0, 0, 1],
[1, 1, 1, 1]
])
]));
})();</lang>
- Output:
[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]
Kotlin
<lang scala>// version 1.1.1 (JVM)
typealias Matrix = Array<IntArray>
fun kroneckerProduct(a: Matrix, b: Matrix): Matrix {
val m = a.size
val n = a[0].size
val p = b.size
val q = b[0].size
val rtn = m * p
val ctn = n * q
val r: Matrix = Array(rtn) { IntArray(ctn) } // all elements zero by default
for (i in 0 until m)
for (j in 0 until n)
for (k in 0 until p)
for (l in 0 until q)
r[p * i + k][q * j + l] = a[i][j] * b[k][l]
return r
}
fun printMatrix(text: String, m: Matrix) {
println(text) for (i in 0 until m.size) println(m[i].contentToString()) println()
}
fun printAll(a: Matrix, b: Matrix, r: Matrix) {
printMatrix("Matrix A:", a)
printMatrix("Matrix B:", b)
printMatrix("Kronecker product:", r)
}
fun main(args: Array<String>) {
var a: Matrix
var b: Matrix
var r: Matrix
a = arrayOf(
intArrayOf(1, 2),
intArrayOf(3, 4)
)
b = arrayOf(
intArrayOf(0, 5),
intArrayOf(6, 7)
)
r = kroneckerProduct(a, b)
printAll(a, b, r)
a = arrayOf(
intArrayOf(0, 1, 0),
intArrayOf(1, 1, 1),
intArrayOf(0, 1, 0)
)
b = arrayOf(
intArrayOf(1, 1, 1, 1),
intArrayOf(1, 0, 0, 1),
intArrayOf(1, 1, 1, 1)
)
r = kroneckerProduct(a, b)
printAll(a, b, r)
}</lang>
- Output:
Matrix A: [1, 2] [3, 4] Matrix B: [0, 5] [6, 7] 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] 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]
PARI/GP
<lang parigp> \\ Print title and matrix mat rows. 4/17/16 aev matprows(title,mat)={print(title); for(i=1,#mat[,1], print(mat[i,]))} \\ \\ Create and return the Kronecker product of the a and b matrices. 4/17/16 aev matkronprod(a,b,pflg=0)={ my(m=#a[,1],n=#a[1,],p=#b[,1],q=#b[1,],r,rtn,ctn); rtn=m*p; ctn=n*q; if(pflg,print(" *** Kronecker product - a: ",m," x ",n," b: ",p," x ",q," result r: ",rtn," x ",ctn)); r=matrix(rtn,ctn); for(i=1,m, for(j=1,n, for(k=1,p, for(l=1,q,
r[p*(i-1)+k,q*(j-1)+l]=a[i,j]*b[k,l];
))));\\all4fend if(pflg,print(r)); return(r); } {\\ Requireq tests: my(a,b,r); \\ Sample 1 a=[1,2;3,4]; b=[0,5;6,7]; r=matkronprod(a,b); matprows("Sample 1 result:",r); \\ Sample 2 a=[0,1,0;1,1,1;0,1,0]; b=[1,1,1,1;1,0,0,1;1,1,1,1]; r=matkronprod(a,b); matprows("Sample 2 result:",r); } </lang>
- Output:
Sample 1 result: [0, 5, 0, 10] [6, 7, 12, 14] [0, 15, 0, 20] [18, 21, 24, 28] Sample 2 result: [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]
Perl 6
<lang perl6>sub kronecker_product ( @a, @b ) {
return (@a X @b).map: { .[0].list X* .[1].list };
}
.say for kronecker_product([ <1 2>, <3 4> ],
[ <0 5>, <6 7> ]);
say ; .say for kronecker_product([ <0 1 0>, <1 1 1>, <0 1 0> ],
[ <1 1 1 1>, <1 0 0 1>, <1 1 1 1>]);
</lang>
- Output:
(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)
R
R has built-in Kronecker product operator for a and b matrices: a %x% b. <lang r>
- Sample using:
a <- matrix(c(1,1,1,1), ncol=2, nrow=2, byrow=TRUE); b <- matrix(c(0,1,1,0), ncol=2, nrow=2, byrow=TRUE); a %x% b </lang>
- Output:
[,1] [,2] [,3] [,4] [1,] 0 1 0 1 [2,] 1 0 1 0 [3,] 0 1 0 1 [4,] 1 0 1 0 Note: This resultant matrix could be used as initial for Checkerboard fractal.
REXX
A little extra coding was added to make the matrix glyphs and element alignment look nicer. <lang rexx>/*REXX program calculates the Kronecker product of two arbitrary size matrices. */ w=0; KP= 'Kronecker product' /*W≡max width of matric elements.*/ aMat= 2x2 1 2 3 4; bMat= 2x2 0 5 6 7 call makeMat 'A', aMat; call makeMat 'B', bMat call KronMat KP w=0; say; say copies('░', 50); say aMat= 3x3 0 1 0 1 1 1 0 1 0; bMat= 3x4 1 1 1 1 1 0 0 1 1 1 1 1 call makeMat 'A', aMat; call makeMat 'B', bMat call KronMat KP 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; w=max(w, length(xy) )
end /*cB*/
end /*cA*/
end /*rB*/
end /*rA*/
call showMat what, aRows*bRows || 'X' || aRows*bCols; return
/*──────────────────────────────────────────────────────────────────────────────────────*/ makeMat: parse arg what, size elements; arg , row 'X' col .; @.what.shape= row col
#=0; do r=1 for row /* [↓] bump item#; get item; max width*/
do c=1 for col; #=#+1; _=word(elements, #); w=max(w, length(_) )
@.what.r.c=_
end /*c*/ /* [↑] define an element of WHAT matrix*/
end /*r*/
call showMat what, size; return
/*──────────────────────────────────────────────────────────────────────────────────────*/ showMat: parse arg what, size .; z='┌'; parse var size row 'X' col; $=left(, 6)
say; say copies('═',7) 'matrix' what copies('═',7)
do r=1 for row; _= '│'
do c=1 for col; _=_ right(@.what.r.c, w); if r==1 then z=z left(,w)
end /*c*/
if r==1 then do; z=z '┐'; say $ z; end /*show the top part of matrix.*/
say $ _ '│'
end /*r*/
say $ translate(z, '└┘', "┌┐"); return /*show the bot part of matrix.*/</lang>
- output when using the default input:
═══════ 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 │
└ ┘
Sidef
<lang ruby>func kronecker_product(a, b) {
a ~X b -> map { _[0] ~X* _[1] }
}
kronecker_product([[1, 2], [3,4]],
[[0, 5], [6, 7]]).each { .say }
say kronecker_product([[0,1,0], [1,1,1], [0,1,0]],
[[1,1,1,1],[1,0,0,1], [1,1,1,1]]).each { .say }</lang>
- Output:
[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]
Tcl
<lang Tcl># some helpers for matrices in nice string form: proc parse_matrix {s} {
split [string trim $s] \n
}
proc print_matrix {m} {
foreach row $m {
puts [join [lmap x $row {format %3s $x}]]
}
}
- obvious imperative version using [foreach]
proc kroenecker {A B} {
foreach arow $A {
foreach brow $B {
set row {}
foreach a $arow {
foreach b $brow {
lappend row [expr {$a * $b}]
}
}
lappend result $row
}
}
return $result
}
proc lolcat {args} { ;# see https://wiki.tcl.tk/41507
concat {*}[uplevel 1 lmap $args]
}
- more compact but obtuse, using [lmap] and [lolcat]
proc kroenecker {A B} {
lolcat arow $A {
lmap brow $B {
lolcat a $arow {
lmap b $brow {
expr {$a * $b}
}
}
}
}
}
- demo:
set inputs {
{1 2
3 4}
{0 5
6 7}
{0 1 0
1 1 1
0 1 0}
{1 1 1 1
1 0 0 1
1 1 1 1}
}
foreach {a b} $inputs {
set a [parse_matrix $a] set b [parse_matrix $b] print_matrix [kroenecker $a $b] puts ""
}</lang>
- Output:
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
VBScript
<lang vb>' Kronecker product - 05/04/2017 dim a(),b(),r()
sub kroneckerproduct '(a,b)
m=ubound(a,1): n=ubound(a,2)
p=ubound(b,1): q=ubound(b,2)
rtn=m*p
ctn=n*q
redim r(rtn,ctn)
for i=1 to m
for j=1 to n
for k=1 to p
for l=1 to q
r(p*(i-1)+k,q*(j-1)+l)=a(i,j)*b(k,l)
next: next: next: next
end sub 'kroneckerproduct
sub printmatrix(text,m,w)
wscript.stdout.writeline text
select case m
case "a": ni=ubound(a,1): nj=ubound(a,2)
case "b": ni=ubound(b,1): nj=ubound(b,2)
case "r": ni=ubound(r,1): nj=ubound(r,2)
end select
for i=1 to ni
for j=1 to nj
select case m
case "a": k=a(i,j)
case "b": k=b(i,j)
case "r": k=r(i,j)
end select
wscript.stdout.write right(space(w)&k,w)
next
wscript.stdout.writeline
next
end sub 'printmatrix
sub printall(w)
printmatrix "matrix a:", "a", w printmatrix "matrix b:", "b", w printmatrix "kronecker product:", "r", w
end sub 'printall
sub main()
xa=array( 1, 2, _
3, 4)
redim a(2,2)
k=0: for i=1 to ubound(a,1): for j=1 to ubound(a,1)
a(i,j)=xa(k): k=k+1
next:next
xb=array( 0, 5, _
6, 7)
redim b(2,2)
k=0: for i=1 to ubound(b,1): for j=1 to ubound(b,1)
b(i,j)=xb(k): k=k+1
next:next
kroneckerproduct
printall 3
xa=array( 0, 1, 0, _
1, 1, 1, _
0, 1, 0)
redim a(3,3)
k=0: for i=1 to ubound(a,1): for j=1 to ubound(a,1)
a(i,j)=xa(k): k=k+1
next:next
xb=array( 1, 1, 1, 1, _
1, 0, 0, 1, _
1, 1, 1, 1)
redim b(3,4)
k=0: for i=1 to ubound(b,1): for j=1 to ubound(b,1)
b(i,j)=xb(k): k=k+1
next:next
kroneckerproduct
printall 2
end sub 'main
main</lang>
- Output:
matrix a: 1 2 3 4 matrix b: 0 5 6 7 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 kronecker product: 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 1 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0
zkl
<lang zkl>var [const] GSL=Import.lib("zklGSL"); // libGSL (GNU Scientific Library) fcn kronecker(A,B){
m,n, p,q := A.rows,A.cols, B.rows,B.cols;
r:=GSL.Matrix(m*p, n*q);
foreach i,j,k,l in (m,n,p,q){ r[p*i + k, q*j + l]=A[i,j]*B[k,l] }
r
}</lang> <lang zkl>A:=GSL.Matrix(2,2).set(1,2, 3,4); B:=GSL.Matrix(2,2).set(0,5, 6,7); kronecker(A,B).format(3,0).println(); // format(width,precision)
A:=GSL.Matrix(3,3).set(0,1,0, 1,1,1, 0,1,0); B:=GSL.Matrix(3,4).set(1,1,1,1, 1,0,0,1, 1,1,1,1); kronecker(A,B).format(2,0).println();</lang>
- Output:
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