如何在Shiny

Question

我正在开发一个带有绘图（代码中的plot1）的Shiny app，它对数据表（rhandsontable）有反应，并显示在表格中选择的项目。 该表非常大，因此您必须向下滚动才能看到所有内容。但我希望绘图始终可见，因此在向下滚动表格时要在布局中修复。 无论如何要做到这一点？我做了很多研究，但任何答案都可以帮助我。

我的用户界面代码是：

ui <- dashboardPage(
    dashboardHeader(title = "IG Suppliers: Tim"),
    dashboardSidebar(
            sidebarMenu(
                    menuItem("Data Cleansing", tabName = "DataCleansing", icon = icon("dashboard")),
                    selectInput("supplier","Supplier:", choices = unique(dt_revision_tool$Supplier)),
                    #selectInput("supplier","Supplier:", choices = 'Phillips'),

                    selectInput("segment","Segment:", choices = unique(dt_revision_tool$Segment_Name), multiple = TRUE, selected = unique(dt_revision_tool$Segment_Name)[1]),
                    #selectInput("segment","Segment:", choices = sgm),

                    selectInput("alert","Alert", choices = unique(dt_revision_tool$Alert),selected = "Yes"),
                    #selectInput("alert","Alert", choices = c('Yes','No'),selected = "Yes"),

                    selectInput("dfu","DFU", choices = c("NULL",unique(dt_revision_tool$DFU)),selected = "NULL"),

                    tags$hr()
                    #                         h5("Save table",align="center"),
                    #                         
                    #                         div(class="col-sm-6",style="display:inline-block", 
                    #                             actionButton("save", "Save"),style="float:center")

            )
    ),
    dashboardBody(
            shinyjs::useShinyjs(),
            #First Tab
            tabItems(
                    tabItem(tabName= "DataCleansing",
                            fluidPage(theme="bootstrap.css",

                                      fluidRow(
                                              plotOutput('plot1')

                                      ),
                                      fluidRow(
                                              verbatimTextOutput('selected'),
                                              rHandsontableOutput("hot")
                                      )



                            )
                    )

                    #       #Second Tab
                    #       tabItem(tabName = "Forecast",
                    #               h2('TBA')
                    #       )
            )
    )

）

服务器代码是：

server <- shinyServer(function(input, output) {
    if (file.exists("DF.RData")==TRUE){
            load("DF.RData")
    }else{
            load("DF1.RData")  
    }
    rv <- reactiveValues(x=dt_revision_tool)

    dt <- reactiveValues(y = DF)

    observe({
            output$hot <- renderRHandsontable({

                    view = data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu))

                    if (nrow(view)>0){

                            rhandsontable(view,
                                          readOnly = FALSE, selectCallback = TRUE, contextMenu = FALSE)  %>%
                                    hot_col(c(1:12,14),type="autocomplete", readOnly = TRUE)
                    }
            })
    })



    observe({

            if (!is.null(input$hot)) {
                    aux = hot_to_r(input$hot)
                    aux = subset(aux, !is.na(Cleansing_Suggestion) | Accept_Cleansing,select=c('DFU','Week','Cleansing_Suggestion',
                                                                                               'Accept_Cleansing'))

                    names(aux) = c('DFU','Week','Cleansing_Suggestion_new','Accept_Cleansing_new')
                    dt$y = update_validations(dt$y,aux)
                    DF = dt$y
                    save(DF, file = 'DF.RData')

            }
    })




    output$plot1 <- renderPlot({

            view = data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu))

            if (nrow(view)>0){
                    if (!is.null(( data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu)))[input$hot_select$select$r]$DFU)) {
                            s = make_plot2(rv$x,(data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu)))[input$hot_select$select$r]$DFU,(data.table(update_view(rv$x,input$alert,input$segment,input$supplier,dt$y,input$dfu)))[input$hot_select$select$r]$Article_Name)
                            print(s)

                    }
            }
    })

}）

欢迎任何帮助或想法！

谢谢！

艾达

Answer 1

以下是使用CSS position: fixed执行此操作的示例。您可以根据自己的要求调整排名top和margin-top。

library(shiny)

ui <- shinyUI(fluidPage(

  titlePanel("Example"),

  sidebarLayout(
    sidebarPanel(
      tags$div(p("Example of fixed plot position"))
    ),

    mainPanel(
      plotOutput("plot"),
      tableOutput("table"),
      tags$head(tags$style(HTML("
                                #plot {
                                  position: fixed;
                                  top: 0px;
                                }
                                #table {
                                  margin-top: 400px;
                                }
                                ")))
    )
  )
))

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

  output$plot <- renderPlot({
    plot(iris$Sepal.Length, iris$Sepal.Width)
  })   

  output$table <- renderTable({
    iris
  })

})

shinyApp(ui = ui, server = server)