0

データ テーブル (rhandsontable) に反応するプロット (コード内の plot1) を持つ Shiny アプリを開発しており、テーブルで選択されたアイテムを表示します。表は非常に大きいため、すべてを表示するには下にスクロールする必要があります。ただし、プロットを常に表示して、テーブルを下にスクロールしている間、レイアウトを固定する必要があります。とにかくそれを行うことはありますか？私は多くの調査を行いましたが、私を助けることができる答えはどれでもあります。

私の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)

                    }
            }
    })

}))

どんな助けやアイデアも大歓迎です！

ありがとう！

会田

4

1 に答える 1

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)
于 2016-12-16T15:47:48.620 に答える