aboutsummaryrefslogtreecommitdiff
path: root/R/mxkin.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2019-11-06 18:56:21 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2019-11-06 18:56:21 +0100
commit731dd9450f08868140f90af7a305133ec9342994 (patch)
tree010c450c80d00e653c2b1e47f1f9aedd9440f701 /R/mxkin.R
parentead1f286271923f57d83aed41cb34181a10773ef (diff)
Attempt of an overall model for an mmkin row
Diffstat (limited to 'R/mxkin.R')
-rw-r--r--R/mxkin.R58
1 files changed, 58 insertions, 0 deletions
diff --git a/R/mxkin.R b/R/mxkin.R
new file mode 100644
index 00000000..ae7563df
--- /dev/null
+++ b/R/mxkin.R
@@ -0,0 +1,58 @@
+#' 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
+}

Contact - Imprint