Version 3.3 from a fresh installationv3.3

1 files changed, 0 insertions, 175 deletions

diff --git a/CakeOlsPlot.R b/CakeOlsPlot.R
deleted file mode 100644
index e92742c..0000000
--- a/CakeOlsPlot.R
+++ /dev/null
@@ -1,175 +0,0 @@
-#$Id$
-# Generates fitted curves so the GUI can plot them
-# Based on code in IRLSkinfit
-# Author: Rob Nelson (Tessella)
-# Modifications developed by Tessella Plc for Syngenta: Copyright (C) 2011  Syngenta
-# Tessella Project Reference: 6245
-#
-#    This program 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.
-# 
-#    This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.”
-
-CakePlotInit <- function(fit, xlim = range(fit$data$time), ...)
-{
-    t.map.names <- names(fit$map)
-    metabolites <- grep("[A-Z]\\d", t.map.names, value = TRUE)
-    t.map.rest  <- setdiff(t.map.names, metabolites)
-    
-    # Generate the normal graphs.
-    final <- CakeOlsPlot(fit, xlim)
-    final_scaled <- final
-    
-    if(length(metabolites) > 0){
-        for(i in 1:length(metabolites))
-        {
-            metabolite <- metabolites[i]
-            decay_var  <- paste("k", metabolite, sep="_")
-            
-            # calculate the new ffm and generate the two ffm scale charts
-            regex <- paste("f_(.+)_to", metabolite, sep="_")
-            decays = grep(regex, names(fit$par), value = TRUE)
-            ffm_fitted <- sum(fit$par[decays])
-            normal <- final
-            ffm_scale <- NULL
-                
-            # Generate the DT50=1000d and ffm as fitted.
-            k_new <- fit$par[decay_var]*fit$distimes[metabolite,]["DT50"]/1000;
-            fit$par[decay_var]<- k_new[metabolite,]
-            dt50_1000_ffm_fitted <- CakeOlsPlot(fit, xlim)[metabolite]
-            
-            naming <- c(names(final), paste(metabolite, "DT50_1000_FFM_FITTED", sep="_"))
-            normal <- c(final, dt50_1000_ffm_fitted)
-            names(normal) <- naming
-            final <- normal
-            
-            # Generate the scaled FFM
-            if(ffm_fitted != 0)
-            {
-                ffm_scale <- 1 / ffm_fitted
-                final_scaled <- final[c("time", metabolite, paste(metabolite, "DT50_1000_FFM_FITTED", sep="_"))]
-                final_scaled[t.map.rest] <- NULL;
-                final_frame <- as.data.frame(final_scaled)
-                new_names <- c(paste(metabolite, "DT50_FITTED_FFM_1", sep="_"), paste(metabolite, "DT50_1000_FFM_1", sep="_"))
-                names(final_frame) <- c("time", new_names)
-                final_frame[new_names]<-final_frame[new_names]*ffm_scale;
-                
-                cat("<PLOT MODEL START>\n")
-            
-                write.table(final_frame, quote=FALSE)
-                
-                cat("<PLOT MODEL END>\n")
-            }
-        }
-    }
-    
-    cat("<PLOT MODEL START>\n")
-    
-    write.table(final, quote=FALSE)
-    
-    cat("<PLOT MODEL END>\n")
-
-    # View(final)
-}
-
-CakeOlsPlot <- function(fit, xlim = range(fit$data$time), scale_x = 1.0, ...)
-{
-   solution = fit$solution
-   if ( is.null(solution) ) {
-      solution <- "deSolve"
-   }
-   atol = fit$atol
-   if ( is.null(atol) ) {
-      atol = 1.0e-6
-   }
-   
-  fixed <- fit$fixed$value
-  names(fixed) <- rownames(fit$fixed)
-  parms.all <- c(fit$par, fixed)
-  ininames <- c(
-    rownames(subset(fit$start, type == "state")),
-    rownames(subset(fit$fixed, type == "state")))
-  odeini <- parms.all[ininames]
-  names(odeini) <- names(fit$diffs)
-
-  outtimes <- seq(0, xlim[2], length.out=101) * scale_x
-
-  odenames <- c(
-    rownames(subset(fit$start, type == "deparm")),
-    rownames(subset(fit$fixed, type == "deparm")))
-  odeparms <- parms.all[odenames]
-
-  # Solve the system
-  evalparse <- function(string)
-  {
-    eval(parse(text=string), as.list(c(odeparms, odeini)))
-  }
-  if (solution == "analytical") {
-    parent.type = names(fit$map[[1]])[1]  
-    parent.name = names(fit$diffs)[[1]]
-    o <- switch(parent.type,
-      SFO = SFO.solution(outtimes, 
-          evalparse(parent.name),
-          evalparse(paste("k", parent.name, sep="_"))),
-      FOMC = FOMC.solution(outtimes,
-          evalparse(parent.name),
-          evalparse("alpha"), evalparse("beta")),
-      DFOP = DFOP.solution(outtimes,
-          evalparse(parent.name),
-          evalparse("k1"), evalparse("k2"),
-          evalparse("g")),
-      HS = HS.solution(outtimes,
-          evalparse(parent.name),
-          evalparse("k1"), evalparse("k2"),
-          evalparse("tb")),
-      SFORB = SFORB.solution(outtimes,
-          evalparse(parent.name),
-          evalparse(paste("k", parent.name, "free_bound", sep="_")),
-          evalparse(paste("k", parent.name, "bound_free", sep="_")),
-          evalparse(paste("k", parent.name, "free_sink", sep="_")))
-    )
-    out <- cbind(outtimes, o)
-    dimnames(out) <- list(outtimes, c("time", parent.name))
-  }
-  if (solution == "eigen") {
-    coefmat.num <- matrix(sapply(as.vector(fit$coefmat), evalparse), 
-      nrow = length(odeini))
-    e <- eigen(coefmat.num)
-    c <- solve(e$vectors, odeini)
-    f.out <- function(t) {
-      e$vectors %*% diag(exp(e$values * t), nrow=length(odeini)) %*% c
-    }
-    o <- matrix(mapply(f.out, outtimes), 
-      nrow = length(odeini), ncol = length(outtimes))
-    dimnames(o) <- list(names(odeini), NULL)
-    out <- cbind(time = outtimes, t(o))
-  } 
-  if (solution == "deSolve") {
-    out <- ode(
-      y = odeini,
-      times = outtimes,
-      func = fit$mkindiff, 
-      parms = odeparms,
-      atol = atol
-    )
-  }
-    
-  # Output transformation for models with unobserved compartments like SFORB
-  out_transformed <- data.frame(time = out[,"time"])
-  for (var in names(fit$map)) {
-    if(length(fit$map[[var]]) == 1) {
-      out_transformed[var] <- out[, var]
-    } else {
-      out_transformed[var] <- rowSums(out[, fit$map[[var]]])
-    }
-  }
-  return(out_transformed)
-}