100  REM SAP - SURVEY ANALYSIS PROGRAM
102  REM  SAP,  HP 36843A, 2/74
105  REM COPYRIGHT 1972,1973 - STATE UNIVERSITY OF NEW YORK
110  REM DEVELOPED BY D. KLASSEN
115  REM PROGRAMMED BY S. HOLLANDER 
120  REM LATEST REVISION: 7-30-73
125  DEF FNA()=INT(10*+.5)/10
130  DEF FNB()=INT(R/10^(C0-)-INT(R/10^(C0-+1))*10)
135  DEF FNE()=SGN(SGN(9-)+SGN(-W))-ABS(SGN(-INT()))
140  DIM P[10,10]
150  PRINT 
155  PRINT " ","SURVEY ANALYSIS PROGRAM"
160  PRINT 
161  REM V2: FORMAT TYPEOUT-LINES UP DECPOINT-C.S. V2=0 
162  LET V2=1
165  REM V:COLUMN WIDTH-C.S.USE <=5 IF CR/LF OCCURS PREMATURELY 
170  LET V=6
175  REM W: LOWER LIMIT FOR SUBSCRIPTS-CERTAIN SYSTEMS USE 1 HERE 
180  LET W=1
181  PRINT "HOW MANY VARIABLES";
182  INPUT C0
185  RESTORE 
190  PRINT 
200  PRINT "OPTION ";
205  INPUT L
210  PRINT 
215  IF L=0 THEN 200
216  IF L=6 THEN 2000
220  IF INT(L) <> L THEN 200
225  IF ABS(L)>5 THEN 200
230  IF L=-1 THEN 315
235  IF L <> 1 THEN 440
240  PRINT "VARIABLE";
245  INPUT C
250  LET A=0
255  GOSUB 1440
280  READ R
285  IF R<0 THEN 315
290  LET Z=FNB(C)
295  IF Z>0 THEN 305
300  IF W=1 THEN 280
305  LET P[1,Z]=P[1,Z]+1
310  GOTO 280
315  LET M=C
320  GOSUB 1270
325  PRINT "RANGE OF VAR. ";C;
330  INPUT C2,C1
331  IF FNE(C2)+FNE(C1)<2 THEN 325
335  PRINT 
340  LET T=0
345  LET N=0
350  PRINT "VALUE  NO."
355  FOR Z=C2 TO C1
360  LET N=N+P[1,Z]
365  LET T=T+(Z+1)*P[1,Z]
370  PRINT "   ";Z;P[1,Z]
375  NEXT Z
380  PRINT "TOTAL ";N
385  PRINT 
390  IF N=0 THEN 655
395  LET M=T/N-1
400  PRINT "MEAN = ";FNA(M)
405  LET R=0
410  FOR Z=C2 TO C1
415  LET R=R+(Z-M)^2*P[1,Z]
420  NEXT Z
425  PRINT "S.D. = ";FNA(SQR(R/N))
430  PRINT 
435  GOTO 185
440  IF L<0 THEN 525
445  PRINT "VARIABLES ";
450  INPUT A,C
455  GOSUB 1440
480  READ R
485  IF R<0 THEN 525
490  LET Z=FNB(A)
495  LET R=FNB(C)
500  IF Z<W THEN 480
505  IF R<W THEN 480
515  LET P[Z,R]=P[Z,R]+1
520  GOTO 480
525  LET M=A
530  GOSUB 1270
535  LET M=C
540  GOSUB 1270
545  FOR Z=W TO 10
550  LET P[Z,10]=0
555  LET P[10,Z]=0
560  NEXT Z
565  PRINT "RANGE OF VAR. ";A;
570  INPUT A2,A1
571  IF FNE(A2)+FNE(A1)<2 THEN 565
572  LET M1=0
575  PRINT "RANGE OF VAR. ";C;
580  INPUT C2,C1
581  IF FNE(C2)+FNE(C1)<2 THEN 575
585  PRINT 
586  LET M2=0
590  PRINT 
595  PRINT 
600  LET L=ABS(L)
605  LET T=0
610  FOR Z=A2 TO A1
615  FOR Z1=C2 TO C1
620  LET M=P[Z,Z1]
625  LET P[Z,10]=P[Z,10]+M
630  LET P[10,Z1]=P[10,Z1]+M
635  LET T=T+M
640  NEXT Z1
645  NEXT Z
650  IF T>0 THEN 665
655  PRINT "ALL ZEROS"
660  GOTO 185
665  IF L=5 THEN 705
670  PRINT "OBSERVED FREQUENCIES ";
675  IF L=3 THEN 695
680  IF L<4 THEN 710
685  PRINT "BY COLUMN PERCENTAGES";
690  GOTO 710
695  PRINT "BY ROW PERCENTAGES";
700  GOTO 710
705  PRINT "EXPECTED FREQUENCIES";
710  PRINT 
715  PRINT "(ROW: VAR. ";A;", COLUMN: VAR. ";C;")"
720  PRINT 
725  PRINT 
730  LET R=12+(C1-C2)*V
735  FOR Z=C2 TO C1
740  PRINT TAB(5+(Z-C2)*V);Z;
745  NEXT Z
750  IF L=4 THEN 760
755  PRINT TAB(R-2);"TOTALS";
760  PRINT 
765  PRINT 
770  PRINT 
775  FOR Z=A2 TO A1
780  PRINT Z;
782  LET M1=M1+P[Z,10]*(Z+1)
785  FOR Z1=C2 TO C1
790  IF L=2 THEN 815
795  IF L=3 THEN 830
800  IF L=4 THEN 850
805  LET X=FNA(P[Z,10]*P[10,Z1]/T)
810  GOTO 820
815  LET X=P[Z,Z1]
820  LET M=P[Z,10]
825  GOTO 875
830  IF P[Z,10]=0 THEN 865
835  LET X=FNA(100*P[Z,Z1]/P[Z,10])
840  LET M=100
845  GOTO 875
850  IF P[10,Z1]=0 THEN 865
855  LET X=FNA(100*P[Z,Z1]/P[10,Z1])
860  GOTO 875
865  LET X=0
870  LET M=0
875  GOSUB 1215
880  NEXT Z1
885  LET X=M
890  LET N=R
900  GOSUB 1220
905  PRINT 
910  PRINT 
915  NEXT Z
920  IF L=3 THEN 995
925  PRINT "TOTALS"
930  PRINT 
935  FOR Z1=C2 TO C1
936  LET M2=M2+P[10,Z1]*(Z1+1)
940  IF L=4 THEN 955
945  LET X=P[10,Z1]
950  GOTO 960
955  LET X=100
960  GOSUB 1215
965  NEXT Z1
970  IF L=4 THEN 990
975  LET X=T
980  LET N=R
985  GOSUB 1220
990  PRINT 
995  PRINT 
1000  IF L <> 2 THEN 185
1005  LET H=0
1010  FOR Z=A2 TO A1
1015  FOR X=C2 TO C1
1020  LET E=P[Z,10]*P[10,X]/T
1025  IF E=0 THEN 1035
1030  LET H=H+(P[Z,X]-E)^2/E
1035  NEXT X
1040  NEXT Z
1045  PRINT "CHI SQUARE= ";FNA(H);" DF= ";FNA((A1-A2)*(C1-C2))
1050  PRINT "CALCULATE GAMMA(1=YES, 0=NO)";
1055  INPUT Z
1060  IF Z <> 1 THEN 185
1065  LET S=0
1070  FOR Z=A2 TO A1-1
1075  FOR Z1=C2 TO C1-1
1080  LET S1=0
1085  FOR X=Z+1 TO A1
1090  FOR X1=Z1+1 TO C1
1095  LET S1=S1+P[X,X1]
1100  NEXT X1
1105  NEXT X
1110  LET S=S+P[Z,Z1]*S1
1115  NEXT Z1
1120  NEXT Z
1125  LET N=0
1130  FOR Z=A2 TO A1-1
1135  FOR Z1=C2+1 TO C1
1140  LET R=0
1145  FOR X=Z+1 TO A1
1150  FOR X1=C2 TO Z1-1
1155  LET R=R+P[X,X1]
1160  NEXT X1
1165  NEXT X
1170  LET N=N+P[Z,Z1]*R
1175  NEXT Z1
1180  NEXT Z
1185  IF S+N=0 THEN 1200
1190  PRINT "GAMMA = ";INT(100*(S-N)/(S+N)+.5)*.01
1195  GOTO 1205
1200  PRINT "GAMMA = 0"
1205  PRINT 
1210  GOTO 185
1215  LET N=5+(Z1-C2)*V
1220  IF X=0 THEN 1260
1225  IF X >= 1 THEN 1240
1230  LET N=N+V2
1235  GOTO 1260
1240  IF X<10 THEN 1260
1245  LET N=N-1
1250  IF X<100 THEN 1260
1255  LET N=N-1
1260  PRINT TAB(N);X;
1265  RETURN 
1270  PRINT "NUMBER OF VALUES TO BE RECODED FOR VARIABLE ";M;
1275  INPUT N
1280  IF N=0 THEN 1415
1285  IF FNE(N)<1 THEN 1270
1290  PRINT "RECODED NEW VALUE";
1295  INPUT R
1300  IF FNE(R)<1 THEN 1290
1305  FOR Z=W TO 10
1310  LET P[Z,10]=0
1315  NEXT Z
1320  FOR Z1=1 TO N
1325  PRINT TAB(8);"OLD VALUE";
1330  INPUT X
1331  IF FNE(X)<1 THEN 1325
1335  FOR Z=W TO 9
1340  IF M=A THEN 1360
1345  LET P[Z,10]=P[Z,10]+P[Z,X]
1350  LET P[Z,X]=0
1355  GOTO 1370
1360  LET P[Z,10]=P[Z,10]+P[X,Z]
1365  LET P[X,Z]=0
1370  NEXT Z
1375  NEXT Z1
1380  FOR Z=W TO 9
1385  IF M=A THEN 1400
1390  LET P[Z,R]=P[Z,10]
1395  GOTO 1405
1400  LET P[R,Z]=P[Z,10]
1404  DATA 212,211,211,211,211
1405  NEXT Z
1410  GOTO 1270
1415  PRINT 
1420  RETURN 
1430  PRINT "BAD RESPONDENT DATA, RESPONDENT ";N
1435  STOP 
1440  FOR Z=W TO 10
1441  FOR Z1=W TO 10
1450  LET P[Z,Z1]=0
1455  NEXT Z1
1460  NEXT Z
1465  RETURN 
1500  DATA 111,111,112,111,111
1501  DATA 111,112,111,122,122
1502  DATA 122,122,122,121,122
1503  DATA 122,121,121,122,122
1505  DATA 211,212,211,211,212
1506  DATA 221,221,222,221,221
1507  DATA 222,222,222,222,222
1508  DATA 311,311,311,311,311
1509  DATA 311,312,312,312,312
1510  DATA 311,311,321,321,322
1511  DATA 322,322,322,322,322
1512  DATA 411,411,411,411,412
1513  DATA 411,411,411,411,422
1514  DATA 422,422,422,422,422
1515  DATA 421,421,421,421,421
1516  DATA 422,422,422,411,211
1517  DATA 222,211,212,111,111
1518  DATA 122,112,311,312,321
1519  DATA 321
1995  DATA -1
2000  END 
