r - 条件付き出力 Shiny UI

Question

調査データがあります。Shiny を使用して、一変量および二変量解析の結果を共同研究者と共有したいと考えています。調査には、数値変数と因子変数があります。Shiny アプリケーションを見ている人が一変量/二変量集計に興味があるかどうか、および集計したい変数の型に応じて、異なる出力を表示したいと考えています。

具体的には、

i) 単変量で数値の場合は、次のように表示されます。

• アイテムの反応率:length() - sum(is.na())
• hist()
• summary()

ii) 単変量で因数分解の場合は、次のように表示されます。

• アイテム反応率
• barplot()
• table()
• prop.table()

iii) 二変量で数値*数値の場合は、次のように表示されます。

• アイテム反応率
• 散布図:plot(x,y)
• summary(x)
• summary(y)
• cor(x,y,method="spearman")

iv) 二変量で因子*因子の場合は、次のように表示されます。

• アイテム反応率
• 棒グラフ...「rCharts nvd3 multiBarChart」のようなもの
• table(x,y)
• prop.table(x,y)
• chisq.test(x,y)

v) 二変量かつ (因子*数値 OR 数値*因子) の場合、次のように表示されます。

• アイテム反応率
• 箱ひげ図
• 因子変数ごとの数値変数の要約:by(numeric, factor, summary)
• クラスカル・ウォリス検定kruskal.test(numeric ~ factor)

現在、5 つのステップすべてに対して必要な出力を個別のアプリケーションとして生成するコードがあります。それらを 1 つの Shiny アプリにまとめたいと考えています。ユーザーがUImainPanel()で行っている選択の関数として受け取るさまざまな出力に反応するようにディスプレイを設定する方法について、概念的に苦労しています。sidebarPanel()

具体的には、

• mainPanel()さまざまな出力を反映するように UI ヘッダーを変更する方法
• 以下のコードを概念的に拡張して複数の出力を含める方法 (つまり、以下のコードは 1 つの部分に対してverbatimTextOutput()機能しますが、表示したい複数の部分/タイプの出力を処理する方法がわかりません (i-iv で説明) ) 上記. 例: テキスト、表、プロット。

以下は、ui.R ファイルのコードです。

library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Shiny Example"),
sidebarPanel(
wellPanel(
selectInput(inputId = "variable1",label = "Select First Variable:", 
choices = c("Binary Variable 1" = "binary1",
"Binary Variable 2" = "binary2", 
"Continuous Variable 1" = "cont1",
"Continuous Variable 2" = "cont2"),
selected = "Binary Variable 1"
)
),

wellPanel(
checkboxInput("bivariate", "Proceed to Bivariate Analysis", FALSE),
conditionalPanel(
condition="input.bivariate==true",
selectInput(inputId = "variable2", 
label = "Select Second Variable:",
choices = c("Binary Variable 1" = "binary1",
"Binary Variable 2" = "binary2", 
"Continuous Variable 1" = "cont1",
"Continuous Variable 2" = "cont2"),
selected = "Binary Variable 2"
)
)
)
),

mainPanel(
h5("Output"),
verbatimTextOutput("out")
)
))

以下は、シミュレートされたデータと server.R ファイルです。

binary1 <- rbinom(100,1,0.5)
binary2 <- rbinom(100,1,0.5)
cont1   <- rnorm(100)
cont2   <- rnorm(100)

dat <- as.data.frame(cbind(binary1, binary2, cont1, cont2))

dat$binary1 <- as.factor(dat$binary1)
dat$binary2 <- as.factor(dat$binary2)
dat$cont1 <- as.numeric(dat$cont1)
dat$cont2 <- as.numeric(dat$cont2)

library(shiny)
library(rCharts)

shinyServer(function(input, output) {

inputVar1 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable1)))
})

inputVar2 <- reactive({
parse(text=sub(" ","",paste("dat$", input$variable2)))
})

output$out <- renderPrint({

if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
table(eval(inputVar1()))
} else {

if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
summary(eval(inputVar1()))
} else {

if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
table(eval(inputVar1()), eval(inputVar2()))
} else {

if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
cor(eval(inputVar1()), eval(inputVar2()))
} else {

if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
by(eval(inputVar2()), eval(inputVar1()), summary)
} else { 

if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
by(eval(inputVar1()), eval(inputVar2()), summary)
}
}
}
}
}
}

})

})

