Fatal编程技术网
  • haskell/
  • Haskell 通过净力计算位置，不同的dts产生不同的答案

Haskell 通过净力计算位置，不同的dts产生不同的答案

haskell

Haskell 通过净力计算位置，不同的dts产生不同的答案,haskell,physics,Haskell,Physics,我正试图为带电和聚集的物体编写一个模拟器，它只需计算每个物体上的净力，然后找出在用户指定的时间段内位置的变化 然而，我发现当我改变dt时，位置的变化是剧烈的，当它不应该发生显著变化时，减小dt应该让位置收敛到正确的答案上 例如，对于笛卡尔坐标（1,0,0）和（-1,0,0）处的物体，质量为9e-31（电子质量），电荷为1库仑（我知道不是电子电荷），运行0.1秒，dt为0.01秒，每个物体的位置总变化为2048米。然而，运行0.1秒，dt为0.001秒，位置变化约为1.3e30米。这对我来说似乎太

我正试图为带电和聚集的物体编写一个模拟器，它只需计算每个物体上的净力，然后找出在用户指定的时间段内位置的变化

然而，我发现当我改变dt时，位置的变化是剧烈的，当它不应该发生显著变化时，减小dt应该让位置收敛到正确的答案上

例如，对于笛卡尔坐标（1,0,0）和（-1,0,0）处的物体，质量为9e-31（电子质量），电荷为1库仑（我知道不是电子电荷），运行0.1秒，dt为0.01秒，每个物体的位置总变化为2048米。然而，运行0.1秒，dt为0.001秒，位置变化约为1.3e30米。这对我来说似乎太离谱了，但在使用dt的部分我找不到任何问题

我正在使用的代码（c/p’d以避免任何可能的更改）

导入数据。列表
main=打印$mainprog
哪里
mainprog=runUniverse makeUniverse 1 0.1
类型长度=双
类型质量=双
类型费用=双倍
类型时间=双
类型向量=（双精度、双精度、双精度）
类型位置=向量
类型速度=矢量
类型加速度=矢量
类型力=矢量
数据小部件=小部件{pos:：Position，mass:：Double，charge:：Double，velocity:：velocity}派生（Eq，Show，Read）
--乌提尔斯
toScalar:：Vector->Double
toScalar（x，y，z）=sqrt（x^^2+y^^2+z^^2）
toUnit:：Vector->Vector
toUnit（x，y，z）=（x/标量，y/标量，z/标量）
哪里
标量=toScalar（x，y，z）
添加：：矢量->矢量->矢量
加上（x1，y1，z1）（x2，y2，z2）=（x1+x2，y1+y2，z1+z2）
mult:：Vector->Double->Vector
mult（x，y，z）k=（k*x，k*y，k*z）
差异：：向量->向量->向量
微分（x1，y1，z1）（x2，y2，z2）=（x1-x2，y1-y2，z1-z2）
--计算器
gForce:：Widget->Widget->Force
gForce（小部件pos1 mass1 uuuuuuuuuuuuuuu）（小部件pos2 mass2 uuuuuuuu）=多单位部队scalarForce
哪里
unitForce=toUnit posdiff
缩放力=（g*质量1*质量2）/（半径^2）
g=6.674e-11
半径=toScalar posdiff
posdiff=diff pos1 pos2
eForce:：Widget->Widget->Force
eForce（小部件位置1收费1收费）（小部件位置2收费2）=多单位部队规模
哪里
单位力=（toUnit posdiff）
--必须确定吸引力与排斥力，而引力总是有吸引力的
标度力=（（绝对值）（k_C*电荷1*电荷2））/（半径^^2））*（符号电荷1）*（符号电荷2）
k_C=8.988e9
半径=toScalar posdiff
posdiff=diff pos1 pos2
netForce:：[Force]->Force
netForce=foldl-add（0,0,0）
toAccel:：强制->小部件->加速
toAccel f（小部件质量）=多个f（1/质量）
newVeloc:：速度->加速度->时间->速度
newVeloc v a dt=添加v（多个a dt）
newPos:：向量->速度->时间->向量
新位置s v dt=添加s（多个v dt）
newWidget:：Widget->Position->Velocity->Widget
newWidget（Widget pos1 mass charge vel1）pos2 vel2=Widget pos2 mass charge vel2
tUniverse:：[Widget]->Time->[Widget]
tUniverse widgets dt=zipWidgets有3个新的小部件
哪里
netMassForces=map（\w->gForcePrime w（widgets\\[w]）widgets
gForcePrime w ws=netForce$map（gForce w）ws
netElectricForces=map（\w->eForcePrime w（widgets\\[w]）widgets
eForcePrime w ws=netForce$map（eForce w）ws
volds=映射速度小部件
polds=映射pos小部件
accels=zipWith to Accel（映射netForce（zipWith（\a b->a:[b]）netMassForces-netElectricForces））小部件
vels=zipWith（\v a->newVeloc v a dt）卷加速度
poses=zipWith（\s v->newPos s v dt）polds vels
makeUniverse:：[Widget]
makeUniverse=[（小部件（-1,0,0）11（0,0,0）），（小部件（1,0,0）11（0,0,0））]
runUniverse:：[Widget]->Time->Time->[Widget]
runUniverse ws t dt
|t[小部件]
非弹性氯化物[]=[]
非弹性氯化物（w:[]）=[w]
非弹性碰撞（w:ws）=（组合w（采样点w-ws））：（非弹性碰撞$ws\\（采样点w-ws））
哪里
sameposes w ws=filter（\w'->pos w==pos w'）ws
combine:：Widget->[Widget]->Widget
combine=foldl（\（部件位置mass1 charge1 veloc1）（部件质量2 charge2 veloc2）->部件位置（charge1+charge2）（mass1+mass2）（newvelocmass1 mass2 veloc1 veloc2））
--非弹性碰撞，m1v1+m2v2=m3v3，因此v3=（m1v1+m2v2）/（m1+m2）
newveloc m1 m2 v1 v2=（（v1`mult`m1）`add`（v2`mult`m2））`mult`（1/（m1+m2））
我知道的问题是tUniverse函数，可能是在计算加速度、速度或位置（加速度、水平或姿势）时。我试着用dt的倒数乘以ccel、newVeloc和newPos，但这并没有显著改变输出

