/*
   linalg.c

   Home made linear algebra

   Yes, really

   $Revision: 1.15 $ $Date: 2022/10/22 10:09:51 $ 

  Copyright (C) Adrian Baddeley, Ege Rubak and Rolf Turner 2001-2018
  Licence: GNU Public Licence >= 2

   Csumouter
   Cwsumouter
   Csum2outer
   Cwsum2outer
   Cquadform
   Csumsymouter
   Cwsumsymouter
*/

#include <R.h>
#include <R_ext/Utils.h>
#include "chunkloop.h"

/* ............... matrices ..............................*/

/* ........................sums of outer products ........*/

/*
    Csumouter
    computes the sum of outer products of columns of x
    y = sum[j] (x[,j] %o% x[,j])
*/

void Csumouter(
	       double *x,       /* p by n matrix */
	       int *n,
	       int *p,
	       double *y       /* output matrix p by p, initialised to zero */
)
{
  int N, P;
  register int i, j, k, maxchunk;
  register double xij, xkj;
  register double *xcolj;
  N = *n; 
  P = *p;
  OUTERCHUNKLOOP(j, N, maxchunk, 2048) {
    R_CheckUserInterrupt();
    INNERCHUNKLOOP(j, N, maxchunk, 2048) {
      xcolj = x + j * P;
      for(i = 0; i < P; i++) {
	xij = xcolj[i];
	for(k = 0; k < P; k++) {
	  xkj = xcolj[k];
	  y[k * P + i] += xij * xkj;
	}
      }
    }
  }
}

/*
    Cwsumouter
    computes the weighted sum of outer products of columns of x
    y = sum[j] (w[j] * x[,j] %o% x[,j])
*/

void Cwsumouter(
  double *x,    /* p by n matrix */
  int *n,
  int *p,
  double *w,    /* weight vector, length n */
  double *y    /* output matrix p by p, initialised to zero */
) {
  int N, P;
  register int i, j, k, maxchunk;
  register double wj, xij, wjxij, xkj;
  register double *xcolj;
  N = *n; 
  P = *p;
  OUTERCHUNKLOOP(j, N, maxchunk, 2048) {
    R_CheckUserInterrupt();
    INNERCHUNKLOOP(j, N, maxchunk, 2048) {
      wj = w[j];
      xcolj = x + j * P;
      for(i = 0; i < P; i++) {
	xij = xcolj[i];
	wjxij = wj * xij;
	for(k = 0; k < P; k++) {
	  xkj = xcolj[k];
	  y[k * P + i] += wjxij * xkj;
	}
      }
    }
  }
}

/*
    Csum2outer
    computes the sum of outer products of columns of x and y
    z = sum[j] (x[,j] %o% y[,j])
*/

void Csum2outer(
   double *x,   /* matrix (px by n) */
   double *y,    /* matrix (py by n) */
   int *n,
   int *px,
   int *py,
   double *z    /* output matrix px by py, initialised to zero */
) {
  int N, Px, Py;
  register int i, j, k, maxchunk;
  register double xij, ykj;
  register double *xcolj, *ycolj;
  N = *n; 
  Px = *px;
  Py = *py;
  OUTERCHUNKLOOP(j, N, maxchunk, 2048) {
    R_CheckUserInterrupt();
    INNERCHUNKLOOP(j, N, maxchunk, 2048) {
      xcolj = x + j * Px;
      ycolj = y + j * Py;
      for(i = 0; i < Px; i++) {
	xij = xcolj[i];
	for(k = 0; k < Py; k++) {
	  ykj = ycolj[k];
	  z[k * Px + i] += xij * ykj;
	}
      }
    }
  }
}

/*
    Cwsum2outer
    computes the weighted sum of outer products of columns of x and y
    z = sum[j] (w[j] * x[,j] %o% y[,j])
*/

