Version 2.0v2.0

1 files changed, 65 insertions, 7 deletions

diff --git a/CakeOlsPlot.R b/CakeOlsPlot.R
index 199cc28..e92742c 100644
--- a/CakeOlsPlot.R
+++ b/CakeOlsPlot.R
@@ -1,4 +1,4 @@
-#$Id: CakeOlsPlot.R 216 2011-07-05 14:35:03Z nelr $
+#$Id$
 # Generates fitted curves so the GUI can plot them
 # Based on code in IRLSkinfit
 # Author: Rob Nelson (Tessella)
@@ -18,10 +18,70 @@
 #    You should have received a copy of the GNU General Public License
 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.”
 
-CakeOlsPlot <- function(fit, xlim = range(fit$data$time), ...)
+CakePlotInit <- function(fit, xlim = range(fit$data$time), ...)
 {
-   cat("<PLOT MODEL START>\n")
+    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"
@@ -40,7 +100,7 @@ CakeOlsPlot <- function(fit, xlim = range(fit$data$time), ...)
   odeini <- parms.all[ininames]
   names(odeini) <- names(fit$diffs)
 
-  outtimes <- seq(0, xlim[2], length.out=101)
+  outtimes <- seq(0, xlim[2], length.out=101) * scale_x
 
   odenames <- c(
     rownames(subset(fit$start, type == "deparm")),
@@ -111,7 +171,5 @@ CakeOlsPlot <- function(fit, xlim = range(fit$data$time), ...)
       out_transformed[var] <- rowSums(out[, fit$map[[var]]])
     }
   }
-  print(out_transformed)
-
-  cat("<PLOT MODEL END>\n")
+  return(out_transformed)
 }