[Lme4-commits] r1692 - in pkg/lme4.0: . R src

[noreply at r-forge.r-project.org]

Author: mmaechler
Date: 2012-03-22 23:14:10 +0100 (Thu, 22 Mar 2012)
New Revision: 1692

Modified:
   pkg/lme4.0/DESCRIPTION
   pkg/lme4.0/R/lmer.R
   pkg/lme4.0/src/lmer.c
   pkg/lme4.0/src/lmer.h
Log:
clean (the unused part of) rWishart() remnants - now that it *is* in base R

Modified: pkg/lme4.0/DESCRIPTION
===================================================================
--- pkg/lme4.0/DESCRIPTION	2012-03-22 19:12:52 UTC (rev 1691)
+++ pkg/lme4.0/DESCRIPTION	2012-03-22 22:14:10 UTC (rev 1692)
@@ -1,6 +1,6 @@
 Package: lme4.0
 Version: 0.9999-1
-Date: 2012-03-17
+Date: 2012-03-22
 Title: Linear mixed-effects models using S4 classes
 Description: Fit linear and generalized linear mixed-effects models.
   This is the implementation of lme4 available on CRAN and developed up to 2011.

Modified: pkg/lme4.0/R/lmer.R
===================================================================
--- pkg/lme4.0/R/lmer.R	2012-03-22 19:12:52 UTC (rev 1691)
+++ pkg/lme4.0/R/lmer.R	2012-03-22 22:14:10 UTC (rev 1692)
@@ -1,12 +1,5 @@
 # lmer, glmer and nlmer plus methods and utilities
 
-if (FALSE) {
-### FIXME: Move this function to the stats package
-rWishart <- function(n, df, invScal)
-### Random sample from a Wishart distribution
-    .Call(lme4_rWishart, n, df, invScal)
-}
-
 ### Utilities for parsing the mixed model formula
 
 findbars <- function(term)

Modified: pkg/lme4.0/src/lmer.c
===================================================================
--- pkg/lme4.0/src/lmer.c	2012-03-22 19:12:52 UTC (rev 1691)
+++ pkg/lme4.0/src/lmer.c	2012-03-22 22:14:10 UTC (rev 1692)
@@ -2454,59 +2454,7 @@
     return ans;
 }
 
-/**
- * Simulate a sample of random matrices from a Wishart distribution
- *
- * @param ns Number of samples to generate
- * @param nuP Degrees of freedom
- * @param scal Positive-definite scale matrix
- *
- * @return
- */
-SEXP
-lme4_rWishart(SEXP ns, SEXP nuP, SEXP scal)
-{
-    SEXP ans;
-    int *dims = INTEGER(getAttrib(scal, R_DimSymbol)), info,
-	n = asInteger(ns), psqr;
-    double *scCp, *ansp, *tmp, nu = asReal(nuP), one = 1, zero = 0;
 
-    if (!isMatrix(scal) || !isReal(scal) || dims[0] != dims[1])
-	error("scal must be a square, real matrix");
-    if (n <= 0) n = 1;
-    psqr = dims[0] * dims[0];
-    tmp = Alloca(psqr, double);
-    scCp = Alloca(psqr, double);
-    R_CheckStack();
-
-    Memcpy(scCp, REAL(scal), psqr);
-    AZERO(tmp, psqr);
-    F77_CALL(dpotrf)("U", &(dims[0]), scCp, &(dims[0]), &info);
-    if (info)
-	error("scal matrix is not positive-definite");
-    PROTECT(ans = alloc3DArray(REALSXP, dims[0], dims[0], n));
-    ansp = REAL(ans);
-    GetRNGstate();
-    for (int j = 0; j < n; j++) {
-	double *ansj = ansp + j * psqr;
-	std_rWishart_factor(nu, dims[0], 1, tmp);
-	F77_CALL(dtrmm)("R", "U", "N", "N", dims, dims,
-			&one, scCp, dims, tmp, dims);
-	F77_CALL(dsyrk)("U", "T", &(dims[1]), &(dims[1]),
-			&one, tmp, &(dims[1]),
-			&zero, ansj, &(dims[1]));
-
-	for (int i = 1; i < dims[0]; i++)
-	    for (int k = 0; k < i; k++)
-		ansj[i + k * dims[0]] = ansj[k + i * dims[0]];
-    }
-
-    PutRNGstate();
-    UNPROTECT(1);
-    return ans;
-}
-
-
 /**
  * Permute the vector src according to the inverse of perm into dest
  *

Modified: pkg/lme4.0/src/lmer.h
===================================================================
--- pkg/lme4.0/src/lmer.h	2012-03-22 19:12:52 UTC (rev 1691)
+++ pkg/lme4.0/src/lmer.h	2012-03-22 22:14:10 UTC (rev 1692)
@@ -6,7 +6,6 @@
  * GET_SLOT, MAKE_CLASS, NEW_OBJECT, SET_SLOT, etc. */
 #include <Rdefines.h>
 
-/* SEXP lme4_rWishart(SEXP ns, SEXP dfp, SEXP scal); */
 SEXP lme4_ghq(SEXP np);
 
 SEXP mer_MCMCsamp(SEXP x, SEXP fm);