R Shiny: совместите выбор и ползунок в интерактивном 3D-графике

Я хотел бы создать 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,...I не могут приступить к работе. Я предполагаю, что после того, как я отсортировал его по x, он должен быть одинаковым для y и z.

Кроме того, я хотел бы увидеть группировку.

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

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

Герит


r reactive scatter3d shiny selectinput
person Gerit    schedule 16.06.2020    source источник

Ответы (1)


arrow_upward
0
arrow_downward

К сожалению, ваш пример кода вызвал у меня ошибку.

Вот игрушечный пример, который, я надеюсь, демонстрирует желаемую функциональность: вы можете выбрать любые переменные по оси 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)
person Limey    schedule 16.06.2020
comment
Спасибо, Лими, за ответ. Это уже показывает другой момент, который я хотел бы сделать. И вы призвали меня попробовать еще раз, чтобы показать то, что я хотел бы видеть. Я надеюсь, что это пройдет. - person Gerit; 16.06.2020