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 _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe