光沢がある別のタブのプロット

Question

私は非常に単純な問題として表示される可能性があります。私は別のプロットを別のタブで表示したいと思います。このため、私はすでにタブの内容としてoutput$Sidebarとoutput$TABUIを使用しているコードをいくつか持っています。

私はプロットに対していくつかのコントロールを使用したいが、すべてのコントロールは同一であるため、それらを複製して各タブ内に表示したくないので、異なるタブのすぐ下にそれらを必要とする。

ダッシュボードボディに何も表示されないので、私のコードで何かを忘れてしまいます。タブはちょうど良い（それが見えるように）作成されますので、私のコントロールはその下にあります。私のデータは読み込まれ（コンソールでこれを見ることができます）、私はコントロールを操作することができますが、ボディには何も表示されません。

私は、以下のように、コードを（もっと長く）変更して、最小限の例を作ろうとしました。

編集：sidebarmenuと​​の両方がUI.Rにある場合、SERVER.Rの先頭にロードされている自分のデータがロードされていないことを除いて、UIのすべてが正しくコンパイルされます。 server.Rが実行されていないようです。 server.Rからsidebarmenuとthetabitemsを定義すると、データはロードされますが、コントロールは表示され、サイドバーメニューと本文は表示されません。私はこの行動も理解できません。 UI.Rにtabitemsを残し、server.Rのサイドバーメニューを残すと、データもロードされません。アプリはちょうどそこに座って何も起こらない。 誰かが理由を知っていると思ったら、私は説明をしてうれしいです。 ありがとうございます。

ui.R：

library(shiny) 
library(shinydashboard) 

body <- dashboardBody(
    tags$head(
    tags$link(
     rel = "stylesheet", 
     type = "text/css", 
     href = "css/custom.css" 
    ) 
), 
    uiOutput("TABUI") 

) 

sidebar <- dashboardSidebar(
    width = 350, 
    uiOutput("Sidebar") 
) 

header <- dashboardHeader(
    title = "Dashboard", 
    titleWidth = 350, 

    tags$li(
    class = "dropdown", 
    img(
     src = 'img/General_Logo.png', 
     style = 'margin-right:150px; margin-top:21px') 
) 
) 

dashboardPage(
    header, 
    sidebar, 
    body 
) 

Server.R

library(ggplot2) 
library(dplyr) 
library(RColorBrewer) 
library(XLConnect) 
library(htmlTable) 
library(plotly) 

# Loading data ----------------------------------------------------- 
raw_data <- read.csv("file.csv") 

# Server function --------------------------------------------------- 
shinyServer(function(input, output) { 

    # Tabs and content 

    ntabs <- 4 
    tabnames <- paste0("tab ", 1:ntabs) 

    output$Sidebar <- renderUI({ 
    Menus <- vector("list", ntabs + 2) 
    for (i in 1:ntabs){ 
      Menus[[i]] <- menuItem(tabnames[i], tabName = tabnames[i], icon = icon("dashboard")) 
    } 
    # Controls to appear below tabs 
    Menus[[ntabs + 1]] <- selectInput("dpt", "Departments :", 
       c("dpt 1" = "DPT1", 
        "dpt 2" = "DPT2", 
        "dpt 3" = "DPT3"), 
       multiple = TRUE, 
       selectize = TRUE) 

    Menus[[ntabs + 2]] <- uiOutput("bottleneck") 
    Menus[[ntabs + 3]] <- uiOutput("daterange") 
    Menus[[ntabs + 4]] <- submitButton() 

    do.call(function(...) sidebarMenu(id = 'sidebarMenu', ...), Menus) 
    }) 

    # content of each tab 
    output$TABUI <- renderUI({ 
    Tabs <- vector("list", ntabs) 
    Tabs[[1]] <- tabItem(tabName = tabnames[1], 
         # fluidRow(box(h3("foo."))) 
         fluidRow(
          box(
          plotOutput("plot_1") 
          ) 
         ) 
    ) 
    Tabs[[2]] <- tabItem(tabName = tabnames[2], 
         "Tab 2 Stuff") 
    Tabs[[3]] <- tabItem(tabName = tabnames[3], 
         "Tab 3 Stuff") 
    Tabs[[4]] <- tabItem(tabName = tabnames[4], 
         "Tab 4 Stuff") 
    do.call(tabItems, Tabs) 
    }) 

    formulaText <- reactive({ 

    if (is.null(data.r())) { 
     return("some text") 
    } 

    paste0(as.character(input$daterange[1]), " to ", as.character(input$daterange[2]), " - blah blah") 
    }) 

    output$bottleneck <- renderUI({ 
    selectInput('bottleneck', HTML('<font color=\"black\"> Bottlenecks : </font>'), c(Choose = '', raw_data[raw_data$is_bottleneck == 1 & !is.na(raw_data$Sort.field) & raw_data$Cost.Center %in% input$dpt,]$Sort.field %>% unique() %>% sort()), selectize = TRUE) 
    }) 

    output$daterange <- renderUI({ 
    dateRangeInput(inputId = 'daterange', 
        label = HTML('<font color=\"black\"> Select period : </font>'), 
        min = min(raw_data$Completn.date) , 
        start = min(raw_data$Completn.date) , 
        max = max(raw_data$Completn.date), 
        end = max(raw_data$Completn.date)) 
    }) 

    data.r = reactive({ 

    if (is.null(input$dpt)) { 
     return(NULL) 
    } 

    ifelse(input$bottleneck == "", a <- raw_data %>% filter(Completn.date >=  input$daterange[1], 
                      Completn.date <= input$daterange[2]), 
      a <- raw_data %>% filter(Completn.date >= input$daterange[1], 
            Completn.date <= input$daterange[2], 
            Sort.field %in% input$bottleneck)) 

    return(a) 
    }) 

    output$table_ranking <- renderHtmlTableWidget({ 

    if (is.null(data.r())) { 
     return() 
    } 

    ranking <- read.csv("ranking.csv", header = TRUE) 
    htmlTableWidget(ranking) 
    }) 

    output$caption <- renderText({ 
    formulaText() 
    }) 

    output$plot_1 <- renderPlot({ 

    if (is.null(data.r())) { 
     return() 
    } 

    current_data <- data.r() 

    p0 <- current_data %>% 
     ggplot(aes(x = x1, y = y1)) + 
     geom_point() 

    p0 

    }) 

    output$plot_2 <- renderPlot({ 

    if (is.null(data.r())) { 
     return() 
    } 

    current_data <- data.r() 

    p0 <- current_data %>% 
     ggplot(aes(x = x2, y = y2)) + 
     geom_point() 

    p0 

    }) 
}) 

これはhere示唆されたものを複製できませんでした試みです。

これを調べていただきありがとうございます。

Answer 1

私はついに答えを見つけました。

私はいくつかの反応性要素を別のタブに重複しています。何らかの理由で、シャイニーはこれを好まない。いったん私は別の反応性の文字列を作成したら（私の場合）、すべてがうまくいきました（server.rのrenderUIのtabitemsとサイドバーメニュー）。

とにかく奇妙ですが。