Seminar Simulation stochastischer Modelle

3. Physiksimulation

Dieses Programm zeigt die physikalische Seite als Modell. Je mehr Teilchen, desto realistischer wird es. Allerdings fehlt es an einem passenden Computer um die nötige Menge von 10^23 Teilchen zu verarbeiten und das Größenverhältnis zwischen dem Pollen und den Wassermolekülen ist nicht ganz korrekt.

Quellcode in R

Window1.MakeSprite:
Sub MakeSprite(n as integer)
  dim s as BallSprite
  dim dx,dy,x,y as Double
  dim l as Double
  dim ok as Boolean
  
  const r=8
  
  do
    x=rnd*(SpriteSurface1.Width-r)
    y=rnd*(SpriteSurface1.Height-r)
    ok=true
    
    for each s in sprites
      dx=x-s.Position.x
      dy=y-s.Position.y
      
      l=sqrt(dx*dx+dy*dy)
      
      if l<s.radius+10 then
        ok=false
        exit
      end if
    next
    
  loop until ok
  
  s=new BallSprite
  s.Image=ballpic
  s.OriginalImage=ballpic
  s.AlternativePicture=ballpic2
  s.Position=new Vector3d(x,y,0)
  s.x=x
  s.y=y
  s.MovingWidth=600-r
  s.MovingHeight=600-r
  
  do
    dx=rnd*4-2
    dy=rnd*4-2
    
  loop until abs(dx*dy)>1
  
  s.delta=new Vector3d(dx,dy,0)
  if CheckBox1.Value then
    s.Group=-1
  else
    s.Group=1
  end if
  s.masse=1
  s.radius=r
  
  SpriteSurface1.Attach s
  sprites.Append s
  
End Sub

Window1.MakeSprites:
Sub MakeSprites()
  dim i as integer
  dim g as Graphics
  
  const r=8
  
  makeSamen
  
  ballpic=NewPicture(r,r,32)
  g=ballpic.Graphics
  g.UseOldRenderer=true
  g.ForeColor=rgb(255,0,0)
  g.FillOval 0,0,r,r
  
  ballpic2=NewPicture(r,r,32)
  g=ballpic2.Graphics
  g.UseOldRenderer=true
  g.ForeColor=rgb(0,255,0)
  g.FillOval 0,0,r,r
  
  for i=1 to 100
    MakeSprite i
  next
  
End Sub

Window1.walk:
Sub walk(ball as ballsprite, ziel as ballsprite)
  dim e as Double
  dim ballv,zielv as Vector3d
  dim t as Double
  
  e=Entfernung(ball,ziel)
  
  DebugMessageEnableMBS true
  DebugMessageMBS "Ball position: "+str(ball.Position)+" "+str(ball.radius)
  DebugMessageMBS "Ziel position: "+str(Ziel.Position)+" "+str(ziel.radius)
  DebugMessageMBS "Entfernung: "+str(e)+" "+str(ball.radius+ziel.radius)
  
  'if e<=ball.radius+ziel.radius then
  
  // innen
  
  
  'p1 as vector3D, p2 as vector3D, 
  'v1 as vector3D, v2 as vector3D, 
  'r1 as double, r2 as double, 
  'f as double, byref timeOfCollision as double
  
  if WillCollide(ball.Position,ziel.Position, _
      ball.delta,ziel.delta,_
      ball.radius,ziel.radius,_
      1,t) then
    DebugMessageMBS "WillCollide: "+str(t)
    if t<1 then
      
      'p1 as vector3D, p2 as vector3D, 
      'v1 as vector3D, v2 as vector3D, 
      'm1 as double, m2 as double, 
      'e1 as double, e2 as double, 
      'byref v1After as vector3D, byref v2After as vector3D
      
      GetCollisionResponse _
          ball.Position,ziel.Position, _
          ball.delta,ziel.delta,_
          ball.masse,ziel.masse,_
          0,0,_
          ballv,zielv
      
      ball.delta=ballv
      ziel.delta=zielv
      
    end if
  end if
  'end if
  
  
End Sub

