Merge branch 'master' into oskar

Author: Oskar Lundström

Physics/src/Dimensions/QuantityExtended.hs

@@ -0,0 +1,202 @@
+
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE KindSignatures #-}
+
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Dimensions.QuantityExtended where
+
+import qualified Dimensions.ValueLevel as V
+import           Dimensions.TypeLevel  as T
+import           Prelude               as P hiding (length)
+
+----------------------------------------
+-- Än så länge inget nytt
+----------------------------------------
+
+data Quantity (d :: T.Dim) (v :: *) where
+  ValQuantity :: V.Dim -> v -> Quantity d v
+
+showQuantity :: (Show v) => Quantity d v -> String
+showQuantity (ValQuantity d v) = show v ++ " " ++ show d
+
+instance (Show v) => Show (Quantity d v) where
+  show = showQuantity
+
+instance (Eq v) => Eq (Quantity d v) where
+  (ValQuantity _ v1) == (ValQuantity _ v2) = v1 == v2
+
+instance (Ord v) => Ord (Quantity d v) where
+  (ValQuantity _ v1) `compare` (ValQuantity _ v2) = v1 `compare` v2
+
+instance Functor (Quantity d) where
+  fmap f (ValQuantity d v) = ValQuantity d (f v)
+
+----------------------------------------
+-- Socker
+----------------------------------------
+
+infixl 3 ##
+(##) :: v -> Quantity d w -> Quantity d v
+v ## (ValQuantity d _) = ValQuantity d v
+
+-- Dummy-värden med matchande värde/typ-nivå dimensioner
+-- med en dummy-typ.
+
+length :: Quantity Length Double
+length = ValQuantity V.length 1.0
+mass :: Quantity Mass Double
+mass = ValQuantity V.mass 1.0
+time :: Quantity Time Double
+time = ValQuantity V.time 1.0
+
+-- Med `##` kan en Quantity med vilken värdetyp som helst skapas
+-- med valfri dimension av ovanstående.
+
+-- Om värdetypen ej stöder multiplikation och division kan
+-- dessa dummy-värden ändå göras så på, och därför kan man
+-- alltid få valfri dimension.
+
+----------------------------------------
+-- Aritmetik
+----------------------------------------
+
+-- En `Quantity` innehåller något av någon typ. Om och hur addition
+-- o.s.v. ser ut för den kan variera, så typen själv ska sköta det.
+-- Dessutom kan det var multiplikation mellan olika typer.
+
+class Addable a b c where
+  doAdd :: a -> b -> c
+
+(+#) :: (Addable a b c) => Quantity d a ->
+                           Quantity d b ->
+                           Quantity d c
+(ValQuantity d a) +# (ValQuantity _ b) = ValQuantity d $ doAdd a b
+
+-- Nedan går ej! Blir problem med Vector då. Vet ej varför.
+
+-- Allt "numeriskt" är adderbart
+--instance (Num v) => Addable v v v where
+--  doAdd = (+)
+
+----------
+
+class Subable a b c where
+  doSub :: a -> b -> c
+
+(-#) :: (Subable a b c) => Quantity d a ->
+                           Quantity d b ->
+                           Quantity d c
+(ValQuantity d a) -# (ValQuantity _ b) = ValQuantity d $ doSub a b
+
+--instance (Num v) => Subable v v v where
+--  doSub = (-)
+
+----------
+
+class Multiplicable a b c where
+  doMul :: a -> b -> c
+
+(*#) :: (Multiplicable a b c) => Quantity d1 a ->
+                                 Quantity d2 b ->
+                                 Quantity (d1 `Mul` d2) c
+(ValQuantity d1 a) *# (ValQuantity d2 b) = ValQuantity (d1 `V.mul` d2) $ doMul a b
+
+--instance (Num v) => Multiplicable v v v where
+--  doMul = (*)
+
+----------
+
+class Divisionable a b c where
+  doDiv :: a -> b -> c
+
+(/#) :: (Divisionable a b c) => Quantity d1 a ->
+                                Quantity d2 b ->
+                                Quantity (d1 `Div` d2) c
+(ValQuantity d1 a) /# (ValQuantity d2 b) = ValQuantity (d1 `V.div` d2) $ doDiv a b
+
+--instance (Fractional v) => Divisionable v v v where
+--  doMul = (*)
+
+----------------------------------------
+-- Derivering och integrering
+----------------------------------------
+
+-- Är själva grejen som finns i en Quantity deriverbar och
+-- integrerbar ska Quantityn med den i också vara det.
+
+class Differentiable a b where
+  doDif :: a -> b
+
+diff :: (Differentiable a b) => Quantity d a -> Quantity (d `Div` time) b
+diff = fmap doDif
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

Physics/src/Examples/Box_incline.lhs

@@ -1,3 +1,10 @@
+Improvmenet:
+    notation
+    formulas
+    tests
+
+
+
 
 Box on an incline
 =================
@@ -10,6 +17,7 @@ All vectors are in newton.
 
 Notation:
 fg = gravitational accelleration
+
 m = mass of box
 
 > fg = V2 0 (-10)
@@ -28,61 +36,24 @@ The normal against the incline:
 > fn :: Vector2 Double -> Angle -> Vector2 Double
 > fn fa a = negate (f_l_ fa a)
 
-Frictionfree incline:
+Friction free incline:
 
-Force resultant:
+Resulting force:
 
 > fr :: Vector2 Double -> Angle -> Vector2 Double
 > fr fa a = (fn fa a) + fa
 
+With friction:
 
-** Tests:**
-------------
-
-*Main> fr (V2 0 10) 0
-
-(0.0 x, 0.0 y)                                  
-
-Good:  No inclination - stands still.
-
-
-*Main> fr (V2 0 (-10)) 0
-
-(0.0 x, -20.0 y)                                
-
-Odd:    Motsatt gravitation ger något underligt? Vi säger fortfarande att normalen är magnituden
-
-
-*Main> fr (V2 0 10) (pi/2)
-
-(-6.123233995736766e-16 x, 10.0 y)              
-
-Good:   90* lutning - faller med G.
-
-*Main> fr (V2 0 10) (pi/3)
-
-(-4.330127018922194 x, 7.499999999999999 y)     
-
-*Main> fr (V2 0 10) (pi/4)
-
-(-5.0 x, 4.999999999999999 y)                   
-
-*Main> fr (V2 0 10) (pi/6)
-
-(-4.330127018922193 x, 2.499999999999999 y)
-
-
-**Frictionconstant - in motion:**
-
-\begin{align}
-  F_{friction} = \mu * F_{normal} \iff \mu = \frac{F_{friction}}{F_{normal}}
-\end{align}
+$$  F_{friction} = \mu * F_{normal} \iff \mu = \frac{F_{friction}}{F_{normal}} $$
 
 > us = 0.5
 > uk = 0.4
 
 Add image how friction depends if there is movement.
 
+![Friction](friction.png){.float-img-left}
+
 > type FricConst = Double
 
 Friction: 
@@ -94,7 +65,7 @@ Friction:
 
 We have the normal force and only needs the constants.
 
-The current speed does not affect the friction. However F*M = Nm = work = J -> racer cars burn tires.
+The current speed does not affect the friction.
 
 > motscalar :: FricConst -> Vector2 Double -> Scalar
 > motscalar u f = u * (magnitude f)
@@ -122,81 +93,3 @@ Now we just need to sum the force vectors:
 > fru' fa a u = (motkraftv u (fn fa a) (fr fa a))
 
 
-
-
-Hmm om jag försöker skala riktningsvektorer till sin enhetsvektor så blir det blub med nollvektorn.
-
-enh_vekt v = scale (1 / (magnitude v)) v 
-$ enh_vekt (V2 0 0)
-(NaN x, NaN y)
-
-Jag skulle anta att enh_vekt bara gäller då (magnitude v) =/= 0.
-
-
-Fixed nollvektorn.
-
-
-*Main> fru fg (pi/4) 0
-(-5.0 x, 4.999999999999999 y)
-*Main> fru fg (pi/4) 1
-(1.7763568394002505e-15 x, -1.7763568394002505e-15 y)
-*Main> fru fg (pi/4) 0.5
-(-2.499999999999999 x, 2.4999999999999987 y)
-Ugh? Den är linjär? 1 i friktionskoeff = full stop. alltid?
-
-När är isf motkraften = fallkraften? 
-*Main> fru fg 0 5
-(0.0 x, 0.0 y)
-*Main> fru fg 0 1
-(0.0 x, 0.0 y)
-*Main> fru fg (pi/2) 10
-(-6.123233995736762e-16 x, 9.999999999999995 y)
-
-Hmm?
-
-*Main> fru fg (pi/6) 1
-(3.169872981077808 x, -1.8301270189221936 y)
-*Main> fru fg (pi/6) 0
-(-4.330127018922193 x, 2.499999999999999 y)
-*Main> fru fg (pi/6) 100000
-(749995.6698729811 x, -433010.2018922193 y)
-
-Den statiska friktionen är konstig. Den borde stå still vid låg vinkel o hög friktion.
-
-Jag summerar ju visserligen krafterna, så det är nog något lurt med friktionshanteringen.
-
-Tests:
-
-fr
-*Main> fr fg (pi/3)
-(-4.330127018922194 x, 7.499999999999999 y)
-*Main> fr fg (pi/6)
-(-4.330127018922193 x, 2.499999999999999 y)
-
-
-fru
-*Main> fru fg (pi/3) 1
-(-1.8301270189221928 x, 3.1698729810778055 y)
-*Main> fru fg (pi/6) 1
-(3.169872981077808 x, -1.8301270189221936 y)
-
-
-
-fru'
-*Main> fru' fg (pi/3) 1
-(2.500000000000001 x, -4.330127018922194 y)
-*Main> fru' fg (pi/6) 1
-(7.500000000000001 x, -4.330127018922193 y
-
-
-
-wtf händer? Hur kan fr ha samma x-vektor för två olika vinklar inom samma kvadrant?
-
-fn
-
-*Main> fn fg (pi/3)
-(-4.330127018922194 x, -2.500000000000001 y)
-*Main> fn fg (pi/6)
-(-4.330127018922193 x, -7.500000000000001 y)
-
-