Skip to content

Commit 3e5bf98

Browse files
author
Oskar Lundström
committed
Vektor i Quantity, ett första försök
1 parent 739b160 commit 3e5bf98

File tree

4 files changed

+835
-785
lines changed

4 files changed

+835
-785
lines changed

‎Physics/src/Combination/Combination.hs‎

Lines changed: 87 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,26 @@
11

22
{-# LANGUAGE TypeOperators #-}
3+
{-# LANGUAGE MultiParamTypeClasses #-}
4+
{-# LANGUAGE FlexibleInstances #-}
35

46
module Combination.Combination
57
(
68
) where
79

8-
import Vector.Vector
9-
import Calculus.FunExpr
10-
import Calculus.DifferentialCalc
11-
import Calculus.IntegralCalc
10+
import Vector.Vector2
11+
--import Calculus.FunExpr
12+
--import Calculus.DifferentialCalc
13+
--import Calculus.IntegralCalc
1214
import Dimensions.Quantity2
1315
import Dimensions.TypeLevel
16+
import qualified Dimensions.ValueLevel as V
1417
import Prelude hiding (length)
1518

1619
-- Calculus i Dimensions
1720
------------------------
1821

22+
{-
23+
1924
instance Fractional FunExpr where
2025
fromRational = Const . fromRational
2126
(/) = (:/)
@@ -81,63 +86,103 @@ differentiateWRTtime qc = fmap simplify $ fmap derive qc /# time
8186
integrateWRTtime :: QC d -> QC (d `Mul` Time)
8287
integrateWRTtime qc = fmap simplify $ fmap integrate qc *# time
8388
89+
-}
90+
91+
92+
--------------------
8493
-- Calc i Vec i Quan
8594
--------------------
8695

87-
type QVC d = Quantity d (Vector2 FunExpr)
96+
-----------------------
97+
-- Instansiering
98+
99+
-- En vektor kan adderas
88100

89-
anyVal :: Vector2 FunExpr
90-
anyVal = V2 (Const 1) (Const 1)
101+
-- (Kan alla göras samtidigt?)
91102

92-
lengthQVC = length' anyVal
93-
massQVC = mass' anyVal
94-
timeQVC = time' anyVal
95-
temperatureQVC = temperature' anyVal
96-
currentQVC = current' anyVal
97-
substanceQVC = substance' anyVal
98-
luminosityQVC = luminosity' anyVal
99-
oneQVC = one' anyVal
103+
instance (Addable v v v) => Addable (Vector2 v) (Vector2 v) (Vector2 v) where
104+
doAdd = vzipWith (doAdd)
105+
instance (Addable v v v) => Addable (Vector3 v) (Vector3 v) (Vector3 v) where
106+
doAdd = vzipWith (doAdd)
100107

101-
s1 :: QVC Length
102-
s1 = V2 (5 :+ Id) (2 :* Id) ## lengthQVC
108+
-- En vektor kan multipliceras på flera sätt
103109

104-
s2 :: QVC Time
105-
s2 = V2 (Id :* Id) (8) ## timeQVC
110+
-- Skalning (från vänster)
111+
instance (Num v) => Multiplicable v (Vector2 v) (Vector2 v) where
112+
doMult = scale
113+
instance (Num v) => Multiplicable v (Vector3 v) (Vector3 v) where
114+
doMult = scale
106115

107-
-- Socker
108-
(###) :: (FunExpr, FunExpr) -> QVC d -> QVC d
109-
(x, y) ### qvc = V2 x y ## qvc
116+
-- Kryssprdoukt
117+
instance (Num v) => Multiplicable (Vector3 v) (Vector3 v) (Vector3 v) where
118+
doMult = crossProd
110119

111-
s3 :: QVC Time
112-
s3 = (Id, Sin) ### timeQVC
120+
-- Skalärprodukt
121+
instance (Num v) => Multiplicable (Vector2 v) (Vector2 v) v where
122+
doMult = dotProd
123+
instance (Num v) => Multiplicable (Vector3 v) (Vector3 v) v where
124+
doMult = dotProd
113125

114-
addQVC :: QVC d -> QVC d -> QVC d
115-
addQVC = quantityAdd' (vzipWith (+))
126+
-- En vektor kan "skapas"
116127

117-
simplifyQVC :: QVC d -> QVC d
118-
simplifyQVC = fmap (vmap simplify)
128+
instance (Creatable v) => Creatable (Vector2 v) where
129+
anyVal = V2 anyVal anyVal
130+
instance (Creatable v) => Creatable (Vector3 v) where
131+
anyVal = V3 anyVal anyVal anyVal
119132

120-
scaleQVC :: Quantity d1 FunExpr -> QVC d2 -> QVC (d1 `Mul` d2)
121-
scaleQVC s qvc = simplifyQVC $ quantityMul' (\fe vec -> scale fe vec) s qvc
133+
------------------------------------
134+
-- Användning
122135

123-
divQVC :: Quantity d1 FunExpr -> QVC d2 -> QVC (d1 `Div` d2)
124-
divQVC s qvc = simplifyQVC $ quantityDiv' (\fe vec -> scale (1 :/ fe) vec) s qvc
136+
-- Ej dimensionssäkra
137+
v1 :: Vector3 Double
138+
v1 = V3 3 2 3
139+
v2 :: Vector3 Double
140+
v2 = V3 1 2 5
141+
v3 :: Vector3 Double
142+
v3 = V3 7 8 2
125143

126-
diffQVC :: QVC d -> QVC (d `Div` Time)
127-
diffQVC qvc = simplifyQVC differentiated
144+
-- Dimensionsäkra
145+
v1d :: Quantity Length (Vector3 Double)
146+
v1d = v1 ## length
147+
v2d :: Quantity Mass (Vector3 Double)
148+
v2d = v2 ## mass
149+
v3d :: Quantity Time (Vector3 Double)
150+
v3d = v3 ## time
151+
152+
-- t1 kräver typsignatur, antagligen för den här MultiParam...
153+
-- så att ska veta vilken instans
154+
155+
-- Addition
156+
t1 :: Quantity Length (Vector3 Double)
157+
t1 = v1d +# v1d
158+
159+
-- Kryssprodukt
160+
t2 :: Quantity (Length `Mul` Mass) (Vector3 Double)
161+
t2 = v1d *# v2d
162+
163+
-- Skalning
164+
t3 :: Quantity (Length `Mul` Mass) (Vector3 Double)
165+
t3 = s *# v2d
128166
where
129-
differentiated = quantityDiv' f (fmap (vmap derive) qvc) timeQVC
130-
f = vzipWith (/)
167+
s :: Quantity Length Double
168+
s = 3.0 ## length
169+
170+
-- Skalärprodukt
171+
t4 :: Quantity (Time `Mul` Length) Double
172+
t4 = v3d *# v1d
173+
174+
175+
176+
177+
178+
179+
180+
181+
131182

132-
-- Ett flygplans position av tiden bestäms av nedan
133183

134-
pos :: QVC Length
135-
pos = (Sin :+ Const 8, Id :* Const 3) ### lengthQVC
136184

137-
-- Vad är hastigheten hos ett flygplan som flyger dubbelt så snabbt, som en funktion av tiden?
138185

139-
velDoub :: QVC (Length `Div` Time)
140-
velDoub = scaleQVC (Const 2 # one) (diffQVC pos)
141186

142187

143188

‎Physics/src/Dimensions/Quantity2.hs‎

Lines changed: 142 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,142 @@
1+
2+
{-# LANGUAGE UndecidableInstances #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE GADTs #-}
5+
{-# LANGUAGE DataKinds #-}
6+
{-# LANGUAGE TypeOperators #-}
7+
{-# LANGUAGE KindSignatures #-}
8+
9+
{-# LANGUAGE MultiParamTypeClasses #-}
10+
11+
module Dimensions.Quantity2 where
12+
13+
import qualified Dimensions.ValueLevel as V
14+
import Dimensions.TypeLevel as T
15+
import Prelude as P hiding (length)
16+
17+
data Quantity (d :: T.Dim) (v :: *) where
18+
ValQuantity :: V.Dim -> v -> Quantity d v
19+
20+
showQuantity :: (Show v) => Quantity d v -> String
21+
showQuantity (ValQuantity d v) = show v ++ " " ++ show d
22+
23+
instance (Show v) => Show (Quantity d v) where
24+
show = showQuantity
25+
26+
----------------------------------
27+
28+
class Addable a b c where
29+
doAdd :: a -> b -> c
30+
31+
(+#) :: (Addable a b c) => Quantity d a ->
32+
Quantity d b ->
33+
Quantity d c
34+
(+#) (ValQuantity d a) (ValQuantity _ b) =
35+
ValQuantity d $ doAdd a b
36+
37+
--instance (Num v) => Addable v v v where
38+
-- doAdd = (+)
39+
40+
instance Addable Double Double Double where
41+
doAdd = (+)
42+
43+
----------------------------------
44+
45+
class Multiplicable a b c where
46+
doMult :: a -> b -> c
47+
48+
(*#) :: (Multiplicable a b c) => Quantity d1 a
49+
-> Quantity d2 b
50+
-> Quantity (d1 `Mul` d2) c
51+
(*#) (ValQuantity d1 a) (ValQuantity d2 b) =
52+
ValQuantity (d1 `V.mul` d2) $ doMult a b
53+
54+
55+
--instance (Num v) => Multiplicable v v v where
56+
-- doMult = (*)
57+
58+
instance (Num v) => Multiplicable Double Double Double where
59+
doMult = (*)
60+
61+
62+
63+
64+
65+
66+
67+
class Creatable a where
68+
anyVal :: a
69+
70+
-- Vad går att "skapa"?
71+
72+
instance Creatable Double where
73+
anyVal = 1.0
74+
75+
instance Creatable Integer where
76+
anyVal = 1
77+
78+
--instance (Num v) => Creatable v where
79+
-- anyVal = fromInteger 0
80+
-- Det blir problem om denna finns med. Overlapping instances.
81+
-- Tas den i combination bort, så klagas det att Num för Vector2 Double krävs. Läggs en sådan till (utan någon definerat) funkar det.
82+
83+
infixl 3 ##
84+
(##) :: v -> Quantity d v -> Quantity d v
85+
v ## (ValQuantity d _) = ValQuantity d v
86+
87+
length :: (Creatable v) => Quantity Length v
88+
length = ValQuantity V.length anyVal
89+
mass :: (Creatable v) => Quantity Mass v
90+
mass = ValQuantity V.mass anyVal
91+
time :: (Creatable v) => Quantity Time v
92+
time = ValQuantity V.time anyVal
93+
94+
95+
96+
97+
98+
99+
100+
101+
102+
103+
104+
105+
106+
107+
108+
109+
110+
111+
112+
113+
114+
115+
116+
117+
118+
119+
120+
121+
122+
123+
124+
125+
126+
127+
128+
129+
130+
131+
132+
133+
134+
135+
136+
137+
138+
139+
140+
141+
142+

0 commit comments

Comments
 (0)