1 '*********************************************************************
3 '***********  LLL.BAS  ***********************************************
5 '*********************************************************************
6 '     NCYCLE = NUMBER OF REPEATS OF PATTERNS FOR LAST WAVE OF DATA
11 '      NPATT = NUMBER OF UNIQUE PATTERNS ACROSS WAVES
16 '      NSIZE = EQUALS NUMBER OF ONES AND INCREMENTS UNTIL NUMBER OF ITEMS
21 '              IS FILLED BY ZEROS
26 '       IEND = (NUMBER OF ITEMS X WAVES-1)
31 '    IICOMP$ = STRING OF ONES AND ZEROS ACROSS WAVES
36 '          I = NUMBER OF ONES IN LAST WAVE
41 '         II = NUMBER OF PATTERNS WITHIN EACH CYCLE OF COMMON STRINGS FOR LAST WAVE
46 '     IOLDI = SET EQUAL TO I
51 '    NCOUNT = NUMBER OF PATTERNS WITHIN EACH CYCLE OF COMMON STRINGS
56 '             AFTER THE FIRST PATTERN
61 ' NNCYCLE-1 = NUMBER OF ONES IN SECOND FROM LAST WAVE OF ITEMS
66 '    NNSIZE = SET EQUAL TO NUMBER OF ONES AND THEN INCREMENTED
71 '   IOLDITT = SET EQUAL TO NNCYCLE
76 '   NNCOUNT = ONE GREATER THAN NUMBER OF ONES IN PATTERN
81 '     NZERO = NUMBER OF ZEROS
86 ' ---------------04-03-90----------------------------------------------------
91 ' ---------------------------------------------------------------------------
96  PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
101  OPEN "I",#1,"LG.OUT":INPUT #1,HEADER$:INPUT #1,QUICK$:INPUT #1,QUICKIE$:INPUT #1,ITEMS:NSUBJ=0
106 'INPUT "WHAT FILE CONTAINS THE INPUT SETUP";INFILE$
111 'PRINT "DO YOU WHAT A QUICK OR COMPREHENSIVE ANALYSIS"
116 'PRINT "QUICK --------------->  1"
121 'PRINT "COMPREHENSIVE ------->  2"
126 'PRINT "-------------------------"
131 'INPUT "PLEASE INPUT YOUR CHOICE, 1 OR 2";QUICK$
136 'IF QUICK$<>"1" AND QUICK$<>"2" THEN:PRINT " ":PRINT " ":PRINT "PLEASE REENTER RESPONSE":GOTO 375
141  OPEN "O",#2,"OUTPUT":OPEN "O",#3,"LG2.OUT"
142  IF QUICKIE$="0" THEN GOTO 146
143  OPEN "O",#4,"CHECKSUB"
146  DIM PROP(100),IEND(900),IICOMP$(900),IONE(900),C$(100),MINREPRO(10),GUTTSCALE(10)
151  DIM RE(10),TOTRE(10),DIFFMIN(4500),XXSQUARE(10),XQUANSQ(10)
156  IIZERO=0:IIONE=0:NCOUNT=0:NNCOUNT=0:ICOUNT=0:NTIME=0:DIFF=0
161  INPUT #1,TITLE$
166  NSUBJ=NSUBJ+1
171  IF MID$(TITLE$,1,1)="-" THEN NSUBJ=NSUBJ-1:GOTO 826
176 FOR I=1 TO 80
181  IF MID$(TITLE$,I,1)="0" THEN IIZERO=IIZERO+1
186  IF MID$(TITLE$,I,1)="1" THEN IIONE=IIONE+1:PROP(I)=PROP(I)+1
191 NEXT I
196 ILENGTH=IIZERO+IIONE
201 IF NSUBJ>1 THEN GOTO 646
206 PRINT #2,"LONGITUDINAL SCALOGRAM ANALYSIS (LSA) PROGRAM (VERSION 2.1)":
211 PRINT #2,"                     BY R. D. HAYS":
216 PRINT #2,"                      RAND            ":PRINT #2," ":
218 PRINT #2,HEADER$
221 'PRINT #2,"Input File Is ";INFILE$:
226 NPATT=1
231 FOR IT=1 TO ILENGTH
236 IICOMP$(1)=IICOMP$(1)+ "0"
241 NEXT IT
246 IWAVES=INT(ILENGTH/ITEMS):PRINT "WAVES= ";IWAVES
251 NADD=1:NCYCLE=1
256 FOR I=1 TO ITEMS
261 NADD=NADD+1
266 NCYCLE=NCYCLE+NADD
271  FOR II=1 TO NCYCLE
276  NPATT=NPATT+1:NSIZE=I
281   FOR III=1 TO I
286   IICOMP$(NPATT)=IICOMP$(NPATT)+"1"
291   NEXT III
296   IF NSIZE<ITEMS THEN IICOMP$(NPATT)=IICOMP$(NPATT)+"0":NSIZE=NSIZE+1:GOTO 296
301  IF II>1 THEN GOTO 331
306  IEND=ILENGTH-ITEMS
311    FOR IIII=1 TO IEND
316    C$(IIII)="0"
321    IICOMP$(NPATT)=IICOMP$(NPATT)+C$(IIII)
326    NEXT IIII:GOTO 486
331  REM
336  IF IOLDI<>I OR II=2 THEN NCOUNT=0:NNCYCLE=2
341  IOLDI=I
346  NCOUNT=NCOUNT+1:
351  ITT=INT(NCOUNT/3+1.1)
356  NNSIZE=NNCYCLE-1
361  FOR IN=1 TO NNCYCLE-1
366  IICOMP$(NPATT)=IICOMP$(NPATT)+"1"
371  NEXT IN
376   IF NNSIZE<ITEMS THEN IICOMP$(NPATT)=IICOMP$(NPATT)+"0":NNSIZE=NNSIZE+1:GOTO 376
381 IF IOLDITT<>NNCYCLE OR II=2 THEN NNCOUNT=0
386  IOLDITT=NNCYCLE
391  NNCOUNT=NNCOUNT+1
396  NZERO=0
401 FOR INN=1 TO NNCOUNT-1
406  IICOMP$(NPATT)=IICOMP$(NPATT)+"1"
411 NEXT INN
416   IF NZERO<ITEMS+1-NNCOUNT THEN IICOMP$(NPATT)=IICOMP$(NPATT)+"0":NZERO=NZERO+1:GOTO 416
421    ICOUNT=ICOUNT+1:IF ICOUNT=NNCYCLE THEN ICOUNT=0:NNCYCLE=NNCYCLE+1
426 IF IWAVES<4 THEN GOTO 486
431 FOR INNN=1 TO NNCOUNT
436  IF INNN<NNCOUNT THEN IICOMP$(NPATT+1)=IICOMP$(NPATT)
441  NONES=INNN-1
446 FOR INNNN=1 TO NONES
451  IICOMP$(NPATT)=IICOMP$(NPATT)+"1"
456 NEXT INNNN
461 FOR III=1 TO ITEMS-INNNN+1
463 PRINT "NPATT=",NPATT
466  IICOMP$(NPATT)=IICOMP$(NPATT)+"0"
471 NEXT III
476 IF INNN<NNCOUNT THEN NPATT=NPATT+1
481 NEXT INNN
486   NEXT II
491 NEXT I
496 NTIME=0
501 IF NSUBJ>1 THEN GOTO 646
506 FOR IT=1 TO NPATT
511  IONE(IT)=0
516   FOR I=1 TO ILENGTH
521    IF MID$(IICOMP$(IT),I,1)="1" THEN IONE(IT)=IONE(IT)+1
526   NEXT I
531   NEXT IT
536 S=0
541 WHILE S=0
546 S=1
551 FOR I=1 TO NPATT-1
556 IF IONE(I)<=IONE(I+1) THEN GOTO 581
561   T=IONE(I):T2$=IICOMP$(I)
566   IONE(I)=IONE(I+1):IICOMP$(I)=IICOMP$(I+1)
571   IONE(I+1)=T:IICOMP$(I+1)=T2$
576   S=0
581  NEXT I
586 WEND
646 INTIME=0:DIFFTOT=0
651 FOR IT=1 TO NPATT
656  DIFF=0
661  IF IONE(IT)<>IIONE THEN GOTO 711
666     INTIME=1
671     FOR I=1 TO ILENGTH
676       IF MID$(IICOMP$(IT),I,1)<>MID$(TITLE$,I,1) THEN DIFF=DIFF+1
681     NEXT I
686     NTIME=NTIME+1
691  IF NTIME=1 THEN DIFFMIN=DIFF
696  IF DIFF>DIFFMAX THEN DIFFMAX=DIFF
701  IF DIFF<DIFFMIN THEN DIFFMIN=DIFF
706  DIFFTOT=DIFFTOT+DIFF:GOTO 716
711  IF INTIME=1 THEN GOTO 721
716 NEXT IT
721 AVG=DIFFTOT/NTIME
726 TOTMAX=TOTMAX+DIFFMAX:TOTMIN=TOTMIN+DIFFMIN:TOTAVG=TOTAVG+AVG
731 DIFFMIN(NSUBJ)=DIFFMIN:IF DIFFMIN=0 THEN NPERF=NPERF+1
735 XSQUARE=(ILENGTH-DIFFMIN(NSUBJ))/ILENGTH
736 XSQUARED=XSQUARED+(XSQUARE*XSQUARE)
738 QUANSQ=QUANSQ+XSQUARE
741 IF QUICK$="1" THEN GOSUB 1176
746 IF NSUBJ=1 THEN PRINT "SUBJECT NUMBER=  "
751 PRINT TAB(15);NSUBJ;:IC=0:
756 FOR JIT=1 TO ILENGTH STEP ITEMS
761  IC=IC+1:CV=0:SUM=0:RE(IC)=0:IF IC>IWAVES THEN GOTO 156
766  TEMPGUTT$=MID$(TITLE$,JIT,ITEMS)
771  FOR J=1 TO ITEMS
776   IF MID$(TEMPGUTT$,J,1)="1" THEN SUM=SUM+1
781  NEXT J
786  FOR JJ=1 TO ITEMS
791   IF JJ<SUM+1 AND MID$(TEMPGUTT$,JJ,1)="0" THEN CV=CV+1
796   IF JJ>=SUM+1 AND MID$(TEMPGUTT$,JJ,1)="1" THEN CV=CV+1
801  NEXT JJ
806  RE(IC)=RE(IC)+(1-(CV/ITEMS))
811  TOTRE(IC)=TOTRE(IC)+RE(IC)
813 XXSQUARE(IC)=XXSQUARE(IC)+RE(IC)*RE(IC)
815 XQUANSQ(IC)=XQUANSQ(IC)+RE(IC)
816 NEXT JIT
821 GOTO 156
826 IF QUICKIE$="0" THEN GOTO 828
827 PRINT #4,USING "#####";NSUBJ
828 GUTTMIN=(NSUBJ*ILENGTH-TOTMAX)/(NSUBJ*ILENGTH):GUTTMAX=(NSUBJ*ILENGTH-TOTMIN)/(NSUBJ*ILENGTH)
831 GUTTAVG=(NSUBJ*ILENGTH-TOTAVG)/(NSUBJ*ILENGTH)
836 ILAST=1
841 FOR II=1 TO IWAVES
846  FOR I=ILAST TO ITEMS*II
851  PROP(I)=PROP(I)/NSUBJ:IF I=1 THEN PRINT #2," ":PRINT #2,"ITEM   PROPORTION PASSING":PRINT #2,"-----------------------------------":PRINT #2,USING "Wave = ##";IWAVES-II+1
856 INPUT #1,LABEL$
861  PRINT #2,USING"###           #.##     &";I-ITEMS*(II-1),PROP(I),LABEL$:IF PROP(I)<.5 THEN PROP(I)=1-PROP(I)
866  MINREPRO(II)=MINREPRO(II)+PROP(I):MINREPR=MINREPR+PROP(I)
871  NEXT I
876  ILAST=ILAST+ITEMS
881  PRINT #2,"------------------------------------":IF II<IWAVES THEN PRINT #2,USING "Wave = ##";IWAVES-II:
886 NEXT II
891 MINREPR=MINREPR/ILENGTH
896 FOR I=1 TO IWAVES
901   MINREPRO(I)=MINREPRO(I)/ITEMS
906 NEXT I
908 IF MINREPR<1 THEN GOTO 912:SCALMIN=0:SCALMAX=0:SCALAVG=0
909 PRINT #2," ":PRINT #2,"WARNING: LONGITUDINAL MINIMUM MARGINAL REPRODUCIBILITY = 1.00"
910 PRINT #2,"                 COEFFICIENT OF SCALABILITY SET EQUAL TO 0.00"
911 PRINT #2," ":ION=1:GOTO 926
912 SCALMIN=(GUTTMIN-MINREPR)/(1-MINREPR):SCALMAX=(GUTTMAX-MINREPR)/(1-MINREPR)
916 SCALAVG=(GUTTAVG-MINREPR)/(1-MINREPR)
921 IF SCALMIN<0 THEN SCALMIN=0:IF SCALMAX<0 THEN SCALMAX=0:IF SCALAVG<0 THEN SCALAVG=0
926 PERMIN=GUTTMIN-MINREPR:PERMAX=GUTTMAX-MINREPR:PERAVG=GUTTAVG-MINREPR
931 PRINT #2," ":PRINT #2,USING "NUMBER OF SUBJECTS                   =######";NSUBJ:
936 PRINT #2," "
941 PRINT #2,"           LONGITUDINAL SCALOGRAM ANALYSIS":PRINT #2," ":
942 PRINT #2,"                                             95% Confidence Interval":
946 PRINT #2,"--------------------------------------------------------------------":
948 SGUTTMA=(1+GUTTMAX)*(1-GUTTMAX)/(NSUBJ*ITEMS*IWAVES):SGUTTMA=SQR(SGUTTMA):SGUTTM=SGUTTMA*2
951 IF QUICK$="1" THEN PRINT #2,USING "COEFFICIENT OF REPRODUCIBILITY (MAX) = #.####                     ";GUTTMA:GOTO 956
952 GOTO 971
956 IF ION=1 THEN PRINT #2,"COEFFICIENT OF SCALABILITY     (MAX) = 0.000":GOTO 971
958 PRINT #2,USING "COEFFICIENT OF SCALABILITY     (MAX) = #.####";(GUTTMA-MINREPR)/(1-MINREPR)
971 PRINT #2,"--------------------------------------------":
974 SGUTTMA=(1+GUTTMAX)*(1-GUTTMAX)/(NSUBJ*ITEMS*IWAVES):SGUTTM=SQR(SGUTTMA)*2
975 SEECR=(XSQUARED-(QUANSQ*QUANSQ)/NSUBJ)/(NSUBJ-1):SEECR=SQR(SEECR)/SQR(NSUBJ):SEE=SEECR*2
976 PRINT #2,USING "COEFFICIENT OF REPRODUCIBILITY (LCR) = #.####   (#.#### -> #.####)";GUTTMAX,GUTTMAX-SEE,GUTTMAX+SEE
978 PRINT #2,USING "ESTIMATED STANDARD ERROR OF LCR      = #.####                     ";SGUTTM/2:
980 PRINT #2,USING "ACTUAL STANDARD ERROR OF LCR         = #.####                     ";SEECR
981 PRINT #2,USING "MINIMUM MARGINAL REPRODUCIBILITY     = #.####";MINREPR:
986 PRINT #2,USING "PERCENT IMPROVEMENT                  = #.####";PERMAX:
991 PRINT #2,USING "COEFFICIENT OF SCALABILITY           = #.####";SCALMAX:
993 PRINT #2,USING "PROPORTION PERFECT GUTTMAN PATTERNS  = #.####";NPERF/NSUBJ:
996 PRINT #2,"--------------------------------------------":
1001 PRINT #2," ":PRINT #2,"          CROSS-SECTIONAL SCALOGRAM ANALYSIS":
1006 FOR III=1 TO IWAVES
1011  TOTRE(III)=TOTRE(III)/NSUBJ
1012 IF MINREPRO(III)<1 THEN GOTO 1016:GUTTSCALE(III)=0
1013 PRINT #2," ":PRINT #2,"WARNING: MINIMUM MARGINAL REPRODUCIBILITY = 1.00"
1014 PRINT #2,"    COEFFICIENT OF SCALABILITY SET EQUAL TO 0.00"
1015 PRINT #2," ":GOTO 1031
1016 GUTTSCALE(III)=(TOTRE(III)-MINREPRO(III))/(1-MINREPRO(III))
1021 PRINT #2," ":
1026 IF GUTTSCALE(III)<0 THEN GUTTSCALE(III)=0
1029 SGUTTMA=(1+TOTRE(III))*(1-TOTRE(III))/(NSUBJ*ITEMS):SGUTTM=SQR(SGUTTMA)*2
1030 SEECR=(XXSQUARE(III)-(XQUANSQ(III)*XQUANSQ(III))/NSUBJ)/(NSUBJ-1):SEECR=SQR(SEECR)/SQR(NSUBJ):SEE=SEECR*2
1031 PRINT #2,USING "COEFFICIENT OF REPRODUCIBILITY WAVE # = #.####   (#.#### -> #.####)";IWAVES+1-III,TOTRE(III),TOTRE(III)-SEE,TOTRE(III)+SEE
1033 PRINT #2,USING "ESTIMATED STANDARD ERROR OF CR        = #.####                     ";SGUTTM/2:
1035 PRINT #2,USING "ACTUAL STANDARD ERROR OF CR           = #.####                     ";SEECR
1036 PRINT #2,USING "MINIMUM MARGINAL REPRODUCIBILITY      = #.####";MINREPRO(III):
1041 PRINT #2,USING "PERCENT IMPROVEMENT                   = #.####";TOTRE(III)-MINREPRO(III):
1046 PRINT #2,USING "COEFFICIENT OF SCALABILITY            = #.####";GUTTSCALE(III):
1051 NEXT III
1056 PRINT #2,"---------------------------------------------":
1066 PRINT #3,"LONGITUDINAL SCALOGRAM ANALYSIS (LSA) PROGRAM (VERSION 2.1)":
1071 PRINT #3,"                     BY R. D. HAYS":
1076 PRINT #3,"                      RAND            ":PRINT #3," "
1077 PRINT #3,HEADER$:PRINT #3," ":ILINES=6
1081  PRINT #3, "PERFECT LONGITUDINAL PATTERNS FOR GIVEN NUMBER OF ITEMS AND WAVES":ILINES=ILINES+1
1086  PRINT #3, "  ":ILINES=ILINES+1
1091  PRINT #3, "N PASSED  SEQUENCE      PATTERN  ":PRINT #3,"_______________________________":ILINES=ILINES+3
1096  FOR I=1 TO NPATT
1101   IF ILINES<61 THEN GOTO 1111
1103  PRINT #3,""
1106  PRINT #3,"N PASSED  SEQUENCE      PATTERN  ":PRINT #3,"_______________________________":ILINES=2
1111  PRINT #3," ":ILINES=ILINES+1
1116   PRINT #3,USING "####        ###  ";IONE(I),I;
1121    FOR IT=1 TO ILENGTH STEP ITEMS
1126     PRINT #3,MID$(IICOMP$(I),IT,ITEMS);" ";
1131    NEXT IT
1136  NEXT I
1146 GOSUB 1261
1147 PRINT #3," ":PRINT #3," ":PRINT #3,"Hays, R. D., & Ellickson, P. L.  (1990).  Longitudinal scalogram"
1148 PRINT #3,"   analysis:  A methodology and microcomputer program for Guttman"
1149 PRINT #3,"   scale analysis of longitudinal data.  Behavior Research Methods,"
1150 PRINT #3,"   Instruments & Computers, 22, 162-166."
1151 CLOSE
1156 SYSTEM
1161 END
1166 '*************************************
1171 '*************************************
1176 'SUBROUTINE TO COMPARE ALL PATTERNS
1181 DIFFTO=0:NTIM=0
1186 FOR IT=1 TO NPATT
1191  DIF=0
1196     FOR I=1 TO ILENGTH
1201       IF MID$(IICOMP$(IT),I,1)<>MID$(TITLE$,I,1) THEN DIF=DIF+1
1206     NEXT I
1211     NTIM=NTIM+1
1216  IF NTIM=1 THEN DIFFMI=DIF
1221  IF DIF>DIFFMA THEN DIFFMA=DIF
1226  IF DIF<DIFFMI THEN DIFFMI=DIF
1231  DIFFTO=DIFFTO+DIF:GOTO 1236
1236 NEXT IT
1241 AV=DIFFTO/NTIM
1246 TOTMI=TOTMI+DIFFMI:
1251 GUTTMA=(NSUBJ*ILENGTH-TOTMI)/(NSUBJ*ILENGTH)
1256 RETURN
1261 '*************************************
1266 'SUBROUTINE TO COMPUTE FREQUENCY OF SCALING ERRORS
1271  S=0
1276  WHILE S=0
1281  S=1
1286  FOR I=1 TO NSUBJ-1
1291    IF DIFFMIN(I)<=DIFFMIN(I+1) THEN GOTO 1316
1296    T=DIFFMIN(I)
1301    DIFFMIN(I)=DIFFMIN(I+1)
1306    DIFFMIN(I+1)=T
1311    S=0
1316  NEXT I
1321  WEND
1326  PRINT #2," ":PRINT #2," ":PRINT #2,"FREQUENCY OF SCALING ERRORS":PRINT #2," "
1331  FOR I=1 TO NSUBJ
1336  IF I>1 AND DIFFMIN(I)=DIFFMIN(I-1) THEN GOTO 1356
1341  NNN=0
1346  IF I>1 THEN PRINT #2,USING " (####";RTN;:PRINT #2,")":RTN=0
1351  PRINT #2,USING " #### ";DIFFMIN(I);
1356  PRINT #2,"*";:NNN=NNN+1:RTN=RTN+1
1361  IF NNN>69 THEN PRINT #2," ":PRINT #2,"     ";:NNN=0
1366  NEXT I
1371  PRINT #2,USING " (####";RTN;:PRINT #2,")"
1376  PRINT #2," "
1381  RETURN
1386 '*************************************