如何避免具有多个输入的双图 Shiny App
How to avoid double plot with multiple inputs Shiny App
我有一个闪亮的应用程序，其中对 pickerInputs 的更改会更新一组图。这些输入是时间、区域或维度过滤器以及指标。指标不必具有相同的时间段。
不幸的是，在某些情况下更改指标 (ind_1) 会导致重新绘制图表。然后再次刷新，第二次绘制图形。所以我最终重绘了多次情节。
我希望当用户更改年份、区域或尺寸时，绘图会更新。但是当用户更改指标时，他也可以同时更新整个绘图而不是分两部分。
有没有办法允许短暂的延迟，以便闪亮的“更新”并且没有输入触发情节？
这是我的部分代码：
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyBS)
library(plotly)
library(shinycssloaders)
library(googledrive)
id1 <- "1Gc9M9mN0U38QXobrFBgdTNYFdCTCU0GZ"
id<-"1cZRfzycJ-bhXHEAC_2g6b6sbOhInlmMG"
metadatos<-read.csv2(sprintf("https://docs.google.com/uc?id=%s&export=download", id1),
encoding = "UTF-8")
metadatos<-subset(metadatos,metadatos[,1]!="")
indicadores<-read.csv2(sprintf("https://docs.google.com/uc?id=%s&export=download", id),
encoding = "UTF-8")
indicadores<-subset(indicadores,indicadores[,1]!="")
indicadores_id<-data.frame(cbind(substr(colnames(indicadores[4:length(indicadores)]),3,100),
4:length(indicadores)))
names(indicadores_id)<-c("ID","column")
metadatos<-subset(metadatos,metadatos[,4] %in% indicadores_id[,1])
list_ind_factor_1<-unique(metadatos[,1])
list_ind_factor_1<-list_ind_factor_1[list_ind_factor_1!=""]
list_ind_factor_2<-unique(metadatos[,2])
list_ind_factor_2<-list_ind_factor_2[list_ind_factor_2!=""]
list_ind<-unique(metadatos$NOMBRE)
list_zona<-unique(indicadores$CCAA)
list_dim<-unique(indicadores$Sexo)
simpleCap <- function(x) {
s <- strsplit(x, " ")[[1]]
paste(toupper(substring(s, 1,1)), substring(s, 2),
sep="", collapse=" ")
}
server <- function(input, output, session) {
observeEvent(input$ind_1, {
output$ft_1<-renderText({
if(isTRUE(input$ft_ind_1)){
m<-1
} else {
m<-0
}
m
})
outputOptions(output, 'ft_1', suspendWhenHidden=FALSE)
output$titol_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)!=0){
m<-m[,5]
} else {
m<-"NO"
}
m
})
output$det_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)!=0){
m<-m[,3]
} else {
m<-"NO"
}
m
})
output$unit_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)!=0){
m<-m[,6]
} else {
m<-"NO"
}
m
})
output$serie_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
ind<-subset(indicadores_id,indicadores_id[,1]==m[,4])
n<-data.frame(indicadores[,1],
indicadores[,as.numeric(ind[,2])])
n<-n[!is.na(n[,2]), ]
if (nrow(n)!=0){
k<-paste(min(n[,1]),max(n[,1]),sep="-")
} else {
k<-paste("-")
}
k
})
output$titol_<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)==0){
m<-0
} else {
m<-1
}
m
})
outputOptions(output, 'titol_', suspendWhenHidden=FALSE)
}, ignoreInit = F, ignoreNULL = F)
observeEvent(c(input$ind_1_factor_1,input$ind_1_factor_2,input$ind_1), {
if(length(input$ind_1_factor_1)!=0){
m<-subset(metadatos, metadatos[,1] %in% input$ind_1_factor_1)
} else {
m<-metadatos
}
if(length(input$ind_1_factor_2)!=0){
n<-subset(metadatos, metadatos[,2] %in% input$ind_1_factor_2)
} else {
n<-metadatos
}
if(length(input$ind_1)!=0){
a<-subset(metadatos, metadatos[,5] %in% input$ind_1)
if (nrow(a)!=0){
a_id<-subset(indicadores_id,indicadores_id[,1]==a[,4])
a_id<-data.frame(indicadores[,1],
indicadores[,2],
indicadores[,3],
indicadores[,as.numeric(a_id[,2])])
names(a_id)<-c("year","dim","zona","valor")
a_id<-a_id[!is.na(a_id$valor),]
a_id<-subset(a_id,valor!="")
a_id_<-subset(a_id,zona!="ESPAÑA")
a_id <- a_id[order(a_id$year,decreasing = T),]
updatePickerInput(session = session,
inputId = "ind_1_any_1",
label = "Selecciona el periodo a estudiar:",
choices = unique(a_id_$year),
selected = unique(a_id_$year))
if(is.null(input$ind_1_zona_1)){
updatePickerInput(session = session,
inputId = "ind_1_zona_1",
label = "Selecciona las zonas a estudiar:",
choices = unique(a_id$zona),
selected = c("ESPAÑA"))
} else {
updatePickerInput(session = session,
inputId = "ind_1_zona_1",
label = "Selecciona las zonas a estudiar:",
choices = unique(a_id$zona),
selected = input$ind_1_zona_1)
}
if(a_id$dim %in% "Ambos sexos"){
updatePickerInput(session = session,
inputId = "ind_1_dim_1",
label = "Selecciona el sexo a estudiar:",
choices = unique(a_id$dim),
selected = c("Ambos sexos"))
updatePickerInput(session = session,
inputId = "ind_1_dim_11",
label = "Sexo a estudiar:",
choices = unique(a_id$dim),
selected = c("Ambos sexos"))
updatePickerInput(session = session,
inputId = "ind_1_dim_12",
label = "Sexo a estudiar:",
choices = unique(a_id$dim),
selected = c("Ambos sexos"))
} else {
updatePickerInput(session = session,
inputId = "ind_1_dim_1",
label = "Selecciona el sexo a estudiar:",
choices = unique(a_id$dim),
selected = unique(a_id$dim))
updatePickerInput(session = session,
inputId = "ind_1_dim_11",
label = "Sexo a estudiar:",
choices = unique(a_id$dim),
selected = unique(a_id$dim))
updatePickerInput(session = session,
inputId = "ind_1_dim_12",
label = "PENE:",
choices = unique(a_id$dim),
selected = unique(a_id$dim))
}
updatePickerInput(session = session,
inputId = "ind_1_any_11",
label = "Periodos a estudiar:",
choices = unique(a_id$year),
selected = unique(a_id$year))
updatePickerInput(session = session,
inputId = "ind_1_any_12",
label = "Periodo a estudiar:",
choices = unique(a_id$year),
selected = unique(a_id$year))
updatePickerInput(session = session,
inputId = "ind_1_zona_11",
label = "Zonas a estudiar:",
choices = unique(a_id$zona),
selected = unique(a_id$zona))
updatePickerInput(session = session,
inputId = "ind_1_zona_12",
label = "Zonas a estudiar:",
choices = unique(a_id$zona),
selected = unique(a_id$zona))
}
} else {
a<-metadatos
}
updatePickerInput(session = session,
inputId = "ind_1_factor_2",
label = "Filtra por el factor de desigualdad: ",
choices = unique(m[,2]),
selected = input$ind_1_factor_2)
updatePickerInput(session = session,
inputId = "ind_1",
label = "Elige un indicador:",
choices = unique(n[,5]),
selected = input$ind_1)
updatePickerInput(session = session,
inputId = "ind_2",
label = "Elige un indicador:",
choices = unique(n[,5]),
selected = input$ind_1)
updatePickerInput(session = session,
inputId = "ind_3",
label = "Elige un indicador:",
choices = unique(n[,5]),
selected = input$ind_1)
}, ignoreInit = F, ignoreNULL = F)
observeEvent(c(input$ind_1,input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1),{
############# FER 3 FILTRES DIFERENTS PER CADA PLOT #############
output$dots_box<-renderPlotly({
a_<-subset(metadatos, metadatos[,5] %in% input$ind_1)
a_id<-subset(indicadores_id,indicadores_id[,1]==a_[,4])
a_id<-data.frame(indicadores[,1],
indicadores[,2],
indicadores[,3],
as.numeric(indicadores[,as.numeric(a_id[,2])]),
a_[,6])
names(a_id)<-c("Periodo","Sexo","Zonas","Valor","Dim")
a_id<-subset(a_id,!is.na(Valor))
n<-input$ind_1
a<-subset(a_id,a_id[,2] %in% input$ind_1_dim_1)
a<-subset(a,a[,1] %in% input$ind_1_any_1)
b<-subset(a,a[,3]!="ESPAÑA")
a<-subset(a,a[,3] %in% input$ind_1_zona_1)
if (length(unique(a[,2]))>2){
sex<-tolower(paste(unique(a[,2])[1]," , ",unique(a[,2])[2]," y ",unique(a[,2])[3],sep=""))
} else if (length(unique(a[,2]))>1){
sex<-tolower(paste(unique(a[,2])[1]," y ",unique(a[,2])[2],sep=""))
} else {
sex<-tolower(unique(a[,2]))
}
p<- plot_ly(data= b, x=~b[,1], y=~as.numeric(b[,4]), type = "box",name = "España",showlegend=FALSE) %>%
layout(boxmode = "group",
yaxis = list(title = unique(b[,5]),
titlefont = list(size = 10)),
xaxis = list(title = 'Años', tickangle = -42,autotick = T), margin=list(b = -0.1),
legend = list(title=list(text='<b> Zonas (medianas) </b>'),
font=list(size=8))) %>%
layout(title = list(text = HTML(paste0(paste('Evolución temporal segun',sex),
'<br>',
'<sup>',
input$ind_1,
'</sup>')),
font=list(size=14)),
x=0,
margin=list(t = 75)) %>%
layout(
showlegend = T) %>%
add_annotations(
text = "Fuente: Atlas de los determinantes sociales de la salud en España",
legendtitle=TRUE,
x = 0,
y = -0.33,
xref="paper",
yref = "paper",
align='left',
textposition="bottom left",
showarrow = FALSE,
font = list(size = 9))
p %>%
layout(resposnive = T)
})
}, ignoreInit = T)
}
ui <-dashboardBody(
fluidPage(
fluidRow(
pickerInput(
inputId = "ind_1",
label = "Elige un indicador:",
choices = list_ind,
selected=1),
pickerInput(
inputId = "ind_1_zona_1",
label = "Selecciona la zona a estudiar:",
choices = c("hola"),
selected = 2,
multiple = T),
pickerInput(
inputId = "ind_1_dim_1",
label = "hola",
choices = c("hola")),
pickerInput(
inputId = "ind_1_any_1",
label = "Selecciona el periodo a estudiar:",
choices = c("hola"),
multiple = T),
plotlyOutput("dots_box")
)
)
)
shinyApp(ui = ui, server = server)
嵌套反应不是一个好主意。您可以使用 eventReactive() 控制何时更新绘图。试试这个
myplot <- eventReactive(c(input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1), { ## removed input$ind_1 so that it does not update when ind_1 is changed
#observeEvent(c(input$ind_1,input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1),{
############# FER 3 FILTRES DIFERENTS PER CADA PLOT #############
#output$dots_box<-renderPlotly({
a_<-subset(metadatos, metadatos[,5] %in% input$ind_1)
a_id<-subset(indicadores_id,indicadores_id[,1]==a_[,4])
a_id<-data.frame(indicadores[,1],
indicadores[,2],
indicadores[,3],
as.numeric(indicadores[,as.numeric(a_id[,2])]),
a_[,6])
names(a_id)<-c("Periodo","Sexo","Zonas","Valor","Dim")
a_id<-subset(a_id,!is.na(Valor))
n<-input$ind_1
a<-subset(a_id,a_id[,2] %in% input$ind_1_dim_1)
a<-subset(a,a[,1] %in% input$ind_1_any_1)
b<-subset(a,a[,3]!="ESPAÑA")
a<-subset(a,a[,3] %in% input$ind_1_zona_1)
if (length(unique(a[,2]))>2){
sex<-tolower(paste(unique(a[,2])[1]," , ",unique(a[,2])[2]," y ",unique(a[,2])[3],sep=""))
} else if (length(unique(a[,2]))>1){
sex<-tolower(paste(unique(a[,2])[1]," y ",unique(a[,2])[2],sep=""))
} else {
sex<-tolower(unique(a[,2]))
}
p<- plot_ly(data= b, x=~b[,1], y=~as.numeric(b[,4]), type = "box",name = "España",showlegend=FALSE) %>%
layout(boxmode = "group",
yaxis = list(title = unique(b[,5]),
titlefont = list(size = 10)),
xaxis = list(title = 'Años', tickangle = -42,autotick = T), margin=list(b = -0.1),
legend = list(title=list(text='<b> Zonas (medianas) </b>'),
font=list(size=8))) %>%
layout(title = list(text = HTML(paste0(paste('Evolución temporal segun',sex),
'<br>',
'<sup>',
input$ind_1,
'</sup>')),
font=list(size=14)),
x=0,
margin=list(t = 75)) %>%
layout(
showlegend = T) %>%
add_annotations(
text = "Fuente: Atlas de los determinantes sociales de la salud en España",
legendtitle=TRUE,
x = 0,
y = -0.33,
xref="paper",
yref = "paper",
align='left',
textposition="bottom left",
showarrow = FALSE,
font = list(size = 9))
p %>% layout(responsive = T)
#})
#}, ignoreInit = T)
})
output$dots_box<-renderPlotly({
myplot()
})
我有一个闪亮的应用程序，其中对 pickerInputs 的更改会更新一组图。这些输入是时间、区域或维度过滤器以及指标。指标不必具有相同的时间段。
不幸的是，在某些情况下更改指标 (ind_1) 会导致重新绘制图表。然后再次刷新，第二次绘制图形。所以我最终重绘了多次情节。
我希望当用户更改年份、区域或尺寸时，绘图会更新。但是当用户更改指标时，他也可以同时更新整个绘图而不是分两部分。
有没有办法允许短暂的延迟，以便闪亮的“更新”并且没有输入触发情节？
这是我的部分代码：
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyBS)
library(plotly)
library(shinycssloaders)
library(googledrive)
id1 <- "1Gc9M9mN0U38QXobrFBgdTNYFdCTCU0GZ"
id<-"1cZRfzycJ-bhXHEAC_2g6b6sbOhInlmMG"
metadatos<-read.csv2(sprintf("https://docs.google.com/uc?id=%s&export=download", id1),
encoding = "UTF-8")
metadatos<-subset(metadatos,metadatos[,1]!="")
indicadores<-read.csv2(sprintf("https://docs.google.com/uc?id=%s&export=download", id),
encoding = "UTF-8")
indicadores<-subset(indicadores,indicadores[,1]!="")
indicadores_id<-data.frame(cbind(substr(colnames(indicadores[4:length(indicadores)]),3,100),
4:length(indicadores)))
names(indicadores_id)<-c("ID","column")
metadatos<-subset(metadatos,metadatos[,4] %in% indicadores_id[,1])
list_ind_factor_1<-unique(metadatos[,1])
list_ind_factor_1<-list_ind_factor_1[list_ind_factor_1!=""]
list_ind_factor_2<-unique(metadatos[,2])
list_ind_factor_2<-list_ind_factor_2[list_ind_factor_2!=""]
list_ind<-unique(metadatos$NOMBRE)
list_zona<-unique(indicadores$CCAA)
list_dim<-unique(indicadores$Sexo)
simpleCap <- function(x) {
s <- strsplit(x, " ")[[1]]
paste(toupper(substring(s, 1,1)), substring(s, 2),
sep="", collapse=" ")
}
server <- function(input, output, session) {
observeEvent(input$ind_1, {
output$ft_1<-renderText({
if(isTRUE(input$ft_ind_1)){
m<-1
} else {
m<-0
}
m
})
outputOptions(output, 'ft_1', suspendWhenHidden=FALSE)
output$titol_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)!=0){
m<-m[,5]
} else {
m<-"NO"
}
m
})
output$det_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)!=0){
m<-m[,3]
} else {
m<-"NO"
}
m
})
output$unit_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)!=0){
m<-m[,6]
} else {
m<-"NO"
}
m
})
output$serie_1<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
ind<-subset(indicadores_id,indicadores_id[,1]==m[,4])
n<-data.frame(indicadores[,1],
indicadores[,as.numeric(ind[,2])])
n<-n[!is.na(n[,2]), ]
if (nrow(n)!=0){
k<-paste(min(n[,1]),max(n[,1]),sep="-")
} else {
k<-paste("-")
}
k
})
output$titol_<-renderText({
m<-subset(metadatos,metadatos[,5]==input$ind_1)
if (nrow(m)==0){
m<-0
} else {
m<-1
}
m
})
outputOptions(output, 'titol_', suspendWhenHidden=FALSE)
}, ignoreInit = F, ignoreNULL = F)
observeEvent(c(input$ind_1_factor_1,input$ind_1_factor_2,input$ind_1), {
if(length(input$ind_1_factor_1)!=0){
m<-subset(metadatos, metadatos[,1] %in% input$ind_1_factor_1)
} else {
m<-metadatos
}
if(length(input$ind_1_factor_2)!=0){
n<-subset(metadatos, metadatos[,2] %in% input$ind_1_factor_2)
} else {
n<-metadatos
}
if(length(input$ind_1)!=0){
a<-subset(metadatos, metadatos[,5] %in% input$ind_1)
if (nrow(a)!=0){
a_id<-subset(indicadores_id,indicadores_id[,1]==a[,4])
a_id<-data.frame(indicadores[,1],
indicadores[,2],
indicadores[,3],
indicadores[,as.numeric(a_id[,2])])
names(a_id)<-c("year","dim","zona","valor")
a_id<-a_id[!is.na(a_id$valor),]
a_id<-subset(a_id,valor!="")
a_id_<-subset(a_id,zona!="ESPAÑA")
a_id <- a_id[order(a_id$year,decreasing = T),]
updatePickerInput(session = session,
inputId = "ind_1_any_1",
label = "Selecciona el periodo a estudiar:",
choices = unique(a_id_$year),
selected = unique(a_id_$year))
if(is.null(input$ind_1_zona_1)){
updatePickerInput(session = session,
inputId = "ind_1_zona_1",
label = "Selecciona las zonas a estudiar:",
choices = unique(a_id$zona),
selected = c("ESPAÑA"))
} else {
updatePickerInput(session = session,
inputId = "ind_1_zona_1",
label = "Selecciona las zonas a estudiar:",
choices = unique(a_id$zona),
selected = input$ind_1_zona_1)
}
if(a_id$dim %in% "Ambos sexos"){
updatePickerInput(session = session,
inputId = "ind_1_dim_1",
label = "Selecciona el sexo a estudiar:",
choices = unique(a_id$dim),
selected = c("Ambos sexos"))
updatePickerInput(session = session,
inputId = "ind_1_dim_11",
label = "Sexo a estudiar:",
choices = unique(a_id$dim),
selected = c("Ambos sexos"))
updatePickerInput(session = session,
inputId = "ind_1_dim_12",
label = "Sexo a estudiar:",
choices = unique(a_id$dim),
selected = c("Ambos sexos"))
} else {
updatePickerInput(session = session,
inputId = "ind_1_dim_1",
label = "Selecciona el sexo a estudiar:",
choices = unique(a_id$dim),
selected = unique(a_id$dim))
updatePickerInput(session = session,
inputId = "ind_1_dim_11",
label = "Sexo a estudiar:",
choices = unique(a_id$dim),
selected = unique(a_id$dim))
updatePickerInput(session = session,
inputId = "ind_1_dim_12",
label = "PENE:",
choices = unique(a_id$dim),
selected = unique(a_id$dim))
}
updatePickerInput(session = session,
inputId = "ind_1_any_11",
label = "Periodos a estudiar:",
choices = unique(a_id$year),
selected = unique(a_id$year))
updatePickerInput(session = session,
inputId = "ind_1_any_12",
label = "Periodo a estudiar:",
choices = unique(a_id$year),
selected = unique(a_id$year))
updatePickerInput(session = session,
inputId = "ind_1_zona_11",
label = "Zonas a estudiar:",
choices = unique(a_id$zona),
selected = unique(a_id$zona))
updatePickerInput(session = session,
inputId = "ind_1_zona_12",
label = "Zonas a estudiar:",
choices = unique(a_id$zona),
selected = unique(a_id$zona))
}
} else {
a<-metadatos
}
updatePickerInput(session = session,
inputId = "ind_1_factor_2",
label = "Filtra por el factor de desigualdad: ",
choices = unique(m[,2]),
selected = input$ind_1_factor_2)
updatePickerInput(session = session,
inputId = "ind_1",
label = "Elige un indicador:",
choices = unique(n[,5]),
selected = input$ind_1)
updatePickerInput(session = session,
inputId = "ind_2",
label = "Elige un indicador:",
choices = unique(n[,5]),
selected = input$ind_1)
updatePickerInput(session = session,
inputId = "ind_3",
label = "Elige un indicador:",
choices = unique(n[,5]),
selected = input$ind_1)
}, ignoreInit = F, ignoreNULL = F)
observeEvent(c(input$ind_1,input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1),{
############# FER 3 FILTRES DIFERENTS PER CADA PLOT #############
output$dots_box<-renderPlotly({
a_<-subset(metadatos, metadatos[,5] %in% input$ind_1)
a_id<-subset(indicadores_id,indicadores_id[,1]==a_[,4])
a_id<-data.frame(indicadores[,1],
indicadores[,2],
indicadores[,3],
as.numeric(indicadores[,as.numeric(a_id[,2])]),
a_[,6])
names(a_id)<-c("Periodo","Sexo","Zonas","Valor","Dim")
a_id<-subset(a_id,!is.na(Valor))
n<-input$ind_1
a<-subset(a_id,a_id[,2] %in% input$ind_1_dim_1)
a<-subset(a,a[,1] %in% input$ind_1_any_1)
b<-subset(a,a[,3]!="ESPAÑA")
a<-subset(a,a[,3] %in% input$ind_1_zona_1)
if (length(unique(a[,2]))>2){
sex<-tolower(paste(unique(a[,2])[1]," , ",unique(a[,2])[2]," y ",unique(a[,2])[3],sep=""))
} else if (length(unique(a[,2]))>1){
sex<-tolower(paste(unique(a[,2])[1]," y ",unique(a[,2])[2],sep=""))
} else {
sex<-tolower(unique(a[,2]))
}
p<- plot_ly(data= b, x=~b[,1], y=~as.numeric(b[,4]), type = "box",name = "España",showlegend=FALSE) %>%
layout(boxmode = "group",
yaxis = list(title = unique(b[,5]),
titlefont = list(size = 10)),
xaxis = list(title = 'Años', tickangle = -42,autotick = T), margin=list(b = -0.1),
legend = list(title=list(text='<b> Zonas (medianas) </b>'),
font=list(size=8))) %>%
layout(title = list(text = HTML(paste0(paste('Evolución temporal segun',sex),
'<br>',
'<sup>',
input$ind_1,
'</sup>')),
font=list(size=14)),
x=0,
margin=list(t = 75)) %>%
layout(
showlegend = T) %>%
add_annotations(
text = "Fuente: Atlas de los determinantes sociales de la salud en España",
legendtitle=TRUE,
x = 0,
y = -0.33,
xref="paper",
yref = "paper",
align='left',
textposition="bottom left",
showarrow = FALSE,
font = list(size = 9))
p %>%
layout(resposnive = T)
})
}, ignoreInit = T)
}
ui <-dashboardBody(
fluidPage(
fluidRow(
pickerInput(
inputId = "ind_1",
label = "Elige un indicador:",
choices = list_ind,
selected=1),
pickerInput(
inputId = "ind_1_zona_1",
label = "Selecciona la zona a estudiar:",
choices = c("hola"),
selected = 2,
multiple = T),
pickerInput(
inputId = "ind_1_dim_1",
label = "hola",
choices = c("hola")),
pickerInput(
inputId = "ind_1_any_1",
label = "Selecciona el periodo a estudiar:",
choices = c("hola"),
multiple = T),
plotlyOutput("dots_box")
)
)
)
shinyApp(ui = ui, server = server)
嵌套反应不是一个好主意。您可以使用 eventReactive() 控制何时更新绘图。试试这个
myplot <- eventReactive(c(input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1), { ## removed input$ind_1 so that it does not update when ind_1 is changed
#observeEvent(c(input$ind_1,input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1),{
############# FER 3 FILTRES DIFERENTS PER CADA PLOT #############
#output$dots_box<-renderPlotly({
a_<-subset(metadatos, metadatos[,5] %in% input$ind_1)
a_id<-subset(indicadores_id,indicadores_id[,1]==a_[,4])
a_id<-data.frame(indicadores[,1],
indicadores[,2],
indicadores[,3],
as.numeric(indicadores[,as.numeric(a_id[,2])]),
a_[,6])
names(a_id)<-c("Periodo","Sexo","Zonas","Valor","Dim")
a_id<-subset(a_id,!is.na(Valor))
n<-input$ind_1
a<-subset(a_id,a_id[,2] %in% input$ind_1_dim_1)
a<-subset(a,a[,1] %in% input$ind_1_any_1)
b<-subset(a,a[,3]!="ESPAÑA")
a<-subset(a,a[,3] %in% input$ind_1_zona_1)
if (length(unique(a[,2]))>2){
sex<-tolower(paste(unique(a[,2])[1]," , ",unique(a[,2])[2]," y ",unique(a[,2])[3],sep=""))
} else if (length(unique(a[,2]))>1){
sex<-tolower(paste(unique(a[,2])[1]," y ",unique(a[,2])[2],sep=""))
} else {
sex<-tolower(unique(a[,2]))
}
p<- plot_ly(data= b, x=~b[,1], y=~as.numeric(b[,4]), type = "box",name = "España",showlegend=FALSE) %>%
layout(boxmode = "group",
yaxis = list(title = unique(b[,5]),
titlefont = list(size = 10)),
xaxis = list(title = 'Años', tickangle = -42,autotick = T), margin=list(b = -0.1),
legend = list(title=list(text='<b> Zonas (medianas) </b>'),
font=list(size=8))) %>%
layout(title = list(text = HTML(paste0(paste('Evolución temporal segun',sex),
'<br>',
'<sup>',
input$ind_1,
'</sup>')),
font=list(size=14)),
x=0,
margin=list(t = 75)) %>%
layout(
showlegend = T) %>%
add_annotations(
text = "Fuente: Atlas de los determinantes sociales de la salud en España",
legendtitle=TRUE,
x = 0,
y = -0.33,
xref="paper",
yref = "paper",
align='left',
textposition="bottom left",
showarrow = FALSE,
font = list(size = 9))
p %>% layout(responsive = T)
#})
#}, ignoreInit = T)
})
output$dots_box<-renderPlotly({
myplot()
})