bundles/org.simantics.scl.runtime/scl/Vector.scl

   1 import "Prelude"
   2 import "IterN"
   3
   4 infixl 7  (**), dotp
   5
   6 importJava "java.lang.System" where
   7     @JavaName arraycopy
   8     copyFromVector :: Vector a -> Integer -> MVector a -> Integer -> Integer -> <Proc> ()
   9
  10     @JavaName arraycopy
  11     copyFromMVector :: MVector a -> Integer -> MVector a -> Integer -> Integer -> <Proc> ()
  12
  13 @inline
  14 mvector :: VecComp a => [a] -> <Proc> MVector a
  15 mvector l = do
  16     len = length l
  17     result = createMVector len
  18     iterIList (setMVector result) l
  19     result
  20
  21 @inline
  22 vector :: VecComp a => [a] -> Vector a
  23 vector l = runProc (freezeMVector (mvector l))
  24
  25 @inline
  26 vectorF :: VecComp a => Integer -> (Integer -> <e> a) -> <e> Vector a
  27 vectorF l f = runProc do
  28      result = createMVector l
  29      forN l $ \i -> setMVector result i (f i)
  30      freezeMVector result
  31
  32 @inline
  33 singletonVector :: VecComp a => a -> Vector a
  34 singletonVector v = runProc do
  35     result = createMVector 1
  36     setMVector result 0 v
  37     freezeMVector result
  38
  39 @inline
  40 @private
  41 subVector :: Vector a -> Integer -> Integer -> Vector a
  42 subVector src begin end = runProc do
  43     len = end-begin
  44     result = createMVectorProto src len
  45     copyFromVector src begin result 0 len
  46     freezeMVector result
  47
  48 @inline
  49 concatVector :: Vector a -> Vector a -> Vector a
  50 concatVector a b = runProc do
  51     lenA = lengthVector a
  52     lenB = lengthVector b
  53     result = createMVectorProto a (lenA + lenB)
  54     copyFromVector a 0 result 0 lenA
  55     copyFromVector b 0 result lenA lenB
  56     freezeMVector result
  57
  58 @inline
  59 mapVector :: VecComp a => VecComp b => (a -> b) -> Vector a -> Vector b
  60 mapVector f a = vectorF (length a) (\i -> f (a!i))
  61
  62 @inline
  63 zipVectorsWith :: VecComp a => VecComp b => VecComp c => (a -> b -> c) -> Vector a -> Vector b -> Vector c
  64 zipVectorsWith f a b = vectorF (length a) (\i -> f (a!i) (b!i))
  65
  66 instance (VecComp a, Additive a) => Additive (Vector a) where
  67     @inline
  68     zero = runProc (freezeMVector (createMVector 0))
  69     @inline
  70     a + b = runProc do
  71         lenA = lengthVector a
  72         lenB = lengthVector b
  73         if lenA < lenB
  74         then do
  75             result = createMVectorProto a lenB
  76             forN lenA $ \i -> setMVector result i (a!i + b!i)
  77             copyFromVector b lenA result lenA (lenB-lenA)
  78             freezeMVector result
  79         else if lenA > lenB
  80         then do
  81             result = createMVectorProto a lenA
  82             forN lenB $ \i -> setMVector result i (a!i + b!i)
  83             copyFromVector a lenB result lenB (lenA-lenB)
  84             freezeMVector result
  85         else do
  86             result = createMVectorProto a lenA
  87             forN lenA $ \i -> setMVector result i (a!i + b!i)
  88             freezeMVector result
  89
  90 instance (VecComp a, Ring a) => Ring (Vector a) where
  91     @inline
  92     a - b = runProc do
  93         lenA = lengthVector a
  94         lenB = lengthVector b
  95         if lenA < lenB
  96         then do
  97             result = createMVectorProto a lenB
  98             forN lenA $ \i -> setMVector result i (a!i - b!i)
  99             forN (lenB-lenA) $ \i -> setMVector result (lenA+i) (- b!(lenA+i))
 100             freezeMVector result
 101         else if lenA > lenB
 102         then do
 103             result = createMVectorProto a lenA
 104             forN lenB $ \i -> setMVector result i (a!i - b!i)
 105             copyFromVector a lenB result lenB (lenA-lenB)
 106             freezeMVector result
 107         else do
 108             result = createMVectorProto a lenA
 109             forN lenA $ \i -> setMVector result i (a!i - b!i)
 110             freezeMVector result
 111     @inline
 112     neg = mapVector (\x -> -x)
 113     one = fail "Unsupported operation one for Vector"
 114     (*) = fail "Unsupported operation (*) for Vector"
 115     fromInteger = fail "Unsupported operation fromInteger for Vector"
 116
 117 @inline
 118 dotp :: Ring a => VecComp a => Vector a -> Vector a -> a
 119 dotp a b = foldlN (\sum i -> sum + a!i * b!i) 0 (min (length a) (length b))
 120
 121 @inline
 122 normSq a = foldlN (\sum i -> do v = a!i ; sum + v*v) 0 (length a)
 123
 124 @inline
 125 norm a = sqrt (normSq a)
 126
 127 maxNorm a = foldlN (\cur i -> max cur (abs (a!i))) 0 (length a)
 128
 129 l1Norm a = foldlN (\cur i -> cur + abs (a!i)) 0 (length a)
 130
 131 @inline
 132 (**) :: Ring a => VecComp a => a -> Vector a -> Vector a
 133 s ** a = mapVector (\x -> s*x) a
 134
 135 instance (Show a, VecComp a) => Show (Vector a) where
 136     s <+ v = s << "vector " <+ [v!i | i <- [0..lengthVector v-1]]
 137
 138 instance (VecComp a) => Sequence (Vector a) where
 139     @inline
 140     length = lengthVector
 141     @inline
 142     sub = subVector
 143
 144 instance IndexedSequence Vector where
 145     (!) = getVector
 146
 147 @inline
 148 iterVector :: (a -> <e> b) -> Vector a -> <e> ()
 149 iterVector f v = forN (lengthVector v) (\i -> f (getVector v i))
 150
 151 @inline
 152 foldlVector :: (a -> b -> <e> a) -> a -> Vector b -> <e> a
 153 foldlVector f initial v = foldlN (\cur i -> f cur (getVector v i)) initial (lengthVector v)
 154
 155 @inline
 156 anyVector :: (a -> <e> Boolean) -> Vector a -> <e> Boolean
 157 anyVector f v = anyN (\i -> f (getVector v i)) (lengthVector v)
 158
 159 @inline
 160 allVector :: (a -> <e> Boolean) -> Vector a -> <e> Boolean
 161 allVector f v = allN (\i -> f (getVector v i)) (lengthVector v)
 162
 163 @inline
 164 mapFirstVector :: (a -> <e> Maybe b) -> Vector a -> <e> Maybe b
 165 mapFirstVector f v = mapFirstN (\i -> f (getVector v i)) (lengthVector v)
 166
 167 @inline
 168 containsVector :: a -> Vector a -> Boolean
 169 containsVector x v = foldlN (\result i -> result || (v!i == x)) False (lengthVector v)
 170
 171 @inline
 172 vectorToList :: Vector a -> [a]
 173 vectorToList v = foldlN (\l i -> addList l (v ! i)) [] (lengthVector v)