あなたが提供できるどんな助けも大歓迎です。変数の選択が与えられた場合に、コードを調整して目的の出力の 2 つの部分をレンダリングする方法を示すだけでも。また、出力の名前付き部分を反映するようにヘッダーを調整する方法。

前もって感謝します...クリス

Answer 1

質問がずっと前のものであったとしても、おそらくこのアプローチの方が優れていると思います。サーバー側で追加のコードは必要ありません。

mainPanel(

  wellPanel(
    conditionalPanel(
        condition = "input.myInput == 'value'",
        ..... Your UI for this case ...........
    ),

    conditionalPanel(
        condition = "input.myInput == 'value2'",
        ..... Your UI for this case ...........
    )                 
  )
  )

Answer 2

上記のように問題に取り組み続けました。一連のネストされた if else ステートメントを server.R ファイルに埋め込んで、選択した入力に基づいて条件付きでキャプションを生成しました。これらのキャプションをUItextOutput()に表示するには、ui.R ファイルの関数を使用します。mainPanelこれはかなりうまく機能しますが、それが最善のアプローチであるかどうかはわかりません。アプローチについての考えを聞きたいですか？

条件付き出力については...変数と分析（単変量または二変量）の選択に応じて、最大5個の出力を生成したいと考えています。繰り返しますが、ネストされた一連の if else ステートメントを使用して、これらの出力を生成します。次に、ui.R ファイルに表示します。私の問題は、現在、5つの出力（可能な最大）を必要としない変数の組み合わせと分析に関係しています。彼らのために、私はオブジェクトを返しNULLます。私の問題は、Shiny がこれらの出力に空白の空白を出力しないことです。やや光沢がある場合は、灰色のボックスと「NULL」という単語が返されます。見栄えが悪いので、この出力を単純に空白に変換する方法についてのフィードバックをいただければ幸いです。

私の新しい ui.R コードを以下に示します。

    library(shiny)
    shinyUI(pageWithSidebar(

headerPanel("Shiny Example"),

    sidebarPanel(

        wellPanel(

        selectInput(    inputId = "variable1",label = "Select First Variable:", 
                choices = c("Binary Variable 1" = "binary1",
                "Binary Variable 2" = "binary2", 
                "Continuous Variable 1" = "cont1",
                "Continuous Variable 2" = "cont2"),
                selected = "Binary Variable 1"
        )
        ),


        wellPanel(

            checkboxInput("bivariate", "Proceed to Bivariate Analysis", FALSE),
        conditionalPanel(
        condition="input.bivariate==true",
        selectInput(inputId = "variable2", 
        label = "Select Second Variable:",
        choices = c("Binary Variable 1" = "binary1",
        "Binary Variable 2" = "binary2", 
        "Continuous Variable 1" = "cont1",
        "Continuous Variable 2" = "cont2"),
        selected = "Binary Variable 2"
    )
    )
    )
    ),
    mainPanel(

    h5("Item Response Rate"),
    verbatimTextOutput("nitem"),

    h5(textOutput("caption2")),
    verbatimTextOutput("out2"),

    h5(textOutput("caption3")),
    verbatimTextOutput("out3"),

    h5(textOutput("caption4")),
    verbatimTextOutput("out4"),

    h5(textOutput("caption5")),
    plotOutput("out5")
    )
    ))

