For some reasons, I am trying to write a small Haskell code for tensor products (See http://en.wikipedia.org/wiki/Tensor_product) of bits, which can expand or shrink their size and dimension as needed. Has anyone already done similar or more general work before? If so, I'd be happy use/consult that and cite the work. Otherwise, I should think about cleaning up and packaging this as a library. My code is like this right now:
data Bits = O -- all 1 bits of any size and dimension | I -- all 0 bits of any size and dimension | Bs [Bits] -- row of bits possibly nested | Rep Bits -- repeating of bits (e.g. O = Rep O = Bs [O,O]) deriving (Eq,Show)
bitwise-and
O .& _ = O _ .& O = O (Rep O) .& _ = O _ .& (Rep O) = O (Bs (O:xs)) .& _ | all (O==) xs = O _ .& (Bs (O:xs)) | all (O==) xs = O I .& y = y x .& I = x (Rep I) .& y = y x .& (Rep I) = x (Bs (I:xs)) .& y | all (I==) xs = y x .& (Bs (I:ys)) | all (I==) ys = x (Bs xs) .& (Bs ys) = reduce $ Bs (zipWith (.&) xs ys) (Rep x) .& (Bs ys) = reduce $ Bs (xs .&. ys) where xs=repeat x (Bs xs) .& (Rep y) = reduce $ Bs (xs .&. ys) where ys=repeat y (Rep x) .& (Rep y) = reduce $ Rep (x .& y)
(.&.) = zipWith (.&)
bitwise-or
O .| y = y x .| O = x (Rep O) .| y = y x .| (Rep O) = x (Bs (O:xs)) .| y | all (O==) xs = y x .| (Bs (O:ys)) | all (O==) ys = x I .| _ = I _ .| I = I (Rep I) .| _ = I _ .| (Rep I) = I (Bs (I:xs)) .| _ | all (I==) xs = I _ .| (Bs (I:ys)) | all (I==) ys = I (Bs xs) .| (Bs ys) = reduce $ Bs (xs .|. ys) (Rep x) .| (Bs ys) = reduce $ Bs (xs .|. ys) where xs=repeat x (Bs xs) .| (Rep y) = reduce $ Bs (xs .|. ys) where ys=repeat y (Rep x) .| (Rep y) = reduce $ Rep (x .| y)
(.|.) = zipWith (.|)
tensor product
O .* _ = O _ .* O = O (Rep O) .* _ = O _ .* (Rep O) = O (Bs (O:xs)) .* _ | all (O==) xs = O _ .* (Bs (O:ys)) | all (O==) ys = O I .* I = I I .* (Rep y) = I .* y (Rep I) .* y = I .* y (Bs (I:xs)) .* y | all (I==) xs = I .* y I .* y = reduce $ Rep y x .* (Rep I) = x .* I x .* (Bs (I:xs)) | all (I==) xs = x .* I x .* I = x (Bs xs) .* (Bs ys) = reduce $ Bs (xs .*. ys) (Bs xs) .* (Rep y) = reduce $ Bs (map (reduce . Rep) $ xs .*. [y]) (Rep x) .* y = reduce $ Rep (x .* y)
[] .*. _ = [] (x:xs) .*. ys = (reduce $ Bs [x .* y | y<-ys]) : (xs .*. ys)
reducing from Bs [O,O,..] to O and from Bs [I,I,..] to I
reduce (Bs (x:xs)) | all (x==) xs = x reduce (Rep x@(Rep _)) = x reduce x = x
Some example run on Hugs: Main> Bs [I,O] Bs [I,O] Main> Bs [I,O] .| Bs [O,Bs [I,I,I,I] .* Bs [I,O,O,O,O]] Bs [I,Rep (Bs [I,O,O,O,O])] Main> Bs [I,O] .| Bs [O, Bs [I,I,I,I] .* Bs [I,O,O,O,O]] .| Bs [O, Bs [I,O,O,O] .* Bs [I,I,I,I,I]] Bs [I,Bs [I,Bs [I,O,O,O,O],Bs [I,O,O,O,O],Bs [I,O,O,O,O]]] Main> Bs [I,O] .| Bs [O, Bs [I,I,I,I] .* Bs [I,O,O,O,O]] .| Bs [O, Bs [I,O,O,O] .* Bs [I,I,I,I,I]] .| Bs [O, Bs [O,I,I,O] .* Bs [O,I,I,O,O]] Bs [I,Bs [I,Bs [I,I,I,O,O],Bs [I,I,I,O,O],Bs [I,O,O,O,O]]] Main> Bs [I,O] .| Bs [O, Bs [I,I,I,I] .* Bs [I,O,O,O,O]] .| Bs [O, Bs [I,O,O,O] .* Bs [I,I,I,I,I]] .| Bs [O, Bs [O,I,I,O] .* Bs [O,I,I,O,O]] .| Bs [O, Bs [O,I,I,I] .* Bs [O,O,O,I,I]] Bs [I,Bs [I,I,I,Bs [I,O,O,I,I]]] Main> Bs [I,O] .| Bs [O, Bs [I,I,I,I] .* Bs [I,O,O,O,O]] .| Bs [O, Bs [I,O,O,O] .* Bs [I,I,I,I,I]] .| Bs [O, Bs [O,I,I,O] .* Bs [O,I,I,O,O]] .| Bs [O, Bs [O,I,I,I] .* Bs [O,O,O,I,I]] .| Bs [O, Bs [O,O,I,I] .* Bs [O,I,I,O,O]] I