RNMImport
Tools for importing and manipulating NONMEM data.

Package index
Search the RNMImport package
Vignettes
Functions
376
Source code
115
Man pages
42
Home
/
R-Forge
/
RNMImport
/
inst/unittests/runit.retrieveParameters.R

inst/unittests/runit.retrieveParameters.R
In RNMImport: Tools for importing and manipulating NONMEM data. 

# $LastChangedBy: fgochez $
# $LastChangedDate: 2010-01-13 14:43:01 +0000 (Wed, 13 Jan 2010) $
# $Rev: 14659 $
# TODO: Add comment
# 
# Author: rweeks
###############################################################################

.removeMethName <- RNMImport:::.removeMethName

# tests getThetas to ensure that  behaviour under various combinations of parameters works as expected
# note that this function is also tested in runit.importNm.R, so this focuses more on
# parameter combinations than anything else


test.getThetas <- function()
{
	#Check NMBasicModel and NMRun
	
	unitTestPath <- get("TestPath", envir = .RNMImportTestEnv)
	run1 <- importNm( "TestData1.ctl", path = file.path(unitTestPath, "testdata/TestRun" ))
	
	prob1 <- getProblem(run1)
	
	run3 <- importNm( "TestData1notab.ctl", path = file.path(unitTestPath, "testdata/TestRunNotab" ))
	# expThetas <- matrix(c(19.6, 84.6, 1.66), 1, 3, dimnames = list(c("estimates"), c("THETA1", "THETA2", "THETA3")))
	expThetas <- c("THETA1" = 19.6, "THETA2" = 84.6, "THETA3" = 1.66)
	expThetaInitial <- matrix(c(-Inf, 18.7, Inf, -Inf, 87.3, Inf, -Inf, 2.13, Inf), 3,
						dimnames = list(c("lowerBound", "initial", "upperBound"), c("THETA1", "THETA2", "THETA3")))
	expThetaStderrs <-  c("THETA1" = 0.963, "THETA2" = 3.56, "THETA3" = 0.218)
	checkEquals(getThetas(prob1), expThetas)
	checkEquals(getThetas(run1), expThetas)
	
	# final and initial together
	
	checkEquals(getThetas(prob1, what = c("final", "initial")), rbind( expThetaInitial, "estimates" = expThetas),
				msg = " |what = final and initial works correctly")
	
	tryStderrs <- try(getThetas(run1, what = "stderrors"), silent = TRUE)
	checkTrue(length(grep(tryStderrs, pattern = "Standard errors not available")) > 0, 
			msg = " | correct error message when no standard errors available")
	# stderrors and final
	checkEquals(getThetas(run3, what = c("final", "stderrors")), 
			rbind("estimates" = expThetas, "standardErrors" = expThetaStderrs), 
			msg = " | final and stderrs together is correct" )
	
	############ Check NMSimModel
	
	unitTestPath <- get("TestPath", envir = .RNMImportTestEnv)
	testDir2 <- file.path(unitTestPath, "testdata/TestSimRun")
	
	run2 <- importNm( "TestData1SIM.con", path = file.path(unitTestPath, "testdata/TestSimRun" ))
	
	prob2 <- getProblem(run2)
	
	simThetas <- matrix(c(17.2, 18.3, 18.0, 19.0, 17.1, 117.0, 108.0, 108.0, 98.9, 109.0, 1.24, 1.40, 1.24, 1.55, 1.38), 5, 3)
	dimnames(simThetas) <- list(c("sim1", "sim2", "sim3", "sim4", "sim5"), c("THETA1", "THETA2", "THETA3"))
	simInitial <- c(19.6, 84.6, 1.66)
	
	names(simInitial) <- c("THETA1", "THETA2", "THETA3")
	
	checkEquals(getThetas(prob2, subProblemNum = 1:5),  simThetas, msg = " |for sim model, final as expected")
	
	checkEquals(getThetas(prob2, subProblemNum = 3:4, what = c("final", "initial")),  
			list("initial.estimates" = simInitial, "final.estimates" = simThetas[3:4,] ), 
			msg = " |for sim model, final + initial as expected")
	
	checkEquals(getThetas(prob2, what = "initial"), simInitial, msg = " |initial alone as expected")
	
	## check that parameters are passed through correctly from run to simModel
	# see also issue 1969
	
	checkEquals(getThetas(run2, subProblemNum = 1:3, what = c("initial", "final")), 
			getThetas(prob2, subProblemNum = 1:3,  what = c("initial", "final") ))
	
	######## NONMEM 7 run
	
	run3 <- importNm( "TestData1.ctl", path = file.path(unitTestPath, "testdata/TestDataNM7" ))
	prob3 <- getProblem(run3)
	
	checkEquals( getThetas(prob3, what = c("initial", "final"), method = 2), 
			structure(c(-Inf, 20, Inf, 19.1, -Inf, 77.3, Inf, 76.7, -Inf, 
							1.27, Inf, 1.68), .Dim = c(4L, 3L), .Dimnames = list(c("lowerBound", 
									"initial", "upperBound", "estimates"), c("THETA1", "THETA2", 
									"THETA3")), methodName = "Stochastic Approximation Expectation-Maximization"))
	
	checkEquals(getThetas(prob3, what = "initial", method = 1), structure(c(-Inf, 18.7, Inf, -Inf, 87.3, Inf, -Inf, 2.13, Inf
					), .Dim = c(3L, 3L), .Dimnames = list(c("lowerBound", "initial", 
									"upperBound"), c("THETA1", "THETA2", "THETA3")), 
					methodName = "Iterative Two Stage"))
	
	checkEquals(getThetas(prob3, what = c("stderrors", "final")), 
			structure(c(20, 1.24, 77.3, 7.71, 1.27, 0.127), .Dim = 2:3, .Dimnames = list(
							c("estimates", "standardErrors"), c("THETA1", "THETA2", "THETA3"
							)), methodName = "Iterative Two Stage" ))

	thetaTest4 <- getThetas(prob3, what = "final", method = 1:2)
	thetaTest5 <- getThetas(prob3, what = c("initial", "final", "stderrors"), method = 1:2 )
	
	checkEquals(thetaTest4, list(getThetas(prob3, what = "final", method = 1), 
					getThetas(prob3, what = "final", method = 2)), msg = " |multiple methods correct (1) " )
	
	checkEquals(thetaTest5, list(getThetas(prob3, what = c("initial", "stderrors", "final"), method = 1), 
					getThetas(prob3, what = c("initial", "stderrors", "final"), method = 2)), 
			msg = " |multiple methods correct (2)")
	
	testDir <- file.path(unitTestPath, "testdata/TestRun")	
	mod1 <- importNmMod("TestData1.ctl",  path = testDir)
	checkEquals(getThetas(mod1), t(mod1$problemContents[[1]]$Theta))
}

