* * *    
Главная » Статьи » Код PB

Просмотров: 1372 | Дата: 19.04.2024 | Коментарии (0)

Гауссова распределения (demo)



Code
; +----------------------------+-----------------------+
; | Random Number Distribution | Ryan 'kenmo' Toukatly |
; +----------------------------+-----------------------+
; | 12.9.2009 - Creation

; This program generates random values on the interval [0, 1)
; using two methods: flat distribution and normal (Gaussian)
; distribution. Both are demonstrated graphically.

; ================ YOU CAN MODIFY THESE ===============================================

#Intervals = 31 ; Number of bars in the histogram
#Iterations = 9 ; Number of samples to generate per cycle
#Timeout = 20 ; Delay in milliseconds (when no window events occur)

; ================ RANDOM NUMBER PROCEDURES ===========================================

Procedure.d RandomFlat(Max.i = 100000)
  Protected Result.d
  If (Max < 1)
  Result = 0.0
  Else
  Result = Random(Max - 1)*1.0/Max
  EndIf
  ProcedureReturn Result
EndProcedure

Procedure.d RandomGauss(Scale.d = 1.0, Max.i = 100000)
  Protected x1.d, x2.d, w.d, Valid.i, Result.d
  If (Scale <= 0.0)
  Result = d
  Else
  Repeat
  Valid = #True
  Repeat
  x1 = 2.0 * RandomFlat(Max) - 1.0
  x2 = 2.0 * RandomFlat(Max) - 1.0
  w = (x1 * x1) + (x2 * x2)
  Until (w < 1.0)
  w = Sqr( (-2.0 * Log(w)) / w)
  x2 = (x1 * w / 5.0 / Scale) + 0.5
  If (x2 < 0.0) Or (x2 > 1.0)
  Valid = #False
  EndIf
  Until Valid
  Result = x2
  EndIf
  ProcedureReturn Result
EndProcedure

; ================ DEMO PROGRAM =======================================================

Global IW.l, IH.l, Maxx.i, Total.i, FID.i

Macro wp(f)
  Int(IW*(f))
EndMacro
Macro hp(f)
  Int(IH*(f))
EndMacro

If (#Intervals < 1) Or (#Iterations < 1)
  End
EndIf
Global Dim Count.i(#Intervals - 1)
Global Dim DispH.f(#Intervals - 1)

Procedure StretchImage(Update.i = #True)
  IW = WindowWidth(0)
  IH = WindowHeight(0) - 110
  FID = LoadFont(0, "Monospace", IH/20)
  If CreateImage(0, IW, IH) And StartDrawing(ImageOutput(0))
  Box(0, 0, IW, IH, #White)
  StopDrawing()
  EndIf
  ResizeGadget(7, 0, 110, IW, IH)
  SetGadgetAttribute(7, #PB_Button_Image, ImageID(0))
EndProcedure

Procedure UpdateImage()
  If StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FID)
   
  Box(0, 0, IW, IH, #White)
  Box(wp(0.01), hp(0.02), wp(0.98), hp(0.96), $E0E0E0)
   
  For i = 0 To #Intervals - 1
  If i = 0
  sx.i = 0
  Else
  sx = ex
  EndIf
  ex = Int(i*IW*0.94/(#Intervals-1))
   
  hf.f = Count(i)*1.0/Maxx
  hmax.i = hp(0.90)
  h.i = hmax * hf
  DispH(i) = DispH(i) + (h - DispH(i))/5.0
  h = DispH(i)
  If h > hmax : h = hmax : DispH(i) = hmax : EndIf
   
  If h > 0
  Box(wp(0.03)+sx, hp(0.95)-h, ex-sx, h, RGB(0, Int(hf*128), 255))
  EndIf
  Next i
   
  If Total > 0
  DrawText(wp(0.05), hp(0.05), "N = " + Str(Total), #Red)
  EndIf
  StopDrawing()
  SetGadgetState(7, ImageID(0))
  EndIf
EndProcedure

WinFlags.i = #PB_Window_Invisible|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget
WinFlags | #PB_Window_SizeGadget|#PB_Window_MaximizeGadget
If Not OpenWindow(0, 0, 0, 300, 300, "Random Number Distribution", WinFlags)
  MessageRequester("Error", "Window could not be opened.", #MB_ICONHAND) : End
EndIf

Frame3DGadget(0, 5, 5, 290, 100, "Random Number Generator")

OptionGadget(1, 15, 25, 200, 20, "Flat Distribuation (native PureBasic)")
OptionGadget(2, 15, 45, 140, 20, "Gaussian (bell curve)")
  SetGadgetState(2, #True)

TextGadget(3, 160, 48, 40, 17, "Scale:")
StringGadget(4, 200, 45, 70, 20, "1.0")

ButtonGadget(5, 75, 70, 70, 25, "Start", #PB_Button_Default)
ButtonGadget(6, 155, 70, 70, 25, "Reset")

CreateImage(0, 1, 1)
ImageGadget(7, 0, 0, 0, 0, ImageID(0))

Running.i = 0
Type.i = 2
BellScale.d = 1.0
Maxx.i = 100
Total = 0
ExitFlag.i = #False

SmartWindowRefresh(0, #True)
WindowBounds(0, 300, 300, #PB_Ignore, #PB_Ignore)

StretchImage()
HideWindow(0, #False)
UpdateImage()

Repeat
  Event.i = WaitWindowEvent(#Timeout)
   
  While Event
   
  If Event = #PB_Event_CloseWindow
  ExitFlag = #True
  ElseIf Event = #PB_Event_SizeWindow
  StretchImage()
  If Not Running : UpdateImage() : EndIf
  ElseIf Event = #PB_Event_Gadget
  ID.i = EventGadget()
  Select ID
  Case 1, 2 : Type = ID
  Case 4
  If EventType() = #PB_EventType_Change
  St.s = GetGadgetText(4)
  If ValD(St) > 0.0
  BellScale = ValD(St)
  EndIf
  EndIf
  Case 5, 7
  Running = 1 - Running
  If Running
  SetGadgetText(5, "Stop")
  Else
  SetGadgetText(5, "Run")
  EndIf
  Case 6
  For i = 0 To #Intervals - 1
  Count(i) = 0
  Next i
  Maxx = 100
  Total = 0
  If Not Running : UpdateImage() : EndIf
  EndSelect
  EndIf
   
  Event = WindowEvent()
  Wend
   
  If Running And (Total < 2000000000)
  For a = 1 To #Iterations
  If Type = 1
  x.d = RandomFlat()
  ElseIf Type = 2
  x.d = RandomGauss(BellScale)
  EndIf
  Group.i = Int(x * #Intervals)
   
  Count(Group) + 1
  If Count(Group) >= Maxx
  Maxx = Count(Group) + 1
  EndIf
  Next a
  Total + #Iterations
   
  EndIf
  UpdateImage()

Until ExitFlag

HideWindow(0, #True)
End

;










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.