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
734 PRINT #3,USING "#### #.######## ";NSUBJ,(ILENGTH-DIFFMIN(NSUBJ))/ILENGTH;
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)
812 PRINT #3,USING "#.######## ";RE(IC);
813 XXSQUARE(IC)=XXSQUARE(IC)+RE(IC)*RE(IC)
815 XQUANSQ(IC)=XQUANSQ(IC)+RE(IC)
816 NEXT JIT
818 PRINT #3," "
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 '*************************************
