X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.scl.compiler%2Ftests%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftests%2Fscl%2FPolynomials.scl;fp=bundles%2Forg.simantics.scl.compiler%2Ftests%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftests%2Fscl%2FPolynomials.scl;h=5e35b9424ac456dd7d61baa7d0c8c59f6df47293;hb=969bd23cab98a79ca9101af33334000879fb60c5;hp=0000000000000000000000000000000000000000;hpb=866dba5cd5a3929bbeae85991796acb212338a08;p=simantics%2Fplatform.git diff --git a/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Polynomials.scl b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Polynomials.scl new file mode 100644 index 000000000..5e35b9424 --- /dev/null +++ b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/Polynomials.scl @@ -0,0 +1,50 @@ +import "Prelude" + +data Poly a = Poly [a] + +normalize l = go (length l) + where + go i = if i > 0 && l!(i-1)==zero + then go (i-1) + else take i l + +instance (Eq a, Additive a) => Additive (Poly a) where + zero = Poly [] + Poly a + Poly b = + Poly ( + normalize ( + zipWith (+) a b + + if la > lb + then drop lb a + else drop la b + ) + ) + where + la = length a + lb = length b + +instance (Eq a, Ring a) => Ring (Poly a) where + one = Poly [one] + neg (Poly l) = Poly (map neg l) + a - b = a + (neg b) + Poly a * Poly b = + Poly ( if aDeg < bDeg + then [ segSum n 0 n | n <- [0 ..aDeg] ] + + [ segSum n 0 aDeg | n <- [aDeg+1..bDeg] ] + + [ segSum n (n-bDeg) aDeg | n <- [bDeg+1..sumDeg] ] + else [ segSum n 0 n | n <- [0 ..bDeg] ] + + [ segSum n (n-bDeg) n | n <- [bDeg+1..aDeg] ] + + [ segSum n (n-bDeg) aDeg | n <- [aDeg+1..sumDeg] ] + ) + where + aDeg = length a - 1 + bDeg = length b - 1 + sumDeg = aDeg + bDeg + segSum n low high = sum [ a!i * b!(n-i) | i <- [low..high] ] + fromInteger x = Poly [fromInteger x] + +a = Poly [4.0,5.0,8.0,3.0,2.0,1.0] +b = Poly [1.0,0.0,2.0,1.0] +main = a * a + a * b + b * a + b * b - (a+b)*(a+b) +-- +[] \ No newline at end of file