Advertisement
Guest User

Untitled

a guest
Jul 23rd, 2019
72
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.02 KB | None | 0 0
  1. options(shiny.reactlog = TRUE)
  2. library(shiny)
  3. library(reactlog)
  4.  
  5. mod_iris_ui <- function(id) {
  6. ns <- NS(id)
  7.  
  8. tagList(
  9. fluidRow(
  10. column(
  11. 2,
  12. selectInput(
  13. inputId = ns("species"),
  14. label = "species",
  15. choices = list(
  16. "loading..." = 1
  17. ),
  18. selected = 1
  19. )
  20. ),
  21. column(
  22. 10,
  23. plotOutput(ns("speciesplot"))
  24. )
  25. )
  26. )
  27. }
  28.  
  29. mod_iris <- function(input, output, session) {
  30. ns <- session$ns
  31.  
  32. df <- reactive({
  33. req(ns(input$open_tab) == "iris")
  34.  
  35. df <- iris
  36. })
  37.  
  38. observe({
  39. req(ns(input$open_tab) == "iris")
  40.  
  41. values <- as.character(unique(df()[["Species"]]))
  42.  
  43. updateSelectInput(session, "species",
  44. choices = values,
  45. selected = values[1]
  46. )
  47. })
  48.  
  49. output$speciesplot <- renderPlot({
  50. hist(iris[iris$Species == input$species, 1])
  51. })
  52. }
  53.  
  54. mod_mtcars_ui <- function(id) {
  55. ns <- NS(id)
  56.  
  57. tagList(
  58. fluidRow(
  59. column(
  60. 2,
  61. selectInput(
  62. inputId = ns("gear"),
  63. label = "gear",
  64. choices = list(
  65. "loading..." = 1
  66. ),
  67. selected = 1
  68. )
  69. ),
  70. column(
  71. 10,
  72. plotOutput(ns("gearplot"))
  73. )
  74. )
  75. )
  76. }
  77.  
  78. mod_mtcars <- function(input, output, session) {
  79. ns <- session$ns
  80.  
  81. df <- reactive({
  82. req(ns(input$open_tab) == "mtcars")
  83.  
  84. df <- mtcars
  85. })
  86.  
  87. observe({
  88. req(ns(input$open_tab) == "mtcars")
  89.  
  90. values <- unique(df()[["gear"]])
  91.  
  92. updateSelectInput(session, "gear",
  93. choices = values,
  94. selected = values[1]
  95. )
  96. })
  97.  
  98. output$gearplot <- renderPlot({
  99. hist(mtcars[mtcars$gear == input$gear, 1])
  100. })
  101. }
  102.  
  103. ui <- tagList(
  104. navbarPage(
  105. title = "App",
  106. id = "open_tab",
  107.  
  108. tabPanel(
  109. "iris",
  110. mod_iris_ui("iris")
  111. ),
  112.  
  113. tabPanel(
  114. "mtcars",
  115. mod_mtcars_ui("mtcars")
  116. )
  117. )
  118. )
  119.  
  120. server <- function(input, output, session) {
  121. callModule(
  122. mod_iris,
  123. "iris"
  124. )
  125.  
  126. callModule(
  127. mod_mtcars,
  128. "mtcars"
  129. )
  130. }
  131.  
  132. shinyApp(ui = ui, server = server)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement