R shiny: объедините выбор и слайдер в интерактивном трехмерном сюжете

Question

Я хотел бы создать трехмерный график рассеяния, который можно вращать с помощью мыши. Я счастлив, что у меня нет всплывающего окна (хотя это не обязательно, но пока упрощает задачу). Я могу сделать это с renderRglwidget(). Мне также удалось добавить ползунок, который изменяет диапазон переменной x.

Теперь все становится выше моей головы: я хотел бы переключаться между разными переменными для оси x, но сохранил все остальные функции . (Я управлял переключателем сам по себе, но другие функции go отсутствуют!)

Как только это будет освоено, я хочу иметь все три оси таким гибким образом: выберите переменную и измените показанный диапазон . Это означает, что каждая переменная numeri c может быть на любой оси в любой комбинации (кроме выбора одной и той же переменной дважды, конечно). для отображения разных цветов в зависимости от фиктивной переменной. Фух! Линии (линейной) регрессии не имеют для меня особого смысла, поскольку реальные данные плохо работают с подземными значениями согласия (10% или ниже!).

Я создаю некоторую игру данные ниже, так как я не могу опубликовать sh свои данные. Мои данные далеки от нормального распределения и имеют выбросы.

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)

Этот пример должен работать. Я хотел бы иметь выбор всех трех переменных оси и их диапазон c. Однако between(input$varx,... и scattered(x=active$varx,... я не могу приступить к работе. Я предполагаю, что, как только я отсортировал его по x, он должен быть одинаковым для y и z.

Еще хотелось бы увидеть группировку.

Я изучил inte rnet, где я могу найти решение для любой проблемы, но мне не удается собрать его воедино. Надеюсь, я написал это понятно.

С нетерпением жду ваших ответов!

Герит

Answer 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)