home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD100309202000.psc / Statistiscal_functions.bas < prev    next >
Encoding:
BASIC Source File  |  2000-09-21  |  3.8 KB  |  117 lines
  1. Attribute VB_Name = "Statistical_functions"
  2. Option Explicit
  3.  
  4. ''''''''''''''''''''''''''''''''''''''''''''''''''
  5. ' If anyone has a better solution to all of the  '
  6. ' modules below, please send it to me at         '
  7. ' foxdetective007@mailcity.com                   '
  8. ''''''''''''''''''''''''''''''''''''''''''''''''''
  9.  
  10. Public Sigma As Double
  11. Public N_scores As Integer
  12. Public Arithmetic_Mean As Double
  13. Public P_S_D As Double
  14. Public S_S_D As Double
  15. Public SigmaSq As Double
  16.  
  17. Public Sub Sum()
  18. On Error GoTo solution
  19. Sigma = S_R(1) + S_R(2) + S_R(3) + S_R(4) + S_R(5) + S_R(6) + _
  20.     S_R(7) + S_R(8) + S_R(9) + S_R(10) + S_R(11) + S_R(12) + S_R(13) + _
  21.     S_R(14) + S_R(15) + S_R(16) + S_R(17) + S_R(18) + S_R(19) + S_R(20)
  22.     
  23. frmMain.Number_space.Text = Sigma
  24. Exit Sub
  25. solution:
  26. Call Misc.solution
  27. End Sub
  28.     
  29. Public Sub Mean()
  30. On Error GoTo solution
  31. Sigma = S_R(1) + S_R(2) + S_R(3) + S_R(4) + S_R(5) + S_R(6) + _
  32.     S_R(7) + S_R(8) + S_R(9) + S_R(10) + S_R(11) + S_R(12) + S_R(13) + _
  33.     S_R(14) + S_R(15) + S_R(16) + S_R(17) + S_R(18) + S_R(19) + S_R(20)
  34.  
  35. Arithmetic_Mean = Sigma / Index
  36.  
  37. frmMain.Number_space.Text = Arithmetic_Mean
  38. Exit Sub
  39. solution:
  40. Call Misc.solution
  41. End Sub
  42.  
  43. Public Sub Population_standard_deviation()
  44. On Error GoTo solution
  45. SigmaSq = (S_R(1) * S_R(1)) + (S_R(2) * S_R(2)) + (S_R(3) * S_R(3)) + _
  46.     (S_R(4) * S_R(4)) + (S_R(5) * S_R(5)) + (S_R(6) * S_R(6)) + (S_R(7) * _
  47.     S_R(7)) + (S_R(8) * S_R(8)) + (S_R(9) * S_R(9)) + (S_R(10) * S_R(10)) + _
  48.     (S_R(11) * S_R(11)) + (S_R(12) * S_R(12)) + (S_R(13) * S_R(13)) + _
  49.     (S_R(14) * S_R(14)) + (S_R(15) * S_R(15)) + (S_R(16) * S_R(16)) + _
  50.     (S_R(17) * S_R(17)) + (S_R(18) * S_R(18)) + (S_R(19) * S_R(19)) + _
  51.     (S_R(20) * S_R(20))
  52.  
  53. Sigma = S_R(1) + S_R(2) + S_R(3) + S_R(4) + S_R(5) + S_R(6) + _
  54.     S_R(7) + S_R(8) + S_R(9) + S_R(10) + S_R(11) + S_R(12) + S_R(13) + _
  55.     S_R(14) + S_R(15) + S_R(16) + S_R(17) + S_R(18) + S_R(19) + S_R(20)
  56.     
  57. P_S_D = Sqr((SigmaSq - ((Sigma * Sigma) / Index)) / Index)
  58.  
  59. frmMain.Number_space.MaxLength = 15
  60. frmMain.Number_space.Text = P_S_D
  61. Exit Sub
  62. solution: Call Misc.solution
  63. End Sub
  64.  
  65. Public Sub Sample_standard_deviation()
  66.  
  67. On Error GoTo solution
  68. SigmaSq = (S_R(1) * S_R(1)) + (S_R(2) * S_R(2)) + (S_R(3) * S_R(3)) + _
  69.     (S_R(4) * S_R(4)) + (S_R(5) * S_R(5)) + (S_R(6) * S_R(6)) + (S_R(7) * _
  70.     S_R(7)) + (S_R(8) * S_R(8)) + (S_R(9) * S_R(9)) + (S_R(10) * S_R(10)) + _
  71.     (S_R(11) * S_R(11)) + (S_R(12) * S_R(12)) + (S_R(13) * S_R(13)) + _
  72.     (S_R(14) * S_R(14)) + (S_R(15) * S_R(15)) + (S_R(16) * S_R(16)) + _
  73.     (S_R(17) * S_R(17)) + (S_R(18) * S_R(18)) + (S_R(19) * S_R(19)) + _
  74.     (S_R(20) * S_R(20))
  75.  
  76. Sigma = S_R(1) + S_R(2) + S_R(3) + S_R(4) + S_R(5) + S_R(6) + _
  77.     S_R(7) + S_R(8) + S_R(9) + S_R(10) + S_R(11) + S_R(12) + S_R(13) + _
  78.     S_R(14) + S_R(15) + S_R(16) + S_R(17) + S_R(18) + S_R(19) + S_R(20)
  79.     
  80. S_S_D = Sqr((SigmaSq - ((Sigma * Sigma) / Index)) / (Index - 1))
  81.  
  82. frmMain.Number_space.MaxLength = 15
  83. frmMain.Number_space.Text = S_S_D
  84. Exit Sub
  85. solution: Call Misc.solution
  86. End Sub
  87.  
  88. Public Sub Clear_s_r()
  89. Dim Response As String
  90.    On Error GoTo solution
  91.    If frmMain.Statistic_score.Visible = True Then
  92.         Response = MsgBox("Are you sure you want to clear the contents of the statistical register" _
  93.         , vbExclamation + vbYesNo, "Clear the statistical register?")
  94.         If Response = vbYes Then
  95.             frmMain.Statistic_score.Text = "n"
  96.             frmMain.Number_space.Text = "0"
  97.             For Index = 1 To 20
  98.                 S_R(Index) = 0
  99.             Next Index
  100.             Index = 0
  101.             Sigma = 0
  102.             Dot = False
  103.             N_scores = 0
  104.             Arithmetic_Mean = 0
  105.         ElseIf Response = vbNo Then
  106.             frmMain.Refresh
  107.         End If
  108.     Else
  109.     
  110.     End If
  111.     Exit Sub
  112. solution:
  113.     Call Misc.solution
  114. End Sub
  115.  
  116.  
  117.