请随意忽略inelasticCollide，我可能会用id函数替换它，但我只是保留了它，因为它在某一点上是相关的

编辑：我已经更新了代码，修正了加速度的错误计算、非弹性collide中质量和电荷的转换以及dpos/dvel的重复计算，但我仍然发现我得到了10级的误差。举例来说，每一个电荷为1摄氏度，我得到了~10^8的dt=0.01和~10^7的dt=0.1，每一个电荷为0.01摄氏度，每一个电荷为~250的dt=0.01和~65的dt=0.1

似乎“明显”的问题是
newWidget
假设
dpo
和
dvel
是delta，但在
tUniverse
poses和
vels
中调用时，实际上已经完成了添加

为了调试，我重写了一些东西来使用
newtypes
thinking 
import Data.List

main = print $ mainprog
    where

        mainprog = runUniverse makeUniverse 1 0.1

type Length = Double
type Mass = Double
type Charge = Double
type Time = Double



type Vector = (Double, Double, Double)
type Position = Vector
type Velocity = Vector
type Acceleration = Vector
type Force = Vector

data Widget = Widget {pos :: Position, mass :: Double, charge :: Double, velocity :: Velocity} deriving (Eq, Show, Read)


--utils
toScalar :: Vector -> Double
toScalar (x, y, z) = sqrt (x ^^ 2 + y ^^ 2 + z ^^ 2)

toUnit :: Vector -> Vector
toUnit (x, y, z) = (x / scalar, y / scalar, z / scalar)
   where 
       scalar = toScalar (x, y, z)

add :: Vector -> Vector -> Vector
add (x1, y1, z1) (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2)

mult :: Vector -> Double -> Vector
mult (x, y, z) k = (k * x, k * y, k * z)

diff :: Vector -> Vector -> Vector
diff (x1, y1, z1) (x2, y2, z2) = (x1 - x2, y1 - y2, z1 - z2)


--calcs
gForce :: Widget -> Widget -> Force
gForce (Widget pos1 mass1 _ _) (Widget pos2 mass2 _ _) = mult unitForce scalarForce
    where
        unitForce = toUnit posdiff
        scalarForce = (g * mass1 * mass2) / (radius ^^ 2)
        g = 6.674e-11
        radius = toScalar posdiff
        posdiff = diff pos1 pos2


