VGnet.dk - Numerisk og udtrækning

Koden anvendes helt på eget ansvar!

Indhold:

• Udtræk et heltal fra en uniform fordeling
• Udtræk nogle heltal fra en uniform fordeling
• Udtræk nogle entydige heltal fra en uniform fordeling
• Udtræk et normalfordelt tal
• Forskellige stokastiske processer

Udtræk et heltal fra en uniform fordeling

Function UdtraekEtTal(Optional OverGrense As Integer, Optional UnderGrense As Integer, Optional Genregn As Boolean)
' (C) Copyright Lars Vangsgaard
' Udtrækker et vilkårligt tal i et talinterval
' Standardgrænser
  If IsMissing(OverGrense) Then OverGrense = 1
  If IsMissing(UnderGrense) Then UnderGrense = 0
  If UnderGrense >= OverGrense Then Exit Function
' Standardmåde statisk
  If IsMissing(Genregn) Then Genregn = False
  Application.Volatile Genregn
' Udtrækningen
  UdtraekTal = Int((OverGrense - UnderGrense + 1) * Rnd) + UnderGrense
End Function

Udtræk nogle heltal fra en uniform fordeling

Function UdtraekTal(Optional og, Optional ug, Optional antal, Optional entydige)
' (C) Copyright Lars Vangsgaard
' Udtræk nogle tal fra en uniform fordeling
  Dim tal, i, ud()
  Dim lager As New Collection
  ' Gemmer de udtrukne tal i en såkaldt Collection
  If IsMissing(entydige) Then entydige = True
  If IsMissing(antal) Then antal = 1
  If IsMissing(ug) Then ug = 0
  If IsMissing(og) Then og = 1
  ' Kontrol for, om der ønskes flere entydige tal end grænserne kan rumme
  If entydige And og - ug < antal Then
  ' Ved fejl i det spørgsmål kommer der kun nuller ud som resultat
    ReDim ud(1 To antal)
    For i = 1 To antal
      ud(i) = 0
    Next i
  Else
    Randomize
    If entydige Then
    ' Rutine, hvis tallene skal være entydige
      On Error Resume Next
      ' Hvis der uheldigvis udtrækkes to ens tal, ignoreres det/de sidste
      Do
        tal = Int(ug + (og - ug) * Rnd())
        lager.Add tal, Format(tal, "0000000000000000")
      Loop Until lager.Count = antal
      On Error GoTo 0
      ReDim ud(1 To lager.Count)
      For i = 1 To lager.Count
        ud(i) = lager.Item(i)
      Next i
    Else
    ' Rutine, hvis tallene godt må være ens
      ReDim ud(1 To antal)
      For i = 1 To antal
        ud(i) = Int(ug + (og - ug) * Rnd())
      Next i
    End If
  End If
  UdtraekTal = ud
End Function

Udtræk nogle entydige heltal fra en uniform fordeling

Sub UdtraekEntydigeTal(ovg, ant)
' (C) Copyright Lars Vangsgaard
' Udtræk nogle entydige heltal fra en uniform fordeling
  Dim h, i, m
  h = UdtraekTal(ovg + 1, 1, ant, True)
  For i = 1 To ant
    m = m & CStr(h(i)) & " "
  Next i
  MsgBox m
End Sub

Funktionen kræver adgang til hjælpefunktionen UdtraekTal ovenfor.

Udtræk et normalfordelt tal

Hovedfunktionen er:

Function Normalfordelt(Optional GenberegnMedExcel, _
  Optional Middelvaerdi, Optional Standardafvigelse)
' (C) Copyright Lars Vangsgaard
' Udtræk et normalfordelt tal
  If IsMissing(GenberegnMedExcel) Then GenberegnMedExcel = False
  If IsMissing(Middelvaerdi) Then Middelvaerdi = 0
  If IsMissing(Standardafvigelse) Then Standardafvigelse = 1
  Application.Volatile GenberegnMedExcel
  If nf_tur Then
    Call polarmars(nf_x, nf_y)
    Normalfordelt = Middelvaerdi + Standardafvigelse * nf_x
  Else
    Normalfordelt = Middelvaerdi + Standardafvigelse * nf_y
  End If
  nf_tur = Not nf_tur
End Function

Funktionen kalder en hjælpefunktion:

Sub polarmars(z1, z2)
'Polar-Marsaglia-metoden til at få normalfordelte tal fra uniformt fordelte
  Dim h1, h2, w, lw
  Do
    h1 = 2 * Math.Rnd() - 1
    h2 = 2 * Math.Rnd() - 1
    w = h1 * h1 + h2 * h2
  Loop Until ((w <= 1#) And (w > 0#))
  lw = Log(w) / w
  lw = Sqr(-lw - lw)
  z1 = h1 * lw
  z2 = h2 * lw
End Sub

Øverst i modulet skal der være to offentlige variable:

Public nf_tur As Boolean
Public nf_x, nf_y

Forskellige stokastiske processer

Function Wiener(z, dt)
' (C) Copyright Lars Vangsgaard
' Wienerproces
  Wiener = z + Math.Sqr(dt) * Normalfordelt
End Function

Function GWiener(x, dt, a, b)
' (C) Copyright Lars Vangsgaard
' Generaliseret Wienerproces
  GWiener = x + a * dt + b * Math.Sqr(dt) * Normalfordelt
End Function

Function GBM(S, dt, my, si)
' (C) Copyright Lars Vangsgaard
' Geometrisk Brown'sk bevægelse
  GBM = S * (1 + my * dt + si * Math.Sqr(dt) * Normalfordelt)
End Function

Function ABM(S, dt, my, si)
' (C) Copyright Lars Vangsgaard
' Aritmetisk Brown'sk bevægelse
  ABM = S + my * dt + si * Math.Sqr(dt) * Normalfordelt
End Function

Function Jump(S, dt, la, u, d)
' (C) Copyright Lars Vangsgaard
' Jump-proces
  'If ((u < 1) Or (d > 1)) Then Exit Function
  If Rnd() < la * dt Then Jump = u * S Else Jump = d * S
End Function

Function JDM(S, dt, my, si, la, u)
' (C) Copyright Lars Vangsgaard
  Dim k
  k = u - 1
  JDM = S * (1 + (my - la * k) * dt + si * Math.Sqr(dt) * Normalfordelt)
  If Rnd() < la * dt Then JDM = JDM + k * S
End Function

Siden er oprettet 25-12-2006 og sidst opdateret 14-01-2007 22:53.

█