1 ! ! F R E Q 10 ! No copyright 20 ! The original version submitted to DECUS July, 1978 Written by Dr. John S. Abma, Professor of Psychology and Coordinator of Academic Computing, Wittenberg University, Springfield, Ohio, 45501 100 ! FREQ provides elementary statistical analysis of one variable. Descripton is available in program FREQ.RNO Major advantage is that FREQ permits grouping the data by any size interval of the user's choice. All statistics are then reported correctly for that interval. 400 ! VARIABLES ARE DEFINED AS; D% DUMMY VARIABLE IN SORT, PERCENTILE, PERCENTILE-RANK AND HISTORGRAM SUBROUTINES. D0% DUMMY VARIABLE IN PERCENTILE SUBROUTINE. D1% FREQUENCY-WITHIN-INTERVAL IN PERCENTILE AND PERCENTILE-RANK SUBROUTINES. F$ PRINT-USING STRING F% FREQUENCY, USED IN PERCENTILE-RANK SUBROUTINE F%() NUMBER (FREQUENCY) OF VALUES IN ANY INTERVAL 405 ! I FLOATING-POINT VERSION OF INTERVAL SIZE. I% INTERVAL SIZE I1% USER OPTION VARIABLE 410 ! J% TRUNCATED RESULT OF DIVIDING SCORE OR PERCENT BY I% (USED IN CONSTRUCTING HISTOGRAM) K% MULTIPLIES ENTRIES BY 1, 10 OR 100, TO MAKE ALL INTEGERS. K1 RECIPROCAL OF K% K1% MARKER INDICATING IF MORE THAN 1000 INTERVALS COULD BE CREATED. L1 LOWER LIMIT OF INTERVAL; ALSO, SWITCH TO END SORTING OF SCORES WHEN COMPLETED L2 UPPER REAL LIMIT OF HIGHEST CLASS IN FREQUENCY TABLE, PERCENTILE AND PERCENTILE-RANK SUBROUTINES. M MEAN FOR GROUPED DATA M1 MEAN FOR UNGROUPED DATA N FLOATING-POINT VERSION OF N% N% NUMBER OF VALUES ENTERED N1% NUMBER OF INTERVALS IN FREQUENCY DISTRIBUTION AND HISTOGRAM N2% NUMBER OF TIED SCORES IN PREPARING TABLE O$ VARIOUS USER OPTIONS O1$ OTHER USER OPTIONS P PERCENTILE REQUESTED BY USER P1 PERCENTILE REPORTED BY PROGRAM R PERCENTILE-RANK REPORTED BY PROGRAM 420 ! S% AN INDIVIDUAL ENTRY S1 STANDARD DEVIATION FOR GROUPED DATA; ALSO, SUM OF RANKS IN PRINTING TABLE S2 NUMBER OF CLASSES SKIPPED FOR TIED SCORES IN FREQUENCY TABLE. S3 STANDARD DEVIATION FOR UNGROUPED DATA T TOTAL OF SCORE VALUES FOR GROUPED DATA T1 TOTAL OF SQUARED SCORE VALUES FOR GROUPED DATA T2 TOTAL OF SCORE VALUES FOR UNGROUPED DATA T3 TOTAL OF SQUARED SCORE VALUES FOR UNGROUPED DATA X PERCENTILE-RANK REQUESTED BY USER X() INPUT STUDENT GRADE X1() A SAVED VERSION OF X() TO ENABLE CORRECTIONS Y SWAP LOWER SCORE FOR HIGHER IN SORTING SCORES Z Z-SCORES 900 DIM F%(999%), X(201%), X1(201%) ! These dimensions are somewhat arbitrary, could be changed. They handle 200 entries, with range of 1000. 1000 PRINT \PRINT ' WELCOME TO F R E Q GIVES ANALYSIS OF ONE VARIABLE.' \ PRINT ' TAKES up to 200 WHOLE or DECIMAL values FROM 0 TO 900' 1010 F$='###.##' ! ***** USER INPUTS *********************************************************** 1020 ON ERROR GOTO 19000 1030 PRINT \PRINT 'Want preliminary instructions? (Recommend YES if first time)'; \ INPUT O$ \ GOSUB 12000 IF LEFT(O$,1%)='Y' 1040 PRINT \INPUT'HOW MANY VALUES will you be ENTERING';N% \ IF 2%>N% OR N%>200% THEN PRINT 'ENTER A WHOLE NUMBER FROM 2 TO 200' \ GOTO 1040 ! Avoid division by 0 and too many entries. 1050 PRINT 'ENTRY'; \ FOR S%=1% TO N% \ PRINT '#';S%;'='; 1060 INPUT'';X(S%) \ IF X(S%)<0% OR X(S%)>900 THEN PRINT 'ENTER VALUES FROM 0 TO 900' \ GOTO 1060 ! Reject values too small or too large. 1070 GOTO 1100 IF X(S%)*100%==INT(X(S%)*100%+.000001) \ PRINT \PRINT 'Enter values to 2 places only' \ GOTO 1060 1100 X1(S%)=X(S%) \ NEXT S% ! Lets in the right kind of data. 1120 PRINT \INPUT'WANT TO CORRECT AN ENTRY';O1$ \ GOTO 1180 UNLESS LEFT(O1$,1%)='Y' ! Terminates entry routine if no corrections or changes. 1130 PRINT \PRINT 'Your entries were' \ FOR S%=1% TO N% \ PRINT '#';S%;'=';X1(S%), \ NEXT S% ! Presents all entries, with entry number, in wide format, (all across the screen or page. 1140 INPUT'CHANGE ENTRY #';S% \ IF S%<1% OR S%>N% THEN PRINT 'NO SUCH SCORE; ENTER NUMBER FROM 1 TO'N% \ GOTO 1140 ! Rejects changing of entries that don't exist. 1150 PRINT '#'S%; \ INPUT'SHOULD BE';X(S%) \ IF X(S%)<0% OR X(S%)>900 THEN PRINT 'ENTER SCORES FROM 0 TO 900' \ GOTO 1150 ! Rejects values outside of permissible range. 1152 GOTO 1160 IF X(S%)*100%==INT(X(S%)*100%+.000001) \ PRINT 'Enter value to 2 places only' \ GOTO 1150 1160 X1(S%)=X(S%) \ GOTO 1120 UNLESS O$='C' ! Goes back for another correction unless the change routine was entered from a later user option. ! ***** SORT SCORES ************************************************************ 1180 GOSUB 10350 \ I%=0% \ RETURN IF O$='C' OR O$='E' ! Sorting subroutine. Sets grouping interval size to 0 initially. Returns for other options if this line is reached by C or E options. ! ***** User Options *********************************************************** 1190 PRINT FNC$;'Now, TYPE A SINGLE LETTER for an option;' \ PRINT \PRINT 'H = Help (Recommended if FIRST TIME using program)' \ PRINT \PRINT 'T = Table of Entered Values' \ PRINT 'F = Frequency Distribution' \ PRINT 'S = Statistical analysis' \ PRINT 'P = Percentiles' \ PRINT 'R = %-tile RANKS' \ PRINT 'G = histo Gram' \ PRINT 'Z = Z-Scores' \ PRINT 'C = Change an entry' \ PRINT 'E = Enter all new data' \ PRINT 'X = eXit from program' ! Clears the screen, then presents the menu. 1200 PRINT \PRINT '**** OPTIONS;' \ PRINT ' H = T = F = S = P = R = G = Z = C = E = X =' 1210 INPUT' Help Table FrqDist Stat %-tile %-Rank hstGrm Zscore Change Enter eXit';O$ \ I1%=0% \ GOTO 1215 IF O$='' \ I1%=INSTR(1%,'HTFSPRGZCEX',O$) \ ON I1% GOSUB 11000,10700,10000,10500,10600,10400,10800,10900,1130,1040,32600 IF I1% 1215 PRINT 'Please type one of the letters shown' UNLESS I1% \ GOTO 1200 ! Rejects any input (including null) not found among options. ! ***** FREQUENCY DISTRIBUTION ************************************************* 10000 F%(J%)=0% FOR J%=0% TO 999% ! Zero the array the holds the integer portion of values after dividing by interval size. 10010 X(S%)=X1(S%) FOR S%=1% TO N% \ K%=1% \ GOTO 10030 ! Updates entry values. Sets data multiplier to 1 10020 X(S%)=X1(S%) FOR S%=1% TO N% \ K%=10%*K% ! Updates entry values again, Sets data multiplier to 10 times its previous value. (K% will be either 1 or 10 or 100). 10030 FOR S%=1% TO N% \ X(S%)=X(S%)*K% \ GOTO 10035 IF X(S%)==INT(X(S%)+.000001) \ GOTO 10020 10035 NEXT S% ! All data are now integers, even if entered as tenths or hundredths. 10040 RETURN IF LEFT(O$,1%)='H' ! This is all that's needed for the HELP options. 10045 IF I%=0% THEN IF O$='Z' OR O$='P' OR O$='R' THEN I%=1% \ GOTO 10060 ! Make the grouping interval 1 for the Z-SCORE, PERCENTILE and PERCENTILE-RANK options, because we don't care how many intervals these options have (under 1000). 10050 I%=((X(1%)-X(N%))/9.1)+1% IF I%=0% \ I%=1% IF I%=0% ! Calculates an interval size that gives about 10 intervals for the Frequency Distribution and Histogram displays, initially. Guarantees an I of at least one. 10060 FOR S%=1% TO N% 10070 IF INT((X(S%)+.5)/I%)>998% THEN K1%=1% \ I%=I%+1% \ GOTO 10070 ! Guarantees that I will be big enough to avoid more than a thousand intervals, which would be slow running in some options. 10080 J%=(X(S%)+.5)/I% \ F%(J%)=F%(J%)+1% \ NEXT S% ! Groups the data 10090 Y=INT(X(N%)) \ Y=Y-1% UNTIL Y/I%=INT(Y/I%) ! Finds a value for a lower apparent limit which is an even multiple of the interval size. 10100 L1=Y \ N1%=0% \ FOR L1=L1 TO X(1%)+.00001 STEP I% \ N1%=N1%+1% \ NEXT L1 ! Finds the lower apparent limit of the highest interval. 10110 L2=L1+I%-.5 \ RETURN IF O$='R' OR O$='P' ! Finds the lower apparent limit of the highest interval. This is all that's needed for the PERCENTILE-RANK and PERCENTILES. 10120 GOTO 10160 IF O$='S' OR O$='Z' ! Skip the following headings for the STATISTICS and Z-SCORES. 10130 PRINT FNC$;'***** FREQUENCY DISTRIBUTION'; IF O$='F' \ PRINT FNC$;'***** HISTOGRAM'; IF O$='G' \ PRINT ' With'N1%' Intervals' \ IF N1%>25% THEN PRINT \PRINT N1%-25%'too many intervals, (25 is maximum).' \ PRINT 'Recommend interval size of'; \ K1=1/K% \ PRINT INT(((L2-Y)/25%)+.5)/K%+K1; \ PRINT ' or larger' \ GOTO 10210 ! Prints headings, also reports how many intervals. Will abort the Frequency Distribution and Histogram if there are more than 25 intervals. 10140 RETURN IF O$='G' ! This is all that's needed for the HistoGram option. 10150 PRINT \PRINT ' CLASS MP f cf c%' \PRINT ' ------------- ---- - -- ------' ! Prints headings for the Frequency Distribution. 10160 N=N% \ T,T1=0% ! A floating-point version of N% is needed. Zero counters for sums. 10170 FOR J%=(X(1%)+.000001)/I% TO 0% STEP-1% \ N=N-F%(J%+1%) \ GOTO 10210 IF N=0% \ GOTO 10180 IF O$<>'F' \ PRINT USING F$,L1/K%; \ PRINT ' -'; \ PRINT USING F$,(L1+I%-1%)/K%; \ PRINT ' '; \ PRINT USING F$,(L1-.5+.5*I%)/K%; \ PRINT ' '; \ PRINT USING'##',F%(J%); \ PRINT ' '; \ PRINT USING'###',N; \ PRINT ' '; \ PRINT USING F$,N/N%*100%; \ PRINT ' ' 10180 T=T+(L1-.5+.5*I%)*F%(J%) \ T1=T1+(L1-.5+.5*I%)^2*F%(J%) \ L1=L1-I% \ NEXT J% ! The frequency distribution includes apparent limits, mid-points, frequency within each class, cumulative frequency and cumulative percents. Also, sums are accumulated for grouped statistics. 10210 M=T/N%/K% \ S1=(SQR(T1*N%-T^2%)/N%)/K% ! Mean (M) and Standard Deviation (S1) for grouped data. 10212 RETURN IF O$='S' OR O$='Z' ! This is all for the STATISTICS and Z-SCORE options. 10215 GOSUB 13000 \ GOTO 10000 IF LEFT(O1$,1%)='Y' \ RETURN ! Permit change of interval size, give another frequency distribution for the new size; else, go back to option selection. ! ***** SUBROUTINE; SORT SCORES IN DESCENDING ORDER **************************** 10350 FOR D%=1% TO N%-1% \ D1%=0% \ FOR S%=1% TO N%-1% \ GOTO 10360 IF X1(S%)>=X1(S%+1%) \ D1%=1% \ Y=X1(S%) \ X1(S%)=X1(S%+1%) \ X1(S%+1%)=Y 10360 NEXT S% \ GOTO 10362 UNLESS D1% \ NEXT D% ! All done if flag (L1%) stays 0 10362 T3,T2=0% ! Zero accummulators for sum (T2) and sum of squares (T3). 10365 FOR S%=1% TO N% \ T2=T2+X1(S%) \ T3=T3+X1(S%)^2 \ NEXT S% ! Get sum (T2) and sum of squares (T3) for ungrouped data. 10370 M1=T2/N% \ S3=SQR(T3/N%-M1^2) ! Mean (M1) and Standard Deviation (S3) for ungrouped data. 10380 RETURN 10400 ! ***** SUBROUTINE; COMPUTE PERCENTILE-RANKS ********************* 10402 GOSUB 10000 \ PRINT \INPUT'***** %-tile RANK for WHAT SCORE';X \ X=X*K% ! Get grouping info from 10000 K% makes integer out of X 10410 S%=1% \ D%,D1%=0% ! Start with highest entry. Zero dummies. 10415 IF X>L2 THEN R=100% \ GOTO 10470 ! We know the answer if X is above the upper real limit. 10420 IF X'Y' \ INPUT'What %-tile';P \ IF P<0% OR 100%