eForce :: Widget -> Widget -> Force
eForce (Widget pos1 _ charge1 _) (Widget pos2 _ charge2 _) = mult unitForce scalarForce
    where 
        unitForce = (toUnit posdiff) 
        --necessary to determine attraction vs repulsion, whereas        gravitational is always attractive
        scalarForce = ((abs (k_C * charge1 * charge2)) / (radius ^^ 2)) * (signum charge1) * (signum charge2)
        k_C = 8.988e9
        radius = toScalar posdiff
        posdiff = diff pos1 pos2


netForce :: [Force] -> Force
netForce = foldl add (0, 0, 0)

toAccel :: Force -> Widget -> Acceleration
toAccel f (Widget _ mass _ _)  = mult f (1/mass) 

newVeloc :: Velocity -> Acceleration -> Time -> Velocity
newVeloc v a dt = add v (mult a dt)

newPos :: Vector -> Velocity -> Time -> Vector
newPos s v dt = add s (mult v dt)



newWidget :: Widget -> Position -> Velocity -> Widget
newWidget (Widget pos1 mass charge vel1) pos2 vel2 = Widget pos2 mass charge vel2

tUniverse :: [Widget] -> Time -> [Widget]
tUniverse widgets dt = zipWith3 newWidget widgets poses vels
    where

        netMassForces = map (\w -> gForcePrime w (widgets \\ [w])) widgets
        gForcePrime w ws = netForce $ map (gForce w) ws

        netElectricForces = map (\w -> eForcePrime w (widgets \\ [w])) widgets
        eForcePrime w ws = netForce $ map (eForce w) ws

        volds = map velocity widgets

        polds = map pos widgets

        accels = zipWith toAccel (map netForce (zipWith (\a b -> a : [b]) netMassForces netElectricForces)) widgets

        vels = zipWith (\v a -> newVeloc v a dt) volds accels

        poses = zipWith (\s v -> newPos s v dt) polds vels


makeUniverse :: [Widget]
makeUniverse = [(Widget (-1, 0, 0) 1 1 (0, 0, 0)), (Widget (1, 0, 0) 1 1 (0, 0, 0))]

runUniverse :: [Widget] -> Time -> Time -> [Widget]
runUniverse ws t dt
    | t <= 0 = ws
    | otherwise = runUniverse (tUniverse (inelasticCollide ws) dt) (t-dt) dt  



inelasticCollide :: [Widget] -> [Widget]
inelasticCollide [] = [] 
inelasticCollide (w:[]) = [w]
inelasticCollide (w:ws) = (combine w (sameposes w ws)) : (inelasticCollide $ ws \\ (sameposes w ws))
    where
        sameposes w ws = filter (\w' -> pos w == pos w') ws

        combine :: Widget -> [Widget] -> Widget
        combine = foldl (\(Widget pos mass1 charge1 veloc1) (Widget _ mass2 charge2 veloc2) -> Widget pos (charge1 + charge2) (mass1 + mass2) (newveloc mass1 mass2 veloc1 veloc2))
        --inelastic collision, m1v1 + m2v2 = m3v3 therefore v3 = (m1v1 + m2v2)/(m1 + m2)
        newveloc m1 m2 v1 v2 = ((v1 `mult` m1) `add` (v2 `mult` m2)) `mult` (1 / (m1 + m2))

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Data.List

import Debug.Trace (trace)

main = print $ runUniverse makeUniverse 0.1 0.01

newtype Length = Length {unLength::Double}
newtype Mass = Mass {unMass::Double} deriving (Num,Eq,Show)
newtype Charge = Charge {unCharge::Double} deriving (Num,Eq,Show)
newtype Time = Time {unTime::Double} deriving (Num,Eq,Ord,Fractional)

type Vector = (Double,Double,Double)
newtype Position = Position {unPosition::Vector} deriving (Eq,Show)
newtype Velocity = Velocity {unVelocity::Vector} deriving (Eq,Show)
newtype Acceleration = Acceleration {unAcceleration::Vector}
newtype Force = Force {unForce::Vector} deriving (Eq,Show)

data Widget = Widget {pos :: Position, mass :: Mass, charge :: Charge, velocity :: Velocity} deriving (Eq, Show)

--utils
toScalar :: Vector -> Double
toScalar (x, y, z) = sqrt (x ^^ 2 + y ^^ 2 + z ^^ 2)

toUnit :: Vector -> Vector
toUnit (x, y, z) = (x / scalar, y / scalar, z / scalar)
   where 
       scalar = toScalar (x, y, z)

add :: Vector -> Vector -> Vector
add (x1, y1, z1) (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2)

