home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 521.lha / Stats_v2.0 / BASICcode next >
Encoding:
Text File  |  1991-06-10  |  6.9 KB  |  299 lines
  1. WINDOW 1,"Unary Data Set Statistics",(0,0)-(640,200),31+256
  2.  
  3. LIBRARY "requester.library"
  4.   DECLARE FUNCTION DoFileIOWindow&() LIBRARY
  5.   DECLARE FUNCTION GetFileIO&() LIBRARY
  6.   DECLARE FUNCTION AutoFileMessage() LIBRARY
  7.  
  8. ' subroutine to call file requestor from the requester.library.
  9.  
  10. '      ireqx,ireqy x and y coordinates for the requestor
  11. '      WindowTitle$ a title displayed in the requestor's title bar
  12. '      Values returned by the subroutine:
  13. '           PathName$    full path for selected file
  14. '           FileName$    file name only
  15. '           VolName$     the volume name or drive id
  16. '           DrawerName$  drawer name or subdirectory
  17. '           DiscOrDir%   returns 1 if selection is a drive or directory only
  18. '           NoExist%     returns 1 if file does not exist
  19. '           flag%        returns 0 if request fails and 1 if successful
  20. '           Reason$      short message explaining failure
  21. '
  22. SUB requestor(ireqx,ireqy,WindowTitle$,PathName$,FileName$,VolName$,DrawerName$,DiscOrDir%,NoExist%,flag%,reason$)
  23.     LOCAL i
  24.     DEFINT i
  25.     DiscOrDir%=0 : NoExist%=0 : flag%=0
  26.     PathName$="" : FileName$="" : VolName$="" : DrawerName$=""
  27.     reason$=""
  28.     PathBuffer$=SPACE$(202)
  29.     ExtPtrBuff$=SPACE$(24)
  30.     FileIO&=GetFileIO&()
  31.     IF FileIO&=0 THEN
  32.         CALL ReleaseFileIO&(FileIO&)
  33.         flag%=0
  34.         reason$="FileIO Failed"
  35.         EXIT SUB
  36.     END IF
  37.     POKEL FileIO&+248,SADD(PathBuffer$)
  38.     POKEL FileIO&+222,SADD(ExtPtrBuff$)
  39.     POKEL FileIO&+244,SADD(WindowTitle$+CHR$(0))
  40.     POKE FileIO&+261,1
  41.     POKE FileIO&+262,1
  42.     POKE FileIO&+263,0
  43.     POKEW FileIO&+232,ireqx
  44.     POKEW FileIO&+234,ireqy
  45.     POKE FileIO&+1,4
  46.     extsize&=LEN(ext$)
  47.     POKE FileIO&+1,128
  48.     result&=DoFileIOWindow&(FileIO&,0&)
  49.     IF result&=-1 THEN
  50.         CALL ResetTitle(FileIO,WINDOW(7))
  51.         CALL ReleaseFileIO(FileIO)
  52.         flag%=0
  53.         reason$="Cancel"
  54.         EXIT SUB
  55.     END IF
  56.     IF result&=0 THEN
  57.         result&=AutoFileMessage&(0&,WINDOW(7))
  58.         INPUT "Type path: ";PathName$
  59.         CALL ParseString&(FileIO&,SADD(PathName$+CHR$(0)))
  60.         GOTO CopyFN
  61.     END IF
  62.  
  63.     pathname$ = ""
  64.         FOR i = 0 TO 202
  65.             value = PEEK(SADD(PathBuffer$)+i)
  66.             IF value = 0 THEN EXIT FOR
  67.             char$ = CHR$(value)
  68.             pathname$ = pathname$+char$
  69.         NEXT i 
  70.  
  71.     CopyFN: 'Copy out the Filename to Filename$.
  72.         FileName$ = ""
  73.         FOR i = 0 TO 30
  74.             value = PEEK(FileIO&+2+i)
  75.             IF value = 0 THEN EXIT FOR
  76.             char$ = CHR$(value)
  77.             FileName$ = FileName$+char$
  78.         NEXT i
  79.  
  80.     CopyDrawer: 'Copy out all the drawers 
  81.         DrawerName$ = ""
  82.         FOR i = 0 TO 132
  83.             value = PEEK(FileIO&+32+i)
  84.             IF value = 0 THEN EXIT FOR
  85.             char$ = CHR$(value)
  86.             DrawerName$ = DrawerName$+char$
  87.         NEXT i
  88.  
  89.     CopyVol: 'Copy out the diskname 
  90.         VolName$ = ""
  91.         FOR i = 0 TO 30
  92.             value = PEEK(FileIO&+164+i)
  93.             IF value = 0 THEN EXIT FOR
  94.             char$ = CHR$(value)
  95.             VolName$ = VolName$+char$
  96.         NEXT i
  97.  
  98.     extsize&=LEN(FileName$)
  99.     IF extsize&=0 THEN DiscOrDir%=1
  100.     IF PEEKL(FileIO&+240)=0 THEN NoExist%=1
  101.     CALL ResetTitle&(FileIO&,WINDOW(7))
  102.     CALL ReleaseFileIO&(FileIO&)
  103.     flag%=1
  104. END SUB
  105.  
  106. 'subroutine to print message at line linenum1%, then wait for key press
  107. 'key press message is printed at line linenum2%
  108.  
  109. SUB message (VAL linenum1%, VAL linenum2%, VAL m$)
  110.     LOCATE linenum1%,INT((80-LEN(m$))/2) : ?m$;
  111.     LOCATE linenum2%,27,0 : ?"Press any key to continue";
  112.     DO 
  113.         IF INKEY$<>"" THEN EXIT LOOP
  114.         SLEEP
  115.     LOOP
  116.     CLS : LOCATE 1,1,1 
  117. END SUB
  118.  
  119. 'subroutine to ask if user wants to continue
  120. 'returns flag%=0 if no, flag%=1 if yes
  121.  
  122. SUB continue (flag%)
  123.     local t$ : t$="" : flag% = 0
  124.     WHILE t$<>"YES" AND t$<>"NO" AND t$<>"Y" AND t$<>"N"
  125.         CLS : LOCATE 12,32 : INPUT "Try again? ",t$
  126.         t$=UCASE$(t$)
  127.         IF t$="YES" OR t$="Y" THEN
  128.             flag%=1 : EXIT SUB
  129.         END IF
  130.         IF t$="NO" OR t$="N" THEN
  131.             flag%=0 : EXIT SUB
  132.         END IF
  133.     WEND
  134. END SUB
  135.  
  136. 'print instructions
  137.  
  138. CLS
  139. ?
  140. ?"This program will allow you to select a data file, and then calculate"
  141. ?"  statistical parameters, such as mean, average deviation, variance,"
  142. ?"  standard deviation, skewness, and kurtosis.  The data file MUST be"
  143. ?"  of a certain format."
  144. ?
  145. ?"  WARNING: This program will NOT accept files that do not conform to"
  146. ?"           the expected format!"
  147. ?
  148. ?"The format is the number of data points (MUST be an integer) followed"
  149. ?"  by the data points, which may be arranged horizontally, vertically,"
  150. ?"  or a combination of the two.  For example, to calculate the statistical"
  151. ?"  parameters of 7.22, 4.56, 3.22, and 1.23 the following files are"
  152. ?"  acceptable:"
  153. ?
  154. ?"          4  7.22  4.56  3.22  1.23"
  155. ?
  156. ?"  OR"
  157. ?
  158. ?"          4 7.22 4.56"
  159. ?"          3.22 1.23"
  160. ?
  161. message 23,23,""
  162. CLS
  163. ? : ? : ?
  164. ?"You may use your favorite word processor, spreadsheet, or whatever to"
  165. ?"  generate the data file.  However, the file MUST be in ASCII.  This"
  166. ?"  is actually pretty simple--it usually just means selecting the"
  167. ?"  ""general"" option when saving the file from your word processor, or"
  168. ?"  the ""print to file"" option when saving the file from your"
  169. ?"  spreadsheet."
  170. ?
  171. ?"Note:  the program does not care about spaces in a file.  It DOES however"
  172. ?"  care about carriage returns, and will treat them as zeros.  IF YOU"
  173. ?"  HAVE EXTRA CARRIAGE RETURNS IN YOUR DATA FILE, DELETE THEM PRIOR TO"
  174. ?"  RUNNING THIS PROGRAM!"
  175. message 19,23,"Happy Analyzing!     C. Niederberger 2/91" 
  176.  
  177. start:    CLS
  178.  
  179. DEFDBL D
  180. DEFINT i-k,n
  181.  
  182. CALL requestor (10,10,"Select Data File",Name$,f$,v$,d$,dod%,ne%,f%,r$)
  183.  
  184. IF dod%=1 OR ne%=1 OR f%=0 THEN
  185.     CLS : message 11,13,"File lookup failed: "+r$
  186.     continue flg%
  187.     IF flg%=0 THEN GOTO finish ELSE GOTO start
  188. END IF
  189.  
  190. OPEN Name$ FOR INPUT AS #1
  191.  
  192. 'load data array with data from file
  193.  
  194. INPUT #1,Dn    'n = Dn = total number of data points
  195.  
  196. n=INT(Dn)
  197. IF Dn<>n THEN
  198.     CLS : message 11,13,"n is not an integer!"
  199.     continue flg%
  200.     IF flg%=0 THEN
  201.         GOTO finish
  202.     ELSE
  203.         ERASE Ddata
  204.         GOTO start
  205.     END IF
  206. END IF
  207.  
  208. DIM Ddata(n)
  209.  
  210. FOR i=1 TO n
  211.     IF EOF(1) THEN
  212.         CLS : message 11,13,"Not enough data for n!"
  213.         continue flg%
  214.         IF flg%=0 THEN
  215.             GOTO finish
  216.         ELSE
  217.             ERASE Ddata
  218.             GOTO start
  219.         END IF
  220.     END IF
  221.     INPUT #1,Ddata(i)
  222. NEXT i
  223.  
  224. IF NOT EOF(1) THEN
  225.     CLS : message 11,13,"Too much data for n!"
  226.     continue flg%
  227.     IF flg%=0 THEN
  228.         GOTO finish
  229.     ELSE
  230.         ERASE Ddata
  231.         GOTO start
  232.     END IF
  233. END IF
  234.  
  235. CLOSE #1
  236.  
  237. 'sum all data
  238.  
  239. Ds=0
  240.  
  241. FOR j=1 TO n
  242.     Ds=Ds+Ddata(j)
  243. NEXT j
  244.  
  245. 'calculate average, and set other results to 0
  246.  
  247. ? : ? : ? : ?
  248. Dave=Ds/n : ?"          mean is "Dave
  249. Dadev=0
  250. Dsvar=0
  251. Dskew=0
  252. Dcurt=0
  253.  
  254. 'now calculate other results
  255.  
  256. FOR j=1 TO n
  257.     Ds=Ddata(j)-Dave
  258.     Dadev=Dadev+ABS(Ds)
  259.     Dp=Ds*Ds
  260.     Dsvar=Dsvar+Dp
  261.     Dp=Dp*Ds
  262.     Dskew=Dskew+Dp
  263.     Dp=Dp*Ds
  264.     Dcurt=Dcurt+Dp
  265. NEXT j
  266.  
  267. Dadev=Dadev/n : ?"          average deviation is "Dadev 
  268. Dsvar=Dsvar/(n-1) : ?"          variance is "Dsvar
  269. Dsdev=SQR(Dsvar) : ?"          standard deviation is "Dsdev
  270.  
  271. IF Dsvar<>0 THEN
  272.     Dskew=Dskew/(n*Dsdev^3) : ?"          skew is "Dskew
  273.     Dcurt=Dcurt/(n*Dsvar^2)-3 : ?"          kurtosis is "Dcurt
  274. ELSE
  275.     PRINT "          No skew or kurtosis when variance = 0"
  276. END IF
  277.  
  278. 'after results display, wait for user entry
  279.  
  280. LOCATE 13,27,0 : ?"Press any key to continue"
  281. DO 
  282.     IF INKEY$<>"" THEN EXIT LOOP
  283.     SLEEP
  284. LOOP
  285.  
  286. continue flg%
  287. IF flg%=0 THEN
  288.     GOTO finish
  289. ELSE
  290.     ERASE Ddata
  291.     GOTO start
  292. END IF
  293.  
  294. finish: WINDOW CLOSE 1
  295.     STOP
  296.  
  297.  
  298.  
  299.