R无效元素:在通用id中使用“i”(对于1:8中的i)

时间:2018-03-16 15:39:10

标签: r hover flexdashboard

我有一个带有几个图形的flexdashboard,我想添加一个悬停功能,其工具提示显示其中8个数据。

为避免复制整个hoveroptions +工具提示代码8次,我使用一个循环来创建具有不同名称(1-8)的hoveroptions 8x(它是相同选项的8倍)并将工具提示(一个renderUI)转换为带参数“data”和“i”的函数。

我需要使用不同名称的相同hoveroptions,因为如果我只使用一个,当我将鼠标悬停在图2上时,图1将显示工具提示,这显然不是我想要的。我的所有图表都使用相同数据集的一部分,但在同一位置显示不同的变量。例如图1显示变量Wtot,而图2显示变量Mtot,它位于相同的植物/行坐标上。

我的工具提示中有问题:如何编写hoverOpts ID的通用版本? id是plot_hover1,plot_hover2等等。使用paste("input$plot_hover",i,sep="")不起作用。它创建一个字符串,看起来与id完全相同,但它显然没有相同的含义。

代码(1个示例)

---
title: "Test"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
library(ggplot2)

# data
Wtot <- c(10,65,139,87) 
plant <- c(15,15,30,30) 
row <- c(10,20,10,20) 
df <- data.frame(Wtot,plant,row)

# hover options x8
HO <- list(NULL)
for (i in 1:8){
  HO[[i]] <- hoverOpts(id = paste("plot_hover",i,sep=""), delay = 300,
                       delayType = c("debounce", "throttle"), clip = TRUE, nullOutside = TRUE)
}

# plot function
Wplot <- function(dat,i){
renderPlot({
  ggplot(data=dat, aes(row, plant, colour=Wtot)) +
    xlim(0,40) +
    ylim(0,50) +
    coord_equal() +
    geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
    scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
                         limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
    scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
    guides(fill=guide_legend(), size = guide_legend())
}, outputArgs = list(hover = HO[[i]])) # <-- i works
}

# tooltip function
tooltip <- function(dat,i){
renderUI({
  hover <- input$plot_hover1 # <-- problem with id, "1" should be "i"
  point <- nearPoints(dat, hover)
  if (nrow(point) == 0) return(NULL)

  left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left)
  top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom)
  left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left)
  top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top)

  style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85);",
                    "left:", left_px + 30, "px; top:", top_px + 2, "px;")
  wellPanel(
    style = style,
    p(HTML(paste0("<b> nr: </b>", rownames(point), "<br/>",
                  "<b> Wtot: </b>", point$Wtot, "<br/>"))))
})
}
```

```{r}
# plot 1 with tooltip
Wplot(df,1)
tooltip(df,1)
```

1 个答案:

答案 0 :(得分:1)

我认为您可以使用hover <- eval(parse(text = paste0("input$plot_hover", i)))

这意味着您解析角色,然后像运行命令一样对其进行评估。

再试一次。你的例子很奇怪,因为所有的图都是一样的,最初你只绘制了第一个图,但你不能用它来测试其他图。我并排绘制了前两个图,但没有打算让两个图都不同 - 我相信你可以做到。

---
title: "Test"
output: 
  flexdashboard::flex_dashboard:
  orientation: columns
vertical_layout: fill
runtime: shiny
---

```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
library(ggplot2)

# data
Wtot <- c(10,65,139,87)
plant <- c(15,15,30,30)
row <- c(10,20,10,20) 
df <- data.frame(Wtot,plant,row)

# hover options x8
HO <- list(NULL)
for (i in 1:8){
  HO[[i]] <- hoverOpts(id = paste("plot_hover",i,sep=""), delay = 300,
                       delayType = c("debounce", "throttle"), clip = TRUE, nullOutside = TRUE)
}

# plot function
Wplot <- function(dat,i){
  renderPlot({
    ggplot(data=dat, aes(row, plant, colour=Wtot)) +
      xlim(0,40) +
      ylim(0,50) +
      coord_equal() +
      geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +
      scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey",
                           limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +
      scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +
      guides(fill=guide_legend(), size = guide_legend())
  }, outputArgs = list(hover = HO[[i]])) # <-- i works
}

# tooltip function
tooltip <- function(dat,i){
  renderUI({
    hover <- eval(parse(text = paste0("input$plot_hover", i))) # <-- problem with id, "1" should be "i"
    # hover <- input$plot_hover1
    point <- nearPoints(dat, hover)
    if (nrow(point) == 0) return(NULL)

    left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left)
    top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom)
    left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left)
    top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top)

    style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85);",
                    "left:", left_px + 30, "px; top:", top_px + 2, "px;")
    wellPanel(
      style = style,
      p(HTML(paste0("<b> nr: </b>", rownames(point), "<br/>",
                    "<b> Wtot: </b>", point$Wtot, "<br/>"))))
  })
}
```

##

### Plot 1

```{r}
# plot 1 with tooltip
Wplot(df,1)
tooltip(df,1)
```

##

### Plot 2

```{r}
# plot 1 with tooltip
Wplot(df,2)
tooltip(df,2)
```