'start'
'#Copyright (c) 2009, 2010 Sebastien Bihorel'
'#All rights reserved.'
'#'
'#This file is part of scaRabee.'
'#'
'#    scaRabee 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 3 of the License, or'
'#    (at your option) any later version.'
'#'
'#    scaRabee 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 scaRabee.  If not, see <http://www.gnu.org/licenses/>.'
'#'
'@newline@'
'model <- function(x=NULL,dosing=NULL,xdata=NULL,covdata=NULL,issim=0){'
'  #'
'  # AIM: Compute model predictions'
'  #'
'  # INPUT: x       - data frame containing model parameters (model,'
'  #                  delays, variability, initial conditions) for model'
'  #                  simulation'
'  #        dosing  - dosing history, a di x 4 matrix is assumed'
'  #        xdata   - independent variable, a 1 x mi matrix is assumed'
'  #        covdata - covariate data, a ti x c matrix is assumed (ti being'
'  #                  the number of covariate measurement time, and c the'
'  #                  number of covariates + 1)'
'  #        issim   - scalar indicator of simulation runs (0/1)'
'  #'
'  # Problem description:'
'  if (size(dosing,2)!=4)'
'    stop(\'model: dosing does not have a di x 4 dimesion\','
'         call.=FALSE)'
'@newline@'
'  # Sorts dosing by time'
'  dosing <- dosing[order(dosing[,1]),]'
'@newline@'
'  # Determines integration intervals'
'  tspan      <- create.intervals(xdata=xdata,dosing=dosing)'
'  nintervals <- size(tspan,2)'
'@newline@'
'  # Determines the time points for model evaluation'
'  if (issim < 0.5){'
'    xdata <- xdata'
'  } else {'
'    xdata <- NULL'
'    nint <- ceiling(1001/nintervals)'
'    # Checks that nint is odd; if not, adds 1'
'    if (!nint%%2)'
'      nint <- nint + 1'
'@newline@'
'    # Creates vector of time'
'    for (i in 1:nintervals){'
'      xtmp <- seq(tspan[1,i],tspan[2,i],length.out=nint)'
'      if (i==1){'
'        xdata <- c(xdata,xtmp)'
'      } else {'
'        xdata <- c(xdata,xtmp[2:length(xtmp)])'
'      }'
'    }'
'  }'
'@newline@'
'  # Retrieves parameters'
'  parms <- c(get.param.data(x=x,which=\'value\',type=\'P\'),'
'             get.param.data(x=x,which=\'value\',type=\'L\'),'
'             get.param.data(x=x,which=\'value\',type=\'IC\'))'
'  names(parms) <- c(get.param.data(x=x,which=\'names\',type=\'P\'),'
'                    get.param.data(x=x,which=\'names\',type=\'L\'),'
'                    get.param.data(x=x,which=\'names\',type=\'IC\'))'
'@newline@'
'  # Creates time variable from xdata'
'  time <- xdata'
'@newline@'
'  f <- with(as.list(parms),{'
'  #########################################################################'
'  #                        USER CODE STARTS HERE'
'  #########################################################################'
'@newline@'
'  # Parameter definition'
'@newline@'
'  # Output'
'  f <- c()'
'@newline@'
'  #########################################################################'
'  #                         USER CODE ENDS HERE'
'  #########################################################################'
'    return(f)}'
'  )'
'@newline@'
'  # Re-attach evaluation times \'time\' for simulation run only'
'  if (issim > 0.5){'
'    f <- rbind(time,f)'
'  }'
'@newline@'
'  return(f)'
'@newline@'
'}'
'@newline@'