1! FRQ1WY - ONE WAY FREQUENCY TABLES THIS PROGRAM IS PART OF THE "FREQ" PACKAGE 2! FREQUENCY ANALYSIS PACKAGE DEVELOPED AT: CENTRAL STATE UNIVERSITY COMPUTER CENTER EDMOND, OKLAHOMA 73034 BY: CAROL T. SUMNER DATE: AUGUST, 1979 5 CHAIN "LIB:FREQ" 10 EXTEND 20 P$="FRQ1WY" \ P%=12% ! PRINT CHANNEL NUMBER; 0 IS KEYBOARD 30 ON ERROR GOTO 9000 \ GOSUB 10000 40! DEFINE STRING CONSTANTS& FF$=CHR$(12%) ! FORM FEED& \ FRQ$=".FRQ" ! FREQUENCY EXTENSION& \ F2$="#####" ! FORMAT FOR PRINT& \ FREQ$="FREQ" \ CR$=CHR$(13%) ! CARRIAGE RETURN& \ FIL$=".FIL" \ LST$=".LST" \ LIB$="LIB:" ! LOGICAL NAME FOR SYSTEM LIBRARY& \ LF$=CHR$(10%) ! LINE FEED& \ E$="INVALID - RE-ENTER" 50 DEF FNMOD%(M%,N%)=M%-M%/N%*N% 80! CHECK RESPONSE (INVALID/YES/NO)& DEF FNA%(A$) \ A%=INSTR(1%," YN",LEFT(A$,1%)) \ A%=1% IF A%=0% \ PRINT "PLEASE ANSWER YES OR NO" IF A%=1% \ FNA%=A% \ FNEND ! CALLING ARGUMENT - A$ - STRING TO CHECK RETURNED ARGUMENT - FNA% 1 - INVALID 2 - YES 3 - NO USAGE - ON FNA%(A$) GOTO ERROR,YES,NO WHERE ERROR,YES AND NO REPRESENT STATEMENT NUMBERS 100! GET FILENAME FOR PROCESSING& INFIL$=SYS(CHR$(7%)) ! FILENAME IN CORE COMMON& \ OPEN INFIL$ FOR INPUT AS FILE 1% 110 ERRRET%=30% ! ERROR RETURN LINE 120 DIM FRQ%(100%,100%) ! FREQUENCY TABLE& \ DIM MM%(100%,2%) ! MAXIMUM/MINIMUM ARRAY 130! GET PARAMETER RECORD& GET #1%, RECORD 1% \ FIELD #1%,1% AS GMAX$, 1% AS GMIN$, 1% AS IDST$, 1% AS IDLEN$,1% AS NITEM$,2% AS N$,1% AS LRECL$ ! FIELD PARAMETER RECORD& \ GMAX%=ASCII(GMAX$) ! GLOBAL MAXIMUM& \ GMIN%=ASCII(GMIN$) ! GLOBAL MINIMUM& \ IDLEN%=ASCII(IDLEN$) ! ID LENGTH& \ NITEM%=ASCII(NITEM$) ! NUMBER OF ITEMS& \ N%=CVT$%(N$) ! NUMBER OF RESPONDENTS& \ LRECL%=ASCII(LRECL$) ! LOGICAL RECORD LENGTH& \ NREC%=512%/LRECL% ! NUMBER RECORDS PER BLOCK& \ NBLK%=N%/NREC% + 1% ! NUMBER OF BLOCK IN FILE (+ CONTROL)& \ NRLB%=FNMOD%(N%,NREC%) ! NUMBER RECORDS LAST BLOCK& \ IF NRLB% THEN NBLK%=NBLK%+1% ELSE NRLB%=NREC% ! ADJUST FOR LAST BLOCK 140 MAT FRQ%=ZER(NITEM%,GMAX%) ! ZERO ONLY PORTION TO BE USED& \ MAT MM%=ZER(NITEM%,2%) 150! TRANSFER CONTROL INFORMATION& FOR I%=1% TO NITEM% \ FIELD #1%, 12% AS D$, (I%-1%)*4% AS D$,1% AS IMAX$,1% AS IMIN$ \ MM%(I%,1%)=ASCII(IMAX$) ! ITEM MAXIMUM& \ MM%(I%,2%)=ASCII(IMIN$) ! ITEM MINIMUM& \ NEXT I% 200! GET DATA FOR ACCUMULATION& JEND%=NREC%-1% \ JSTART%=0% \ FOR I%=2% TO NBLK% ! PROCESS ALL BLOCKS& \ GET #1%, RECORD I% \ JEND%=NRLB%-1% IF I%=NBLK% \ FOR J%=JSTART% TO JEND% \ FOR ITEM%=1% TO NITEM% \ FIELD #1%, J%*LRECL% AS D$, IDLEN% AS ID$, ITEM%-1% AS D$, 1% AS DAT$ \ DAT%=ASCII(DAT$) \ FRQ%(ITEM%,DAT%)=FRQ%(ITEM%,DAT%)+1% UNLESS DAT%=255% \ NEXT ITEM% \ NEXT J% \ NEXT I% \ CLOSE 1% 250! ALL RECORDS READ AND ACCUMULATED. TABULATE AND PRINT& INPUT "DO YOU WANT MEANS AND STANDARD DEVIATIONS";A$ \ ON FNA%(A$) GO TO 250,260,300 260 MEANSTD%=-1% ! ANSWER = YES 300 PRINT "TITLE OF FREQUENCY TABLE"; \ INPUT LINE TITLE$ \ TITLE$=CVT$$(TITLE$,4%) \ TITLE$="ONE WAY FREQUENCY DISTRIBUTION" UNLESS LEN(TITLE$) ! DEFAULT TITLE& \ TITLE$=LEFT(TITLE$,65%) ! ONLY ALLOW 65 CHARACTERS IN TITLE& \ OPEN FREQ$ + LST$ FOR INPUT AS FILE P%, MODE 2% ! PRINT FILE, APPEND& \ PRINT #P%,FF$ ! ADVANCE TO TOP OF PAGE& \ PAGE%=1% ! PAGE COUNTER INITIALIZE& \ GO SUB 2000 ! PRINT NEW PAGE HEADER& \ PRINT #P% ! RETURN CARRAIGE AFTER HEADER PRINT& \ L%=L%+1% ! INCREMENT LINE COUNTER 350! PRINT FREQUENCIES& FOR ITEM%=1% TO NITEM% \ IRES%,LASTPASS%,SUM,SUMSQR=0 \ FOR J%=MM%(ITEM%,2%) TO MM%(ITEM%,1%) \ IRES%=IRES%+FRQ%(ITEM%,J%) ! ITEM RESPONDENTS& \ IF MEANSTD% THEN FRQ=FRQ%(ITEM%,J%) \ J=J% \ SUM=SUM+FRQ*J \ SUMSQR=SUMSQR+FRQ*J^2 360 NEXT J% \ IRES=IRES% \ GOTO 370 IF IRES%=0% \ IF MEANSTD% THEN MEAN=SUM/IRES \ IF IRES > 1 THEN STD=SQR((SUMSQR-SUM^2/IRES)/(IRES-1)) ELSE STD=0 370 PRINT #P%,USING "###",ITEM%; \ ST%=MM%(ITEM%,2%) \ ED%=MM%(ITEM%,1%) \ IF IRES=0 THEN GO SUB 1000 ! PRINT RANGE, ETC.& \ PRINT #P% \ GO TO 450 380! BEGIN ACTUAL PRINTING& 390 LEND%=(ST%-GMIN%)/20% * 20%+GMIN%+19% ! COMPUTE LAST VALUE ON THIS LINE& \ IF MM%(ITEM%,1%) > LEND% THEN ED%=LEND% ELSE ED%=MM%(ITEM%,1%) \ LASTPASS%=-1% 400 GO SUB 1000 ! PRINT INITIAL LINE& \ PRINT #P%,TAB(25%); \ PRINT #P%,SPACE$((ST%-(LEND%-19%))*5%); ! SKIP TO START POSITION 410 PRINT #P%,USING F2$,FRQ%(ITEM%,J%);FOR J%=ST% TO ED% \ IF LASTPASS% THEN PRINT #P%,USING " ###.## ###.##",MEAN,STD; IF MEANSTD% 420 PRINT #P% \ IF ST%=MM%(ITEM%,2%) THEN PRINT #P%,TAB(16%);"100.0";TAB(25%);SPACE$((ST%-(LEND%-19%))*5%); ELSE PRINT #P%,TAB(25%); 430 PRINT #P%,USING "###.#",FRQ%(ITEM%,J%)/IRES*100; FOR J%=ST% TO ED% \ PRINT #P% ! RETURN CARRAIGE& \ PRINT #P% ! SKIP A LINE& \ L%=L%+3% \ GO TO 450 IF LASTPASS% ! FINISHED WITH THIS ITEM& \ ST%=ED%+1% ! RESET LINE START& \ IF MM%(ITEM%,1%)-ST% >= 18% THEN ED%=ST%+18% ELSE ED%=MM%(ITEM%,1%) ! RESET LINE END& \ LASTPASS%=-1% 440 PRINT #P%,TAB(3%); \ PRINT #P%,USING " ##"+"!"+"##",ST%;"-";ED%; \ PRINT #P%,TAB(25%); \ GO TO 410 450! PAGE CONTROL& IF L% >= 55% THEN PAGE%=PAGE%+1% \ PRINT #P%,FF$ ! FORM FEED& \ LASTPASS%=0% \ GO SUB 2000 ! PRINT HEADER 460 NEXT ITEM% 470! PRINT #P%,FF$ 500! ALL QUESTIONS FINISHED& CLOSE P% \ FRQRET%=250% ! NORMAL RETURN& \ GO TO 32750 1000! SUBROUTINE TO PRINT FIRST PART OF LINE FOR ANY ITEM& PRINT #P%,USING " ##"+"!"+"##",ST%,"-",ED%; \ PRINT #P%,TAB(12%); \ PRINT #P%,USING "### ####",N%-IRES%,IRES%; \ RETURN 2000! SUBROUTINE TO REINITIALIZE A NEW PAGE& PRINT #P%,TITLE$;TAB(70%);"TOTAL RESPONDENTS: ";N%; TAB(100%);"PAGE";PAGE% \ PRINT #P%,P$+" INPUT FILE: ";INFIL$ \ PRINT #P% \ PRINT #P%,"NO. RANGE NR TOTAL";TAB(25%); \ L%=3% \ ST%=GMIN% 2010 IF GMAX%-ST% >=19% THEN ED%=ST% + 19% ELSE ED% = GMAX% \ LASTPASS%=-1% 2020 PRINT #P%,USING F2$,I%;FOR I%=ST% TO ED% \ UNTIL LASTPASS% \ PRINT #P% \ L%=L%+1% \ ST%=ED%+1% \ PRINT #P%,TAB(25%); \ GO TO 2010 \ NEXT 2030 PRINT #P%," MEAN STD"; IF MEANSTD% \ PRINT #P% \ L%=L%+1% \ RETURN 9000! ERROR ROUTINE 9010 IF ERR=28% THEN GOSUB 10000 \ CLOSE 1%,P% \ FRQRET%=ERRRET% \ RESUME 32750 ! LINE NUMBER OF 'OPTION' OR 'CLOSE' 9020 IF ERR=11 AND ERL=200 THEN CLOSE 1% \ RESUME 250 9030 IF ERR=19 THEN PRINT "FILE IN USE. TRY AGAIN LATER." \ RESUME 32750 9040 IF ERR=2 OR ERR=5 OR ERR=10 THEN PRINT "CORRUPT FILENAME" \ FRQRET%=ERRRET% \ RESUME 32750 9090 PRINT "UNEXPECTED ERROR ";ERR;" ENCOUNTERED AT ";ERL \ PRINT "PLEASE NOTIFY COMPUTER CENTER PERSONNEL" \ FRQRET%=ERRRET% \ RESUME 32750 9990 ON ERROR GOTO 0 10000! CTRL/C TRAP 10010 V$=SYS(CHR$(6%)+CHR$(-7%)) \ V$="" \ RETURN 32750 CHAIN LIB$+FREQ$ FRQRET% 32767 END