2016-12-16 64 views
0

我正在开发一个Shiny应用程序与情节(plot1在代码中)反应的数据表(rhandsontable),它显示在桌上选择的项目。 表格非常大,所以您必须向下滚动以查看所有内容。但是我希望情节总是可见的,所以当你向下滚动表格时,要在版面中修正。 还有吗?我做了很多研究,但任何可以帮助我的答案。我怎样才能得到一个固定plotOutput在闪亮

我的UI代码是:

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) 

        } 
      } 
    }) 

})

任何帮助或想法会受到欢迎!

谢谢!

阿依

+0

你能提供服务器代码和可再现的数据来渲染应用程序吗? –

+0

@raistlin我可以提供服务器代码,但不提供数据,因为它是保密的。但我认为这可能更简单,只是通过UI进行学习。我现在将用服务器代码修改我的问题。谢谢 – Aida

回答

0

下面是使用CSS position: fixed做到这一点的例子。您可以根据您的要求调整位置topmargin-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)