以下は私のserver.Rファイルのコードです：

    binary1 <- rbinom(100,1,0.5)
    binary2 <- rbinom(100,1,0.5)
    cont1   <- rnorm(100)
    cont2   <- rnorm(100)

    dat <- as.data.frame(cbind(binary1, binary2, cont1, cont2))

    dat$binary1 <- as.factor(dat$binary1)
    dat$binary2 <- as.factor(dat$binary2)
    dat$cont1 <- as.numeric(dat$cont1)
    dat$cont2 <- as.numeric(dat$cont2)

    library(shiny)

    shinyServer(function(input, output) {

    inputVar1 <- reactive({
    parse(text=sub(" ","",paste("dat$", input$variable1)))
    })

    inputVar2 <- reactive({
    parse(text=sub(" ","",paste("dat$", input$variable2)))
    })

    output$nitem <- renderPrint({


    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    n <- sum(table(eval(inputVar1())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    n <- sum(table(eval(inputVar1())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    n <- sum(table(eval(inputVar1()),eval(inputVar2())))
    p <- n/100
    out <- cat(paste(n,gsub(" ","",paste("(",round(as.numeric(p)*100,2),"%",")"))),"\n")
    }
    }
    }
    }
    }
    }

    })

    output$caption2 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption2 <- "Univariate Table"
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption2 <- "Univariate Summary"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions2 <- "Bivariate Table"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption2 <- "Numeric Summary First Variable"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption2 <- "Numeric Summary By Factor"
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption2 <- "Numeric Summary By Factor"
    }
    }
    }
    }
    }
    }

    })

    output$out2 <- renderPrint({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    table(eval(inputVar1()))
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    summary(eval(inputVar1()))
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    table(eval(inputVar1()), eval(inputVar2()))
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    summary(eval(inputVar1()))
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    by(eval(inputVar2()), eval(inputVar1()), summary)
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    by(eval(inputVar1()), eval(inputVar2()), summary)
    }
    }
    }
    }
    }
    }

    })

    output$caption3 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption3 <- "Univariate Table of Proportions"
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption3 <- ""
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions3 <- "Bivariate Table of Row Proportions"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption3 <- "Numeric Summary Second Variable"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption3 <- "Kruskal Wallis Test"
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption3 <- "Kruskal Wallis Test"
    }
    }
    }
    }
    }
    }

    })


    output$out3 <- renderPrint({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    prop.table(table(eval(inputVar1())))
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    NULL
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    prop.table(table(eval(inputVar1()), eval(inputVar2())), margin=1)
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    summary(eval(inputVar2()))
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    kruskal.test(eval(inputVar2()) ~ eval(inputVar1()))
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    kruskal.test(eval(inputVar1()) ~ eval(inputVar2()))
    }
    }
    }
    }
    }
    }

    })

    output$caption4 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption4 <- ""
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption4 <- ""
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions4 <- "Pearsons Chi-Squared Test"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption4 <- "Spearmans Correlation Coefficient"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption4 <- ""
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption4 <- ""
    }
    }
    }
    }
    }
    }

    })

    output$out4 <- renderPrint({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    NULL
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    NULL
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    chisq.test(table(eval(inputVar1()), eval(inputVar2())))
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    cor(eval(inputVar1()), eval(inputVar2()), method="spearman", use="pairwise.complete.obs")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    NULL
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    NULL
    }
    }
    }
    }
    }
    }

    })

    output$caption5 <- renderText({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    caption5 <- "Univariate Barplot"
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    caption5 <- "Univariate Histogram"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    captions5 <- "Bivariate Barplot"
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption5 <- "Bivariate Scatter Graph"
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    caption5 <- "Bivariate Boxplot"
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    caption5 <- "Bivariate Boxplot"
    }
    }
    }
    }
    }
    }

    })

    output$out5 <- renderPlot({

    if ( (input$bivariate==FALSE) & (is.factor(eval(inputVar1()))==TRUE) ) {
    barplot(table(eval(inputVar1())))
    } else {

    if ( (input$bivariate==FALSE) & (is.numeric(eval(inputVar1()))==TRUE) ) {
    hist(eval(inputVar1()),main="")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    barplot(table(eval(inputVar1()), eval(inputVar2())), beside=TRUE)
    } else {

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    plot(eval(inputVar1()), eval(inputVar2()), main="")
    } else {

    if ( (input$bivariate==TRUE) & (is.factor(eval(inputVar1()))==TRUE) & (is.numeric(eval(inputVar2()))==TRUE) ) {
    boxplot(eval(inputVar2()) ~ eval(inputVar1()))
    } else { 

    if ( (input$bivariate==TRUE) & (is.numeric(eval(inputVar1()))==TRUE) & (is.factor(eval(inputVar2()))==TRUE) ) {
    boxplot(eval(inputVar1()) ~ eval(inputVar2()))
    }
    }
    }
    }
    }
    }

    })

    })

前述のように、現在の問題は「NULL」出力の印刷です。この出力が表示されないようにする方法について何か提案があれば、フィードバックをいただければ幸いです。また、提案された解決策と他の実行可能な解決策についての考えを歓迎します。