static void updateRegressionForNewCommonScale(SEXP regression, MERCache* cache) { // the update is only required if the total sum of squares term depends on the common scale, // itself being a question of whether or not the unmodeled coefficient prior is SEXP unmodeledCoefPrior = GET_SLOT(regression, blme_unmodeledCoefficientPriorSym); if (PRIOR_TYPE_SLOT(unmodeledCoefPrior) != PRIOR_TYPE_DIRECT || PRIOR_FAMILIES_SLOT(unmodeledCoefPrior)[0] != PRIOR_FAMILY_GAUSSIAN || getCommonScaleBit(PRIOR_SCALES_SLOT(unmodeledCoefPrior)[0]) != PRIOR_COMMON_SCALE_FALSE) return; const int* dims = DIMS_SLOT(regression); double* deviances = DEV_SLOT(regression); int numUnmodeledCoefs = dims[p_POS]; // we need to refactor (X'X - Rzx'Rzx + sigma^2 / sigma_beta^2 * I) double* lowerRightBlockRightFactorization = RX_SLOT(regression); // recover the cached version of X'X - Rzx'Rzx Memcpy(lowerRightBlockRightFactorization, (const double*) cache->downdatedDenseCrossproduct, numUnmodeledCoefs * numUnmodeledCoefs); addGaussianContributionToDenseBlock(regression, lowerRightBlockRightFactorization, deviances[dims[isREML_POS] ? sigmaREML_POS : sigmaML_POS]); int choleskyResult = getDenseCholeskyDecomposition(lowerRightBlockRightFactorization, numUnmodeledCoefs, TRIANGLE_TYPE_UPPER); if (choleskyResult > 0) error("Leading minor %d of downdated X'X is not positive definite.", choleskyResult); if (choleskyResult < 0) error("Illegal argument %d to cholesky decomposition (dpotrf).", -choleskyResult); deviances[ldRX2_POS] = 0.0; for (int j = 0; j < numUnmodeledCoefs; ++j) { deviances[ldRX2_POS] += 2.0 * log(lowerRightBlockRightFactorization[j * (numUnmodeledCoefs + 1)]); } // at this point, we have the correct Rx stored. now we need to // compute the new half projection and the new sum of squares double* unmodeledCoefProjection = cache->unmodeledCoefProjection; // copy in (X'Y - Rzx' theta half projection); beta half projection is Rx^-1 times that Memcpy(unmodeledCoefProjection, (const double*) cache->downdatedDenseResponseRotation, numUnmodeledCoefs); int i_one = 1; // solve A'x = b for A an Upper triangular, Tranposed, Non-unit matrix F77_CALL(dtrsv)("U", "T", "N", &numUnmodeledCoefs, lowerRightBlockRightFactorization, &numUnmodeledCoefs, unmodeledCoefProjection, &i_one); // now update the sums of squares double newSumOfSquares = getSumOfSquares(unmodeledCoefProjection, numUnmodeledCoefs); cache->totalSumOfSquares -= newSumOfSquares - cache->unmodeledCoefProjectionSumOfSquares; cache->unmodeledCoefProjectionSumOfSquares = newSumOfSquares; }
double Sound_getPowerInAir (Sound me) { long n; double sum2 = getSumOfSquares (me, 0, 0, & n); return NUMdefined (sum2) ? sum2 / (n * my ny) / 400 : NUMundefined; }
double Sound_getIntensity_dB (Sound me) { long n; double sum2 = getSumOfSquares (me, 0, 0, & n); return NUMdefined (sum2) && sum2 != 0.0 ? 10 * log10 (sum2 / (n * my ny) / 4.0e-10) : NUMundefined; }
double Sound_getEnergyInAir (Sound me) { long n; double sum2 = getSumOfSquares (me, 0, 0, & n); return NUMdefined (sum2) ? sum2 * my dx / (400 * my ny) : NUMundefined; }
double Sound_getPower (Sound me, double xmin, double xmax) { long n; double sum2 = getSumOfSquares (me, xmin, xmax, & n); return NUMdefined (sum2) ? sum2 / (n * my ny) : NUMundefined; }
double Sound_getEnergy (Sound me, double xmin, double xmax) { long n; double sum2 = getSumOfSquares (me, xmin, xmax, & n); return NUMdefined (sum2) ? sum2 * my dx / my ny : NUMundefined; }
double Sound_getRootMeanSquare (Sound me, double xmin, double xmax) { long n; double sum2 = getSumOfSquares (me, xmin, xmax, & n); return NUMdefined (sum2) ? sqrt (sum2 / (n * my ny)) : NUMundefined; }
static void getDerivativesOfSumOfSquares(SEXP regression, MERCache* cache, double* firstDerivative, double* secondDerivative) { const int* dims = DIMS_SLOT(regression); double* deviances = DEV_SLOT(regression); int i_one = 1; double d_one = 1.0; int numUnmodeledCoefs = dims[p_POS]; SEXP unmodeledCoefPrior = GET_SLOT(regression, blme_unmodeledCoefficientPriorSym); const double* hyperparameters = PRIOR_HYPERPARAMETERS_SLOT(unmodeledCoefPrior) + 1; // skip over the log det of the covar, not needed here unsigned int numHyperparameters = LENGTH(GET_SLOT(unmodeledCoefPrior, blme_prior_hyperparametersSym)) - 1; // take Rx and get Rx^-1 const double* lowerRightFactor = RX_SLOT(regression); double rightFactorInverse[numUnmodeledCoefs * numUnmodeledCoefs]; // Rx^-1 invertUpperTriangularMatrix(lowerRightFactor, numUnmodeledCoefs, rightFactorInverse); // calculate Lbeta^-1 * Rx^-1 int factorIsTriangular = TRUE; if (numHyperparameters == 1) { // multiply by a scalar // printMatrix(lowerRightFactor, numUnmodeledCoefs, numUnmodeledCoefs); for (int col = 0; col < numUnmodeledCoefs; ++col) { int offset = col * numUnmodeledCoefs; for (int row = 0; row <= col; ++row) { rightFactorInverse[offset++] *= hyperparameters[0]; } } // printMatrix(rightFactorInverse, numUnmodeledCoefs, numUnmodeledCoefs); } else if (numHyperparameters == numUnmodeledCoefs) { // left multiply by a diagonal matrix const double *diagonal = hyperparameters; for (int col = 0; col < numUnmodeledCoefs; ++col) { int offset = col * numUnmodeledCoefs; for (int row = 0; row <= col; ++row) { rightFactorInverse[offset++] *= diagonal[row]; } } } else { const double* priorLeftFactorInverse = hyperparameters; // want L * R // Left multiply, Lower triangluar matrix, No-transpose, Non-unit F77_CALL(dtrmm)("L", "L", "N", "N", &numUnmodeledCoefs, &numUnmodeledCoefs, &d_one, (double*) priorLeftFactorInverse, &numUnmodeledCoefs, rightFactorInverse, &numUnmodeledCoefs); factorIsTriangular = FALSE; } double projectionRotation[numUnmodeledCoefs]; Memcpy(projectionRotation, (const double *) cache->unmodeledCoefProjection, numUnmodeledCoefs); // this step corresponds to Rx^-1 * unmodeled coef projection if (factorIsTriangular) { // X := A x, A triangular F77_CALL(dtrmv)("Upper triangular", "Non transposed", "Non unit diagonal", &numUnmodeledCoefs, rightFactorInverse, &numUnmodeledCoefs, projectionRotation, &i_one); } else { applyMatrixToVector(rightFactorInverse, numUnmodeledCoefs, numUnmodeledCoefs, FALSE, projectionRotation, projectionRotation); } double firstRotationSumOfSquares = getSumOfSquares(projectionRotation, numUnmodeledCoefs); // now for Rx^-T Rx^-1 * modeled coef projection if (factorIsTriangular) { // X: = A' x, A triangular F77_CALL(dtrmv)("Upper triangular", "Transposed", "Non unit diagonal", &numUnmodeledCoefs, rightFactorInverse, &numUnmodeledCoefs, projectionRotation, &i_one); } else { applyMatrixToVector(rightFactorInverse, numUnmodeledCoefs, numUnmodeledCoefs, TRUE, projectionRotation, projectionRotation); } double secondRotationSumOfSquares = getSumOfSquares(projectionRotation, numUnmodeledCoefs); // in general, DoF depends on unmodeled coefficient prior scale, as we can get back those // lost DoF. However, in that case we can't get here, where optimization is required. double sigma = deviances[dims[isREML_POS] ? sigmaREML_POS : sigmaML_POS]; double sigma_sq = sigma * sigma; *firstDerivative -= firstRotationSumOfSquares / sigma; *secondDerivative += 3.0 * firstRotationSumOfSquares / sigma_sq + 4.0 * secondRotationSumOfSquares; // From here, done unless REML. REML involves taking the derivative of // the log determinant of LxLx' (with some unmodeled covariance terms), // which is just the trace of the product. The second derivative is // the trace of the "square" of that product. if (dims[isREML_POS]) { int covarianceMatrixLength = numUnmodeledCoefs * numUnmodeledCoefs; double crossproduct[covarianceMatrixLength]; // we square the left factor Lx^-T * Lx^-1. the trace of this is immediately // useful, but we also need the trace of its square. Fortunately, the trace // of AA' is simply the sum of the squares of all of the elements. if (factorIsTriangular) { // want UU' singleTriangularMatrixCrossproduct(rightFactorInverse, numUnmodeledCoefs, TRUE, TRIANGLE_TYPE_UPPER, crossproduct); } else { singleMatrixCrossproduct(rightFactorInverse, numUnmodeledCoefs, numUnmodeledCoefs, crossproduct, TRUE, TRIANGLE_TYPE_UPPER); } double firstOrderTrace = 0.0; double secondOrderTrace = 0.0; int offset; // as the cross product is symmetric, we only have to use its upper // triangle and the diagonal for (int col = 0; col < numUnmodeledCoefs; ++col) { offset = col * numUnmodeledCoefs; for (int row = 0; row < col; ++row) { secondOrderTrace += 2.0 * crossproduct[offset] * crossproduct[offset]; ++offset; } firstOrderTrace += crossproduct[offset]; secondOrderTrace += crossproduct[offset] * crossproduct[offset]; } *firstDerivative -= sigma * firstOrderTrace; *secondDerivative += -firstOrderTrace + 2.0 * sigma_sq * secondOrderTrace; } }