複数の従属スライダーをバイパスする光沢のある条件付きパネル

Question

私はビルドしている比較的複雑なアプリケーションを持っています。ユーザーは結合スライダーをドラッグしていくつかの計算のための重みを設定します。これらは常に100％になるはずです。私はthisとthatを見ましたが、私は反応性と隔離に本当の問題があり、updatesliderオプションは2つのスライダの上で動作するようです。

代わりに、私は問題を転記しました。私は、重みが100％になるようにする必要がある場合は合計100％にする必要があり、そうであればプロット出力の例を表示する必要があることをユーザーに伝えます。 Simplesの権利？まあ、条件は合致していないので、いいえ。 thisとthisとthisを見た後、私はそれを動作させることができません。

私はこの問題を実証するために、以下の再現可能な例を提供しています。それは、反応性とオブザーバーが光沢のある私の厄介さのためだと思われます。

library(shiny) 

# Define UI for application that draws a histogram 
ui <- fluidPage(

    # Application title 
    titlePanel("testing 1 2 3"), 

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
     sidebarPanel(
    ), 

     # Show a plot of the generated distribution 
     mainPanel(
     fluidRow(

      column(width = 2, 
        offset = 0, 
        align = "center", 
        sliderInput(inputId = "sld_1", 
           label = "weight", 
           min = 0, 
           max = 1, 
           value = 0.25, 
           step = 0.05, 
           animate = TRUE) 
        , 
        sliderInput(inputId = "sld_2", 
           label = "weight", 
           min = 0, 
           max = 1, 
           value = 0.25, 
           step = 0.05, 
           animate = TRUE) 
        , 
        sliderInput(inputId = "sld_3", 
           label = "weight", 
           min = 0, 
           max = 1, 
           value = 0.25, 
           step = 0.05, 
           animate = TRUE) 
        , 
        sliderInput(inputId = "sld_4", 
           label = "weight", 
           min = 0, 
           max = 1, 
           value = 0.25, 
           step = 0.05, 
           animate = TRUE) 
      ) #slider columns 
      , 
      column(width = 9, 
        offset = 0, 
        align = "center", 
        conditionalPanel(
         condition = "output.myCondition == FALSE", 
         textOutput(outputId = "distPrint") 
        ) #conditional1 
        , 
        conditionalPanel(
         condition = "output.myCondition == TRUE", 
         plotOutput(outputId = "distPlot") 
        ) #conditional2 
      ) #column 
     )#fluidrow 
    ) 
    ) 
) 

# Define server logic required to draw a histogram 
server <- function(input, output,session) { 

    dister <- reactive({ 
     if(!is.null(input$sld_1) && 
      !is.null(input$sld_2) && 
      !is.null(input$sld_3) && 
      !is.null(input$sld_4) && 
      sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1 
    ) { 
     rnorm(input$sld_1*1000) 
     } else {c(0,1,2,3,4,5)} 
    }) 

    output.myCondition <- reactive({ 
     if(!is.null(input$sld_1) && 
      !is.null(input$sld_2) && 
      !is.null(input$sld_3) && 
      !is.null(input$sld_4) && 
      sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1 
    ) { 
       TRUE 
     } else {FALSE} 
    }) 

    output$distPlot <- renderPlot({ 
     x<-dister() 
     hist(x) 
    }) 

    output$distPrint <- renderText({ 
     print("The weights must sum to 100%") 
    }) 
} 

# Run the application 
shinyApp(ui = ui, server = server) 

Answer 1

がshinyjsパッケージを使用して、わずかに異なるアプローチです：

• 我々は2つのdivの、プロット（plotdiv）用とエラーのための1つを作成する（ERRORDIV）
• 私たちは、作成dtributionを保持するreactVal
• observeEventは、スライダが変化して1になる場合のみ、reactValを更新します。その場合、errordivを非表示にしてplotdivを表示します。それ以外の場合は、エラーを表示してプロットを非表示にします。
だから、

：

library(shiny) 
library(shinyjs) 

