R shiny：在交互式 3d 图中结合选择和滑块

Posted 2023-03-24

【中文标题】R shiny：在交互式 3d 图中结合选择和滑块

【英文标题】：R shiny : combine choice and slider in interactive 3d plot

【发布时间】：2020-10-05 16:53:36

【问题描述】：

我想制作一个可以用鼠标旋转的 3d 散点图。我很高兴有这个没有弹出窗口（虽然这不是必须的，但现在让事情变得更容易了。）。我可以通过renderRglwidget() 愉快地做到这一点。我还设法添加了一个更改 x 变量范围的滑块。

现在事情超出了我的想象：我想在 x 轴的不同变量之间切换，但保留所有其他功能。 （我自己管理了一个开关，但是其他功能就不见了！）

一旦掌握了这一点，我将希望以这种灵活的方式拥有所有三个轴：选择变量并更改显示的范围。这意味着每个数值变量可以以任意组合位于任意轴上（当然，除了选择相同的变量两次之外）。

提前思考 (!!) 有可能根据虚拟变量显示不同的颜色会很酷。呸！ （线性）回归线对我来说没有多大意义，因为现实生活中的数据表现不佳，拟合优度低于地球（10% 或更低！）。

我在下面生成了一些播放数据，因为我无法发布我的数据。我的数据远未接近正态分布并且存在异常值。

set.seed(1)
somedata <- data.frame(
    v1 = rnorm(2000, 0, 1),
    v2 = sample(c("yes", "no"), 2000, replace = TRUE),
    v3 = rnorm(2000, 100, 15),
    v4 = sample(c("blue", "green", "red"), 2000, replace = TRUE),
    v5 = rnorm(2000, 10, 15),
    v6 = rnorm(2000, 10, 15)
)
somedata$v1 <- ifelse(somedata$v2 == "yes", somedata$v1 + 1000, somedata$v1)

这是我调整后的代码

library(rgl) #plot widget
library(car) # scatter3d
library(shiny)
library(dplyr)# "select", "filter"


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(

      helpText("Just some text"),

      selectInput("varx",
                  label = "x-Variable", 
                  choices = c("textx1", "textx2"),
                  selected = "textx1"),

      sliderInput("rangex",
                  label = "Range of X", 
                  min = -5000, max = 9000, value = c(-5000, 9000)),

      textOutput("SliderTextx")
  ), #sidebarPanel
  mainPanel(

      rglwidgetOutput("plot",  width = 800, height = 600)
  )#mainPanel
  )#sidelayout
)#fluidpage

server <- function(input, output) 
  chosendata <-  reactive(
    # make sure inputs are not Null
    req(input$rangex)

    #filter data according to inputs
    chosendata <- filter(somedata, between(v1, input$rangex[1], input$rangex[2]))
    return(chosendata)
  )#reactive

  # ensures that our filter works
  observe(print(str(chosendata())))

  #create a graph
  output$plot <- renderRglwidget(
    req(chosendata())
    active <- chosendata()
    rgl.open(useNULL=T)
    scatter3d(x= active$v1, y= active$v5, z= active$v6, 
              surface=FALSE, ellipsoid = TRUE)
    rglwidget()
  )

#function   

shinyApp(ui = ui, server = server)

这个例子应该运行。我想选择所有三个轴变量及其特定范围。但是，between(input$varx,... 和scattered(x=active$varx,...我无法上班。我猜一旦我对 x 进行了排序，它对 y 和 z 应该是相同的。

除此之外，我还想查看分组。

我在互联网上四处搜寻，可以找到解决非此即彼挑战的方法，但我无法将它们组合在一起。我希望我以一种可以理解的方式写了这篇文章。

期待您的回复！

格瑞特

【参考方案1】：

很遗憾，您的示例代码对我产生了错误。

这是一个玩具示例，我希望展示您想要的功能：您可以选择 x 轴、y 轴和（作为一个因素）上的任何变量作为分组变量。显然，并非每种组合都是明智的！

library(shiny)
library(tidyverse)

ui <- fluidPage(
  wellPanel(
    selectInput("x", "X axis variable", choices=c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb"), selected="wt"),
    selectInput("y", "Y axis variable", choices=c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")),
    selectInput("group", "Grouping variable", choices=c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb"), selected="cyl")
  ),
  wellPanel(
    plotOutput("plot")
  )
)

server <- function(input, output) 
  output$plot <- renderPlot(
    req(input$group, input$x, input$y)

    mtcars %>% 
      ggplot(aes_string(x=input$x, y=input$y)) +
      geom_point(aes(colour=as.factor(!!as.name(input$group))))
  )


shinyApp(ui, server)

【讨论】：

感谢 Limey 的回复。它已经表明了我想提出的另一点。你鼓励我再次尝试展示我想看到的东西。我希望这能通过。