[Calibayesr-commits] r6 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 19 11:37:39 CET 2010
Author: csgillespie
Date: 2010-03-19 11:37:39 +0100 (Fri, 19 Mar 2010)
New Revision: 6
Added:
pkg/R/caliBayesObject.R
pkg/R/caliBayesWebservices.R
Removed:
pkg/R/calibayesObject.R
pkg/R/calibayesWebservices.R
Modified:
pkg/R/basisWS.R
Log:
changing calibayes to CaliBayes
Modified: pkg/R/basisWS.R
===================================================================
--- pkg/R/basisWS.R 2010-03-16 11:52:42 UTC (rev 5)
+++ pkg/R/basisWS.R 2010-03-19 10:37:39 UTC (rev 6)
@@ -69,7 +69,7 @@
getPredictiveDistribution = function(sbml, max_time, iters, no_of_sims, prior, posterior, asText=FALSE)
{
- sbmlModel = xmlInternalTreeParse(sbml,asText=asText)
+ sbmlModel = xmlInternalTreeParse(sbml, asText=asText)
sbml = xmlChildren(sbmlModel)$sbml
@@ -110,7 +110,7 @@
results$indxs = indxs
results$isReady = vector(length=length(indxs))
- class(results) = "calibayesPredictive"
+ class(results) = "CaliBayesPredictive"
return(results)
}
Copied: pkg/R/caliBayesObject.R (from rev 2, pkg/R/calibayesObject.R)
===================================================================
--- pkg/R/caliBayesObject.R (rev 0)
+++ pkg/R/caliBayesObject.R 2010-03-19 10:37:39 UTC (rev 6)
@@ -0,0 +1,186 @@
+################################################
+#Private functions
+################################################
+
+
+createCalibayesObject = function(iters, par_df, sp_df, dist, err_df, exp_df)
+{
+ y = list()
+ y$iters = iters
+ y$parameters = par_df
+ y$species = sp_df
+ y$errors = err_df
+ y$dist = dist
+ y$experiments = exp_df
+ class(y) = "CaliBayes"
+ return(y)
+}
+
+
+mean.CaliBayes = function(x,...)
+{
+ x = cbind(x$parameters, x$species, x$errors)
+ mean(x)
+
+}
+
+summary.CaliBayes = function(object,...)
+{
+ object = cbind(object$parameters, object$species, object$errors)
+ summary(object)
+}
+
+
+plot.CaliBayes = function(x, lm=400, rows=4, burnin=1, thin=1, ...)
+{
+ d = cbind(x$parameters, x$species, x$errors)
+ names = attr(d, "names")
+ iters = x$iters
+
+ op = par(mfrow=c(rows, 3), ask=TRUE)
+ thining = (seq(0:(dim(d)[1]-1)) %% thin)
+ d = d[thining==0,]
+
+
+ for (i in 1:dim(d)[2])
+ {
+ plot(iters, d[[i]], main=paste("Trace plot for",names[i]),
+ ylab="Value", xlab="Iteration",col=4, type='l')
+
+ v = var(d[[i]])
+
+ if (v>1e-20)
+ {
+ acf(d[[i]],lag.max=10,ci=0, main=paste("ACF plot for ",names[i]),col=2)
+ den = density(d[[i]])
+ plot(den, main=paste("Density for", names[i]), xlab="Value", col=4, lwd=3)
+
+ }
+ else{
+ plot(0,0,type="n",main=paste("ACF plot for ",names[i]),col=2,xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
+ text(0,0,"N/A",cex=3.5,col=2)
+ plot(median(d[[i]]),1.0/median(d[[i]]),
+ type="h", main=paste("Density for", names[i]),
+ xlab="Value", col=4, lwd=3, ylim=c(0,1.0/median(d[[i]])),
+ ylab="Density"
+ )
+ }
+ }
+ par(op)
+ NULL
+}
+
+
+
+pri_compareDistributions = function(prior, posterior)
+{
+
+ names=attr(posterior, "names")
+ for (i in 1:dim(posterior)[2]){
+
+ d1=density(posterior[[names[i]]])
+ d2=density(prior[[names[i]]])
+ plot(d1,
+ main=paste("Density for", names[i]),
+ xlab="Value", col=4, lwd=3,
+ xlim = range(min(d1$x,d2$x), max(d1$x,d2$x)),
+ ylim = range(0, max(d1$y,d2$y))
+ )
+ lines(d2, col=2)
+ abline(h=0)
+ }
+}
+
+
+
+################################################
+#Public Calibayes functions
+################################################
+
+
+createCalibayes = function(parameters, species, distributions, errors, experiments)
+{
+ mf = match.call(expand.dots = FALSE)
+ m = match(c("parameters", "experiments"), names(mf), 0L)
+ mf = mf[c(1L, m)]
+ if(!is.element("parameters",names(mf)))
+ parameters = FALSE
+
+ if(is.element("experiments",names(mf))){
+ if(is.data.frame(experiments)){
+ experiments = list(experiments)
+ }
+ checkExperiments(experiments, species)
+ }else{
+ experiments = NULL
+ }
+ checkDistribution(parameters, species, distributions, errors)
+ y = createCalibayesObject(seq(0, (dim(species)[1]-1)), parameters, species, distributions, errors, experiments)
+ return(y)
+}
+
+saveCalibayes = function(filename, calibayes)
+{
+ data = calibayes
+ if(is.data.frame(data$species))
+ {
+ dis_filename = paste(filename, '_distributions.xml', sep='')
+ makeDistribution(dis_filename, data$parameters, data$species, data$dist, data$errors, FALSE)
+ }
+ if(is.list(data$experiments))
+ {
+ exp_filename = paste(filename, '_experiments.xml', sep='')
+ makeExperiments(exp_filename, data$experiments, check=FALSE)
+ }
+
+ return(TRUE)
+}
+
+loadCalibayes = function(filename)
+{
+ calibayes = getDistribution(filename, asText=FALSE)
+ return(calibayes)
+}
+
+
+############################################################################################################
+#Public Plotting function - compare prior to posterior
+############################################################################################################
+compareDistributions = function(prior, posterior)
+{
+ op = par(mfrow=c(2,1), ask=TRUE)
+ pri_compareDistributions(prior$parameters, posterior$parameters)
+ pri_compareDistributions(prior$errors, posterior$errors)
+ par(op)
+ NULL
+}
+
+
+
+############################################################################################################
+#Public Settings functions
+############################################################################################################
+createSettings = function(wsdl, burn=500, thin=50, block=1, simulator="copasi-deterministic", wsdl.simulator="internal")
+{
+ checkSettings(burn, thin, block)
+
+ y = list()
+ y$burn = burn
+ y$thin = thin
+ y$block = block
+ y$simulator = simulator
+ y$wsdl.simulator = wsdl.simulator
+ class(y) = "settings"
+ return(y)
+}
+
+saveSettings = function(filename, settings)
+{
+ makeSettings(filename, settings$burn, settings$thin, settings$block,
+ settings$simulator, settings$wsdl, FALSE)
+}
+
+
+
+
+
Property changes on: pkg/R/caliBayesObject.R
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author
Name: svn:mergeinfo
+
Copied: pkg/R/caliBayesWebservices.R (from rev 2, pkg/R/calibayesWebservices.R)
===================================================================
--- pkg/R/caliBayesWebservices.R (rev 0)
+++ pkg/R/caliBayesWebservices.R 2010-03-19 10:37:39 UTC (rev 6)
@@ -0,0 +1,146 @@
+require(SSOAP)
+
+##########################################################
+#Private methods
+########################################################
+getCaliDef = function(wsdl, verbose=TRUE)
+{
+ cali.wsdl = processWSDL(wsdl)
+ cali.def = genSOAPClientInterface(def = cali.wsdl, verbose = verbose)
+ return(cali.def)
+}
+
+
+RSubmit = function(from)
+{
+ obj = new("rSubmit")
+ obj at inputs = from
+ obj
+}
+
+# isReady
+pri_isReady= function(from)
+{
+ obj = new("isReady")
+ obj at sessionId = from
+ obj
+}
+
+
+# getResult
+getResult= function(from)
+{
+ obj = new("getResult")
+ obj at sessionId = from
+ obj
+}
+
+# discard
+Discard= function (from)
+{
+ obj = new("discard")
+ obj at sessionId = from
+ obj
+}
+
+getSessions= function (from)
+{
+ obj = new("getSessions")
+ obj at sessionId = from
+ obj
+}
+
+
+# simMethods
+simMethods = function(from)
+{
+ obj = new("getAvailableSimMethods")
+ obj
+}
+
+pri_getUpdate = function(from)
+{
+ obj = new("getExecReport")
+ obj at sessionId = from
+ obj
+}
+
+
+##########################################################
+#Public methods
+########################################################
+
+calibrate = function(wsdl, sbml, settings, calibayes, asText=FALSE)
+{
+ if(!asText)
+ sbml = toString.XMLNode(xmlInternalTreeParse(sbml))
+
+ #Remove the XML heading
+ sbml = strsplit(sbml,'\\?>')[[1]][[2]]
+
+ cali.def = getCaliDef(wsdl, FALSE)
+
+ expDataXml = makeExperiments(FALSE, calibayes$experiments, calibayes$species, FALSE)
+ distributionXml = makeDistribution(FALSE, calibayes$parameters, calibayes$species, calibayes$dist, calibayes$errors, FALSE)
+ tuningXml = makeSettings(FALSE, settings$burn, settings$thin, settings$block, settings$simulator, settings$wsdl, FALSE)
+
+
+ req = paste("<doc>", sbml, expDataXml, tuningXml, distributionXml, "</doc>", sep="")
+ req = gsub('\n','',req)
+
+ setAs("character", "rSubmit", RSubmit, where=globalenv())
+ rst = cali.def at functions$rSubmit(req)
+ return(rst at sessionId)
+}
+
+
+getUpdate = function(wsdl, sid)
+{
+ cali.def = getCaliDef(wsdl, FALSE)
+
+ setAs("character", "getExecReport", pri_getUpdate, where=globalenv())
+ rst = cali.def at functions$getExecReport(sid)
+ return(rst at report)
+}
+
+
+isCaliBayesReady = function(wsdl, sid)
+{
+ cali.def = getCaliDef(wsdl, FALSE)
+
+ setAs("character", "isReady", pri_isReady, where=globalenv())
+ param = c(sid)
+ rst = cali.def at functions$isReady(param)
+ return(rst at status)
+}
+
+getPosterior = function(wsdl, sid)
+{
+ r = isCaliBayesReady(wsdl, sid)
+ if(!r)
+ {
+ cat('Calibration has not finished\n')
+ return(FALSE)
+ }
+ cali.def = getCaliDef(wsdl, FALSE)
+ setAs("character", "getResult", getResult, where=globalenv())
+ rst = cali.def at functions$getResult(sid)
+ xmlString = rst at result
+ result = getDistribution(xmlString)
+
+ return(result)
+}
+
+listSimulatorMethods = function(wsdl)
+{
+ cali.def = getCaliDef(wsdl, FALSE)
+ setAs("character", "getAvailableSimMethods", simMethods, where=globalenv())
+ rst = cali.def at functions$getAvailableSimMethods('')
+ simulators = vector(length = length(names(rst)))
+ for(i in 1:length(names(rst)))
+ simulators[i] = rst[[i]]
+
+ return(simulators)
+}
+
+
Property changes on: pkg/R/caliBayesWebservices.R
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author
Name: svn:mergeinfo
+
Deleted: pkg/R/calibayesObject.R
===================================================================
--- pkg/R/calibayesObject.R 2010-03-16 11:52:42 UTC (rev 5)
+++ pkg/R/calibayesObject.R 2010-03-19 10:37:39 UTC (rev 6)
@@ -1,186 +0,0 @@
-################################################
-#Private functions
-################################################
-
-
-createCalibayesObject = function(iters, par_df, sp_df, dist, err_df, exp_df)
-{
- y = list()
- y$iters = iters
- y$parameters = par_df
- y$species = sp_df
- y$errors = err_df
- y$dist = dist
- y$experiments = exp_df
- class(y) = "calibayes"
- return(y)
-}
-
-
-mean.calibayes = function(x,...)
-{
- x = cbind(x$parameters, x$species, x$errors)
- mean(x)
-
-}
-
-summary.calibayes = function(object,...)
-{
- object = cbind(object$parameters, object$species, object$errors)
- summary(object)
-}
-
-
-plot.calibayes = function(x, lm=400, rows=4, burnin=1, thin=1, ...)
-{
- d = cbind(x$parameters, x$species, x$errors)
- names = attr(d, "names")
- iters = x$iters
-
- op = par(mfrow=c(rows, 3), ask=TRUE)
- thining = (seq(0:(dim(d)[1]-1)) %% thin)
- d = d[thining==0,]
-
-
- for (i in 1:dim(d)[2])
- {
- plot(iters, d[[i]], main=paste("Trace plot for",names[i]),
- ylab="Value", xlab="Iteration",col=4, type='l')
-
- v = var(d[[i]])
-
- if (v>1e-20)
- {
- acf(d[[i]],lag.max=10,ci=0, main=paste("ACF plot for ",names[i]),col=2)
- den = density(d[[i]])
- plot(den, main=paste("Density for", names[i]), xlab="Value", col=4, lwd=3)
-
- }
- else{
- plot(0,0,type="n",main=paste("ACF plot for ",names[i]),col=2,xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
- text(0,0,"N/A",cex=3.5,col=2)
- plot(median(d[[i]]),1.0/median(d[[i]]),
- type="h", main=paste("Density for", names[i]),
- xlab="Value", col=4, lwd=3, ylim=c(0,1.0/median(d[[i]])),
- ylab="Density"
- )
- }
- }
- par(op)
- NULL
-}
-
-
-
-pri_compareDistributions = function(prior, posterior)
-{
-
- names=attr(posterior, "names")
- for (i in 1:dim(posterior)[2]){
-
- d1=density(posterior[[names[i]]])
- d2=density(prior[[names[i]]])
- plot(d1,
- main=paste("Density for", names[i]),
- xlab="Value", col=4, lwd=3,
- xlim = range(min(d1$x,d2$x), max(d1$x,d2$x)),
- ylim = range(0, max(d1$y,d2$y))
- )
- lines(d2, col=2)
- abline(h=0)
- }
-}
-
-
-
-################################################
-#Public Calibayes functions
-################################################
-
-
-createCalibayes = function(parameters, species, distributions, errors, experiments)
-{
- mf = match.call(expand.dots = FALSE)
- m = match(c("parameters", "experiments"), names(mf), 0L)
- mf = mf[c(1L, m)]
- if(!is.element("parameters",names(mf)))
- parameters = FALSE
-
- if(is.element("experiments",names(mf))){
- if(is.data.frame(experiments)){
- experiments = list(experiments)
- }
- checkExperiments(experiments, species)
- }else{
- experiments = NULL
- }
- checkDistribution(parameters, species, distributions, errors)
- y = createCalibayesObject(seq(0, (dim(species)[1]-1)), parameters, species, distributions, errors, experiments)
- return(y)
-}
-
-saveCalibayes = function(filename, calibayes)
-{
- data = calibayes
- if(is.data.frame(data$species))
- {
- dis_filename = paste(filename, '_distributions.xml', sep='')
- makeDistribution(dis_filename, data$parameters, data$species, data$dist, data$errors, FALSE)
- }
- if(is.list(data$experiments))
- {
- exp_filename = paste(filename, '_experiments.xml', sep='')
- makeExperiments(exp_filename, data$experiments, check=FALSE)
- }
-
- return(TRUE)
-}
-
-loadCalibayes = function(filename)
-{
- calibayes = getDistribution(filename, asText=FALSE)
- return(calibayes)
-}
-
-
-############################################################################################################
-#Public Plotting function - compare prior to posterior
-############################################################################################################
-compareDistributions = function(prior, posterior)
-{
- op = par(mfrow=c(2,1), ask=TRUE)
- pri_compareDistributions(prior$parameters, posterior$parameters)
- pri_compareDistributions(prior$errors, posterior$errors)
- par(op)
- NULL
-}
-
-
-
-############################################################################################################
-#Public Settings functions
-############################################################################################################
-createSettings = function(wsdl, burn=500, thin=50, block=1, simulator="copasi-deterministic", wsdl.simulator="internal")
-{
- checkSettings(burn, thin, block)
-
- y = list()
- y$burn = burn
- y$thin = thin
- y$block = block
- y$simulator = simulator
- y$wsdl.simulator = wsdl.simulator
- class(y) = "settings"
- return(y)
-}
-
-saveSettings = function(filename, settings)
-{
- makeSettings(filename, settings$burn, settings$thin, settings$block,
- settings$simulator, settings$wsdl, FALSE)
-}
-
-
-
-
-
Deleted: pkg/R/calibayesWebservices.R
===================================================================
--- pkg/R/calibayesWebservices.R 2010-03-16 11:52:42 UTC (rev 5)
+++ pkg/R/calibayesWebservices.R 2010-03-19 10:37:39 UTC (rev 6)
@@ -1,146 +0,0 @@
-require(SSOAP)
-
-##########################################################
-#Private methods
-########################################################
-getCaliDef = function(wsdl, verbose=TRUE)
-{
- cali.wsdl = processWSDL(wsdl)
- cali.def = genSOAPClientInterface(def = cali.wsdl, verbose = verbose)
- return(cali.def)
-}
-
-
-RSubmit = function(from)
-{
- obj = new("rSubmit")
- obj at inputs = from
- obj
-}
-
-# isReady
-pri_isReady= function(from)
-{
- obj = new("isReady")
- obj at sessionId = from
- obj
-}
-
-
-# getResult
-getResult= function(from)
-{
- obj = new("getResult")
- obj at sessionId = from
- obj
-}
-
-# discard
-Discard= function (from)
-{
- obj = new("discard")
- obj at sessionId = from
- obj
-}
-
-getSessions= function (from)
-{
- obj = new("getSessions")
- obj at sessionId = from
- obj
-}
-
-
-# simMethods
-simMethods = function(from)
-{
- obj = new("getAvailableSimMethods")
- obj
-}
-
-pri_getUpdate = function(from)
-{
- obj = new("getExecReport")
- obj at sessionId = from
- obj
-}
-
-
-##########################################################
-#Public methods
-########################################################
-
-calibrate = function(wsdl, sbml, settings, calibayes, asText=FALSE)
-{
- if(!asText)
- sbml = toString.XMLNode(xmlInternalTreeParse(sbml))
-
- #Remove the XML heading
- sbml = strsplit(sbml,'\\?>')[[1]][[2]]
-
- cali.def = getCaliDef(wsdl, FALSE)
-
- expDataXml = makeExperiments(FALSE, calibayes$experiments, calibayes$species, FALSE)
- distributionXml = makeDistribution(FALSE, calibayes$parameters, calibayes$species, calibayes$dist, calibayes$errors, FALSE)
- tuningXml = makeSettings(FALSE, settings$burn, settings$thin, settings$block, settings$simulator, settings$wsdl, FALSE)
-
-
- req = paste("<doc>", sbml, expDataXml, tuningXml, distributionXml, "</doc>", sep="")
- req = gsub('\n','',req)
-
- setAs("character", "rSubmit", RSubmit, where=globalenv())
- rst = cali.def at functions$rSubmit(req)
- return(rst at sessionId)
-}
-
-
-getUpdate = function(wsdl, sid)
-{
- cali.def = getCaliDef(wsdl, FALSE)
-
- setAs("character", "getExecReport", pri_getUpdate, where=globalenv())
- rst = cali.def at functions$getExecReport(sid)
- return(rst at report)
-}
-
-
-isCaliBayesReady = function(wsdl, sid)
-{
- cali.def = getCaliDef(wsdl, FALSE)
-
- setAs("character", "isReady", pri_isReady, where=globalenv())
- param = c(sid)
- rst = cali.def at functions$isReady(param)
- return(rst at status)
-}
-
-getPosterior = function(wsdl, sid)
-{
- r = isCaliBayesReady(wsdl, sid)
- if(!r)
- {
- cat('Calibration has not finished\n')
- return(FALSE)
- }
- cali.def = getCaliDef(wsdl, FALSE)
- setAs("character", "getResult", getResult, where=globalenv())
- rst = cali.def at functions$getResult(sid)
- xmlString = rst at result
- result = getDistribution(xmlString)
-
- return(result)
-}
-
-listSimulatorMethods = function(wsdl)
-{
- cali.def = getCaliDef(wsdl, FALSE)
- setAs("character", "getAvailableSimMethods", simMethods, where=globalenv())
- rst = cali.def at functions$getAvailableSimMethods('')
- simulators = vector(length = length(names(rst)))
- for(i in 1:length(names(rst)))
- simulators[i] = rst[[i]]
-
- return(simulators)
-}
-
-
More information about the Calibayesr-commits
mailing list