Haskell：递归矩阵Kronecker积和多维块矩阵的递归平坦绘制

我在Haskell for learning中实现了kronecker产品功能，一切正常， 除了我还没有找到高阶kroneckerProduct的正确实现 可以将sub-kroneckerProduct作为参数，这也促使我考虑如何渲染 由kroneckerProduct生成的块矩阵

{-# LANGUAGE RankNTypes #-}

import Data.List (intercalate, transpose)
import Data.List.Split (chunksOf)
import Control.Applicative (Applicative, pure, (<$>), (<*>))

newtype Matrix a = Matrix { getMatrix :: [[a]] }

instance Functor Matrix where
    fmap f = Matrix . (fmap (fmap f)) . getMatrix 

instance Applicative Matrix where
    pure x = Matrix [[x]]
    (Matrix as) <*> (Matrix bs) = Matrix $ zipWith (zipWith id) as bs

instance (Show a) => Show (Matrix a) where 
    show = (intercalate "\n") . fmap (unwords . fmap show) . getMatrix

scalarProduct :: (Num a) => a -> Matrix a -> Matrix a
scalarProduct scalar matrix = (* scalar) <$> matrix

hadamardProduct :: (Num a) => Matrix a -> Matrix a -> Matrix a
hadamardProduct matrix1 matrix2 = (*) <$> matrix1 <*> matrix2

-- The kronecker product M1 ⊗ M2, results in a block matrix.
-- It is a matrix that has elements that are also matrices, 
-- this makes it somewhat multidimensional tensor. 
-- The resulting block matrix has the same dimensions as M1. 
-- Every resulting element M1M2ij is equal to M1ij × M2. 
-- Assuming M1 contains scalars, this would mean every element 
-- in the resulting matrix requires a further scalar multiplication. 
-- But it could also be some other multiplication method.
-- This requires a RankNTypes
kroneckerProduct :: (a -> Matrix b -> Matrix b) -> Matrix a -> Matrix b -> Matrix (Matrix b)
kroneckerProduct f m1 m2 = (`f` m2) <$> m1

-- Flattening a block matrix produced by kroneckerProduct into a normal Matrix.
-- This works by assuming a quad layer matrix: [[[[...]]]].
-- We tranpose the middle 2,then concat the outside 2, and concat the inner 2.
-- This ends up bringing out the inner block matrices into the outside.
-- The resulting size of the new matrix is rowA*colA * rowB*colB, 
-- where A is the outer Matrix, and B is the inner Matrix.
flattenBlock :: Matrix (Matrix a) -> Matrix a
flattenBlock blockMatrix = Matrix $ dilate $ getMatrix2 blockMatrix
    where 
        dilate = (fmap concat) . concat . (fmap transpose)
        getMatrix2 = getMatrix . fmap getMatrix

incrementingMatrix :: Int -> Int -> Matrix Int
incrementingMatrix rowSize colSize = Matrix $ chunksOf colSize [1..(rowSize * colSize)]

但是，我们无法编译此项（但从数学上讲，它应该是可能的）：

我以“发生检查”结束：

需要使用某种类型的类型类递归，但我尝试使用多参数类型类，但没有理解它

因此，我重申：

如何更改kroneckerProduct函数，以便在接受子kroneckerProduct函数时具有更大的灵活性

然后如何展平多层块矩阵并进行渲染

---

类型错误是合理的-

kroneckerProduct

期望类型为

x->矩阵y->矩阵y

，但是

kroneckerProduct scalarProduct

的类型是

矩阵a->矩阵a->矩阵（矩阵a）

-y与

矩阵a

统一，在这种情况下，给出无限类型错误。我认为

kroneckerProduct

的类型是错误的，它是一个二进制关联运算符，所以它的类型应该反映这一点。我认为你想要的函数类型是

环a=>矩阵a->矩阵a->矩阵a->矩阵（矩阵a）

-因为矩阵形成

环

，这就给了你“无限塔”你想要的产品。有没有一个现有的名为Ring的typeclass我可以使用？我相信任何搜索引擎都可以找到很多——但也许你正在寻找一个kroneckerProduct可以使用任何形式的乘法的类型。有时必须指定乘法的类型，而不仅仅是通过类型类多态性。所以我不明白kroneckerProduct:：Ring a=>矩阵a->矩阵a->矩阵a->矩阵（矩阵a）是怎么回事。当你说“kroneckerProduct可以使用任何类型的乘法”时，我假设你的意思是它不需要整个环结构（也许只是一个组？）-然后类型可以是

kroneckerProduct:：groupa=>Matrix a->Matrix a->Matrix（Matrix a）

，当然，矩阵仍然是一个组。如果您不希望typeclasses强制执行唯一性属性，可以将类具体化为记录，并让

kroneckerProduct:：Group a->Matrix a->Matrix a->Matrix（Matrix a）

-我认为这些关注点是完全正交的。

> let blockMatrix1 = kroneckerProduct scalarProduct (incrementingMatrix 2 2) (incrementingMatrix 2 2)
> putStrLn $ show $ flattenBlock blockMatrix1
> let blockMatrix2 = kroneckerProduct hadamardProduct blockMatrix1 (incrementingMatrix 2 2)
> putStrLn $ show $ flattenBlock blockMatrix2

> let recursiveKro = kroneckerProduct (kroneckerProduct scalarProduct)

Occurs check: cannot construct the infinite type: b ~ Matrix b
Expected type: Matrix b -> Matrix b -> Matrix b
  Actual type: Matrix b -> Matrix b -> Matrix (Matrix b)
Relevant bindings include
  recursiveKro :: Matrix (Matrix b) -> Matrix b -> Matrix (Matrix b)
    (bound at <interactive>:240:5)
In the first argument of ‘kroneckerProduct’, namely
  ‘(kroneckerProduct scalarProduct)’
In the expression:
  kroneckerProduct (kroneckerProduct scalarProduct)

flattenBlockRecursive m = fmap flattenBlockRecursive $ Matrix $ (concat . (fmap transpose) . (fmap concat)) (getMatrix $ fmap getMatrix $ m)