P/100%*N% \ NEXT L2 10680 D%=D%-F%(J%+1%) \ D1%=F%(J%+1%) \ P1=L2-(P/100%*N%-D%)/D1%*I% 10690 RETURN ! ***** TABLE OF ENTERED VALUES ************************************************ 10700 PRINT \PRINT FNC$;'***** TABLE OF ENTERED VALUES' \ PRINT \PRINT \PRINT 'SCORE'TAB(8%)'FREQ'TAB(14%)'% OF MAX'TAB(24%)'RANK'TAB(32%)'Z-SCORE' \ PRINT '------'TAB(8%)'----'TAB(15%)'------'TAB(24%)'----'TAB(32%)'-------' ! Set up headings for table 10710 N2%=1% \ X1(N%+1%)=-1% \ FOR S%=1% TO N% \ IF X1(S%)=X1(S%+1%) THEN N2%=N2%+1% \S2=S2+S%\ GOTO 10760 10720 PRINT X1(S%); \ PRINT TAB(8% ); \ PRINT USING '###', N2%; \ PRINT TAB(16%); \ PRINT USING '###', 100%*X1(S%)/X1(1%); \ IF S2=0% THEN S2=S% ELSE S2=S2+S% 10730 PRINT TAB(23%); \ PRINT USING '###.#', S2/N2%; \ IF S3=0% THEN PRINT ' NO Z-SCORE (DIVISION BY 0)' \ GOTO 10750 10740 PRINT TAB(33%); \ PRINT USING F$, (X1(S%)-M1)/S3; 10750 PRINT \ N2%=1% \ S2=0% 10760 NEXT S% ! Gives the entered values in descending order of magnitude, also, the frequency in case of identical entries, the percentage each entry is of the highest entry and the Z-scores. 10770 PRINT \PRINT 'N ='N%' Mean ='M1' Standard Deviation ='S3 ! Also, gives Mean and Standard Deviation for UNGROUPED DATA. 10780 RETURN 10799 ! ! ***** HISTOGRAM ****************************************************** ! 10800 GOSUB 10000 \ RETURN IF N1%>25% 10810 F%(J%)=0% FOR J%=0% TO 999% \ FOR S%=N% TO 1% STEP-1% \ J%=X(S%)/I% \ F%(J%)=F%(J%)+1% \ NEXT S% ! Zero array to hold grouped data. Then, group the data, using interval size I going from low to high. 10820 N1%=X(1%)/I% \ L1,D%=0% ! The number of intervals (N1) is the highest score (X(1)) divided by the interval size (I). Also, set lower limit (L1) to zero, and zero a flag (D). 10830 PRINT \PRINT ' frequency' \ PRINT ' ---------------------' 10840 PRINT ' MP 0 5 10 15 20' \ PRINT ' ---- ----+----+----+----+-' ! Draw the picture. If the histogram is held on its side, it is a frequency polygon. (This histogram is really a bar-chart). 10850 FOR J%=0% TO N1% \ GOTO 10860 IF D% OR F%(J%) \ L1=L1+I% \ GOTO 10880 ! Keep adding interval size (I%) to lower limit until we reach an existing lower limit for these data. 10860 PRINT \PRINT USINGF$,(L1-.5+.5*I%)/K%; \ PRINT ' |'; ! Print the mid-points, not limits. Then print a little vertical line. 10870 FOR D%=1% TO F%(J%) \ PRINT 'X'; \ NEXT D% \ L1=L1+I% ! Print an X for every score in that interval, then increment to the next limit (L1). 10880 NEXT J% \ PRINT 10890 GOSUB 13000 \ GOTO 10800 IF LEFT(O1$,1%)='Y' \ RETURN ! User may change grouping interval, see again. Else get options. 10899 ! ! ***** Z-SCORES ******************************************************* ! 10900 PRINT \PRINT '***** Representative Z-scores are;' \ PRINT \PRINT TAB(5%)'Z-score'TAB(14%)'Raw score' \ PRINT TAB(5%)'-------'TAB(14%)'---------' \ PRINT \FOR Z=-3% TO 3% STEP .5 \ GOSUB 10000 \ PRINT TAB(6%);Z;TAB(14%); \ PRINT USING'####.##',M+S1*Z \ NEXT Z ! Provides Z-scores from -3 to +3, each half-unit (.5) 10905 PRINT \INPUT'Want to enter a different Z-score';O1$ \ GOTO 10930 UNLESS LEFT(O1$,1%)='Y' 10915 PRINT \INPUT'What Z-score';Z \ IF Z<-6% OR 6%X OR X>900 THEN PRINT 'Enter score from 0 to 900' \ GOTO 10935 ! Raw scores must be within acceptable range 10940 GOSUB 10000 \ PRINT \PRINT 'Z-score is'; \ PRINT USING'###.##',(X-M)/S1 \ GOTO 10930 ! Get grouping info from 10000, print Z-score, ask for more 10955 GOSUB 13000 \ GOTO 10900 IF LEFT(O1$,1%)='Y' \ RETURN ! Report on interval size, ask for change, give new options 10999 ! ! ***** HELP MESSAGES ******************************************** ! 11000 GOSUB 10000 ! Get grouping info for some of the help messages 11005 PRINT \PRINT 'Next, type in the LETTER for the OPTION you want HELP with.' \ INPUT O$ \ I1%=0% \ GOTO 11007 IF O$='' \ I1%=INSTR(1%,'TFSPRGZCEX',O$) \ IF I1% THEN PRINT FNC$ \ ON I1% GOTO 11010,11020,11030,11040,11050,11060,11070,11080, 11090,11100 11007 PRINT 'Type one of the letters indicated' \ GOTO 11005 11010 PRINT 'T = TABLE OF VALUES ENTERED' \ PRINT \PRINT '1. A table is constructed, with values listed in descending order.' \ PRINT ' Tied scores are not repeated. Instead, the frequency of occurrence is given' \ PRINT ' for each score.' 11012 PRINT \PRINT '2. Next, the frequency column is given, "f"' \ PRINT \PRINT '3. The PERCENT OF MAXIMUM column gives the % each score is of' \ PRINT ' of highest score entered. This can be useful in assigning' \ PRINT ' grades or other performance ratings.' \ PRINT \PRINT '4. The RANK is reported for each score, with the MEAN RANK' \ PRINT ' assigned in case of tied ranks.' \ PRINT \PRINT '5. Finally, the Z-score (Standard Score) is given. This is;' \ PRINT ' the DISTANCE FROM THE MEAN, DIVIDED BY THE STANDARD DEVIATION.' \ PRINT ' The Z-scores in this table assume UNGROUPED DATA, (Or, a' \ PRINT ' grouping interval of'1/K%',which yields the same result,' \ PRINT ' for the data you have entered.' 11014 RETURN 11020 PRINT 'F = FREQUENCY DISTRIBUTION' \ PRINT \PRINT '1. A Frequency table with these columns is provided;' \ PRINT ' CLASS, with apparent limits; midpoints; "f" (Frequency);' \ PRINT ' "cf" (Cumulative Frequency; and "c%" (Cumulative Percent)' \ PRINT \PRINT '2. An initial grouping interval is chosen which yields a ' \ PRINT ' maximum of 10 intervals.' \ PRINT \PRINT '3. Then you can select any interval size, and the grouped ' \ PRINT ' frequency distribution will be printed, based on that interval size.' \ PRINT \PRINT '4. For UNGROUPED DISTRIBUTION, you can select an interval ' \ PRINT ' size of'1/K%'at any time, for the data you have entered.' \ PRINT \PRINT '5. A maximum of 25 intervals will be printed, so the table may ' \ PRINT ' not appear sometimes. Nevertheless, the interval size selected will be ' \ PRINT ' retained for the NEXT OPTION.' 11025 RETURN 11030 PRINT 'S = STATISTICS: The statistics provided are;' \ PRINT \PRINT ' 1. NUMBER of cases, SUM of entered values,' \ PRINT ' SUM of squared values, and the SUM-of-entered-values SQUARED.' \PRINT \PRINT ' 2. The MEAN, and statistics based on the mean.' \ PRINT \PRINT ' 3. The MEDIAN, and statistics based on the median.' \ PRINT \PRINT ' 4. The VARIANCE AND STANDARD DEVIATION.' \ PRINT \PRINT 'Some of these statistics will VARY with different grouping intervals.' \ PRINT 'An interval size of'1/K%'will yield the results for UNGROUPED DATA,' \ PRINT 'for the data you have entered.' 11035 RETURN 11040 PRINT 'P = PERCENTILE' \ PRINT \PRINT ' A percentile, (or %-tile), is a SCORE VALUE that EXCEEDS A' \ PRINT ' SPECIFIED PERCENT of all the scores.' 11044 PRINT \PRINT ' Examples: The 90th %-tile would exceed 90% of the cases.' \ PRINT ' The 75th %-tile would exceed 75% of the cases.' \ PRINT ' The 50th %-tile would exceed HALF of the cases.' \ PRINT ' The 5th %-tile exceeds only 5% of the cases.' 11046 PRINT \PRINT ' Some representative %-tiles are first given.' \ PRINT \PRINT ' When called for, YOU type in the PERCENT TO BE EXCEEDED, and' \ PRINT ' the PROGRAM will give the SCORE VALUE.' 11047 PRINT \PRINT ' Percentiles will VARY with different GROUPING INTERVALS.' \ PRINT ' Select an interval size of'1/K%'to get percentiles for UNGROUPED DATA,' \ PRINT ' for the values you have entered.' 11049 RETURN 11050 PRINT \PRINT 'R = Percentile-RANK' \ PRINT \PRINT ' A Percentile-RANK, (%-Rank), is the PERCENT OF SCORES' \ PRINT ' EXCEEDED by a SPECIFIED SCORE. YOU specify the SCORE, and' \ PRINT ' the PROGRAM returns the % of SCORES EXCEEDED BY that score.' 11052 PRINT \PRINT ' Examples: If the specified score is HIGHER than ANY score value' \ PRINT ' entered, then the %-RANK is 100.' \ PRINT \PRINT ' If the score is BELOW ALL entered values, the %-RANK is 0.' \ PRINT \PRINT ' If the score is exactly in the middle, its %-RANK is 50,' \ PRINT ' (the MEDIAN).' 11054 PRINT \PRINT ' (Percentile-RANKS may VARY with different GROUPING INTERVALS.' \ PRINT ' An interval size of'1/K%'will give results for UNGROUPED DATA,' \ PRINT ' for the values you have entered).' 11059 RETURN 11060 PRINT 'G = Histo-GRAM' \ PRINT \PRINT ' A histogram is a bar-chart showing HOW MANY score values fall' \ PRINT ' within each GROUPING INTERVAL.' \ PRINT \PRINT ' Usually, the histogram is presented VERTICALLY, but in this' \ PRINT ' program, it is given with HORIZONTAL BARS.' \ PRINT \PRINT ' If a PRINTING TERMINAL is used, the paper may be held with the' \ PRINT ' LEFT EDGE AT THE BOTTOM, and the usual, vertical figure is seen.' \ PRINT \PRINT ' Note that the MIDPOINTS are given in ASCENDING order. When viewed from' \ PRINT ' the edge, the MIDPOINTS THEN INCREASE FROM LEFT-to-RIGHT.' 11062 PRINT \PRINT ' A maximum of 25 intervals is allowed. If a small interval size is' \ PRINT ' chosen, the histogram may not be printed.' \ PRINT \PRINT ' (NEVERTHELESS, the interval size WILL BE RETAINED for the next options,' \ PRINT ' UNTIL YOU enter a DIFFERENT INTERVAL SIZE.)' 11069 RETURN 11070 PRINT 'Z = Z-SCORE, ("Standard score")' \ PRINT \PRINT ' A Z-score is the DEVIATION of a SCORE FROM THE MEAN, divided by' \ PRINT ' the STANDARD DEVIATION. (It is sometimes referred to as a' \ PRINT ' "STANDARD DEVIATE".' \ PRINT \PRINT ' Representative Z-scores are listed, then you can request others.' \ PRINT ' Next, you can enter a RAW SCORE, and the PROGRAM RETURNS THE Z-score.' \ PRINT \PRINT ' With Z-scores it is possible to compare performance on tests or' \ PRINT ' measures having DIFFERENT MEANS AND DIFFERENT VARIABILITY,' \ PRINT ' (Standard deviations).' 11075 PRINT \PRINT ' Since MEANS and STANDARD DEVIATIONS are affected by "ERRORS OF' \ PRINT ' GROUPING", Z-score also may VARY with different GROUPING INTERVALS.' \ PRINT ' An interval size of'1/K%'will give Z-scores for UNGROUPED DATA,' \ PRINT ' for the data you have entered' 11079 RETURN 11080 PRINT 'C = CHANGE an entry' \ PRINT \PRINT ' 1. The SCORES you FIRST ENTERED will be DISPLAYED, with an identifying' \ PRINT ' number.' \ PRINT \PRINT ' 2. To CHANGE a SCORE, type in the NUMBER of the SCORE, followed' \ PRINT ' by the NEW SCORE VALUE.' 11082 PRINT \PRINT ' 3. The purpose of this OPTION is to SEE THE EFFECT on VARIOUS' \ PRINT ' STATISTICS of changing ONE OR SEVERAL score values.' \ PRINT \PRINT ' 4. For example, the EFFECT ON THE RANGE may be very great, while' \ PRINT ' the STANDARD DEVIATION may be affected very little.' \ PRINT \PRINT ' 5. To change MORE than ONE VALUE, simply USE THE "C" OPTION' \ PRINT ' repeatedly.' 11089 RETURN 11090 PRINT 'E = ENTER all new data' \ PRINT \PRINT ' If you have FINISHED your analysis, and have A DIFFERENT SET' \ PRINT ' of DATA TO ANALYZE, use this option.' \ PRINT \PRINT ' Your old data WILL NOT be saved. THIS OPTION LOOSES the original data.' 11099 RETURN 11100 PRINT 'X = EXIT from the program' \ PRINT \PRINT ' When FINISHED, use OPTION "X"' \ PRINT \PRINT ' Before leaving the terminal, BE SURE TO type "BYEF"' \ PRINT ' This will free the terminal for the next user.' \ PRINT \PRINT ' Your DATA IS NOT SAVED by this program. It is LOST when you' \ PRINT ' EXIT the program.' \ PRINT \PRINT ' Be sure you have all the analysis you want, then use"X"' 11900 RETURN 11999 ! ***** SUBROUTINE; INITIAL INSTRUCTION ********************************** 12000 PRINT FNC$;'***** Initial INSTRUCTIONS' \ PRINT \PRINT ' 1. YOU WILL BE ASKED FOR THE NUMBER OF SCORES OR VALUES TO ENTER.' \ PRINT \PRINT ' 2. THEN, TYPE IN EACH VALUE, USING THE "RETURN" KEY AFTER EACH ENTRY.' \ PRINT \PRINT ' The numbers may be entered in any order.' \ PRINT \PRINT ' Leading or trailing "0"s need not be entered.' \ PRINT \PRINT ' Numbers may be WHOLE or DECIMAL values, to two places.' \ PRINT \PRINT ' (YOU WILL HAVE A CHANCE TO CORRECT ANY ERRORS AFTER ALL' \ PRINT ' VALUES HAVE BEEN ENTERED)' 12005 PRINT \PRINT ' 3. This program can be run on either the VIDEO or PRINTING' \ PRINT ' terminals. IF YOU NEED A COPY of the results, USE A PRINTING' \ PRINT ' TERMINAL.' 12007 PRINT \PRINT ' 4. When asked a question, type Y or YES for affirmative.' \ PRINT ' Any other response, including RETURN is considered "NO"' 12010 RETURN ! ***** INTERVAL SIZE ********************************************************* 13000 I=I% \ IF 1/K%=I/K% THEN PRINT \PRINT '********** This is for UNGROUPED DATA'; \ PRINT '(Interval size ='; I/K%;')' \ GOTO 13007 ! Report heading for ungrouped data 13005 PRINT \PRINT '********** For GROUPED DATA with INTERVAL SIZE ='I/K% 13007 PRINT IF K1% \ PRINT '(Smallest INTERVAL SIZE is'I/K%'for these data)' IF K1% \ K1%=0% ! K1% is a switch showing that ungrouped data will result in too many intervals. 13010 PRINT \INPUT' Want NEW INTERVAL SIZE? **********';O1$ \ RETURN UNLESS LEFT(O1$,1%)='Y' 13020 PRINT \INPUT'WHAT SIZE INTERVAL';I \ IF I<1/K% OR I>100% THEN PRINT 'Enter INTERVAL SIZE BETWEEN';1/K%;'and 100' \ GOTO 13020 ! Makes sure new interval size is legal 13050 I%=K%*I \ RETURN 14999 ! ! ***** FUNCTION ****************************************************** ! 15000 DEF FNC$ \ PRINT CHR$(155%)+'H'; \ PRINT CHR$(155%)+'J'; \ FNEND 18999 ! ***** ERROR ROUTINES *************************************************** 19000 IF ERR=50 THEN PRINT 'ENTER A WHOLE NUMBER ONLY' IF ERL=1040 OR ERL=1140 OR ERL=10800 \ RESUME IF ERL=1040 OR ERL=1140 OR ERL=10800 19010 IF ERR=50 THEN PRINT 'ENTER A NUMBER, NOT A LETTER OR OTHER SYMBOL' \ RESUME 19040 IF ERR=11 THEN PRINT \PRINT ' DO NOT USE THE CTRL-Z COMMAND' \ RESUME 19050 IF ERR=28 THEN PRINT \PRINT ' YOU USED THE CTRL-C COMMAND DURING AN ERROR HANDLING ROUTINE. TRY AGAIN LATER.' \ RESUME 19060 IF ERR=52 THEN PRINT \PRINT 'ENTER VALUES MORE CAREFULLY' \ RESUME 19990 ON ERROR GOTO 0 32600 ! ***** SIGN-OFF MESSAGE ************************************************* 32620 PRINT \PRINT \PRINT "(Don't forget to type BYEF before you leave.)" 32767 END