将拟合回归线添加到 R plotly 小提琴

Question

我有跨三个integer age的三个group的xy数据：

set.seed(1)
df <- data.frame(value = c(rnorm(500,8,1),rnorm(600,6,1.5),rnorm(400,4,0.5),rnorm(500,2,2),rnorm(400,4,1),rnorm(600,7,0.5),rnorm(500,3,1),rnorm(500,3,1),rnorm(500,3,1)),
                 age = c(rep(3,500),rep(8,600),rep(24,400),rep(3,500),rep(8,400),rep(24,600),rep(3,500),rep(8,500),rep(24,500)),
                 group = c(rep("A",1500),rep("B",1500),rep("C",1500)))

我的目的是使用R的plotly到 plot 的value s 作为violin s，像这样：

library(plotly)
library(dplyr)
df$age <- factor(df$age)
plot_ly(x=df$group,y=df$value,type='violin',name=df$age,color=df$age,box=list(visible=T)) %>%
  layout(violinmode='group')

并在group中添加lm拟合线，如果可能的话，还添加标准误差线。

所以我首先将group的拟合线添加到df中：

df$age <- as.integer(df$age)
df$fitted.value <- unlist(lapply(c("A","B","C"),function(g) lm(value ~ age,dplyr::filter(df,group == g)) %>% fitted.values()))

然后我尝试只做一个group的 violin 添加它的拟合线使用：

df <- df %>% dplyr::filter(group == "A")
plot_ly(x=df$age,y=df$value,type='violin',color=df$age,box=list(visible=T)) %>%
  add_trace(x=df$age,y=df$fitted.value,mode="lines")

但这给出了一长串warnings ：

Warning messages:
1: 'violin' objects don't have these attributes: 'mode'
Valid attributes include:
'type', 'visible', 'showlegend', 'legendgroup', 'opacity', 'uid', 'ids', 'customdata', 'meta', 'selectedpoints', 'hoverinfo', 'hoverlabel', 'stream', 'transforms', 'uirevision', 'y', 'x', 'x0', 'y0', 'name', 'orientation', 'bandwidth', 'scalegroup', 'scalemode', 'spanmode', 'span', 'line', 'fillcolor', 'points', 'jitter', 'pointpos', 'width', 'marker', 'text', 'hovertext', 'hovertemplate', 'box', 'meanline', 'side', 'offsetgroup', 'alignmentgroup', 'selected', 'unselected', 'hoveron', 'xaxis', 'yaxis', 'idssrc', 'customdatasrc', 'metasrc', 'hoverinfosrc', 'ysrc', 'xsrc', 'textsrc', 'hovertextsrc', 'hovertemplatesrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
 
2: 'violin' objects don't have these attributes: 'mode'
Valid attributes include:
'type', 'visible', 'showlegend', 'legendgroup', 'opacity', 'uid', 'ids', 'customdata', 'meta', 'selectedpoints', 'hoverinfo', 'hoverlabel', 'stream', 'transforms', 'uirevision', 'y', 'x', 'x0', 'y0', 'name', 'orientation', 'bandwidth', 'scalegroup', 'scalemode', 'spanmode', 'span', 'line', 'fillcolor', 'points', 'jitter', 'pointpos', 'width', 'marker', 'text', 'hovertext', 'hovertemplate', 'box', 'meanline', 'side', 'offsetgroup', 'alignmentgroup', 'selected', 'unselected', 'hoveron', 'xaxis', 'yaxis', 'idssrc', 'customdatasrc', 'metasrc', 'hoverinfosrc', 'ysrc', 'xsrc', 'textsrc', 'hovertextsrc', 'hovertemplatesrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'
 
3: 'violin' objects don't have these attributes: 'mode'
Valid attributes include:
'type', 'visible', 'showlegend', 'legendgroup', 'opacity', 'uid', 'ids', 'customdata', 'meta', 'selectedpoints', 'hoverinfo', 'hoverlabel', 'stream', 'transforms', 'uirevision', 'y', 'x', 'x0', 'y0', 'name', 'orientation', 'bandwidth', 'scalegroup', 'scalemode', 'spanmode', 'span', 'line', 'fillcolor', 'points', 'jitter', 'pointpos', 'width', 'marker', 'text', 'hovertext', 'hovertemplate', 'box', 'meanline', 'side', 'offsetgroup', 'alignmentgroup', 'selected', 'unselected', 'hoveron', 'xaxis', 'yaxis', 'idssrc', 'customdatasrc', 'metasrc', 'hoverinfosrc', 'ysrc', 'xsrc', 'textsrc', 'hovertextsrc', 'hovertemplatesrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

而这个不受欢迎的 plot：

知道如何为所有group添加趋势线以及最佳的标准误差线吗？

Answer 1

也许你可以使用这个解决方案。 它首先创建一个新的 df ，其中包含一个描述 group 和subgroup的附加变量。

另一个 DF 构建group_by(group, moreA)的平均值。

plot 是用ggplot制作的， geom_violin填充了来自第一个 DF 的数据和来自第二个 DF geom_point的sum_res以及geom_smooth 。 这个geom_smooth采用sum_res的平均值来进行拟合。

在此之后， ggplot object 被带入ggplotly 。

不幸的是，像悬停这样的ggplotly行为并没有出现在这个reprex中。 但它在 RStudio 中工作

library(plotly)
library(tidyverse)


ddf <- df %>% #glimpse()
  mutate(moreA = case_when(
    age == 3 ~ paste0(group,'3'),
    age == 8 ~ paste0(group,'8'),
    age == 24 ~ paste0(group,'24'),
  )) 

# this will bring the right order
ddf$moreA <- factor(ddf$moreA, levels = unique(ddf$moreA))

sum_res <- ddf %>% #
  group_by(group, moreA) %>% 
  summarise(meanA = mean(value))
    
p <- ggplot(ddf, aes(x = moreA, y = value, color = moreA)) +
  geom_violin() +
  geom_point(data = sum_res, mapping = aes(x = moreA, y = meanA), size = 1) +
  geom_smooth(data = sum_res, 
              mapping = aes(x = moreA, y = meanA, group = group, color = group),
              method='lm', size = 1, se =F) +
  theme_bw() +
  theme(legend.position = 'none')
#p

ggplotly(p)