From: Benjamin Auder Date: Tue, 11 Apr 2017 12:41:31 +0000 (+0200) Subject: Add 'fast' argument to select C code or R code X-Git-Url: https://git.auder.net/pieces/current/img/js/doc/R.css?a=commitdiff_plain;h=a3105972158da4773b33d41e1ead65a942c15f80;p=valse.git Add 'fast' argument to select C code or R code --- diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index 0a1c30e..32ed6a8 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -37,7 +37,5 @@ Collate: 'initSmallEM.R' 'EMGrank.R' 'EMGLLF.R' - 'EMGrank_R.R' - 'EMGLLF_R.R' 'generateXY.R' 'A_NAMESPACE.R' diff --git a/pkg/R/A_NAMESPACE.R b/pkg/R/A_NAMESPACE.R index 359cf88..81e91ec 100644 --- a/pkg/R/A_NAMESPACE.R +++ b/pkg/R/A_NAMESPACE.R @@ -1,6 +1,4 @@ #' @include generateXY.R -#' @include EMGLLF_R.R -#' @include EMGrank_R.R #' @include EMGLLF.R #' @include EMGrank.R #' @include initSmallEM.R diff --git a/pkg/R/EMGLLF.R b/pkg/R/EMGLLF.R index 0158914..1739204 100644 --- a/pkg/R/EMGLLF.R +++ b/pkg/R/EMGLLF.R @@ -28,7 +28,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, if (!fast) { # Function in R - return (EMGLLF_R(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau)) + return (.EMGLLF_R(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau)) } # Function in C @@ -45,7 +45,7 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, } # R version - slow but easy to read -EMGLLF_R = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau) +.EMGLLF_R = function(phiInit,rhoInit,piInit,gamInit,mini,maxi,gamma,lambda,X,Y,tau) { # Matrix dimensions n = dim(X)[1] diff --git a/pkg/R/EMGrank.R b/pkg/R/EMGrank.R index e30b605..0e68cb4 100644 --- a/pkg/R/EMGrank.R +++ b/pkg/R/EMGrank.R @@ -22,7 +22,7 @@ EMGrank <- function(Pi, Rho, mini, maxi, X, Y, tau, rank, fast=TRUE) if (!fast) { # Function in R - return (EMGrank_R(Pi, Rho, mini, maxi, X, Y, tau, rank)) + return (.EMGrank_R(Pi, Rho, mini, maxi, X, Y, tau, rank)) } # Function in C @@ -47,7 +47,7 @@ matricize <- function(X) } # R version - slow but easy to read -EMGrank_R = function(Pi, Rho, mini, maxi, X, Y, tau, rank) +.EMGrank_R = function(Pi, Rho, mini, maxi, X, Y, tau, rank) { #matrix dimensions n = dim(X)[1] diff --git a/test/generateRunSaveTest_EMGLLF.R b/test/generateRunSaveTest_EMGLLF.R index 8a61c1b..bf37b5f 100644 --- a/test/generateRunSaveTest_EMGLLF.R +++ b/test/generateRunSaveTest_EMGLLF.R @@ -1,4 +1,5 @@ source("helper.R") +library(valse) generateRunSaveTest_EMGLLF = function(n=200, p=15, m=10, k=3, mini=5, maxi=10, gamma=1., lambda=0.5, tau=1e-6) @@ -6,7 +7,6 @@ generateRunSaveTest_EMGLLF = function(n=200, p=15, m=10, k=3, mini=5, maxi=10, testFolder = "../data/" dir.create(testFolder, showWarnings=FALSE, mode="0755") - require(valse) params = basicInitParameters(n, p, m, k) xy = generateXYdefault(n, p, m, k) @@ -36,14 +36,14 @@ generateRunSaveTest_EMGLLF = function(n=200, p=15, m=10, k=3, mini=5, maxi=10, write.table(as.integer(c(n,p,m,k)), paste(testFolder,"dimensions",sep=""), row.names=F, col.names=F) - res = EMGLLF_R(params$phiInit,params$rhoInit,params$piInit,params$gamInit,mini,maxi, - gamma,lambda,xy$X,xy$Y,tau) + res = valse::EMGLLF(params$phiInit,params$rhoInit,params$piInit,params$gamInit,mini, + maxi,gamma,lambda,xy$X,xy$Y,tau,fast=FALSE) #save outputs - write.table(as.double(res$phi), paste(testFolder,"phi",sep=""), row.names=F, col.names=F) - write.table(as.double(res$rho), paste(testFolder,"rho",sep=""), row.names=F, col.names=F) - write.table(as.double(res$pi), paste(testFolder,"pi",sep=""), row.names=F, col.names=F) - write.table(as.double(res$llh), paste(testFolder,"llh",sep=""), row.names=F, col.names=F) - write.table(as.double(res$S), paste(testFolder,"S",sep=""), row.names=F, col.names=F) - write.table(as.integer(res$affec), paste(testFolder,"affec",sep=""), row.names=F, col.names=F) + write.table(as.double(res$phi),paste(testFolder,"phi",sep=""),row.names=F,col.names=F) + write.table(as.double(res$rho),paste(testFolder,"rho",sep=""),row.names=F,col.names=F) + write.table(as.double(res$pi),paste(testFolder,"pi",sep=""),row.names=F,col.names=F) + write.table(as.double(res$llh),paste(testFolder,"llh",sep=""),row.names=F,col.names=F) + write.table(as.double(res$S),paste(testFolder,"S",sep=""),row.names=F,col.names=F) + write.table(as.integer(res$affec),paste(testFolder,"affec",sep=""),row.names=F,col.names=F) } diff --git a/test/generateRunSaveTest_EMGrank.R b/test/generateRunSaveTest_EMGrank.R index becf62a..935eada 100644 --- a/test/generateRunSaveTest_EMGrank.R +++ b/test/generateRunSaveTest_EMGrank.R @@ -1,4 +1,5 @@ source("helper.R") +library(valse) generateRunSaveTest_EMGrank = function(n=200, p=15, m=10, k=3, mini=5, maxi=10, gamma=1.0, rank = c(1,2,4)) @@ -8,7 +9,6 @@ generateRunSaveTest_EMGrank = function(n=200, p=15, m=10, k=3, mini=5, maxi=10, rho = array(dim=c(m,m,k)) for(i in 1:k) rho[,,i] = diag(1,m) - require(valse) xy = generateXYdefault(n, p, m, k) testFolder = "../data/" @@ -33,9 +33,9 @@ generateRunSaveTest_EMGrank = function(n=200, p=15, m=10, k=3, mini=5, maxi=10, write.table(as.integer(c(n,p,m,k)), paste(testFolder,"dimensions",sep=""), row.names=F, col.names=F) - res = EMGrank_R(pi,rho,mini,maxi,xy$X,xy$Y,tau,rank) + res = valse::EMGrank(pi,rho,mini,maxi,xy$X,xy$Y,tau,rank,fast=FALSE) #save output - write.table(as.double(res$phi), paste(testFolder,"phi",sep=""), row.names=F,col.names=F) - write.table(as.double(res$LLF), paste(testFolder,"LLF",sep=""), row.names=F,col.names=F) + write.table(as.double(res$phi),paste(testFolder,"phi",sep=""),row.names=F,col.names=F) + write.table(as.double(res$LLF),paste(testFolder,"LLF",sep=""),row.names=F,col.names=F) }