test.getOmegas <- function()
{
	########### Check NMBasicModel and NMRun
	unitTestPath <- get("TestPath", envir = .RNMImportTestEnv)
	testDir1 <- file.path(unitTestPath, "testdata/TestRun")
	
	run1 <- importNm( "TestData1.ctl", path = file.path(unitTestPath, "testdata/TestRun" ))
	
	prob1 <- getProblem(run1)
	
	expOmegas <- array(c(0.164, 0, 0, 0, 0.165, 0, 0, 0, 1.3), c(3,3))
#	dimnames(expOmegas) = list(c("ETA1", "ETA2", "ETA3"), c("ETA1", "ETA2", "ETA3"), "estimates)
	
	dimnames(expOmegas) = list(paste("OMEGA", 1:3, sep = ""), paste("OMEGA", 1:3, sep = ""))
	expOmegaInit <- diag(c(0.128, 0.142, 1.82))
	dimnames(expOmegaInit) = list(c("OMEGA1", "OMEGA2", "OMEGA3"), c("OMEGA1", "OMEGA2", "OMEGA3"))
	
	checkEquals(getOmegas(prob1),  expOmegas, msg = " |default parameters : extract final values")
	checkEquals(getOmegas(run1),  expOmegas)
	
	omegaTest1 <- getOmegas(prob1, what = "initial")
	omegaTest2 <- getOmegas(run1, what = "initial")
	
	checkEquals(omegaTest1,  expOmegaInit)
	checkEquals(omegaTest2,  expOmegaInit)	
	
	run3 <- importNm( "TestData1notab.ctl", path = file.path(unitTestPath, "testdata/TestRunNotab" ))
	omegaTest3 <- getOmegas(run3, what = c("final", "stderrors"))
	omegaStderrs <- structure(c(0.0239, 0, 0, 0, 0.022, 0, 0, 0, 0.345), .Dim = c(3L, 
					3L), .Dimnames = list(c("OMEGA1", "OMEGA2", "OMEGA3"), c("OMEGA1", 
							"OMEGA2", "OMEGA3")))
	checkEquals(omegaTest3, list(final.estimates = expOmegas, 
					standard.errors = omegaStderrs), msg = " | final + standard errors as expected")
	
	# check exception handling

	tryOmega <- try(getOmegas(run3, what = "foo"))
	checkTrue( inherits(tryOmega, "try-error") )
	checkTrue(length(grep( tryOmega, pattern = "No valid items selected for retrieval!" )) > 0)
	
	# try to get standard errors that aren't there, check for correct error message
	
	tryOmega2 <- try(getOmegas(run1, what = "stderrors"))
	checkTrue( inherits(tryOmega2, "try-error") )
	checkTrue(length(grep( tryOmega2, pattern = "Standard errors not available" )) > 0)
	
	#Check NMSimModel
	
	
	# run2 <- importNm(conFile = "testdata1sim.con", reportFile = "testdata1sim.lst", 
	#		path = testDir2)
	
	run2 <- importNm( "TestData1SIM.con", path = file.path(unitTestPath, "testdata/TestSimRun" ))
	prob2 <- getProblem(run2)
	
	simOmegas <- array(dim = c(3,3,5), dimnames = list(paste("OMEGA", 1:3, sep = ""), 
					c(paste("OMEGA", 1:3, sep = "")), 
					c("sim1", "sim2", "sim3", "sim4", "sim5")))
	simOmegas[, , 1] <- diag(c(0.174, 0.19, 1.45)); simOmegas[, , 2] <- diag(c(0.167, 0.143, 1.24))
	simOmegas[, , 3] <- diag(c(0.181, 0.142, 1.57)); simOmegas[, , 4] <- diag(c(0.245, 0.189, 0.945))
	simOmegas[, , 5] <- diag(c(0.174, 0.197, 1.47))
	initialSimOmegas <- diag(c(0.164, 0.165, 1.3)) 
	
	dimnames(initialSimOmegas) <- list(c("OMEGA1", "OMEGA2", "OMEGA3"), c("OMEGA1", "OMEGA2", "OMEGA3"))
	
	checkEquals(getOmegas(prob2, subProblemNum = 1:5),  simOmegas)
	checkEquals(getOmegas(prob2, what = "initial", subProblemNum = 1:5),  initialSimOmegas)
	
	checkEquals(getOmegas(prob2, what = c("final", "initial"), subProblemNum = 1:5), 
			list("initial.estimates" = initialSimOmegas , "final.estimates" = simOmegas))
	
	checkEquals(getOmegas(prob2, what = c("final", "initial"), subProblemNum = 4), 
			list("initial.estimates" = initialSimOmegas , "final.estimates" = simOmegas[,,4, drop = FALSE]))
	# check that parameters passed down correctly (see also issue 1969)
	checkEquals(getOmegas(run2, subProblemNum = 1:3, what = c("initial", "final")), 
			getOmegas(prob2, subProblemNum = 1:3,  what = c("initial", "final") ))
	
	
	###################################
	# NMBasicModelNM7
	#
	##################################
	
	run3 <- importNm( "TestData1.ctl", path = file.path(unitTestPath, "testdata/TestDataNM7" ))
	prob3 <- getProblem(run3)
	
	omegaTest1 <- getOmegas(prob3, what = c("initial", "final"), method = 2)
	
	expOmega1 <- list(initial.estimates = .removeMethName( getOmegas(prob3, what = "final", method = 1) ),	
			final.estimates = .removeMethName(getOmegas(prob3, method = 2)))
	
	attr(expOmega1, "methodName") <- "Stochastic Approximation Expectation-Maximization"
	
	checkEquals(omegaTest1, expOmega1,	msg = " | getOmegas correct (1)")
	
	omegaTest2 <- getOmegas(prob3, what = c("stderrors", "initial"), method = 1)
	
	checkEquals(omegaTest2, 
			structure(list(initial.estimates = structure(c(0.128, 0, 0, 0, 
											0.142, 0, 0, 0, 1.82), .Dim = c(3L,  3L), .Dimnames = list(c("OMEGA1", 
													"OMEGA2", "OMEGA3"), c("OMEGA1", "OMEGA2", "OMEGA3"))), 
											standard.errors = structure(c(0.0426, 
											0, 0, 0, 0.0483, 0, 0, 0, 0.201), .Dim = c(3L, 3L), .Dimnames = list(
											c("ETA1", "ETA2", "ETA3"), c("ETA1", "ETA2", "ETA3")))), .Names = c("initial.estimates", 
							"standard.errors"), methodName = "Iterative Two Stage"), 
			msg = " | getOmegas correct (2)")
	
	omegaTest3 <- getOmegas( prob3, what = c("stderrors", "final"))
	
	expOmega3 <- list(final.estimates =  .removeMethName(getOmegas(prob3, what = "final")), 
			standard.errors = .removeMethName(getOmegas(prob3, what = "stderrors")))
	
	attr(expOmega3, "methodName" ) <- "Iterative Two Stage"
	
	checkEquals(omegaTest3, expOmega3,
			 	msg = " | getOmegas correct (3)")
		
	## add additional tests for extracting multple methods at once
	
	omegaTest4 <- getOmegas(prob3, what = "final", method = 1:2)
	omegaTest5 <- getOmegas(prob3, what = c("final", "stderrors"), method = 1:2 )
	
	checkEquals(omegaTest4, list(getOmegas(prob3, what = "final", method = 1), 
					getOmegas(prob3, what = "final", method = 2)), msg = " |multiple methods correct (1) " )
	
	checkEquals(omegaTest5, list(getOmegas(prob3, what = c("stderrors", "final"), method = 1), 
					getOmegas(prob3, what = c("stderrors", "final"), method = 2)), 
			msg = " |multiple methods correct (2)")
	
	testDir <- file.path(unitTestPath, "testdata/TestRun")	
	mod1 <- importNmMod("TestData1.ctl",  path = testDir)
	checkEquals(getOmegas(mod1), mod1$problemContents[[1]]$Omega)
}