Window1.makeSamen:
Sub makeSamen()
  dim g as Graphics
  dim s as BallSprite
  dim dx,dy,x,y as Double
  
  const r=16
  
  samenpic=NewPicture(r,r,32)
  g=samenpic.Graphics
  g.UseOldRenderer=true
  g.ForeColor=rgb(0,0,255)
  g.FillOval 0,0,r,r
  
  x=rnd*(SpriteSurface1.Width-r)
  y=rnd*(SpriteSurface1.Height-r)
  
  s=new BallSprite
  s.x=x
  s.y=y
  s.Image=samenpic
  s.OriginalImage=samenpic
  s.Position=new Vector3d(x,y,0)
  s.Group=-1
  s.masse=10
  s.radius=r/2
  s.delta=new Vector3D(cdbl(iSamenX.text),cdbl(iSamenY.text),0)
  s.MovingWidth=600-r
  s.MovingHeight=600-r
  
  SpriteSurface1.Attach s
  sprites.Append s
  samen=s
  
  samenpic=NewPicture(r,r,32)
  g=samenpic.Graphics
  g.UseOldRenderer=true
  g.ForeColor=rgb(0,255,0)
  g.FillOval 0,0,r,r
  
  s.AlternativePicture=samenpic
End Sub

Window1.Reset:
Protected Sub Reset()
  SpriteSurface1.Close
  ballpic=nil
  ballpic2=nil
  count=0
  firstweg=true
  lastSamenPosition=nil
  samen=nil
  samenpic=nil
  redim sprites(-1)
  wegbuf=NewPicture(weg.Width,weg.Height,32)
  
  MakeSprites
  
End Sub

Window1.Open:
Sub Open()
  Reset
  
End Sub

Window1.SpriteSurface1.NextFrame:
Sub NextFrame()
  dim s as BallSprite
  dim l as Double
  dim g as Graphics
  dim x1,x2,y1,y2 as Double
  dim v as Vector3D
  
  count=count+1
  for each s in sprites
    s.move
  next
  
  if count=100 then
    
    l=0
    for each s in sprites
      l=l+s.delta.Length
    next
    
    g=Graphics
    g.ForeColor=rgb(0,20,0)
    g.fillrect 0,0,250,20
    g.ForeColor=rgb(255,0,0)
    g.DrawString str(l)+"; "+str(samen.delta),10,15
    count=0
  end if
  
  if count mod 10=0 then
    if lastSamenPosition<>nil then
      x1=lastSamenPosition.x/2
      y1=lastSamenPosition.y/2
      x2=samen.Position.x/2
      y2=samen.Position.y/2
      
      #if TargetWin32 then
        g=wegbuf.Graphics
        g.UseOldRenderer=false
        g.ForeColor=rgb(255,0,0)
        g.DrawLine x1, y1, x2, y2
      #endif
      
      g=weg.Graphics
      g.UseOldRenderer=false
      g.ForeColor=rgb(255,0,0)
      g.DrawLine x1, y1, x2, y2
      
    end if
    
    if firstweg then
      g=weg.Graphics
      g.UseOldRenderer=true
      g.DrawPicture wegbuf,0,0
      UpdateNow
      firstweg=False
    end if
    
    v=samen.Position
    lastSamenPosition=new Vector3D(v.x,v.y,v.z)
    
  end if
End Sub

Window1.SpriteSurface1.Collision:
Sub Collision(s1 as Sprite, s2 as Sprite)
  dim bs1,bs2 as BallSprite
  
  bs1=BallSprite(s1)
  bs1.picresetcounter=3
  bs1.Image=bs1.AlternativePicture
  
  bs2=BallSprite(s2)
  bs2.picresetcounter=3
  bs2.Image=bs2.AlternativePicture
  
  walk bs1,bs2
End Sub

Window1.PushButton1.Action:
Sub Action()
  SpriteSurface1.run
End Sub

BallSprite.move:
Sub move()
  
  Position.add delta
  
  if Position.X<0 then
    Position.x=-Position.x
    delta.x=-delta.x
  elseif Position.x>MovingWidth then
    Position.x=MovingWidth-(Position.x-MovingWidth)
    delta.x=-delta.x
  end if
  
  if Position.y<0 then
    Position.y=-Position.y
    delta.y=-delta.y
  elseif Position.y>MovingHeight then
    Position.y=MovingHeight-(Position.y-MovingHeight)
    delta.y=-delta.y
  end if
  
  x=Position.x
  y=Position.y
  
  if picresetcounter>0 then
    picresetcounter=picresetcounter-1
    
    if picresetcounter=0 then
      Image=OriginalImage
    end if
  end if
End Sub

Util.Entfernung:
Function Entfernung(x1 as double, y1 as double, x2 as double, y2 as double) As double
  dim d as Double
  dim x,y as Double
  
  x=abs(x1-x2)
  y=abs(y1-y2)
  
  Return sqrt(x*x+y*y)
  
End Function