# Define UI for application that draws a histogram 
ui <- fluidPage(

    # Application title 
    titlePanel("testing 1 2 3"), 
    shinyjs::useShinyjs(), 

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
    sidebarPanel(
    ), 


    # Show a plot of the generated distribution 
    mainPanel(
     fluidRow(

     column(width = 2, 
       offset = 0, 
       align = "center", 
       sliderInput(inputId = "sld_1", 
          label = "weight", 
          min = 0, 
          max = 1, 
          value = 0.25, 
          step = 0.05, 
          animate = TRUE) 
       , 
       sliderInput(inputId = "sld_2", 
          label = "weight", 
          min = 0, 
          max = 1, 
          value = 0.25, 
          step = 0.05, 
          animate = TRUE) 
       , 
       sliderInput(inputId = "sld_3", 
          label = "weight", 
          min = 0, 
          max = 1, 
          value = 0.25, 
          step = 0.05, 
          animate = TRUE) 
       , 
       sliderInput(inputId = "sld_4", 
          label = "weight", 
          min = 0, 
          max = 1, 
          value = 0.25, 
          step = 0.05, 
          animate = TRUE) 
     ) #slider columns 
     , 
     column(width = 9, 
       offset = 0, 
       align = "center", 
       div(id="plotdiv", 
        plotOutput(outputId = "distPlot") 
       ),    
       shinyjs::hidden(
       div(id="errordiv", 
        p("The weights must sum to one!") 
       ) 
       ) 
     ) #column 
    )#fluidrow 
    ) 
) 
) 

# Define server logic required to draw a histogram 
server <- function(input, output,session) { 

    dister <- reactiveVal() 

    observeEvent({ 
    input$sld_1 
    input$sld_2 
    input$sld_3 
    input$sld_4},{ 
     if(!is.null(input$sld_1) && 
      !is.null(input$sld_2) && 
      !is.null(input$sld_3) && 
      !is.null(input$sld_4) && 
      sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1 
    ) { 
     dister(rnorm(input$sld_1*1000)) 
     shinyjs::show("plotdiv") 
     shinyjs::hide("errordiv") 
     } 
     else 
     { 
     shinyjs::hide("plotdiv") 
     shinyjs::show("errordiv") 
     } 
    }) 

    output$distPlot <- renderPlot({ 
    x<-dister() 
    hist(x) 
    }) 

} 

# Run the application 
shinyApp(ui = ui, server = server) 

私はこれが役に立てば幸い！

Answer 2

あなたはほぼtherです。

output$distPrint <- renderText({ 
    if(output.myCondition()){ 
     print("") 
    }else 
    { 
     print("The weights must sum to 100%") 
    } 

    }) 

[EDIT]：

私はあなたのクエリを誤解しているように見える何をする必要があると次のように反応性表現output.myConditionがrenderTextでの使用です。私はこの質問がすでに答えられていることを知っています。私は、ここで遭遇する可能性のある誰かのために代替ソリューションを提供すると考えました。ここでは、output.myCondition()の出力に基づいて、renderTextとrenderPlotの両方にelseを追加しました。ここには更新されたサーバーコードがあります。ここで

server <- function(input, output,session) { 

     dister <- reactive({ 
     if(!is.null(input$sld_1) && 
      !is.null(input$sld_2) && 
      !is.null(input$sld_3) && 
      !is.null(input$sld_4) && 
      sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1 
     ) { 
      rnorm(input$sld_1*1000) 
     } else {c(0,1,2,3,4,5)} 
     }) 

     output.myCondition <- reactive({ 
     if(!is.null(input$sld_1) && 
      !is.null(input$sld_2) && 
      !is.null(input$sld_3) && 
      !is.null(input$sld_4) && 
      sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1 
     ) { 
      TRUE 
     } else {FALSE} 
     }) 

     output$distPlot <- renderPlot({ 
     if(output.myCondition()){ 
     x<-dister() 
     hist(x) 
     }else 
     { 
     NULL 
     } 
     }) 

     output$distPrint <- renderText({ 
     if(output.myCondition()){ 
      print("") 
     }else 
     { 
      print("The weights must sum to 100%") 
     } 

     }) 
    }