test.getSigmas <- function()
{
	unitTestPath <- get("TestPath", envir = .RNMImportTestEnv)
	run1 <- importNm( "TestData1notab.ctl", path = file.path(unitTestPath, "testdata/TestRunNotab" ))
	prob1 <- getProblem(run1)
	
	expSigmas <- array(0.0202, c(1,1), dimnames = list("SIGMA1", "SIGMA1"))
	expSigmaStderrs <- array(0.00322, c(1,1), dimnames = list("SIGMA1", "SIGMA1"))
	expSigmaInit <- matrix(0.0231, 1,dimnames = list("SIGMA1", "SIGMA1")) 
	
	
	checkEquals(getSigmas(prob1),  expSigmas)
	checkEquals(getSigmas(run1),  expSigmas)
	checkEquals(getSigmas(prob1, what = "initial"),  expSigmaInit)
	checkEquals(getSigmas(run1, what = "initial"),  expSigmaInit)
	
	checkEquals(getSigmas(prob1, what = c("initial", "stderrors")), list("initial.estimates" = expSigmaInit, 
					"standard.errors" = expSigmaStderrs) )
	
	run3 <- importNm( "TestData1.ctl", path = file.path(unitTestPath, "testdata/TestRun" ))
	
	# try to get standard errors that aren't there, check for correct error message
	
	trySigmas2 <- try(getSigmas(run3, what = "stderrors"))
	checkTrue( inherits(trySigmas2, "try-error") )
	checkTrue(length(grep( trySigmas2, pattern = "Standard errors not available" )) > 0)
	
	#Check NMSimModel
	run2 <- importNm( "TestData1SIM.con", path = file.path(unitTestPath, "testdata/TestSimRun" ))
	
	prob2 <- getProblem(run2)
	
	simSigmas <- array(c(0.0241, 0.026, 0.0262, 0.0295, 0.0244), dim = c(1,1,5), 
			dimnames = list("SIGMA1", "SIGMA1", c("sim1", "sim2", "sim3", "sim4", "sim5")))
	sigmaInitial <- matrix(0.0202, 1, dimnames = list("SIGMA1", "SIGMA1"))
	
	checkEquals(getSigmas(prob2, subProblemNum = 2:4),  simSigmas[,, 2:4, drop = FALSE ])
	checkEquals(getSigmas(prob2, what = "initial", subProblemNum = 1:5), sigmaInitial)
	checkEquals(getSigmas(prob2, what = c("final", "initial"), subProblemNum = 3), 
			list("initial.estimates" = sigmaInitial, "final.estimates" = simSigmas[,,3, drop = FALSE] ) )
	
	# check that parameters passed down correctly (see also issue 1969)
	
	checkEquals(getSigmas(run2, subProblemNum = 1:3, what = c("initial", "final")), 
			getSigmas(prob2, subProblemNum = 1:3,  what = c("initial", "final") ))
	
	
	###############################
	#
	# NMBasicModelNM7
	#
	################################

	run3 <- importNm( "TestData1.ctl", path = file.path(unitTestPath, "testdata/TestDataNM7" ))
	prob3 <- getProblem(run3)
	
	sigmaTest1 <- getSigmas(prob3, what = c("initial", "final"), method = 2)
	
	
	expSigma1 <- list(initial.estimates = .removeMethName( getSigmas(prob3, what = "final", method = 1) ),	
			final.estimates = .removeMethName(getSigmas(prob3, method = 2)))
	
	attr(expSigma1, "methodName") <- "Stochastic Approximation Expectation-Maximization"
	
	checkEquals(sigmaTest1, expSigma1,
			msg = " | getSigmas correct (1)")
	
	sigmaTest2 <- getSigmas(prob3, what = c("stderrors", "initial"), method = 1)
	
	checkEquals(sigmaTest2, 
			structure(list(initial.estimates = structure(0.0231, .Dim = c(1L, 
											1L), .Dimnames = list("EPS1", "EPS1")), standard.errors = structure(0.000746, .Dim = c(1L, 
											1L), .Dimnames = list("EPS1", "EPS1"))), .Names = c("initial.estimates", 
							"standard.errors"), methodName = "Iterative Two Stage"), 
			msg = " | getSigmas correct (2)")
	
	sigmaTest3 <- getSigmas( prob3, what = c("stderrors", "final") )
	expSigma3 <- list(final.estimates = .removeMethName(getSigmas(prob3, what = "final")), 
			standard.errors = .removeMethName(getSigmas(prob3, what = "stderrors")))
	attr(expSigma3, "methodName") <- "Iterative Two Stage"
	checkEquals(sigmaTest3,	expSigma3,	msg = " | getSigmas correct (3)")
	
	# check multiple methods at once
	
	sigmaTest4 <- getSigmas(prob3, what = "final", method = 1:2)
	sigmaTest5 <- getSigmas(prob3, what = c("initial", "final", "stderrors"), method = 1:2 )
	
	checkEquals(sigmaTest4, list(getSigmas(prob3, what = "final", method = 1), 
					getSigmas(prob3, what = "final", method = 2)), msg = " |multiple methods correct (1) " )
	
	checkEquals(sigmaTest5, list(getSigmas(prob3, what = c("initial", "stderrors", "final"), method = 1), 
					getSigmas(prob3, what = c("initial", "stderrors", "final"), method = 2)), 
			msg = " |multiple methods correct (2)")
	
	# check nmModel
	
	unitTestPath <- get("TestPath", envir = .RNMImportTestEnv)
	testDir <- file.path(unitTestPath, "testdata/TestRun")	
	mod1 <- importNmMod("TestData1.ctl",  path = testDir)
	checkEquals(getSigmas(mod1), mod1$problemContents[[1]]$Sigma)
	
}

Try the RNMImport package in your browser

Any scripts or data that you put into this service are public.

RNMImport documentation built on May 2, 2019, 5:21 p.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close