summaryrefslogtreecommitdiff
path: root/lib/Numeric/ContainerBoot.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Numeric/ContainerBoot.hs')
-rw-r--r--lib/Numeric/ContainerBoot.hs29
1 files changed, 4 insertions, 25 deletions
diff --git a/lib/Numeric/ContainerBoot.hs b/lib/Numeric/ContainerBoot.hs
index 276eaa8..d9f0d78 100644
--- a/lib/Numeric/ContainerBoot.hs
+++ b/lib/Numeric/ContainerBoot.hs
@@ -639,33 +639,12 @@ assocM (r,c) z xs = ST.runSTMatrix $ do
639 639
640---------------------------------------------------------------------- 640----------------------------------------------------------------------
641 641
642conformMTo (r,c) m 642condM a b l e t = reshape (cols a'') $ cond a' b' l' e' t'
643 | size m == (r,c) = m
644 | size m == (1,1) = konst (m@@>(0,0)) (r,c)
645 | size m == (r,1) = repCols c m
646 | size m == (1,c) = repRows r m
647 | otherwise = error $ "matrix " ++ shSize m ++ " cannot be expanded to (" ++ show r ++ "><"++ show c ++")"
648
649conformVTo n v
650 | dim v == n = v
651 | dim v == 1 = konst (v@>0) n
652 | otherwise = error $ "vector of dim=" ++ show (dim v) ++ " cannot be expanded to dim=" ++ show n
653
654repRows n x = fromRows (replicate n (flatten x))
655repCols n x = fromColumns (replicate n (flatten x))
656
657size m = (rows m, cols m)
658
659shSize m = "(" ++ show (rows m) ++"><"++ show (cols m)++")"
660
661condM a b l e t = reshape c $ cond a' b' l' e' t'
662 where 643 where
663 r = maximum (map rows [a,b,l,e,t]) 644 args@(a'':_) = conformMs [a,b,l,e,t]
664 c = maximum (map cols [a,b,l,e,t]) 645 [a', b', l', e', t'] = map flatten args
665 [a', b', l', e', t'] = map (flatten . conformMTo (r,c)) [a,b,l,e,t]
666 646
667condV f a b l e t = f a' b' l' e' t' 647condV f a b l e t = f a' b' l' e' t'
668 where 648 where
669 n = maximum (map dim [a,b,l,e,t]) 649 [a', b', l', e', t'] = conformVs [a,b,l,e,t]
670 [a', b', l', e', t'] = map (conformVTo n) [a,b,l,e,t]
671 650