2016-12-16 3 views
0

私は、データテーブル(rhandsontable)に反応するプロット(plot1)を使ってShinyアプリケーションを開発しており、テーブルに選択された項目を表示します。 テーブルが非常に大きいので、すべてを見るためにスクロールする必要があります。しかし、私はプロットを常に目に見えるようにしたいので、テーブルを下にスクロールしながらレイアウトに固定する必要があります。 これはどうしてですか?私は多くの研究をしましたが、私を助けることができる答えです。Shinyで固定PlotOutputを得るには

私のUIコードがあることである:すべてのヘルプやアイデアは大歓迎だろう

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) 

        } 
      } 
    }) 

})

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

サーバーコードはということです!

ありがとうございます!ここでアイーダ

+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) 
関連する問題