diff options
author | Johannes Ranke <jranke@uni-bremen.de> | 2020-03-29 22:02:34 +0200 |
---|---|---|
committer | Johannes Ranke <jranke@uni-bremen.de> | 2020-03-29 22:02:34 +0200 |
commit | 6263a53ef24ff0c06e5f4a869a987f41f361bc58 (patch) | |
tree | 7ea91eff19047165c95f15a49a23a264f9d90d53 /R/mxkin.R | |
parent | 20ece4e0bcbeceb90a940e04a858f4ffb6d6b5e4 (diff) |
First automatic generation of an nlme model
Diffstat (limited to 'R/mxkin.R')
-rw-r--r-- | R/mxkin.R | 58 |
1 files changed, 0 insertions, 58 deletions
diff --git a/R/mxkin.R b/R/mxkin.R deleted file mode 100644 index ae7563df..00000000 --- a/R/mxkin.R +++ /dev/null @@ -1,58 +0,0 @@ -#' Estimation of parameter distributions from mmkin objects -#' -#' @param object An mmkin row object containing several fits of the same model to different datasets -#' @return A fitted object of class 'mrkin' -#' @examples -#' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120) - -m_SFO <- mkinmod(parent = mkinsub("SFO")) -d_SFO_1 <- mkinpredict(m_SFO, - c(k_parent_sink = 0.1), - c(parent = 98), sampling_times) -d_SFO_1_long <- mkin_wide_to_long(d_SFO_1, time = "time") -d_SFO_2 <- mkinpredict(m_SFO, - c(k_parent_sink = 0.05), - c(parent = 102), sampling_times) -d_SFO_2_long <- mkin_wide_to_long(d_SFO_2, time = "time") -d_SFO_3 <- mkinpredict(m_SFO, - c(k_parent_sink = 0.02), - c(parent = 103), sampling_times) -d_SFO_3_long <- mkin_wide_to_long(d_SFO_3, time = "time") - -d1 <- add_err(d_SFO_1, function(value) 3, n = 1) -d2 <- add_err(d_SFO_2, function(value) 2, n = 1) -d3 <- add_err(d_SFO_3, function(value) 4, n = 1) -ds <- c(d1 = d1, d2 = d2, d3 = d3) - -f <- mmkin("SFO", ds) -x <- mrkin(f) -as.numeric(x) - -#' -#' @export -mrkin <- function(object) { - if (nrow(object) > 1) stop("Only row objects allowed") - n_d <- ncol(object) - p_names <- names(parms(object[[1, 1]])) - p_names_trans <- names(parms(object[[1, 1]])) - - p_mat_start_trans <- sapply(object, parms, transformed = TRUE) - colnames(p_mat_start_trans) <- colnames(object) - p_mat_attr_trans <- attributes(p_mat_start_trans) - - p_dist_names <- p_names[grepl("^log_", p_names)] - p_free_names <- p_names[!grepl("^log_", p_names)] - - cost <- function(P) { - p_cost_mat <- P - attributes(P) <- p_mat_attr_trans - - ll_ds <- 0 - for (i_d in 1:n_d) { - - } - - } - - p_mat_start -} |