如何在 ggplot 上的 r 中对活动数据拟合正弦波答案

【问题标题】：How to fit a sine wave over activity data in r on ggplot如何在 ggplot 上的 r 中对活动数据拟合正弦波
【发布时间】：2020-06-16 17:51:54
【问题描述】：

我有来自大型数据集的活动数据，我正试图拟合正弦波以找到活动高峰和低谷的相应时间点。数据不一定是正弦曲线，这可能是个问题，但我还是想拟合一条曲线。在节奏数据和数据分析方面，我也是新手，因此请随时提供新的信息或建议。这是一个鼠标第一周数据的链接https://www.dropbox.com/s/m08vk7ovij2wcnb/stack_sine_dt.csv?dl=0

          id  eday   act      t
       <fctr> <int> <num>  <num>
    1:   M001     1    17  86400
    2:   M001     1    10  86460
    3:   M001     1    13  86520
    4:   M001     1    14  86580
    5:   M001     1    24  86640
   ---                          
10076:   M001     7     0 690900
10077:   M001     7     1 690960
10078:   M001     7     0 691020
10079:   M001     7     0 691080
10080:   M001     7     0 691140

我遵循this post here 的指导，得到了一个不错的图表，尽管波浪似乎不是每天都出现高峰和低谷。我希望将其覆盖在 ggplot 散点图上。

# here I fit a wave using lm()
lmfit <- lm(data = dt,
            act ~ sin(2*pi*t/365.25) + cos(2*pi*t/365.25))
# then get relevant parameters
b0 <- coef(lmfit)[1]
alpha <- coef(lmfit)[2]
beta <- coef(lmfit)[3]

r <- sqrt(alpha^2 + beta^2)
phi <- atan2(beta, alpha)

# and fit it to some base plots
par(mfrow=c(1,2))
curve(b0 + r * sin(x + phi), 0, 2*pi, lwd=3, col="Gray",
      main="Overplotted Graphs", xlab="x", ylab="y")
curve(b0 + alpha * sin(x) + beta * cos(x), lwd=3, lty=3, col="Red", add=TRUE)
curve(b0 + r * sin(x + phi) - (b0 + alpha * sin(x) + beta * cos(x)), 
      0, 2*pi, n=257, lwd=3, col="Gray", main="Difference", xlab="x", y="")

这里是基图的输出，也是我想在上面放置正弦波的 ggplot 散点图。

【问题讨论】：

是否有可以分配给您的数据的频率？看来你的频率太低了。您可能希望使用具有不同频率的正弦和余弦的线性组合作为模型。归根结底，您将弄清楚哪些术语很重要。一旦我有更多时间，我会仔细研究你的问题。
另一种表达@slava-kohut 问题的方式：t 的单位是什么？秒？您使用的代码假定t 以天为单位...
啊，谢谢！是的，它以秒为单位。应该指定的。

标签： r ggplot2 trigonometry

【解决方案1】：

您的主要问题是您的时间以秒为单位并且想要一个每日周期，但是您使用的代码假定时间以天为单位并且您想要一个年度周期...

x <- read.csv("stack_sine_dt.csv")

secs_per_day <- 24*3600
x$tday <- x$t/secs_per_day
lmfit <- lm(data = x,
            act ~ sin(2*pi*tday) + cos(2*pi*tday))
b0 <- coef(lmfit)[1]
alpha <- coef(lmfit)[2]
beta <- coef(lmfit)[3]

pframe <- data.frame(tday=seq(min(x$tday),max(x$tday),length=501))
pframe$act <- predict(lmfit,newdata=pframe)

library(ggplot2); theme_set(theme_bw())
ggplot(x,aes(tday,act))+
    geom_point(alpha=0.2) + geom_line(data=pframe,colour="red")

【讨论】：

嗨，Ben 感谢您的大力响应。你的代码运行得非常好，但我不得不做一个小的修改。您分配 pframe
预测向量不必与输入向量的长度相同。另一种选择是使用pframe <- data.frame(tday=unique(x$tday))

【解决方案2】：

像这样，您可以将拟合曲线叠加在 ggplot 散点图上（我改编了来自 here 的代码）：

library(broom)
library(dplyr)
# here I fit a wave using lm()
lmfit <- lm(data = dt,
            act ~ sin(2*pi*t/36500.25))

bind_cols(dt, lmfit %>% augment) %>% 
  ggplot(aes(t, act...3)) +
  geom_point() +
  geom_ribbon(aes(ymin = .fitted - 1.96*.se.fit, ymax = .fitted + 1.96*.se.fit), alpha = 0.5) + geom_line(mapping = aes(y = .fitted), col = "red")

【讨论】：