void Cwsum2outer(
		 double *x,   /* matrix (px by n) */
		 double *y,   /* matrix (py by n) */
		 int *n,
		 int *px,
		 int *py,
		 double *w,    /* weight vector, length n */
		 double *z    /* output matrix px by py, initialised to zero */
) {
  int N, Px, Py;
  register int i, j, k, maxchunk;
  register double wj, xij, wjxij, ykj;
  register double *xcolj, *ycolj;
  N = *n; 
  Px = *px;
  Py = *py;
  OUTERCHUNKLOOP(j, N, maxchunk, 2048) {
    R_CheckUserInterrupt();
    INNERCHUNKLOOP(j, N, maxchunk, 2048) {
      wj = w[j];
      xcolj = x + j * Px;
      ycolj = y + j * Py;
      for(i = 0; i < Px; i++) {
	xij = xcolj[i];
	wjxij = wj * xij;
	for(k = 0; k < Py; k++) {
	  ykj = ycolj[k];
	  z[k * Px + i] += wjxij * ykj;
	}
      }
    }
  }
}

/* ........................quadratic/bilinear forms ......*/

/*
    computes the quadratic form values
    y[j] = x[,j] %*% v %*% t(x[,j])
*/

void Cquadform(
  double *x,    /* p by n matrix */
  int *n,
  int *p,
  double *v,    /* p by p matrix */
  double *y    /* output vector, length n */
) {
  int N, P;
  register int i, j, k, maxchunk;
  register double xij, xkj, vik, yj;
  register double *xcolj;
  N = *n; 
  P = *p;
  OUTERCHUNKLOOP(j, N, maxchunk, 2048) {
    R_CheckUserInterrupt();
    INNERCHUNKLOOP(j, N, maxchunk, 2048) {
      xcolj = x + j * P;
      yj = 0;
      for(i = 0; i < P; i++) {
	xij = xcolj[i];
	for(k = 0; k < P; k++) {
	  xkj = xcolj[k];
	  vik = v[k * P + i];
	  yj += xij * vik * xkj;
	}
      }
      y[j] = yj;
    }
  }
}

/*
    computes the bilinear form values
    z[j] = x[,j] %*% v %*% t(y[,j])
*/

void Cbiform(
	     double *x,
	     double *y,    /* p by n matrices */
	     int *n,
	     int *p,
	     double *v,    /* p by p matrix */
	     double *z    /* output vector, length n */
) {
  int N, P;
  register int i, j, k, maxchunk;
  register double xij, vik, ykj, zj;
  register double *xcolj, *ycolj;
  N = *n; 
  P = *p;
  OUTERCHUNKLOOP(j, N, maxchunk, 2048) {
    R_CheckUserInterrupt();
    INNERCHUNKLOOP(j, N, maxchunk, 2048) {
      xcolj = x + j * P;
      ycolj = y + j * P;
      zj = 0;
      for(i = 0; i < P; i++) {
	xij = xcolj[i];
	for(k = 0; k < P; k++) {
	  ykj = ycolj[k];
	  vik = v[k * P + i];
	  zj += xij * vik * ykj;
	}
      }
      z[j] = zj;
    }
  }
}

/* ............... 3D arrays ...................... */

#undef FNAME
#undef WEIGHTED
#undef DISTINCT

/*
  sumsymouter
  computes the sum of outer products 
  x[,i,j] %o% x[,j,i]  over all pairs i, j 
*/

#define FNAME Csumsymouter
#include "sumsymouter.h"
#undef FNAME

/*
  wsumsymouter
  computes the weighted sum of outer products 
  w[i,j] * (x[,i,j] %o% x[,j,i])  over all pairs i, j
*/

#define FNAME Cwsumsymouter
#define WEIGHTED
#include "sumsymouter.h"
#undef FNAME
#undef WEIGHTED


#define DISTINCT

/*
  sumDsymouter
  computes the sum of outer products 
  x[,i,j] %o% x[,j,i]  over all pairs i, j with i != j
*/

#define FNAME CsumDsymouter
#include "sumsymouter.h"
#undef FNAME

/*
  wsumDsymouter
  computes the weighted sum of outer products 
  w[i,j] * (x[,i,j] %o% x[,j,i])  over all pairs i, j with i != j
*/

#define FNAME CwsumDsymouter
#define WEIGHTED
#include "sumsymouter.h"
#undef FNAME
#undef WEIGHTED

