September 2017 Update

Task/Multiple-regression/Fortran/multiple-regression.f

@@ -0,0 +1,85 @@
+*-----------------------------------------------------------------------
+* MR - multiple regression using the SLATEC library routine DHFTI
+*
+* Finds the nearest approximation to BETA in the system of linear equations:
+*
+*              X(j,i) . BETA(i) = Y(j)
+* where
+*                  1 ... j ... N
+*                  1 ... i ... K
+* and
+*                  K .LE. N
+*
+* INPUT ARRAYS ARE DESTROYED!
+*
+*___Name_________Type_______________In/Out____Description________________________
+*   X(N,K)       Double precision   In        Predictors
+*   Y(N)         Double precision   Both      On input:   N Observations
+*                                             On output:  K beta weights
+*   N            Integer            In        Number of observations
+*   K            Integer            In        Number of predictor variables
+*   DWORK(3*K)   Double precision   Neither   Workspace
+*   IWORK(K)     Integer            Neither   Workspace
+*-----------------------------------------------------------------------
+      SUBROUTINE MR (X, Y, N, K, DWORK, IWORK)
+       IMPLICIT NONE
+       INTEGER K, N, IWORK
+       DOUBLE PRECISION X, Y, DWORK
+       DIMENSION X(N,K), Y(N), DWORK(3*K), IWORK(K)
+
+*         local variables
+       INTEGER I, J
+       DOUBLE PRECISION TAU, TOT
+
+*        maximum of all column sums of magnitudes
+       TAU = 0.
+       DO J = 1, K
+         TOT = 0.
+         DO I = 1, N
+           TOT = TOT + ABS(X(I,J))
+         END DO
+         IF (TOT > TAU) TAU = TOT
+       END DO
+       TAU = TAU * EPSILON(TAU)        ! tolerance argument
+
+*            call function
+       CALL DHFTI (X, N, N, K, Y, N, 1, TAU,
+     $  J, DWORK(1), DWORK(K+1), DWORK(2*K+1), IWORK)
+       IF (J < K) PRINT *, 'mr: solution is rank deficient!'
+       RETURN
+      END  ! of MR
+
+*-----------------------------------------------------------------------
+      PROGRAM t_mr        ! polynomial regression example
+       IMPLICIT NONE
+       INTEGER N, K
+       PARAMETER (N=15, K=3)
+       INTEGER IWORK(K), I, J
+       DOUBLE PRECISION XIN(N), X(N,K), Y(N), DWORK(3*K)
+
+       DATA XIN / 1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65, 1.68,
+     $            1.70, 1.73, 1.75, 1.78, 1.80, 1.83 /
+       DATA Y / 52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29,
+     $          63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46 /
+
+*              make coefficient matrix
+       DO J = 1, K
+         DO I = 1, N
+           X(I,J) = XIN(I) **(J-1)
+         END DO
+       END DO
+
+*               solve
+       CALL MR (X, Y, N, K, DWORK, IWORK)
+
+*               print result
+  10   FORMAT ('beta: ', $)
+  20   FORMAT (F12.4, $)
+  30   FORMAT ()
+       PRINT 10
+       DO J = 1, K
+         PRINT 20, Y(J)
+       END DO
+       PRINT 30
+       STOP 'program complete'
+      END

Task/Multiple-regression/J/multiple-regression-4.j

@@ -0,0 +1,4 @@
+   load 'math/lapack'
+   load 'math/lapack/gels'
+   gels_jlapack_ X;y
+128.813 _143.162 61.9603

Task/Multiple-regression/Zkl/multiple-regression-1.zkl

@@ -0,0 +1,9 @@
+var [const] GSL=Import("zklGSL");	// libGSL (GNU Scientific Library)
+height:=GSL.VectorFromData(1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63,
+		   1.65, 1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83);
+weight:=GSL.VectorFromData(52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93,
+		   61.29, 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46);
+v:=GSL.polyFit(height,weight,2);
+v.format().println();
+GSL.Helpers.polyString(v).println();
+GSL.Helpers.polyEval(v,height).format().println();

Task/Multiple-regression/Zkl/multiple-regression-2.zkl

@@ -0,0 +1,56 @@
+// Solve a linear system AX=B where A is symmetric and positive definite, so it can be Cholesky decomposed.
+fcn linsys(A,B){
+   n,m:=A.len(),B[1].len();  // A.rows,B.cols
+   y:=n.pump(List.createLong(n).write,0.0); // writable vector of n zeros
+   X:=make_array(n,m,0.0);
+   L:=cholesky(A); // A=LL'
+
+   foreach col in (m){
+      foreach k in (n){ // Forward substitution: y = L\B
+         y[k]=( B[k][col] - k.reduce('wrap(s,j){ s + L[k][j]*y[j] },0.0) )
+	      /L[k][k];
+      }
+      foreach k in ([n-1..0,-1]){   // Back substitution. x=L'\y
+         X[k][col]=
+	  ( y[k] - (k+1).reduce(n-k-1,'wrap(s,j){ s + L[j][k]*X[j][col] },0.0) )
+	  /L[k][k];
+      }
+   }
+   X
+}
+fcn cholesky(mat){   // Cholesky decomposition task
+   rows:=mat.len();
+   r:=(0).pump(rows,List().write, (0).pump(rows,List,0.0).copy); // matrix of zeros
+   foreach i,j in (rows,i+1){
+      s:=(0).reduce(j,'wrap(s,k){ s + r[i][k]*r[j][k] },0.0);
+      r[i][j]=( if(i==j)(mat[i][i] - s).sqrt()
+	        else    1.0/r[j][j]*(mat[i][j] - s) );
+   }
+   r
+}
+
+// Solve a linear least squares problem. Ax=b, with A being mxn, with m>n.
+// Solves the linear system A'Ax=A'b.
+fcn lsqr(A,b){
+   at:=transpose(A);
+   linsys(matMult(at,A), matMult(at,b));
+}
+// Least square fit of a polynomial of order n the x-y-curve.
+fcn polyfit(x,y,n){
+   n+=1;
+   m:=x[0].len();  // columns
+   A:=make_array(m,n,0.0);
+   foreach i,j in (m,n){ A[i][j]=x[0][i].pow(j); }
+   lsqr(A, transpose(y));
+}
+fcn make_array(n,m,v){ (m).pump(List.createLong(m).write,v)*n }
+fcn matMult(a,b){
+   n,m,p:=a[0].len(),a.len(),b[0].len();
+   ans:=make_array(m,p,0.0);
+   foreach i,j,k in (m,p,n){ ans[i][j]+=a[i][k]*b[k][j]; }
+   ans
+}
+fcn transpose(M){
+   if(M.len()==1) M[0].pump(List,List.create); // 1 row --> n columns
+   else M[0].zip(M.xplode(1));
+}

Task/Multiple-regression/Zkl/multiple-regression-3.zkl

@@ -0,0 +1,5 @@
+height:=T(T(1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63,
+        1.65, 1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83));
+weight:=T(T(52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93,
+        61.29, 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46));
+polyfit(height,weight,2).flatten().println();