如何在Shiny

时间:2016-12-16 12:49:11

标签: r plot shiny rhandsontable

我正在开发一个带有绘图(代码中的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)

                    }
            }
    })

})

欢迎任何帮助或想法!

谢谢!

艾达

1 个答案:

答案 0 :(得分: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)