Wie kann ich eine feste PlotOutput in Shiny

Question

Ich entwickle eine Shiny-App mit einem Plot (Plot1 im Code), die auf eine Datentabelle (rhandsontable) reagiert und es zeigt das Element in der Tabelle ausgewählt. Der Tisch ist sehr groß, so dass Sie nach unten scrollen müssen, um alles zu sehen. Aber ich möchte, dass die Handlung immer sichtbar ist, also im Layout fixiert werden, während Sie den Tisch nach unten scrollen. Es gibt sowieso, es zu tun? Ich habe viel geforscht, aber jede Antwort, die mir helfen kann.

Mein UI-Code ist, dass:

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') 
        #  ) 
      ) 
    ) 

)

Der Server-Code das heißt:

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) 

        } 
      } 
    }) 

})

Jede Hilfe oder Idee ist willkommen!

Danke!

Aida

Answer 1

Hier ist ein Beispiel für die Verwendung von CSS position: fixed dies zu tun. Sie können die Position top und margin-top entsprechend Ihrer Anforderung einstellen.

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)