Util.Entfernung:
Function Entfernung(s1 as ballsprite, s2 as ballsprite) As double
  dim d as Double
  dim x,y as Double
  
  x=abs(s1.Position.x-s2.Position.x)
  y=abs(s1.Position.y-s2.Position.y)
  
  Return sqrt(x*x+y*y)
  
Exception
End Function

Util.drawrechtwinklige:
Sub drawrechtwinklige(extends g as graphics, x as double, y as double, w as double)
  dim x1,x2,y1,y2 as Double
  
  x1=x+sin(w+pi/2)*50
  y1=y+cos(w+pi/2)*50
  x2=x+sin(w-pi/2)*50
  y2=y+cos(w-pi/2)*50
  
  g.DrawLine x1,y1,x2,y2
End Sub

Util.Str:
Function Str(v as vector3D) As string
  Return str(v.x)+" / "+str(v.y)
Exception
End Function

modCollisions.WillCollide:
Function WillCollide(p1 as vector3D, p2 as vector3D, v1 as vector3D, _
v2 as vector3D, r1 as double, r2 as double, f as double, _
byref timeOfCollision as double) As boolean
  
  // Given two spheres with the input
  // positions, velocities, and radii,
  // this routine finds the earliest time
  // between 0 and f at which the separation
  // between spheres is zero.
  //
  // If there is such a time, it sets
  // time to that value and returns true.
  //
  // If the spheres are overlapping at
  // the start of the frame, it sets
  // time to zero and returns true.
  //
  // If there is no collision, it leaves
  // time unchanged and returns false.
  
  dim tCollide as boolean
  dim v, p as vector3D
  dim r, sep, pv, vv, fvv, disc as double
  
  // Take the dot product of relative
  // position with relative velocity.
  // A positive value means the bodies
  // are receding from one another.
  
  p = p2.Minus(p1)
  v = v2.Minus(v1)
  pv = p.x*v.x + p.y*v.y + p.z*v.z
  
  if pv >= 0 then
    return false
  end if
  
  // Get the separation between bodies.
  // A negative value means the bodies
  // overlap already.
  
  r = r1 + r2
  sep = p.x*p.x + p.y*p.y + p.z*p.z - r*r
  
  if sep < 0 then
    timeOfCollision = 0.0
    return true
  end if
  
  // See if t1 can be within our
  // allotted time.
  
  vv = v.x*v.x + v.y*v.y + v.z*v.z
  fvv = f * vv
  
  if (pv + fvv) < 0 and f*(fvv + 2*pv) + sep > 0 then
    return false
  end if
  
  // If discriminant is less than zero,
  // our quadratic equation has no roots.
  
  disc = pv*pv - vv*sep
  if ( disc < 0 ) then
    return false
  end if
  
  // If we got this far, there is a
  // solution to for t1. Calculate it.
  
  timeOfCollision = (-pv - sqrt(disc)) / vv
  return true
  
End Function

modCollisions.GetCollisionResponse:
Sub GetCollisionResponse(p1 as vector3D, p2 as vector3D, v1 as vector3D, _ 
v2 as vector3D, m1 as double, m2 as double, e1 as double, e2 as double, _ 
byref v1After as vector3D, byref v2After as vector3D)
  
  // For two spherical bodies in collision,
  // with the given positions at collision,
  // velocities before collision, masses, and
  // elasticities, this routine calculates
  // their resulting post-collision velocities:
  //
  //   v1After = v1 + km2n
  //   v2After = v2 - km1n
  //
  // where
  //
  //   k = c(e + 1)/(m1+m2)
  //   n = relative position, normalized
  //   c = n dot relative velocity
  //   e = coefficient of restitution
  //       (product of body elasticities)
  //       equals 1 for elastic collisions
  
  dim n as vector3D
  n = p2.Minus(p1)
  n.Normalize
  
  dim v as vector3D
  v = v2.Minus(v1)
  
  dim c as double
  c = n.Dot(v)
  
  dim k as double
  k = c * (e1*e2 + 1) / (m1 + m2)
  
  v1After = v1.Plus(n.Times(k * m2))
  v2After = v2.Minus(n.Times(k * m1))
  
End Sub

Downloads

BrownSim.rb.sit (8 KB)
BrownSim.rb.zip (8 KB)
BrownSim.sit (880 KB)
BrownSim.exe.zip (728 KB)

Screenshot

Die Aufnahme wurde leider während der Grafikausgabe gemacht, weshalb einige Bälle zweimal zu sehen sind.

Screenshot

Links
MBS Realbasic Plugins - Christians Software aus Nickenich

In Erinnerung and den lächelnden Mac Plus, den man beim Start von Mac OS 1 bis X.1 sieht...