有沒有辦法在一個圖上繪制具有不同衰減常數的指數衰減曲線？

Question

我一直試圖在一張圖上繪制不同的指數衰減曲線。 最初我認為這會很容易，但結果卻令人沮喪。

我想得到什么：

nlsplot(k_data_nls, model = 6, start = c(a= 603.3, b= -0.03812), xlab = "hours", ylab = "copies")

nlsplot(r4, model=6, start=c(a=25.5487,b=-0.5723), xlab = "hours", ylab = "copies")

以下是數據的一些附加代碼：

df4 <- data.frame(hours=c(0,1,3,5,12,24,48,96,168,336,504,720), copies=c(603.3,406,588,393.27,458.47,501.67,767.53,444.13,340.6,298.47,61.42,51.6))
nlsfit(df4, model=6, start=c(a=603.3,b=-0.009955831526))
d4plot <- nlsplot(df4, model=6, start=c(a=603.3,b=-0.009955831526))

r4 <- data.frame(hours=c(0,1,3,5,12,24,48,96,168,336,504,720), copies=c(26,13.44,4.57,3.12,6.89,0.71,0.47,0.47,0,0,0.24,0.48))
nlsLM(copies ~ a*exp(b*hours), data=r4, start=list(a=26,b=-0.65986))
r4plot <- nlsplot(r4, model=6, start=c(a=25.5487,b=-0.5723))

本質上，我希望能夠在一張圖上獲得這兩個圖。 我是 R 的新手，所以我不太確定我可以從哪里開始。 謝謝 ！

Answer 1

我不知道這是否真的有幫助，因為它太具體了，但這就是我要做的（使用ggplot2 ）。 首先，您需要要繪制的函數的數據。 取 x 代表您要顯示的所有值，並將您的函數和系數應用於數據。 您需要有數據點，而不僅僅是一個函數來繪制數據。

df_simulated <- data.frame("x" = rep(1:100, 2),
                           "class"= rep(c("DNA", "RNA"), each = 100))
df_simulated$y <- c(1683.7 * exp(-0.103 * 1:100),  # DNA
                    578.7455 * exp(-0.156 * 1:100))  # RNA

但是，由於我從未使用過您使用的軟件包，因此我不知道如何從模型中提取值，因此我采用了您的示例圖中的值。 重要的是，兩組的“模擬”值都在一個數據框中，並且您有一列將點歸因於相應的組（RNA 或 DNA）。 如果你這樣做，至少它會更容易。 然后您需要一個數據框，其中包含您對點的實際觀察結果。 我又發明了數據：

df_observed <- data.frame("x" = c(12, 13, 25, 26, 50, 51),
                          "y" = c(500, 50, 250, 25, 0, 5),
                          "class" = rep(c("DNA", "RNA"), 3))

然后你可以創建情節。 使用color=class您指定數據點將按“類”分組並相應地着色。 （“apple”和“banana”只是用來演示換行的虛擬詞）

ggplot() +
  geom_line(data = df_simulated, aes(x = x, y = y, color = class), size = 1, linetype = "dashed") +
  geom_point(data = df_observed, aes(x = x, y = y, color = class), size = 4, pch = 1) +
  annotate("text", x = 50, y = 1250, label = "DNA\napple", color = "tomato", hjust = 0) +
  annotate("text", x = 50, y = 750, label  ="RNA\nbanana", color = "steelblue", hjust = 0) +
  ggtitle(expression(~italic("Styela clava")~"(isolated)")) +
  ylab("COI copies per 1ml") +
  xlab("Time since removal of organisms (hours)") +
  theme_classic() +
  theme(legend.position = "none") +
  scale_color_manual(values = c("DNA" = "tomato", "RNA" = "steelblue"))

這是輸出：

Answer 2

首先請注意，R 平方通常用於線性模型而不是非線性模型，因此此處使用此統計量是可疑的； 然而，無論如何，我們在下面展示它。 我們定義了一個函數 r2 來計算它。

然后對於 df4 和 r4 中的每一個，我們使用 lm 來獲取起始值（對兩邊取對數，我們得到一個在 log(a) 和 b 中線性的模型），運行 nls 擬合並獲得系數。

現在繪制點並添加擬合線和圖例。 （請注意，在設置圖形時，我們使用 rbind，它假定 df4 和 r4 具有相同的列名，它們確實如此。）

請注意，問題中提供的數據與問題圖像中顯示的數據大不相同。

不使用任何包。

r2 <- function(fm, digits = 3) {
  y <- fitted(fm) + resid(fm) 
  r2 <- 1 - deviance(fm) / sum((y - mean(y))^2)
  if (is.numeric(digits)) r2 <- round(r2, digits)
  r2
}

fo <- copies ~ a * exp(b * hours)  # formula used in nls

# get nls fitted model and coefficients for df4
co_d0 <- coef(lm(log(copies) ~ hours, df4))
fmd <- nls(fo, df4, start = list(a = exp(co_d0[[1]]), b = co_d0[[2]]))
co_d <- round(coef(fmd), 4)

# get nls fitted model and coefficients for r4
co_r0 <- coef(lm(log(copies) ~ hours, r4, subset = copies > 0))
fmr <- nls(fo, r4, start = list(a = exp(co_r0[[1]]), b = co_r0[[2]]))
co_r <- round(coef(fmr), 4)

both <- rbind(cbind(df4, col = "red"), cbind(r4, col = "blue"))
plot(both[1:2], col = both$col,
  xlab = "Time since removal of organisms", ylab = "COI copies per 1ml",
  main = "C)" ~ italic("Styela clava")~"(isolated)", adj = 0)
lines(fitted(fmd) ~ hours, df4, col = "red", lty = 2)
lines(fitted(fmr) ~ hours, r4, col = "blue", lty = 2)

legend <- c(bquote(DNA), 
            bquote(y == .(co_d[[1]]) * e ^ {.(co_d[[2]])*x}),
            bquote(R^2 == .(r2(fmd))),
            bquote(),
            bquote(RNA), 
            bquote(y == .(co_r[[1]]) * e ^ {.(co_r[[2]])*x}),
            bquote(R^2 == .(r2(fmr))))
legend("right", legend = as.expression(legend), bty = "n",
  text.col = c("red", "red", "red", NA, "blue", "blue", "blue"))