[解決済み] RのシャイニーリアクティブselectInput
2022-02-28 01:34:26
質問
私は反応データを含むアプリケーションの光沢を持っています。私は、アプリケーションがX軸とY軸のための非空白の列のみを選択することを望みます。今のところ、私は次のいずれかを選択します。
colnames(TD[,3:7])
しかし、列には空の値もあるので、これらの列を変数選択に表示させたくありません。以下は例と私のコードです。
type <- as.character(c('summer','summer','summer','summer','winter','winter','winter','winter'))
country <- as.character(c('A','A','B','B','A','A','B','B'))
year <- c(2011,2012,2013,2014,2011,2012,2013,2014)
col1 <- c(33,7,NA,NA,5,11,NA,NA)
col2 <- c(10,3,NA,NA,8,15,NA,NA)
col3 <- c(NA,NA,10,15,NA,NA,20,25)
col4 <- c(NA,NA,8,5,NA,NA,22,16)
TD <- data.frame(type,country,year,col1,col2,col3,col4,stringsAsFactors=FALSE)
library(readxl)
library(shiny)
library(ggplot2)
library(shinythemes)
library(DT)
ui <-shinyUI(fluidPage(pageWithSidebar(
headerPanel("Test App"),
sidebarPanel(
selectInput("type","Choose a type", choices = c("All",unique(TD$type))),
selectInput("country","Choose an country", choices = c("All",unique(TD$country))),
selectInput("yaxis", "Choose a y variable", choices = colnames(TD[,3:7])),
selectInput("xaxis", "Choose a x variable", choices = colnames(TD[,3:7])),
actionButton("goButton", "Update")
),
mainPanel(
tabsetPanel(
tabPanel('Plot', plotOutput("plot1"))
))
)
))
server <- shinyServer(function(input,output, session){
data1 <- reactive({
if(input$type == "All"){
TD
}
else{
TD[which(TD$type == input$type),]
}
})
data2 <- eventReactive(input$goButton,{
if (input$country == "All"){
TD
}else{
TD[which(TD$country == input$country),]
}
})
observe({
if(input$type != "All"){
updateSelectInput(session,"country","Choose a country", choices = c("All",unique(data1()$country)))
}
else if(input$country != 'All'){
updateSelectInput(session,"type","Choose a type", choices = c('All',unique(data2()$type)))
}
else if (input$type == "All" & input$country == "All"){
updateSelectInput(session,"country","Choose a country", choices = c('All',unique(TD$country)))
updateSelectInput(session,"type","Choose a type", choices = c('All',unique(TD$type)))
}
})
data3 <- eventReactive( input$goButton,{
req(input$goButton)
req(input$goButton)
if(input$country == "All"){
data1()
}
else if (input$type == "All"){
data2()
}
else if (input$country == "All" & input$type == "All"){
TD
}
else
{
TD[which(TD$country== input$country & TD$type == input$type),]
}
})
x_var<- eventReactive(input$goButton, {
input$xaxis
})
y_var <- eventReactive(input$goButton,{
input$yaxis
})
output$plot1 <- renderPlot({
x <- x_var()
y <- y_var()
p <- ggplot(data3(),aes(x=data3()[,x], y=data3()[,y])) + geom_line() + geom_point()
p + labs(x = x_var(), y = y_var()) + theme(plot.title = element_text(hjust = 0.5, size=20))
})
})
shinyApp(ui,server)
解決方法は?
ここに方法があります。これは セレクタイズ プラグイン disable_options .
プラグインをダウンロードする こちら . 名前を付けて保存します。 selectize-disable-options.js の中で www のサブフォルダを作成します。
続いて、アプリの紹介です。
library(shiny)
library(ggplot2)
CSS <- "
.selectize-dropdown [data-selectable].option-disabled {
color: #aaa;
cursor: default;
}"
type <- as.character(c('summer','summer','summer','summer','winter','winter','winter','winter'))
country <- as.character(c('A','A','B','B','A','A','B','B'))
year <- c(2011,2012,2013,2014,2011,2012,2013,2014)
col1 <- c(33,7,NA,NA,5,11,NA,NA)
col2 <- c(10,3,NA,NA,8,15,NA,NA)
col3 <- c(NA,NA,10,15,NA,NA,20,25)
col4 <- c(NA,NA,8,5,NA,NA,22,16)
TD <- data.frame(type,country,year,col1,col2,col3,col4,stringsAsFactors=FALSE)
ui <- fluidPage(
tags$head(
tags$script(src = "selectize-disable-options.js"),
tags$style(HTML(CSS))
),
titlePanel("Test App"),
sidebarLayout(
sidebarPanel(
selectInput("type","Choose a type", choices = c("All",unique(TD$type))),
selectInput("country","Choose an country", choices = c("All",unique(TD$country))),
selectizeInput("yaxis", "Choose a y variable", choices = colnames(TD[,3:7])),
selectInput("xaxis", "Choose a x variable", choices = colnames(TD[,3:7])),
actionButton("goButton", "Update")
),
mainPanel(
tabsetPanel(
tabPanel('Plot', plotOutput("plot1"))
)
)
)
)
server <- function(input, output, session){
data1 <- reactive({
if(input$type == "All"){
TD
}else{
TD[TD$type == input$type,]
}
})
data2 <- reactive({
if(input$country == "All"){
TD
}else{
TD[TD$country == input$country,]
}
})
observe({
if(input$type != "All"){
selected_country <- isolate(input$country)
countries <- unique(data1()$country)
updateSelectInput(
session, "country",
choices = c("All", countries),
selected = ifelse(selected_country %in% countries, selected_country, "All")
)
}else if(input$country != 'All'){
selected_type <- isolate(input$type)
types <- unique(data2()$type)
updateSelectInput(
session, "type",
choices = c('All', types),
selected = ifelse(selected_type %in% types, selected_type, "All")
)
}else if(input$type == "All" && input$country == "All"){
updateSelectInput(
session, "country",
choices = c('All', unique(TD$country))
)
updateSelectInput(
session, "type",
choices = c('All', unique(TD$type))
)
}
})
data3 <- reactive({
if(input$country == "All"){
data1()
}else if(input$type == "All"){
data2()
}else if(input$country == "All" && input$type == "All"){
TD
}else{
TD[which(TD$country== input$country & TD$type == input$type),]
}
})
observeEvent(data3(), {
emptyColumns <- sapply(data3()[,3:7], function(x){
all(is.na(x))
})
choices <- colnames(TD[,3:7])
choices[emptyColumns] <- paste(choices[emptyColumns], "(no data)")
updateSelectizeInput(
session, "yaxis", choices = choices,
options = list(
plugins = list(
disable_options = list(
disableOptions = as.list(choices[emptyColumns])
)
)
)
)
})
data4 <- eventReactive(input$goButton, {
data3()
})
x_var<- eventReactive(input$goButton, {
input$xaxis
})
y_var <- eventReactive(input$goButton,{
input$yaxis
})
output$plot1 <- renderPlot({
x <- x_var()
y <- y_var()
p <- ggplot(data4(), aes_string(x=x, y=y)) + geom_line() + geom_point()
p + labs(x = x, y = y) + theme(plot.title = element_text(hjust = 0.5, size=20))
})
}
shinyApp(ui,server)
セレクト入力で空欄を無効にする。
関連
-
[解決済み】基本 - T-検定 -> グループ化因子は正確に2水準でなければならない
-
[解決済み】model.frame.defaultでのエラー:変数の長さが異なる
-
[解決済み] Stataバージョン5-12の.dtaファイルではない
-
[解決済み】LMEモデルのレベル0、ブロック1でのバックソルブにおける特異性
-
[解決済み】Rで立方根と対数変換をする
-
[解決済み】 colMeans(x, na.rm = TRUE) のエラー : KNN分類では 'x' は数値でなければならない
-
[解決済み] ヒートマップ作成時のエラー - 外部関数呼び出しでNA/NaN/Inf (arg 11)
-
[解決済み】エラー - replacement has [x] rows, data has [y].
-
[解決済み】Rでmax.printの制限値を増やす方法
-
[解決済み] (関数型)リアクティブプログラミングとは?
最新
-
nginxです。[emerg] 0.0.0.0:80 への bind() に失敗しました (98: アドレスは既に使用中です)
-
htmlページでギリシャ文字を使うには
-
ピュアhtml+cssでの要素読み込み効果
-
純粋なhtml + cssで五輪を実現するサンプルコード
-
ナビゲーションバー・ドロップダウンメニューのHTML+CSSサンプルコード
-
タイピング効果を実現するピュアhtml+css
-
htmlの選択ボックスのプレースホルダー作成に関する質問
-
html css3 伸縮しない 画像表示効果
-
トップナビゲーションバーメニュー作成用HTML+CSS
-
html+css 実装 サイバーパンク風ボタン
おすすめ
-
[解決済み】Rで「パッケージ'FILE_PATH'のインストールで終了ステータスが0でなかった」。
-
[解決済み] write.tableしようとすると、未実装の型リストが表示される。
-
[解決済み】ggplot boxplotでPosition-dodge警告?
-
[解決済み】ggplotのエラー。関数型オブジェクトのスケールを自動的に選択する方法がわかりません。
-
[解決済み] lmer エラー: グループ化係数は観測数未満でなければならない
-
[解決済み】 lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) のエラー : 'y' の NA/NaN/Inf, あらゆる方法を試したが解決しなかった。
-
[解決済み】「Error in stripchart.default(x1, ...) : invalid plotting method」エラーを回避する方法は?
-
[解決済み】r Error dim(X) must have a positive length?
-
[解決済み】.External.graphics Rでエラーが発生しました。
-
[解決済み】dplyr: "Error in n(): 関数は直接呼ばれるべきではありません"