R Shiny-同时过滤两个表格和热图（具有固定宽度的单元格）

Question

我有两个输入表：label和main_plot。 我可以使用sidePanel中的控件来过滤图。 “ main_plot”中的列对应于“ label”的列。 我想同时使用控件过滤两个表。 （例如：如果在过滤后仅看到“标签”的第一列和第二列，我只想看到图中的第一列和第二列）另外，我希望表格和图中的单元格宽度相同。 实际上，我可以将过滤条件从output $ label复制到output $ main_plot，但是单元格的问题仍然存在...感谢您的任何建议Kamila

编码：

shinyUI(fluidPage(
  titlePanel("title panel"),

  sidebarLayout(

    sidebarPanel(
      selectInput("select_name", 
                     label = "name",
                     choices = c("all", "A", "B", "C", "D","E"),
                     selected = "all"),

   selectInput("select_type", 
              label = "Type",
             choices = c("all", "M", "FFF"),
            selected = "all")
    ),

  mainPanel(
  tableOutput("lab"),
  plotOutput("main_plot")
  )
  )
))



f <- function () sample(seq(1:10), 25, replace=TRUE)
in1 <- cbind (f(), f(), f(), f(), f(), f())
label <- data.frame(L1= c(rep("A", 5), rep("B", 5), rep("C", 5), rep("D", 5), rep("E", 5)), L2=(sample(c("M", "FFF"), 25, replace=TRUE)))
shinyServer(function(input, output) {
  output$main_plot <- renderPlot({
    plot.new()
    par(mar=c(0, 0, 0, 0)); barplot(1:10, xaxs="i", ylim=c(0,10), space=0)
    image(in1)
  })

    output$lab <- renderTable({
      label_sub <- label

      if (input$select_type!="all")
      {
        label_sub <- subset(label_sub, label_sub$L2==input$select_type)
      }


      if (input$select_name!="all")
      {
        label_sub <- subset(label_sub, label_sub$L1==input$select_name)
      }

      t(label_sub)}, include.rownames=FALSE)

})

Answer 1

最终，我和Joe Cheng（非常感谢）对以下解决方案进行了实施。 https://groups.google.com/forum/#!topic/shiny-discuss/hW4uw51r1Ak

 f <- function () sample(seq(1:10), 25, replace=TRUE)

in1 <- cbind (f(), f(), f(), f(), f(), f())
label <- data.frame(L1= c(rep("A", 5), rep("B", 5), rep("C", 5), rep("D", 5), rep("E", 5)), L2=(sample(c("M", "FFF"), 25, replace=TRUE)), ID=seq(1,25))

label_sub <- label  


shinyServer(function(input, output) {
#Create a reactive object which will hold the table in actual state.

   labelSub <- reactive({
    label_sub <- label

    if (input$select_type!="all")
    {
      label_sub <- subset(label_sub, label_sub$L2==input$select_type)
    }


    if (input$select_name!="all")
    {
      label_sub <- subset(label_sub, label_sub$L1==input$select_name)
    }

    return(label_sub)
  })

  output$main_plot <- renderPlot({
    plot.new()
#Access column IDs from the reactive

     IDs <- labelSub()[,3]
    par(mar=c(0, 0, 0, 0)); barplot(1:10, xaxs="i", ylim=c(0,10), space=0)
#get corresponding columns of the source table of the heatmap for_plot <- in1[IDs,]

#If just one column is selected the output is not a matrix but a vector. Therefore we need to convert it to matrix and transpose it.

     if(is.matrix(for_plot)==FALSE)
    {for_plot <- t(as.matrix(for_plot))}

  image(for_plot)
  }, width = function () {60*nrow(labelSub())})

改变宽度的功能

  output$lab <- renderTable({
    t(labelSub())}, include.rownames=FALSE)

})

On Wednesday, June 10, 2015 at 6:17:30 PM UTC+2, machova...@seznam.cz wrote:
I have two input tables: label and main_plot. I am able to filter the plot using controls in the sidePanel. Column in "main_plot" corresponds to columns of "label". I want to filter both tables using controls simultaneously. (e.g.: if I see only first and second column of "label" after filtering I want to see only first and second column in the plot) Additionally I would like to have the same width of cells in the table and in the plot. Actually I could copy filtering criteria from output$label to output$main_plot but the problem with the widht of cells remains... Thank you for any suggestions Kamila

The code:

 shinyUI(fluidPage(
  titlePanel("title panel"),

  sidebarLayout(

    sidebarPanel(
      selectInput("select_name", 
                     label = "name",
                     choices = c("all", "A", "B", "C", "D","E"),
                     selected = "all"),

   selectInput("select_type", 
              label = "Type",
             choices = c("all", "M", "FFF"),
            selected = "all")
    ),

  mainPanel(
  tableOutput("lab"),
  plotOutput("main_plot")
  )
  )
))



f <- function () sample(seq(1:10), 25, replace=TRUE)
in1 <- cbind (f(), f(), f(), f(), f(), f())
label <- data.frame(L1= c(rep("A", 5), rep("B", 5), rep("C", 5), rep("D", 5), rep("E", 5)), L2=(sample(c("M", "FFF"), 25, replace=TRUE)))
shinyServer(function(input, output) {
  output$main_plot <- renderPlot({
    plot.new()
    par(mar=c(0, 0, 0, 0)); barplot(1:10, xaxs="i", ylim=c(0,10), space=0)
    image(in1)
  })

    output$lab <- renderTable({
      label_sub <- label

      if (input$select_type!="all")
      {
        label_sub <- subset(label_sub, label_sub$L2==input$select_ type)
      }


      if (input$select_name!="all")
      {
        label_sub <- subset(label_sub, label_sub$L1==input$select_ name)
      }

      t(label_sub)}, include.rownames=FALSE)

})