Kronecker product: Difference between revisions
Content added Content deleted
(→{{header|Haskell}}: (slight reformulation for fewer maps)) |
(→{{header|AppleScript}}: Added a sketch in Applescript (using generic functions)) |
||
Line 29: | Line 29: | ||
;See also: |
;See also: |
||
* [[Kronecker_product_based_fractals| Kronecker product based fractals]]. |
* [[Kronecker_product_based_fractals| Kronecker product based fractals]]. |
||
=={{header|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 mapMult |
|||
on product(a, b) |
|||
a * b |
|||
end product |
|||
on lambda(xs) |
|||
map(curry(product)'s lambda(n), xs) |
|||
end lambda |
|||
end script |
|||
map(mapMult, 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> |
|||
{{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> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |