| #------------------------------------------------------------- |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License") you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| #------------------------------------------------------------- |
| |
| # The lmDC function solves linear regression using the direct solve method |
| # |
| # INPUT: |
| # -------------------------------------------------------------------------------------- |
| # X Matrix of feature vectors. |
| # y 1-column matrix of response values. |
| # icpt Intercept presence, shifting and rescaling the columns of X |
| # reg Regularization constant (lambda) for L2-regularization. set to nonzero |
| # for highly dependant/sparse/numerous features |
| # tol Tolerance (epsilon) conjugate gradient procedure terminates early if L2 |
| # norm of the beta-residual is less than tolerance * its initial norm |
| # maxi Maximum number of conjugate gradient iterations. 0 = no maximum |
| # verbose If TRUE print messages are activated |
| # -------------------------------------------------------------------------------------- |
| # |
| # OUTPUT: |
| # --------------------------------------------------------------- |
| # B The model fit beta that can be used as input in lmPredict |
| # --------------------------------------------------------------- |
| |
| m_lmDS = function(Matrix[Double] X, Matrix[Double] y, Integer icpt = 0, |
| Double reg = 1e-7, Boolean verbose = TRUE) return (Matrix[Double] B) { |
| intercept_status = icpt |
| regularization = reg |
| |
| n = nrow(X) |
| m = ncol(X) |
| |
| # Introduce the intercept, shift and rescale the columns of X if needed |
| # add the intercept column |
| if(intercept_status == 1 | intercept_status == 2){ |
| ones_n = matrix (1, rows = n, cols = 1) |
| X = cbind (X, ones_n) |
| m_ext = ncol (X) |
| scale_lambda = matrix (1, rows = m_ext, cols = 1) |
| scale_lambda [m_ext, 1] = 0 |
| } |
| else { |
| scale_lambda = matrix (1, rows = m, cols = 1) |
| m_ext = m |
| } |
| |
| # scale-&-shift X columns to mean 0, variance 1 |
| # Important assumption: X [, m_ext] = ones_n |
| if(intercept_status == 2){ |
| avg_X_cols = t(colSums(X)) / n |
| var_X_cols = (t(colSums(X ^ 2)) - n * (avg_X_cols ^ 2)) / (n - 1) |
| is_unsafe = (var_X_cols <= 0) |
| scale_X = 1.0 / sqrt(var_X_cols * (1 - is_unsafe) + is_unsafe) |
| scale_X [m_ext, 1] = 1 |
| shift_X = - avg_X_cols * scale_X |
| shift_X [m_ext, 1] = 0 |
| }else{ |
| scale_X = matrix(1, rows = m_ext, cols = 1) |
| shift_X = matrix(0, rows = m_ext, cols = 1) |
| } |
| |
| # Henceforth, if intercept_status == 2, we use "X %*% (SHIFT/SCALE TRANSFORM)" |
| # instead of "X". However, in order to preserve the sparsity of X, |
| # we apply the transform associatively to some other part of the expression |
| # in which it occurs. To avoid materializing a large matrix, we rewrite it: |
| # |
| # ssX_A = (SHIFT/SCALE TRANSFORM) %*% A --- is rewritten as: |
| # ssX_A = diag (scale_X) %*% A |
| # ssX_A [m_ext, ] = ssX_A [m_ext, ] + t(shift_X) %*% A |
| # |
| # tssX_A = t(SHIFT/SCALE TRANSFORM) %*% A --- is rewritten as: |
| # tssX_A = diag (scale_X) %*% A + shift_X %*% A [m_ext, ] |
| |
| lambda = scale_lambda * regularization |
| # BEGIN THE DIRECT SOLVE ALGORITHM (EXTERNAL CALL) |
| A = t(X) %*% X |
| b = t(X) %*% y |
| if(intercept_status == 2){ |
| A = t(diag(scale_X) %*% A + shift_X %*% A[m_ext, ]) |
| A = diag(scale_X) %*% A + shift_X %*% A[m_ext, ] |
| b = diag(scale_X) %*% b + shift_X %*% b[m_ext, ] |
| } |
| A = A + diag(lambda) |
| |
| if(verbose){ |
| print("Calling the Direct Solver...") |
| } |
| |
| beta_unscaled = solve(A, b) |
| |
| # END THE DIRECT SOLVE ALGORITHM |
| if(intercept_status == 2){ |
| beta = scale_X * beta_unscaled |
| beta[m_ext, ] = beta[m_ext, ] + t(shift_X) %*% beta_unscaled |
| }else{ |
| beta = beta_unscaled |
| } |
| |
| # Set output variable |
| B = beta |
| } |