mult :: Vector -> Double -> Vector
mult (x, y, z) k = (k * x, k * y, k * z)

diff :: Vector -> Vector -> Vector
diff (x1, y1, z1) (x2, y2, z2) = (x1 - x2, y1 - y2, z1 - z2)


--calcs
gForce :: Widget -> Widget -> Force
gForce (Widget (Position pos1) (Mass mass1) _ _) (Widget (Position pos2) (Mass mass2) _ _) = Force (mult unitForce scalarForce)
    where
        unitForce = toUnit posdiff
        scalarForce = (g * mass1 * mass2) / (radius ^^ 2)
        g = 6.674e-11
        radius = toScalar posdiff
        posdiff = diff pos1 pos2


eForce :: Widget -> Widget -> Force
eForce (Widget (Position pos1) _ (Charge charge1) _) (Widget (Position pos2) _ (Charge charge2) _) = Force (mult unitForce scalarForce)
    where 
       unitForce = (toUnit posdiff) 
       --necessary to determine attraction vs repulsion, whereas        gravitational is always attractive
       scalarForce = ((abs (k_C * charge1 * charge2)) / (radius ^^ 2)) * (signum charge1) * (signum charge2)
       k_C = 8.988e9
       radius = toScalar posdiff
       posdiff = diff pos1 pos2


netForce :: [Force] -> Force
netForce = Force . foldl add (0,0,0) . map unForce

toAccel :: Force -> Widget -> Acceleration
toAccel f (Widget _ mass _ _)  = Acceleration (mult (unForce f) (unMass mass))

newVeloc :: Velocity -> Acceleration -> Time -> Velocity
newVeloc v a dt = Velocity (add (unVelocity v) (mult (unAcceleration a) (unTime dt)))

newPos :: Position -> Velocity -> Time -> Position
newPos s v dt = Position (add (unPosition s) (mult (unVelocity v) (unTime dt)))

newWidget :: Widget -> Position -> Velocity -> Widget
newWidget w@(Widget pos1 _ _ vel1) dpos dvel = w { pos=Position ((unPosition dpos)),velocity=Velocity ((unVelocity dvel)) }

tUniverse :: [Widget] -> Time -> [Widget]
tUniverse widgets dt = zipWith3 newWidget widgets (trace (show poses) poses) (trace (show vels) vels)
    where
        netMassForces = map (\w -> gForcePrime w (widgets \\ [w])) widgets
        gForcePrime w ws = netForce $ map (gForce w) ws

        netElectricForces = map (\w -> eForcePrime w (widgets \\ [w])) widgets
        eForcePrime w ws = netForce $ map (eForce w) ws

        volds = map velocity widgets

        polds = map pos widgets

        accels = zipWith toAccel (map netForce (zipWith (\a b -> a : [b]) netMassForces netElectricForces)) widgets

        vels = zipWith (\v a -> newVeloc v a dt) volds accels

        poses = zipWith (\s v -> newPos s v dt) polds vels

makeUniverse :: [Widget]
makeUniverse = [Widget (Position (1,0,0)) (Mass 0) (Charge 0) (Velocity (1,0,0))] -- , (Widget (1, 0, 0) 9e-31 1 (0, 0, 0))]

runUniverse :: [Widget] -> Time -> Time -> [Widget]
runUniverse ws t dt
    | t < 0 = ws
    | otherwise = runUniverse (tUniverse (inelasticCollide ws) dt) (t-dt) dt

inelasticCollide :: [Widget] -> [Widget]
inelasticCollide [] = [] 
inelasticCollide (w:[]) = [w]
inelasticCollide (w:ws) = (combine w (sameposes w ws)) : (inelasticCollide $ ws \\ (sameposes w ws))
    where
        sameposes w ws = filter (\w' -> pos w == pos w') ws

        combine :: Widget -> [Widget] -> Widget
        combine = foldl (\(Widget pos mass1 charge1 veloc1) (Widget _ mass2 charge2 veloc2) -> Widget pos (mass1 + mass2) (charge1 + charge2) (Velocity (newveloc (unMass mass1) (unMass mass2) (unVelocity veloc1) (unVelocity veloc2))))

        --inelastic collision, m1v1 + m2v2 = m3v3 therefore v3 = (m1v1 + m2v2)/(m1 + m2)
        newveloc m1 m2 v1 v2 = ((v1 `mult` m1) `add` (v2 `mult` m2)) `mult` (1 / (m1 + m2))