Regression

Date: 198x
Type: Program
Platform(s): TS 1000

This program performs multiple linear regression using matrix operations implemented entirely in BASIC. It accepts user input for observations and independent variables, then computes regression coefficients by solving the normal equations via the formula (X’X)⁻¹X’Y, relying on subroutines at lines 7300 (matrix multiplication) and 7500 (matrix inversion). The matrix inversion routine at line 7500 uses Gauss-Jordan elimination with partial pivoting and detects singular matrices by setting an error string E$. A utility routine starting at line 9000 uses direct PEEK and POKE operations on the system’s program area—reading the D_FILE system variable at address 16396/16397 and walking the BASIC line-length bytes—to delete a range of program lines from memory, allowing optional removal of unused subroutines to free RAM.

Program Analysis

Program Structure

The program is divided into four logical blocks:

  1. Lines 1000–1900: Main routine — data entry, matrix setup, computation of regression coefficients, and display of results.
  2. Lines 7000–7665: Matrix operation subroutine library (scalar multiply, add/subtract, multiply, transpose, inversion).
  3. Lines 8000–8010: SAVE utility.
  4. Lines 9000–9210: Self-modifying line-deletion utility using PEEK/POKE on the BASIC program area.

Regression Algorithm

The program computes ordinary least-squares regression coefficients using the normal equation solution β = (X'X)⁻¹ X'Y. The implementation proceeds in steps:

  1. Build design matrix X(NOB, NV+1) with the first column fixed to 1 (for the intercept).
  2. Compute X'Y by calling the matrix multiplication subroutine (line 7300) with the transpose of X and Y. The result is stored in T(NV+1, 1).
  3. Compute X'X by multiplying transposed X by X, storing the result in A(NV+1, NV+1).
  4. Invert X'X via GOSUB 7500 (Gauss-Jordan elimination).
  5. Multiply the inverse by X'Y (GOSUB 7300) to obtain the coefficient vector C.

Lines 1830–1860 print both actual and predicted values (rounded to two decimal places using INT(P*100+.5)/100), but no residuals, R², or other statistics are computed.

Matrix Subroutine Library (7000-block)

LineOperationInputsOutput
7100Scalar multiplicationSCALAR, A, ROWA, COLAC = SCALAR * A
7200Matrix add/subtractA, B, ROWA, COLA, SIGNC = A ± B
7300Matrix multiplicationA, B, ROWA, COLA, COLBC = A * B
7400Matrix transpositionA, ROWA, COLAC = A'
7500Matrix inversionA, ROWAC = A⁻¹

Note that subroutines 7100, 7200, and 7400 are defined and documented but never called by the main regression routine — they are included as a general-purpose library.

Matrix Inversion (Gauss-Jordan, line 7500)

The inversion routine implements Gauss-Jordan elimination with partial pivoting. It initializes C as the identity matrix (lines 7505–7520), then for each pivot column searches downward for a non-zero element. If none is found the matrix is singular and E$ is set to "SINGULAR MATRIX" before returning. Row swaps are applied simultaneously to both A and C (lines 7555–7590). Each pivot row is normalized by dividing by A(J,J), and all other rows are reduced. The variable E$ is initialized to an empty string at line 7502 but is never checked by the calling code — any singular-matrix condition would silently return an incorrect result.

Transposition Approach

Rather than calling the transposition subroutine at line 7400, the main code manually constructs the transpose of X into array A at lines 1220–1290. This avoids an extra array copy but means the transposition subroutine is unused by the main algorithm. Similarly, B is populated with a copy of Y at lines 1320–1350 and later with a copy of X at lines 1430–1480, reflecting how the subroutines communicate through global arrays.

Notable Techniques

  • Global array passing convention: All subroutines communicate via globally named arrays A, B, C, and dimension variables ROWA, COLA, COLB. Arrays must be re-dimensioned before each subroutine call.
  • Rounding display: Predicted values are rounded to two decimal places using the idiom INT(P*100+.5)/100 at line 1850.
  • Input validation: After each observation is entered, the user is asked “CORRECT?” and the observation is re-entered if the first character of the response is not “Y” (line 1180), using substring indexing A$(1).
  • Matrix multiplication bug: The multiplication loop at lines 7320–7380 accumulates into C(I,J) without initializing it to zero first. Because C is freshly DIMmed at line 7310, its elements are zero-initialized, so this works correctly on the first call. However, if the same C array were reused without re-dimensioning, results would be incorrect.

Line-Deletion Utility (9000-block)

Lines 9000–9210 implement a self-modifying routine that deletes a range of BASIC lines by directly manipulating the program’s byte representation in memory. It reads the D_FILE system variable from addresses 16396–16397 to find the end of the program, then walks the program line by line using the two-byte line-length field at offset 2–3 of each line header. Once the byte positions of the first and last lines to delete are found, it overwrites the length bytes of the first retained line to span over the deleted block, effectively compressing them out of the program. This is a sophisticated and risky technique, as any miscalculation could corrupt the program or system variables.

The intended purpose is to allow the user to delete unused subroutines (e.g., 7100, 7200, 7400) to reclaim RAM after loading the program on a memory-constrained system.

Content

Appears On

Related Products

Related Articles

Related Content

Image Gallery

Source Code

 1000 CLS 
 1010 PRINT "NUMBER OF OBSERVATIONS=";
 1020 INPUT NOB
 1030 PRINT NOB
 1040 PRINT "NO. INDEP. VARIABLES  =";
 1050 INPUT NV
 1060 PRINT NV
 1070 PRINT 
 1080 DIM X(NOB,NV+1)
 1085 DIM Y(NOB,1)
 1090 FOR I=1 TO NOB
 1095 LET X(I,1)=1
 1097 CLS 
 1100 PRINT ,,"OBSERVATION ",I,,,
 1102 PRINT "  DEP. VAR. = ",
 1103 INPUT Y(I,1)
 1104 PRINT Y(I,1)
 1105 FOR J=2 TO NV+1
 1110 PRINT "      VAR ";J;" = ",
 1120 INPUT X(I,J)
 1130 PRINT X(I,J)
 1140 NEXT J
 1150 PRINT 
 1160 PRINT "CORRECT?"
 1170 INPUT A$
 1180 IF A$(1)<>"Y" THEN GOTO 1097
 1190 NEXT I
 1200 REM %T%R%A%N%S%O%S%E% %X
 1220 LET ROWA=NV+1
 1225 LET COLA=NOB
 1230 DIM A(ROWA,COLA)
 1240 FOR I=1 TO COLA
 1250 FOR J=1 TO ROWA
 1260 LET A(J,I)=X(I,J)
 1280 NEXT J
 1290 NEXT I
 1300 LET ROWB=NOB
 1310 LET COLB=1
 1320 DIM B(ROWB,COLB)
 1330 FOR I=1 TO ROWB
 1340 LET B(I,1)=Y(I,1)
 1350 NEXT I
 1360 GOSUB 7300
 1370 DIM T(NV+1,1)
 1380 FOR I=1 TO NV+1
 1390 LET T(I,1)=C(I,1)
 1400 NEXT I
 1410 LET ROWB=NOB
 1420 LET COLB=NV+1
 1430 DIM B(ROWB,COLB)
 1440 FOR I=1 TO ROWB
 1450 FOR J=1 TO COLB
 1460 LET B(I,J)=X(I,J)
 1470 NEXT J
 1480 NEXT I
 1490 GOSUB 7300
 1500 DIM A(NV+1,NV+1)
 1510 LET ROWA=NV+1
 1520 LET COLA=NV+1
 1530 FOR I=1 TO ROWA
 1540 FOR J=1 TO COLA
 1550 LET A(I,J)=C(I,J)
 1560 NEXT J
 1570 NEXT I
 1580 LET ROWB=NV+1
 1590 LET COLB=1
 1600 DIM B(ROWB,COLB)
 1610 FOR I=1 TO ROWB
 1630 LET B(I,1)=T(I,1)
 1640 NEXT I
 1650 GOSUB 7500
 1660 FOR I=1 TO ROWA
 1670 FOR J=1 TO COLA
 1680 LET A(I,J)=C(I,J)
 1690 NEXT J
 1700 NEXT I
 1710 GOSUB 7300
 1800 FOR I=1 TO NV+1
 1810 PRINT I,C(I,1)
 1820 NEXT I
 1830 FOR I=1 TO NOB
 1832 LET P=0
 1835 FOR J=1 TO NV+1
 1840 LET P=P+C(J,1)*X(I,J)
 1845 NEXT J
 1850 PRINT Y(I,1),INT (P*100+.5)/100
 1860 NEXT I
 1900 STOP 
 7000 REM %T%H%E% %S%U%B%R%O%U%T%I%N%E%S% %I%N% %T%H%E% %7%0%0%0% %B%L%O%C%K% %O%F% %T%H%I%S% %P%R%O%G%R%A%M% %A%R%E% %T%H%E% %M%A%T%R%I%X% %O%P%E%R%A%T%I%O%N%S%.% %7%1%0%0% %=% %S%C%A%L%A%R% %M%U%L%T%I%P%L%I%C%A%T%I%O%N%,% %7%2%0%0% %=% %M%A%T%R%I%X% %A%D%D%I%T%I%O%N% %A%N%D% %S%U%B%T%R%A%C%T%I%O%N%,% %7%3%0%0% %=% %M%A%T%R%I%X% %M%U%L%T%I%P%L%I%C%A%T%I%O%N%,% %7%4%0%0% %=% %M%A%T%R%I%X% %T%R%A%N%S%P%O%S%I%T%I%O%N%,% %7%5%0%0% %=% %M%A%T%R%I%X% %I%N%V%E%R%S%I%O%N%.
 7100 REM %S%C%A%L%A%R% %M%U%L%T%I%P%L%I%C%A%T%I%O%N%:%I%N%P%U%T%S%:% %S%C%A%L%A%R%,% %A% %(%M%A%T%R%I%X%)%,% %R%O%W%A%,% %C%O%L%A%.% %O%U%T%P%U%T%:% %C% %(%M%A%T%R%I%X%)% %W%H%E%R%E% %C%=%S%C%A%L%A%R%*%A
 7110 DIM C(ROWA,COLA)
 7120 FOR I=1 TO ROWA
 7130 FOR J=1 TO COLA
 7140 LET C(I,J)=SCALAR*A(I,J)
 7150 NEXT J
 7160 NEXT I
 7170 RETURN 
 7200 REM %M%A%T%R%I%X% %A%D%D%I%T%I%O%N% %A%N%D% %S%U%B%T%R%A%C%T%I%O%N%.% %I%N%P%U%T%S%:% %A% %(%M%A%T%R%I%X%)%,% %B% %(%M%A%T%R%I%X%)%,% %R%O%W%A%,% %C%O%L%A%,% %S%I%G%N% %(%+%1% %F%O%R% %A%D%D%,% %-%1% %F%O%R% %S%U%B%T%.%)%.% %O%U%T%P%U%T%S%:% %C% %(%M%A%T%R%I%X%)% %W%H%E%R%E% %C%=%A%+% %O%R% %-%B%.
 7210 DIM C(ROWA,COLA)
 7220 FOR I=1 TO ROWA
 7230 FOR J=1 TO COLA
 7240 LET C(I,J)=A(I,J)+SIGN*B(I,J)
 7250 NEXT J
 7260 NEXT I
 7270 RETURN 
 7300 REM %M%A%T%R%I%X% %M%U%L%T%I%P%L%I%C%A%T%I%O%N%.% %I%N%P%U%T%S% %A% %(%M%A%T%R%I%X%)%,% %B% %(%M%A%T%R%I%X%)%,% %R%O%W%A%,% %C%O%L%A%,% %C%O%L%B%.% %O%U%T%P%U%T%S%:% %C% %(%M%A%T%R%I%X%)% %W%H%E%R%E% %C%=%A%*%B%.
 7310 DIM C(ROWA,COLB)
 7320 FOR I=1 TO ROWA
 7330 FOR J=1 TO COLB
 7340 FOR K=1 TO COLA
 7350 LET C(I,J)=C(I,J)+A(I,K)*B(K,J)
 7360 NEXT K
 7370 NEXT J
 7380 NEXT I
 7390 RETURN 
 7400 REM %M%A%T%R%I%X% %T%R%A%N%S%P%O%S%I%T%I%O%N%.% %I%N%P%U%T%S%:% %A% %(%M%A%T%R%I%X%)%,% %R%O%W%A%,% %C%O%L%A%.% %O%U%T%P%U%T%S%:% %C% %(%M%A%T%R%I%X%)% %W%H%E%R%E% %C%=%A%"%.
 7410 DIM C(ROWA,COLA)
 7420 FOR I=1 TO ROWA
 7430 FOR J=1 TO COLA
 7440 LET C(I,J)=A(J,I)
 7450 NEXT J
 7460 NEXT I
 7470 RETURN 
 7500 REM %M%A%T%R%I%X% %I%N%V%E%R%S%I%O%N%.% %I%N%P%U%T%S%:% %A% %(%M%A%T%R%I%X%)%,% %R%O%W%A%.% %O%U%T%P%U%T%S%:% %C% %(%M%A%T%R%I%X%)% %W%H%E%R%E% %C%=%A%*%*%-%1%.
 7502 LET E$=""
 7505 DIM C(ROWA,ROWA)
 7510 FOR J=1 TO ROWA
 7515 LET C(J,J)=1
 7520 NEXT J
 7525 FOR J=1 TO ROWA
 7530 FOR I=J TO ROWA
 7535 IF A(I,J)<>0 THEN GOTO 7555
 7540 NEXT I
 7545 LET E$="SINGULAR MATRIX"
 7550 RETURN 
 7555 FOR K=1 TO ROWA
 7560 LET TEMP=A(J,K)
 7565 LET A(J,K)=A(I,K)
 7570 LET A(I,K)=TEMP
 7575 LET TEMP=C(J,K)
 7580 LET C(J,K)=C(I,K)
 7585 LET C(I,K)=TEMP
 7590 NEXT K
 7595 LET TEMP=1/A(J,J)
 7600 FOR K=1 TO ROWA
 7605 LET A(J,K)=TEMP*A(J,K)
 7610 LET C(J,K)=TEMP*C(J,K)
 7615 NEXT K
 7620 FOR L=1 TO ROWA
 7625 IF L=J THEN GOTO 7655
 7630 LET TEMP=-A(L,J)
 7635 FOR K=1 TO ROWA
 7640 LET A(L,K)=A(L,K)+TEMP*A(J,K)
 7645 LET C(L,K)=C(L,K)+TEMP*C(J,K)
 7650 NEXT K
 7655 NEXT L
 7660 NEXT J
 7665 RETURN 
 8000 SAVE "REGRESSIO%N"
 8010 STOP 
 9000 REM %D%E%L%E%T%E%S% %L%I%N%E%S% %O%F% %P%R%O%G
 9005 CLS 
 9007 PRINT "FIRST LINE TO BE DELETED=";
 9010 INPUT FIRSTLINE
 9012 PRINT FIRSTLINE
 9015 PRINT "LAST  LINE TO BE DELETED=";
 9020 INPUT LASTLINE
 9022 PRINT LASTLINE
 9030 PRINT 
 9032 PRINT "CORRECT?"
 9034 INPUT Z$
 9036 IF Z$(1)<>"Y" THEN GOTO 9000
 9040 LET PROGBYTE=16509
 9045 LET DFILE=PEEK 16396+256*PEEK 16397
 9050 IF (256*PEEK PROGBYTE+PEEK (PROGBYTE+1))=FIRSTLINE THEN GOTO 9080
 9060 LET PROGBYTE=PROGBYTE+4+PEEK (PROGBYTE+2)+256*PEEK (PROGBYTE+3)
 9065 IF PROGBYTE>=DFILE THEN GOTO 9200
 9070 GOTO 9050
 9080 LET FIRSTLINE=PROGBYTE
 9090 IF (256*PEEK PROGBYTE+PEEK (PROGBYTE+1))>LASTLINE THEN GOTO 9120
 9100 LET PROGBYTE=PROGBYTE+4+PEEK (PROGBYTE+2)+256*PEEK (PROGBYTE+3)
 9105 IF PROGBYTE>=DFILE THEN GOTO 9115
 9110 GOTO 9090
 9115 LET PROGBYTE=DFILE
 9120 LET LASTLINE=PROGBYTE
 9130 POKE (FIRSTLINE+2),(LASTLINE-FIRSTLINE-4)-256*INT ((LASTLINE-FIRSTLINE-4)/256)
 9140 POKE (FIRSTLINE+3),INT ((LASTLINE-FIRSTLINE-4)/256)
 9150 STOP 
 9200 PRINT "ERROR: FIRST LINE ";FIRSTLINE;" NOT FOUND."
 9210 STOP

Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.

Tags

Archived Media Downloadable TS 1000 Mathematics

People

No people associated with this content.

Scroll to Top