10  COM X[103,22],M[20,20],U[20,20]
20  COM Q[20],V[20]
30  COM M$[60],N$[72]
40  COM N,K,N8,K8,N9,K9,Q9,Q7,Q5,Q4,Q3,Q2,Q1
45  COM I3,I4,U9,X$[20]
46  REM HEWLETT-PACKARD 36755B, 6/74
50  REM:VERSION 23APR73
150  DIM C$[7],D$[10],A$[60],A[20]
160  FILES *
250  MAT X=ZER[N9+3,K9+2]
252  MAT Q=ZER
253  MAT M=ZER
254  MAT U=ZER
300  PRINT 
302  GOTO Q9 OF 304,312,312
304  PRINT "IDA CAN CURRENTLY STORE A MAXIMUM OF"
306  PRINT N9" OBSERVATIONS ON "K9-1" VARIABLES"
308  PRINT "IN A 'TABLE', OR MATRIX, OF "N9" ROWS AND "K9-1" COLUMNS."
310  GOTO 314
312  PRINT "CURRENT IDA DIM. ARE "N9" X "K9-1
314  PRINT 
316  GOTO Q9 OF 322,318,318
318  PRINT "FILE NAME IS  ";
320  GOTO 324
322  PRINT "NAME OF INPUT FILE IS  ";
324  INPUT C$
326  ASSIGN C$,1,Q8
328  PRINT 
330  GOSUB 3000
332  IF D$[1,1]#"N" THEN 336
334  GOTO 700
336  READ #1;N,K
338  FOR I=1 TO N
340  X[I,K9+2]=1
342  FOR J=1 TO K
344  READ #1;X[I,J]
346  GOSUB 7500
348  NEXT J
350  NEXT I
352  PRINT LIN(1);"FILE '"C$"' HAS "N" OBSERVATIONS ON "K" VARIABLES."
354  X=Z=0
356  READ A$
358  FOR J=1 TO K
360  IF U[1,J]#0 THEN 370
362  PRINT LIN(1);"BUT VARIABLE "J" IS A CONSTANT, NOT A VARIABLE,"
364  PRINT "AND WILL NOT BE ENTERED IN THE IDA DATA MATRIX."
366  X=X+1
368  GOTO 386
370  Z=Z+1
372  A[Z]=J
374  IF J<11 THEN 384
376  IF J>11 THEN 380
378  READ A$
380  N$[6*Z-65,6*Z]=A$[6*J-65,6*J]
382  GOTO 386
384  M$[6*Z-5,6*Z]=A$[6*J-5,6*J]
386  NEXT J
388  K3=K-X
390  FOR J=1 TO K
392  U[1,J]=0
394  NEXT J
395  IF X=0 THEN 398
396  GOSUB 8000
398  K=K3
400  IMAGE 2X6A," IN COLUMN",2X2D
402  PRINT LIN(1);"DATA MATRIX NOW HAS "N" OBSERVATIONS AND "K" VARIABLES."
404  PRINT "THEY ARE:"'10'13
406  FOR J=1 TO K
408  IF J<11 THEN 414
410  D$=N$[6*J-65,6*J-60]
412  GOTO 418
414  D$=M$[6*J-5,6*J]
416  PRINT  USING 400;D$,J
418  NEXT J
420  PRINT LIN(1);"WANT TO USE ALL "K" VARIABLES LISTED ABOVE  ";
422  INPUT D$
424  IF D$[1,1]#"N" THEN 581
426  PRINT 
428  GOTO Q9 OF 430,434,434
430  PRINT "HOW MANY OF THESE "K" VAR. DO YOU WANT TO USE  ";
432  GOTO 436
434  PRINT "HOW MANY OF "K" VAR.  ";
436  INPUT K3
438  MAT A=ZER[K3]
440  IF K3>0 AND K3 <= K THEN 446
442  PRINT "YOU MUST GIVE A NUMBER BETWEEN 1 AND "K". TRY AGAIN!"
444  GOTO 430
446  PRINT 
448  GOTO Q9 OF 450,456,456
450  PRINT "GIVE NUMBERS, SEPARATED BY COMMAS, OF THE IDA COLUMNS"
452  PRINT "LISTED ABOVE THAT ARE TO BE RETAINED IN THE DATA MATRIX."
454  GOTO 458
456  PRINT "GIVE "K3" NUMBERS OF COLUMNS:  ";
458  MAT  INPUT A
460  FOR I=1 TO K3-1
462  FOR J=I+1 TO K3
464  IF A[I]=A[J] THEN 486
466  IF A[I]<A[J] THEN 474
468  X=A[I]
470  A[I]=A[J]
472  A[J]=X
474  NEXT J
476  NEXT I
478  IF A[K3] <= K THEN 490
480  PRINT 
482  PRINT "!!!GIVE NUMBERS BETWEEN 1 AND "K"!!"
484  GOTO 450
486  PRINT "!!!DUPLICATE NUMBERS! TRY AGAIN."
488  GOTO 446
490  GOSUB 8000
492  FOR J=1 TO K3
494  U[2,J]=0
496  Z=A[J]
498  IF Z>10 THEN 504
500  D$=M$[6*Z-5,6*Z]
502  GOTO 506
504  D$=N$[6*Z-65,6*Z-60]
506  GOSUB 8300
508  NEXT J
510  FOR J=K3+1 TO K
512  D$="      "
514  GOSUB 8300
516  U[2,J]=0
518  NEXT J
580  K=K3
581  PRINT LIN(1);"COMPUTING..."
586  Q[1]=1
588  FOR J=1 TO K
590  GOSUB 6000
592  NEXT J
594  GOSUB 7000
596  Q4=1
598  GOTO Q9 OF 600,608,608
600  PRINT LIN(1);"EACH COLUMN WILL AUTOMATICALLY BE NAMED VAR01,VAR02,"
602  PRINT "ETC..., ACCORDING TO THE NUMBER OF THE '"C$"'VARIABLE"
604  PRINT "IN THAT COLUMN UNLESS YOU CHOOSE TO GIVE EACH VARIABLE A"
606  PRINT "NAME OF 1 TO 6 CHARACTERS."
608  PRINT LIN(1);"WANT TO SUPPLY NEW NAMES ";
610  Q3=1
612  INPUT D$
614  IF D$[1,1]="N" THEN 9997
616  I3=1
618  I4=K
620  FOR I=I3 TO I4
622  PRINT  USING 624;I
624  IMAGE #,"VAR.",XDD,X,"= "
626  INPUT D$
628  IF I>10 THEN 634
630  M$[6*I-5,6*I]=D$[1,6]
632  GOTO 636
634  N$[6*I-65,6*I-60]=D$[1,6]
636  NEXT I
638  GOTO 9997
700  GOTO Q9 OF 710,710,880
710  PRINT LIN(1);"* SAMPLE SIZE (N) = ";
720  ENTER 30,Q8,N
725  PRINT 
730  IF Q8>0 THEN 760
740  PRINT "N IS THE NUMBER OF ROWS IN DATA MATRIX"
750  GOTO 710
760  IF N <= N9 THEN 800
770  PRINT "N MUST BE LESS THAN OR EQUAL TO ",N9
780  GOTO 710
800  PRINT LIN(1);"* NO. OF VARIABLES (K) = ";
810  ENTER 30,Q8,K
815  PRINT 
820  IF Q8>0 THEN 850
830  PRINT "K IS THE NUMBER OF COLUMNS IN DATA MATRIX"
840  GOTO 800
850  IF K<K9 THEN 940
860  PRINT "K MUST BE LESS THAN ",K9
870  GOTO 800
880  PRINT "N,K = ";
890  INPUT N,K
940  GOTO 338
3000  GOTO Q9 OF 3010,3010,3040
3010  PRINT "* ARE THE FIRST TWO ELEMENTS OF YOUR DATA FILE"
3020  PRINT "  VALUES FOR N AND K (SIZE OF DATA MATRIX) TO FOLLOW? ";
3030  GOTO 3050
3040  PRINT "* N,K GIVEN IN FILE? ";
3050  ENTER 30,Q8,D$
3060  PRINT 
3070  IF Q8>0 THEN 3150
3080  PRINT "IF THE FIRST TWO ELEMENTS OF YOUR DATA FILE ARE"
3090  PRINT "VALUES FOR THE SIZE OF THE DATA MATRIX TO BE READ,"
3100  PRINT "YOU WILL NOT BE ASKED TO SPECIFY THEM.  IF YOUR "
3110  PRINT "FILE CONSISTS OF DATA ALONE, THEN YOU WILL BE PROMPTED"
3120  PRINT "FOR THE VALUES OF N AND K."
3130  GOTO 3040
3150  IF D$[1,1]="H" THEN 3080
3160  IF D$[1,1]="N" THEN 3200
3170  IF D$[1,1]="Y" THEN 3200
3180  PRINT "RESPONSE INVALID.  ANSWER 'YES' OR 'NO'."
3190  GOTO 3080
3200  RETURN 
6000  I5=0
6010  I6=X[1,J]
6020  N0=1
6030  FOR I=2 TO N
6040  I5=I5+X[I,K9+2]*(X[I,J]-I6)
6050  N0=N0+X[I,K9+2]
6060  NEXT I
6070  J5=I6+I5/N0
6080  J6=0
6090  FOR I=1 TO N
6100  IF X[I,K9+2]=0 THEN 6120
6110  J6=J6+(X[I,J]-J5)^2
6120  NEXT I
6130  X[N9+1,J]=J5
6140  X[N9+2,J]=SQR(J6/(N0-1))
6142  C=ABS((X[N9+2,J])/J5)
6144  IF C>.02 THEN 6150
6145  PRINT LIN(1);"FOR VAR."J", ABS(S.D./MEAN) IS LESS THAN .02."
6146  PRINT "FOR NUMERICAL ACCURACY YOU MAY WISH TO RECODE THE "
6147  PRINT "ORIGINAL DATA BY ADDING AN APPROPRIATE CONSTANT TO"
6148  PRINT "EACH OBSERVATION. THEN RE-ENTER. WARNING ONLY."
6150  RETURN 
7000  FOR I=1 TO K
7010  FOR J=1 TO I
7020  IF I=J THEN 7100
7030  M[I,J]=0
7040  FOR J1=1 TO N
7050  A=(X[J1,I]-X[N9+1,I])/X[N9+2,I]
7060  B=(X[J1,J]-X[N9+1,J])/X[N9+2,J]
7070  M[I,J]=M[I,J]+A*B
7080  NEXT J1
7082  M[I,J]=M[I,J]/(N-1)
7085  M[J,I]=M[I,J]
7090  GOTO 7110
7100  M[I,J]=1
7110  NEXT J
7120  NEXT I
7130  RETURN 
7500  IF U[1,J]=1 THEN 7506
7502  IF ABS(X[I,J]-X[1,J])<.001 THEN 7506
7504  U[1,J]=1
7506  RETURN 
8000  FOR I=1 TO N
8002  X[I,K9+2]=1
8004  FOR J=1 TO K
8006  U[2,J]=X[I,J]
8008  X[I,J]=0
8010  NEXT J
8012  FOR J=1 TO K3
8014  Z=A[J]
8016  X[I,J]=U[2,Z]
8018  GOSUB 7500
8020  NEXT J
8022  NEXT I
8024  RETURN 
8300  IF J>10 THEN 8306
8302  M$[6*J-5,6*J]=D$
8304  GOTO 8308
8306  N$[6*J-65,6*J-60]=D$
8308  RETURN 
9000  DATA "VAR01 VAR02 VAR03 VAR04 VAR05 VAR06 VAR07 VAR08 VAR09 VAR10"
9010  DATA "VAR11 VAR12 VAR13 VAR14 VAR15 VAR16 VAR17 VAR18 VAR19"
9997  PRINT LIN(1);"TO LIST CURRENT NAMES USE COMMAND 'NAME'."
9998  CHAIN "$IDA",150
9999  END 
