R 使用ggvis显示基于模型的预测？

我想在ggvis图上显示模型的预测线，这样我可以动态地改变x轴上的比例

我可以很容易地在ggplot中绘制模型预测：

但是，当我尝试在ggvis中这样做时，我会有奇怪的行为——我不知道如何告诉ggvis在预测的数据帧中按“pop”分组。这些是我得到的图表。。。我想知道现在这是否可能？请阅读“您当前无法将线条的组成部分设置为不同的颜色：跟踪进度”

下面的可复制示例。

在@aosmith的帮助下（谢谢！），经过一些调整，我们想出了两种解决方案，我在这里发布了这两种解决方案-要查看图表，请查看我原始问题的“编辑”部分

第一种解决方案（您不必对输入数据帧进行排序，但必须按此顺序将参数放入ggvis）：

第二种解决方案（您必须首先对预测值data.frame进行排序）：

predframe%
安排（x）
ggvis（dframe，~x，~y，fill=~pop，stroke=~pop）%>%
图层_点（）%>%
图层路径（数据=分组依据（predframe，pop），y=~拟合，笔划=~ pop，填充：=NA）%>%
缩放数值（'x'，域=输入\滑块（0,11，c（0,11）），钳位=T）

您只需将预测值添加到原始数据集中，然后使用

层线进行绘图

，即

dframe$pred=predict（model，level=0）

layer\u lines

当前没有数据参数-您可以改用

layer\u路径

，但是您必须手动按“x”对数据集进行排序。在我的“真实”情况下，这两种解决方案都不适合我。层线因为我的数据是块状的，所以在块之间的模型线看起来奇怪的平坦，层线路径-不知道为什么会如此复杂。我认为数据集需要按x变量排序，而不是按拟合值排序（层线的帮助页澄清了这一点）。很高兴你找到了一些东西；您应该添加一个解决方案作为答案。对于

layer\u path

选项，您可以将预测数据集-

layer\u path（data=group\u by（predframe，pop），y=~fitted，stroke=~pop）

可能在打印之前忘记了设置

predframe

的顺序？您的注释代码对我有效（使用排序的

predframe

）。

library(nlme)
library(dplyr)
library(ggplot2)
library(ggvis)


dframe <- structure(list(pop = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label =
c("P1", "P2"), class = "factor"), id = structure(c(1L, 2L, 1L, 3L, 4L, 5L, 6L,
7L, 8L, 9L, 2L, 10L, 11L, 11L, 12L, 5L, 13L, 2L, 14L, 10L, 15L, 5L, 16L, 16L,
17L, 18L, 19L, 20L, 21L, 23L, 24L, 25L, 22L, 24L, 23L, 25L, 22L, 16L, 20L,
11L, 3L, 2L, 1L, 1L), .Label = c("A", "B", "C", "D", "E", "F", "G", "H", "I",
"J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y"
), class = "factor"), x = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5, 7.5, 8.5, 9.5,
10.5, 0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5, 7.5, 8.5, 9.5, 10.5, 0.5, 1.5, 2.5,
3.5, 4.5, 5.5, 6.5, 7.5, 8.5, 9.5, 10.5, 0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5,
7.5, 8.5, 9.5, 10.5), act = c(13.9, 47.8, 68.3, 80.8, 88.4, 92.9, 95.7, 97.4,
98.4, 99, 99.4, 13.9, 47.8, 68.3, 80.8, 88.4, 92.9, 95.7, 97.4, 98.4, 99,
99.4, 12.7, 35.2, 48.9, 57.2, 62.2, 65.3, 67.1, 68.3, 69, 69.4, 69.6, 12.7,
35.2, 48.9, 57.2, 62.2, 65.3, 67.1, 68.3, 69, 69.4, 69.6), y = c(15L, 46L, 
68L, 80L, 92L, 89L, 95L, 97L, 99L, 96L, 103L, 14L, 43L, 72L, 81L, 88L, 94L,
93L, 98L, 96L, 100L, 102L, 12L, 36L, 50L, 54L, 62L, 66L, 68L, 65L, 71L, 69L,
68L, 14L, 37L, 51L, 56L, 63L, 66L, 69L, 65L, 70L, 69L, 73L)), .Names =
c("pop", "id", "x", "act", "y"), class = "data.frame", row.names = c(NA, -44L 
))

LVB = function(t, Linf, K, t0) 
{
  if (length(Linf) == 3) {
    K <- Linf[[2]]
    t0 <- Linf[[3]]
    Linf <- Linf[[1]]
  }
  Linf*(1-exp(-K*(t-t0)))
}

# Fit a null model with random effects (not interested in them right now)
model <- nlme(y~LVB(x,Linf, K, t0),data=dframe,
              fixed = list(Linf~pop, K~1, t0~pop),
              random = Linf ~1|id,
              start  = list(fixed= c(80, 0,
                                     0.5,
                                     -0.2, 0)))

# Create data frame of predicted values
predframe <- with(dframe, expand.grid(x = seq(0.5, 11, 0.1), y = seq(min(y), max(y), 20), pop = unique(pop)))
predframe$fitted <- predict(model, level = 0, newdata = predframe)

# Graph with ggplot 
g <- ggplot(dframe, aes(x, y, color = pop))
g + geom_point() + 
  geom_line(data =predframe, aes(x=x, y=fitted, color= pop))

# This is plotting the model bits properly
ggvis(dframe, ~x, ~y, fill = ~pop) %>%
  layer_points(size := 30) %>%
  layer_points(data = predframe, y =~fitted, fill =~pop, size := 1)

# This is the best I can get
ggvis(dframe, ~x, ~y, fill = ~pop) %>%
  layer_points() %>%
  layer_paths(data = predframe, y =~fitted, fill := NA, stroke =~pop)

# Results in squiggles
predframe <- predframe[order(predframe$fitted),]
ggvis(dframe, ~x, ~y, fill = ~pop) %>%
  layer_points() %>%
  layer_paths(data = predframe, y =~fitted, fill := NA, stroke =~pop)

# More squiggles.
predframe <- predframe[order(predframe$x),]
ggvis(dframe, ~x, ~y, fill = ~pop) %>%
  layer_points() %>%
  layer_paths(data = predframe, y =~fitted, fill := NA, stroke =~pop)

    ggvis(predframe, ~x, ~fitted, stroke = ~pop) %>%
  layer_lines() %>%
  layer_points(data = dframe, x=~x, y=~y, fill = ~pop) %>%
  scale_numeric('x', domain = input_slider(0, 11, c(0, 11)), clamp = T)

ggvis(predframe, ~x, ~fitted, stroke = ~pop) %>%
  layer_lines() %>%
  layer_points(data = dframe, x=~x, y=~y, fill = ~pop) %>%
  scale_numeric('x', domain = input_slider(0, 11, c(0, 11)), clamp = T)

predframe <- predframe %>%
  arrange(x)
ggvis(dframe, ~x, ~y, fill = ~pop, stroke = ~pop) %>%
  layer_points() %>%
  layer_paths(data = group_by(predframe, pop), y =~fitted, stroke =~pop, fill := NA) %>%
  scale_numeric('x', domain = input_slider(0, 11, c(0, 11)), clamp = T)