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

Question

我有两个输入 table：标签和 main_plot。我可以使用侧面板中的控件过滤绘图。 "main_plot" 中的列对应于 "label" 中的列。我想同时使用控件过滤两个 table。（例如：如果过滤后我只看到 "label" 的第一列和第二列，我只想看到图中的第一列和第二列）此外，我希望 table 中的单元格宽度相同在情节中。实际上我可以将过滤条件从 output$label 复制到 output$main_plot 但是单元格宽度的问题仍然存在...... 谢谢你的任何建议卡米拉

代码：

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)

})

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

R Shiny - filter two table and heatmap simultaneously (with cells of fix width)

filtering

r

callback

shiny

改变宽度的函数