diff options
Diffstat (limited to 'CakeOlsPlot.R')
| -rw-r--r-- | CakeOlsPlot.R | 72 |
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) } |