Distribution plot
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 | 'Begin Description 'This script plots the normal-, binomial- and chisquare probability distributions; 'the user chooses the number of degrees of freedom etc.. Charttype and titles 'can be customized from within the dialogbox. The script does a fair amount of 'checking of the input (range and sign of values), currently no checking is done 'against requesting plots with more categories than SPSS' graph-engine will accept; '3000. ' 'Written 27/09/1998 by Rolf Kjшller (rolf.kjoeller@get2net.dk) . 'End Description Option Explicit 'For localized versions of Windows which use comma (,) 'instead of period (.) as the decimal separator, 'change the following from False to True Const DECIMAL_COMMA As Boolean = False Global strMacrocall As String Global booInputIsOK As Boolean Global strMainTitle As String Global strSubTitle As String Global intChartType As Integer Sub Main Dim blnOverwriteWarning As Boolean If SPSSVersion8 Then 'don't warn unless the data have been modified blnOverwriteWarning = objSpssApp.Documents.GetDataDoc(0).Modified Else 'or install code from query.sbs to check blnOverwriteWarning = True End If If blnOverwriteWarning Then If vbCancel = MsgBox ("Current data will be overwritten! OK to proceed?", _ vbExclamation + vbOkCancel) Then Exit Sub End If End If Call MainDialog End Sub Sub MainDialog Dim distributions$(3) distributions$(1)="Normal" distributions$(2)="Binomial" distributions$(3)="Chisquare" Dim stepvalues$(6) stepvalues$(1)="1" stepvalues$(2)="0.5" stepvalues$(3)="0.1" stepvalues$(4)="0.05" stepvalues$(5)="0.01" stepvalues$(6)="0.005" Begin Dialog UserDialog 420,140,"Plot Probability Distributions",.RunMainDialog Text 30,7,220,21,"Probability Distribution:",.maintext OKButton 290,20,100,20,.cmdOK CancelButton 290,50,100,20,.cmdCancel DropListBox 30,20,225,77,distributions(),.distribution Text 30,50,140,21,"Mean:",.meantext TextBox 210,50,45,20,.mean Text 30,75,140,20,"Standard Deviation:",.stdevtext TextBox 210,75,45,20,.stdev Text 30,100,140,21,"Step Value:",.stepvaluetext ListBox 185,100,70,28,stepvalues(),.stepvalue Text 30,50,140,21,"n trials:",.ntext TextBox 210,50,45,20,.n Text 30,75,140,20,"Prob:",.Probtext TextBox 210,75,45,20,.Prob Text 30,50,140,20,"Degrees of Freedom:",.dfstext TextBox 210,50,45,20,.dfs PushButton 290,100,100,20,"Options ...",.cmdOptions End Dialog Dim MainDlg As UserDialog Dialog MainDlg End Sub Sub OptionsDialog Begin Dialog UserDialog 420,140,"Plot Probability Distributions: Options",.RunOptionsDialog Text 30,7,140,20,"Titles:",.title PushButton 290,20,100,20,"Continue",.cmdContinue TextBox 30,20,230,20,.MainTitle TextBox 30,50,230,20,.SubTitle OptionGroup.ChartType OptionButton 30,100,60,20,"Line",.OptionButton1 OptionButton 120,100,60,20,"Area",.OptionButton2 OptionButton 210,100,60,20,"Bar",.OptionButton3 Text 30,87,90,14,"Graph:",.Text1 End Dialog Dim OptionsDlg As UserDialog Dialog OptionsDlg End Sub Private Function RunMainDialog(DlgItem As String, Action As Integer, SuppValue As Integer) As Boolean Select Case Action Case 1 'Dialog box initialization DlgVisible "meantext",True DlgVisible "mean",True DlgVisible "stdevtext",True DlgVisible "stdev",True DlgVisible "stepvaluetext",True DlgVisible "stepvalue",True DlgVisible "dfstext",False DlgVisible "dfs",False DlgVisible "ntext",False DlgVisible "n",False DlgVisible "Probtext",False DlgVisible "Prob",False DlgValue "stepvalue",2 DlgFocus "distribution" strMainTitle="Normal Distribution" strSubTitle="Mean=" + DlgText("mean") + ", Standard Deviation=" + DlgText("stdev") intChartType=0 Case 2 'Value changing or button pressed Select Case dlgItem Case "distribution" Select Case SuppValue Case 0 DlgVisible "meantext",True DlgVisible "mean",True DlgVisible "stdevtext",True DlgVisible "stdev",True DlgVisible "ntext",False DlgVisible "n",False DlgVisible "Probtext",False DlgVisible "Prob",False DlgVisible "dfstext",False DlgVisible "dfs",False DlgVisible "stepvaluetext",True DlgVisible "stepvalue",True strMainTitle="Normal Distribution" strSubTitle="Mean=" + DlgText("mean") + ", Standard Deviation=" + DlgText("stdev") intChartType=0 Case 1 DlgVisible "meantext",False DlgVisible "mean",False DlgVisible "stdevtext",False DlgVisible "stdev",False DlgVisible "ntext",True DlgVisible "n",True DlgVisible "Probtext",True DlgVisible "Prob",True DlgVisible "dfstext",False DlgVisible "dfs",False DlgVisible "stepvaluetext",False DlgVisible "stepvalue",False strMainTitle="Binomial Distribution" strSubTitle="n=" + DlgText("n") + ", Prob=" + DlgText("Prob") intChartType=2 Case 2 DlgVisible "meantext",False DlgVisible "mean",False DlgVisible "stdevtext",False DlgVisible "stdev",False DlgVisible "ntext",False DlgVisible "n",False DlgVisible "Probtext",False DlgVisible "Prob",False DlgVisible "dfstext",True DlgVisible "dfs",True DlgVisible "stepvaluetext",True DlgVisible "stepvalue",True strMainTitle="Chisquare Distribution" strSubTitle="df=" + DlgText("dfs") intChartType=0 End Select Case "cmdOK" strMainTitle="'" + strMainTitle + "'" strSubTitle="'" + strSubTitle + "'" Select Case DlgText("distribution") Case "Normal" Call CheckInput (DlgText("mean"), DlgText("stdev")) If booInputIsOK Then Call BuildMacroCall (DlgText("mean"), DlgText("stdev")) Call plot RunMainDialog = False Else RunMainDialog = True End If Case "Binomial" Call CheckInput (DlgText("n"), DlgText("Prob")) If booInputIsOK Then Call BuildMacroCall (DlgText("n"), DlgText("Prob")) Call plot RunMainDialog = False Else RunMainDialog = True End If Case "Chisquare" Call CheckInput (DlgText("dfs")) If booInputIsOK Then Call BuildMacroCall (DlgText("dfs")) Call plot RunMainDialog = False Else RunMainDialog = True End If End Select Case "cmdCancel" End Case "cmdOptions" Call OptionsDialog RunMainDialog = True End Select Case 3 'TextBox or ComboBox text changed Select Case DlgItem Case "mean" strMainTitle="Normal Distribution" strSubTitle="Mean=" + DlgText("mean") + ", Standard Deviation=" + DlgText("stdev") intChartType=0 Case "stdev" strMainTitle="Normal Distribution" strSubTitle="Mean=" + DlgText("mean") + ", Standard Deviation=" + DlgText("stdev") intChartType=0 Case "n" strMainTitle="Binomial Distribution" strSubTitle="n=" + DlgText("n") + ", Prob=" + DlgText("Prob") intChartType=2 Case "Prob" strMainTitle="Binomial Distribution" strSubTitle="n=" + DlgText("n") + ", Prob=" + DlgText("Prob") intChartType=2 Case "dfs" strMainTitle="Chisquare Distribution" strSubTitle="df=" + DlgText("dfs") intChartType=0 End Select Case 4 'Focus changed Case 5 'Idle End Select End Function Private Function RunOptionsDialog(DlgItem As String, Action As Integer, SuppValue As Integer) As Boolean Select Case Action Case 1 'Dialog box initialization DlgText "MainTitle", strMainTitle DlgText "SubTitle", strSubTitle DlgValue "ChartType", intChartType Case 2 'Value changing or button pressed Select Case dlgItem Case "cmdContinue" strMainTitle=DlgText("MainTitle") strSubTitle=DlgText("SubTitle") intChartType=DlgValue("ChartType") Exit Function End Select Case 3 'TextBox or ComboBox text changed Case 4 'Focus changed Case 5 'Idle End Select End Function Sub CheckInput (ParamArray InputValueList()) Dim i As Integer Dim j As Integer booInputIsOK=False For j=0 To UBound(Inputvaluelist) '*************************************** 'First check: Is the inputvalue numeric? '*************************************** If DECIMAL_COMMA Then 'dots are replaced with commas: For i=1 To Len(InputValuelist(j)) If Mid(InputValuelist(j),i,1) = "." Then InputValuelist(j)=Left(InputValuelist(j),i-1)+","+Right(InputValuelist(j),Len(InputValuelist(j))-i) Next i End If booInputIsOK=IsNumeric(InputValuelist(j)) If Not booInputIsOK Then MsgBox "An input field is either empty or contains non-numeric or multiple values" Exit Sub End If '**************************************************** 'Second check: Is the inputvalue within proper range? '**************************************************** Select Case DlgText("distribution") Case "Normal" If j=1 Then booInputIsOK = (CDbl(InputValuelist(j))>0) If Not booInputIsOK Then MsgBox "Standard Deviation must be greater than 0" Exit Sub End If End If Case "Binomial" Select Case j Case 0 booInputIsOK = (CDbl(InputValuelist(j))>0 And CDbl(InputValuelist(j))=Int(CDbl(InputValuelist(j)))) If Not booInputIsOK Then MsgBox "n must be an integer greater than 0" Exit Sub End If Case 1 booInputIsOK = (CDbl(InputValuelist(j))>=0 And CDbl(InputValuelist(j))<=1) If Not booInputIsOK Then MsgBox "Prob must be a number between 0 and 1" Exit Sub End If End Select Case "Chisquare" booInputIsOK = (CDbl(InputValuelist(j))>0 And CDbl(InputValuelist(j))=Int(CDbl(InputValuelist(j)))) If Not booInputIsOK Then MsgBox "Degrees of Freedom must be an integer greater than 0" Exit Sub End If End Select Next j End Sub Sub BuildMacroCall(ParamArray InputValueList()) Dim i As Integer Dim j As Integer For j=0 To UBound(Inputvaluelist) 'commas are replaced with dots: For i=1 To Len(InputValuelist(j)) If Mid(InputValuelist(j),i,1) = "," Then InputValuelist(j)=Left(InputValuelist(j),i-1)+"."+Right(InputValuelist(j),Len(InputValuelist(j))-i) Next i Next j Select Case DlgText("distribution") Case "Normal" strMacrocall="!norm mean=" + InputValuelist(0) + " stdev=" + InputValuelist(1) + " step=" + DlgText("stepvalue") + " ." Case "Binomial" strMacrocall="!bin n=" + InputValuelist(0) + " p=" + InputValuelist(1) + " ." Case "Chisquare" strMacrocall="!chisq df=" + InputValuelist(0) + " step=" + DlgText("stepvalue") + " ." End Select 'MsgBox strMacrocall End Sub Sub plot Dim strCommand As String strCommand = strCommand + "SET ERRORS=OFF ." &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "/* Normal:" &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "DEFINE !norm (mean=!TOKENS(1) /stdev=!TOKENS(1) /step=!DEFAULT(0.05) !TOKENS(1)) ." &vbCrLf strCommand = strCommand + "NEW FILE ." &vbCrLf strCommand = strCommand + "INPUT PROGRAM ." &vbCrLf strCommand = strCommand + "LOOP x=(-4*!stdev+!mean) TO (4*!stdev+!mean) BY !step ." &vbCrLf strCommand = strCommand + "COMPUTE cpx=CDF.NORM(x,!mean,!stdev) ." &vbCrLf strCommand = strCommand + "COMPUTE px=CDF.NORM(x,!mean,!stdev)-CDF.NORM(LAG(x),!mean,!stdev) ." &vbCrLf strCommand = strCommand + "IF x EQ (-4*!stdev+!mean) px=cpx ." &vbCrLf strCommand = strCommand + "END CASE ." &vbCrLf strCommand = strCommand + "END LOOP ." &vbCrLf strCommand = strCommand + "END FILE ." &vbCrLf strCommand = strCommand + "END INPUT PROGRAM ." &vbCrLf strCommand = strCommand + "EXECUTE ." &vbCrLf strCommand = strCommand + "VARIABLE LABELS x 'Z' px 'p(z=Z)' cpx 'p(z<=Z)' ." &vbCrLf strCommand = strCommand + "!ENDDEFINE ." &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "/* Binomial:" &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "DEFINE !bin (n=!TOKENS(1) /p=!TOKENS(1)) ." &vbCrLf strCommand = strCommand + "NEW FILE ." &vbCrLf strCommand = strCommand + "INPUT PROGRAM ." &vbCrLf strCommand = strCommand + "LOOP x=0 TO !n BY 1 ." &vbCrLf strCommand = strCommand + "COMPUTE cpx=CDF.BINOM(x,!n,!p) ." &vbCrLf strCommand = strCommand + "COMPUTE px=CDF.BINOM(x,!n,!p)-CDF.BINOM(LAG(x),!n,!p) ." &vbCrLf strCommand = strCommand + "IF x EQ 0 px=cpx ." &vbCrLf strCommand = strCommand + "END CASE ." &vbCrLf strCommand = strCommand + "END LOOP ." &vbCrLf strCommand = strCommand + "END FILE ." &vbCrLf strCommand = strCommand + "END INPUT PROGRAM ." &vbCrLf strCommand = strCommand + "EXECUTE ." &vbCrLf strCommand = strCommand + "FORMAT x (F4) ." &vbCrLf strCommand = strCommand + "VARIABLE LABELS x 'X' px 'p(x=X)' cpx 'p(x<=X)' ." &vbCrLf strCommand = strCommand + "!ENDDEFINE ." &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "/* Chisquare:" &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "DEFINE !chisq (df=!TOKENS(1) /step=!TOKENS(1)) ." &vbCrLf strCommand = strCommand + "NEW FILE ." &vbCrLf strCommand = strCommand + "INPUT PROGRAM ." &vbCrLf strCommand = strCommand + "LOOP x=0 TO 5*!df BY !step ." &vbCrLf strCommand = strCommand + "COMPUTE cpx=CDF.CHISQ(x,!df) ." &vbCrLf strCommand = strCommand + "COMPUTE px=CDF.CHISQ(x,!df)-CDF.CHISQ(LAG(x),!df) ." &vbCrLf strCommand = strCommand + "IF x EQ 0 px=cpx ." &vbCrLf strCommand = strCommand + "DO IF cpx GT 0.9999 ." &vbCrLf strCommand = strCommand + "BREAK ." &vbCrLf strCommand = strCommand + "END IF ." &vbCrLf strCommand = strCommand + "END CASE ." &vbCrLf strCommand = strCommand + "END LOOP ." &vbCrLf strCommand = strCommand + "END FILE ." &vbCrLf strCommand = strCommand + "END INPUT PROGRAM ." &vbCrLf strCommand = strCommand + "EXECUTE ." &vbCrLf strCommand = strCommand + "VARIABLE LABELS x 'Q' cpx 'p(q<=Q)' px 'p(q=Q)' ." &vbCrLf strCommand = strCommand + "!ENDDEFINE ." &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "/* Plot:" &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + "DEFINE !plot (type=!TOKENS(1)) ." &vbCrLf strCommand = strCommand + "!IF (!type !EQ 0) !THEN ." &vbCrLf strCommand = strCommand + "GRAPH" &vbCrLf strCommand = strCommand + "/TITLE=" + strMainTitle &vbCrLf strCommand = strCommand + "/SUBTITLE=" + strSubTitle &vbCrLf strCommand = strCommand + "/LINE(SIMPLE)=VALUE(cpx) BY x ." &vbCrLf strCommand = strCommand + "GRAPH" &vbCrLf strCommand = strCommand + "/TITLE=" + strMainTitle &vbCrLf strCommand = strCommand + "/SUBTITLE=" + strSubTitle &vbCrLf strCommand = strCommand + "/LINE(SIMPLE)=VALUE(px) BY x ." &vbCrLf strCommand = strCommand + "!IFEND ." &vbCrLf strCommand = strCommand + "!IF (!type !EQ 1) !THEN ." &vbCrLf strCommand = strCommand + "GRAPH" &vbCrLf strCommand = strCommand + "/TITLE=" + strMainTitle &vbCrLf strCommand = strCommand + "/SUBTITLE=" + strSubTitle &vbCrLf strCommand = strCommand + "/LINE(AREA)=VALUE(cpx) BY x ." &vbCrLf strCommand = strCommand + "GRAPH" &vbCrLf strCommand = strCommand + "/TITLE=" + strMainTitle &vbCrLf strCommand = strCommand + "/SUBTITLE=" + strSubTitle &vbCrLf strCommand = strCommand + "/LINE(AREA)=VALUE(px) BY x ." &vbCrLf strCommand = strCommand + "!IFEND ." &vbCrLf strCommand = strCommand + "!IF (!type !EQ 2) !THEN ." &vbCrLf strCommand = strCommand + "GRAPH" &vbCrLf strCommand = strCommand + "/TITLE=" + strMainTitle &vbCrLf strCommand = strCommand + "/SUBTITLE=" + strSubTitle &vbCrLf strCommand = strCommand + "/BAR(SIMPLE)=VALUE(cpx) BY x ." &vbCrLf strCommand = strCommand + "GRAPH" &vbCrLf strCommand = strCommand + "/TITLE=" + strMainTitle &vbCrLf strCommand = strCommand + "/SUBTITLE=" + strSubTitle &vbCrLf strCommand = strCommand + "/BAR(SIMPLE)=VALUE(px) BY x ." &vbCrLf strCommand = strCommand + "!IFEND ." &vbCrLf strCommand = strCommand + "!ENDDEFINE ." &vbCrLf strCommand = strCommand + "SET ERRORS=LISTING ." &vbCrLf strCommand = strCommand + "/******************************************************************************" &vbCrLf strCommand = strCommand + strMacrocall &vbCrLf strCommand = strCommand + "!plot type=" + Str(intChartType) &vbCrLf objSpssApp.ExecuteCommands strCommand , False End Sub Function SPSSVersion8 As Boolean 'turn on error handling On Error Resume Next 'this will cause an error in SPSS 7.5, specifically: ' Error 10091 ' OLE Automation: no such property or method. objSpssApp.ScriptParameter(0) SPSSVersion8 = (Err = 0) 'clear the error, if any Err.Clear 'turn off error handling On Error GoTo 0 End Function |
Related pages
...
Navigate from here