динамический интерфейс, который позволяет обновлять фильтры и создавать графики в блестящем R - PullRequest
Новая
       10

динамический интерфейс, который позволяет обновлять фильтры и создавать графики в блестящем R

0 голосов
/ 06 ноября 2018

Я прошу прощения, если это что-то очень простое ... но я не могу понять это. Я создал приложение с сюжетом, который реагирует на 4 выпадающих меню. Первые два выпадающих меню предназначены для осей X и Y (у меня они работают нормально). Вторые два основаны на уникальных значениях в моем фрейме данных. Мне бы хотелось, чтобы эти два выпадающих меню реагировали друг на друга, а затем реагировали на сюжет. Таким образом, в основном я хотел бы, чтобы пользователь выбрал параметр в первом раскрывающемся меню, затем кадр данных будет отфильтрован (также отфильтрован график), а затем также будет отобран выбор для второго раскрывающегося меню с уникальными совпадениями с первое выпадающее меню и наоборот. Я пробовал несколько вещей, но ничего не получалось. Любое руководство или помощь будет принята с благодарностью!

Пример данных: 

df<-structure(list(stdate = structure(c(16611, 16611, 16615, 16615, 
 14004, 14004, 16616, 16616, 16616, 17485, 17485, 17483, 17483, 
 16678, 16678, 14000, 14000, 17211, 17211, 17210), class = "Date"), 
     sttime = structure(c(37800, 37800, 35100, 35100, 42600, 42600, 
     38700, 38700, 32400, 35400, 35400, 33000, 33000, 49800, 49800, 
     34200, 34200, 37800, 37800, 30600), class = c("hms", "difftime"
     ), units = "secs"), locid = c("USGS-01388500", "USGS-01388500", 
     "USGS-01464585", "USGS-01464585", "USGS-01464515", "USGS-01464515", 
     "USGS-01407330", "USGS-01407330", "USGS-01466500", "USGS-01387500", 
     "USGS-01387500", "USGS-01395000", "USGS-01395000", "USGS-01400860", 
     "USGS-01400860", "USGS-01377000", "USGS-01377000", "USGS-01367625", 
     "USGS-01367625", "USGS-01398000"), Specific_conductance = c(525, 
     525, 184, 184, 226, 226, 203, 203, 41, 674, 674, 466, 466, 
     312, 312, 540, 540, 844, 844, 683), HUC14 = c("HUC02030103110020", 
     "HUC02030103110020", "HUC02040201100030", "HUC02040201100030", 
     "HUC02040201060020", "HUC02040201060020", "HUC02030104070070", 
     "HUC02030104070070", "HUC02040202030070", "HUC02030103100030", 
     "HUC02030103100030", "HUC02030104050060", "HUC02030104050060", 
     "HUC02030105090020", "HUC02030105090020", "HUC02030103170060", 
     "HUC02030103170060", "HUC02020007010010", "HUC02020007010010", 
     "HUC02030105030060"), tds = c(294L, 275L, 119L, 100L, 155L, 
     116L, 155L, 115L, 43L, 403L, 382L, 286L, 274L, 177L, 173L, 
     328L, 277L, 435L, 440L, 347L), Chloride = c(109, 109, 31.9, 
     31.9, 33, 33, 36.4, 36.4, 3.38, 153, 153, 72.6, 72.6, 41.5, 
     41.5, 105, 105, 179, 179, 161)), row.names = c(NA, -20L), class = c("tbl_df", 
 "tbl", "data.frame"), .Names = c("stdate", "sttime", "locid", 
 "Specific_conductance", "HUC14", "tds", "Chloride"))

Что я пробовал: 

library(ggplot2)
library(shiny)
library(shinydashboard)

header<-dashboardHeader()
sidebar<-dashboardSidebar()
body<-dashboardBody(


fluidRow(
    box(width = 12, plotOutput("plot5"))),

fluidRow(
  box(selectInput("x","x",choices = c("tds","Chloride","Specific_conductance"),selected = "Specific_conductance")),
  box(selectInput("y","y",choices =c("tds","Chloride","Specific_conductance") ,selected = "tds")),
  uiOutput("locid1"),
  uiOutput("huc1")))

ui<- dashboardPage(
  header = header,
  sidebar = sidebar,
  body = body

)
### Create server of app ###
server<- function(input,output,session){

  output$locid1<- renderUI({
    selectizeInput("locid","Select Locid",
                   choices = as.character(unique(df$locid)))
  })

  datasub<-reactive({
    df[df$locid == input$locid,]
  })

  output$huc1<- renderUI({
    selectizeInput("huc","Select HUC",
                   choices = unique(datasub()[,"HUC14"]),
                   selected = unique(datasub()[,"HUC14"])[1])
  })

  datasub2<-reactive({
    datasub()[df$HUC14 == input$huc,]
  })


  output$plot5 <- renderPlot({
    ggplot(data= datasub2(),aes_string(x=input$x,y=input$y))+
      geom_point()+
      geom_smooth(method = "lm", se = FALSE) +
      ggtitle(input$locid,input$huc)
  })
}

shinyApp(ui,server)

1 Ответ

0 голосов
/ 06 ноября 2018

Вы можете сделать это, используя subset. Во-первых, вы выбираете только те записи, где locid - это то, что пользователь указывает, используя input$locid, чтобы получить реактивный фрейм данных. Затем вы устанавливаете этот фрейм данных на основе HUC14 == input$huc.

Также см. Правильный способ генерации значений для output$huc1 с использованием unique(datasub()$HUC14)

server<- function(input,output,session){

  output$locid1<- renderUI({
    selectizeInput("locid","Select Locid",
                   choices = as.character(unique(df$locid)))
  })

  datasub<-reactive({
    foo <- subset(df, locid == input$locid)
    return(foo)
  })

  output$huc1<- renderUI({
    selectizeInput("huc","Select HUC",
                   choices = unique(datasub()$HUC14),
                   selected = unique(datasub()$HUC14)[1])
  })

  datasub2<-reactive({
    foo <- subset(datasub(), HUC14 == input$huc)
    return(foo)
  })

  output$plot5 <- renderPlot({
    ggplot(data = datasub2(), aes_string(x=input$x, y=input$y))+
      geom_point()+
      geom_smooth(method = "lm", se = FALSE) +
      ggtitle(input$locid, input$huc)
  })
}
...