# Copyright (C) 2013 - 2019 Metrum Research Group, LLC
#
# This file is part of mrgsolve.
#
# mrgsolve is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# mrgsolve is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with mrgsolve. If not, see <http://www.gnu.org/licenses/>.
print_leading <- "%-17s"
parheader <- c(" parameters: ", rep(" ", 6))
initheader <- gsub("parameters", "compartments", parheader)
captheader <- gsub("parameters", "captures", parheader)
parheader <- sprintf(print_leading, parheader)
initheader <- sprintf(print_leading, initheader)
captheader <- sprintf(print_leading, captheader)
timeheader <- sprintf(print_leading,c(" time: ", " "))
print.os.header <- sprintf(print_leading, " OS type: ")
print.solver.header <- sprintf(print_leading, c(" solver:"))
print.mrgmod <- function(x,verbose=FALSE,...) {
add <- x@add
nadd <- length(add)
tt1 <- c(start=x@start,end=x@end, delta=x@delta)
tt1 <- paste(names(tt1), tt1, sep=": ")
tt1 <- paste(tt1, collapse=" ")
add_suffix <- ""
add <- paste0(add,collapse=" ")
add <- strwrap(add, width=30)
if(length(add) > 1) {
add <- add[1]
add_suffix <- " ..."
}
add <- paste0("add: " , paste0(add,add_suffix))
if(nadd ==0) add <- "add: <none>"
tt <- c(tt1,add)
tt <- paste0(timeheader,tt)
pars <- param(x)
npars <- length(pars)
if(npars > 0) {
partxt <- strwrap(paste0(names(pars),collapse=" "),width = 40)
if(length(partxt) > 4) {
partxt <- partxt[1:4]
partxt[5] <- "..."
}
partxt[length(partxt)] <- paste0(partxt[length(partxt)], " [", npars,"]")
partxt <- paste0(parheader[1:length(partxt)],partxt)
} else {
partxt <- paste0(parheader[1],"<none>")
}
inits <- cmt(x)
ninit <- length(inits)
if(ninit > 0) {
inittxt <- strwrap(paste0(inits,collapse=" "),width = 40)
if(length(inittxt) > 4) {
inittxt <- inittxt[1:4]
inittxt[5] <- "..."
}
inittxt[length(inittxt)] <- paste0(inittxt[length(inittxt)], " [", ninit,"]")
inittxt <- paste0(initheader[1:length(inittxt)],inittxt)
} else {
inittxt <- paste0(initheader[1],"<none>")
}
capt <- x@capture
ncapt <- length(capt)
if(ncapt > 0) {
capttext <- strwrap(paste0(capt,collapse=" "),width = 40)
if(length(capttext) > 4) {
capttext <- capttext[1:4]
capttext[5] <- "..."
}
capttext[length(capttext)] <- paste0(capttext[length(capttext)], " [", ncapt,"]")
capttext <- paste0(captheader[1:length(capttext)],capttext)
} else {
capttext <- paste0(captheader[1],"<none>")
}
maxs <- paste0(floor(x@maxsteps/1000), "k")
solvertxt <- list(atol=x@atol,rtol=x@rtol,maxsteps=maxs)
solvertxt <- paste(names(solvertxt), unlist(solvertxt), sep=": ")
solvertxt <- list(solvertxt[1:3])
solvertxt <- sapply(solvertxt, function(i) paste(i, collapse= " "))
solvertxt <- paste0(print.solver.header, solvertxt)
proj <- normalizePath(project(x), mustWork=FALSE,
winslash=.Platform$file.sep)
proj <- cropstr(proj, 16,16)
osig <- dim_matlist(x@omega)
osig <- paste(osig,osig, sep="x", collapse=',')
ssig <- dim_matlist(x@sigma)
ssig <- paste(ssig,ssig, sep="x", collapse=',')
loaded <- ifelse(model_loaded(x),"", "<not loaded>")
src <- paste0("source: ", basename(cfile(x)))
nsrc <- nchar(src)
nside <- max((54-nsrc)/2 - 2, 0)
side <- paste0(rep("-", nside),collapse="")
header <- paste0("\n\n",side, " ", src, " ", side, "\n\n")
cat(header)
cat(" project: ",proj,"\n", sep="")
cat(" shared object: ", dllname(x), " ",loaded,"\n\n", sep="")
cat(tt, sep="\n")
cat("\n")
cat(inittxt, sep="\n")
cat(partxt, sep="\n")
cat(capttext,sep="\n")
cat(" omega: ", osig, "\n")
cat(" sigma: ", ssig, "\n")
cat("\n")
cat(solvertxt, sep="\n")
cat(paste0(rep('-',54),collapse=""))
cat("\n")
}
##' Print model details
##'
##' @param object the model object
##' @export
##' @keywords internal
setMethod("show", "mrgmod", function(object) print.mrgmod(object))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.