闪亮的反应子集

时间:2018-01-31 17:57:11

标签: r shiny

我正在尝试对三列(StockCode,Price,label)的数据框进行子集化

但我不得不使用被动反应,我的问题是如何渲染标签

我需要像renderText(dataset()$ label)

这样的思考

ui.R

library(shiny)

# Define UI for app that draws a histogram ----
ui <- fluidPage(

  # App title ----
  titlePanel("Hello Shiny!"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(
     uiOutput("codePanel") 


    ),

    # Main panel for displaying outputs ----
    mainPanel(

     textOutput("text")

    )
  )
)

server.R

server <- function(input, output) {

output$codePanel<-renderUI({

selectInput("codeInput",label ="choose code",choices =data$StockCode)  


})


dataset<-reactive({ 

subset(data,data$StockCode==input$codeInput)  

})


 output$text<-renderText(dataset())

}

2 个答案:

答案 0 :(得分:1)

如果我们希望显示data.frame输出,请使用renderDataTable中的DT。为了重现性,使用内置数据集iris

library(shiny)
library(DT)
ui <- fluidPage(
  # App title ----
  titlePanel("Hello Shiny!"),
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(
      uiOutput("codePanel") 
    ),

    mainPanel(

      DT::dataTableOutput("text")

    )
  )
)

server <- function(input, output) {


  filt <- selectInput("codeInput",label ="choose code",
                        choices = as.list(unique(iris$Species)))

  output$codePanel <- renderUI({ filt

  })

  dataset<-reactive({ 

    subset(iris, Species == input$codeInput)  

  })


  output$text<-renderDataTable(dataset())


}

shinyApp(ui = ui, server = server)

-output

enter image description here

数据集行可以粘贴到一个字符串中,以便在renderText

中使用
ui <- fluidPage(
  # App title ----
  titlePanel("Hello Shiny!"),
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(
      uiOutput("codePanel") 
    ),

    mainPanel(

      verbatimTextOutput("text")

    )
  )
)




server <- function(input, output) {


  filt <- selectInput("codeInput",label ="choose code",
                        choices = as.list(unique(iris$Species)))

  output$codePanel <- renderUI({ filt

  })

  iris$Species <- as.character(iris$Species)
  dataset<-reactive({ 

    do.call(paste, c(collapse = "\n", rbind(colnames(iris), subset(iris, Species == input$codeInput))))

  })


  output$text<-renderText(dataset())


}




shinyApp(ui = ui, server = server)

-output

enter image description here

或将htmlOutputrenderUI

一起使用
ui <- fluidPage(
  # App title ----
  titlePanel("Hello Shiny!"),
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(
      uiOutput("codePanel") 
    ),

    mainPanel(

      htmlOutput("text")

    )
  )
)

server <- function(input, output) {


  filt <- selectInput("codeInput",label ="choose code",
                        choices = as.list(unique(iris$Species)))

  output$codePanel <- renderUI({ filt

  })

  dataset<-reactive({ 

    do.call(paste, c(collapse = "<br/>", rbind(colnames(iris), subset(iris, Species == input$codeInput))))

  })


  output$text<-renderUI(HTML(dataset()))


}




shinyApp(ui = ui, server = server)

enter image description here

答案 1 :(得分:0)

我无法从renderDataTable获得DT上班。一条消息说某些功能被屏蔽了。因此,我删除了DT,并从R Studio关于表和data.frames的教程中添加了一些代码。这是我想出的:

library(shiny)

ui <- fluidPage(

  # App title ----
  titlePanel("Subsetting Iris Dataset"),

  sidebarLayout(

    # Sidebar panel for inputs
    sidebarPanel(
      uiOutput("codePanel"),

      # Input: Numeric entry for number of obs to view
      numericInput(inputId = "obs",
                   label = "Number of observations to view:",
                   value = 10)
    ),

    mainPanel(
      tableOutput("view")
    )
  )
)

server <- function(input, output) {

  filt <- selectInput("codeInput", label = "choose code",
                       choices = unique(iris$Species))

  output$codePanel <- renderUI({ filt

  })

  dataset <- reactive({ 

    subset(iris, Species == input$codeInput)  

  })

  output$view <- renderTable(head(dataset(), n = input$obs))

}

shinyApp(ui = ui, server = server)

enter image description here