#r #shiny #shiny-reactivity
Вопрос:
В приведенном ниже коде MWE две вкладки, созданные при выполнении кода, «Модуль обязательств» и «Процентные ставки», идентичны. Они предназначены как два разных пути к одной и той же таблице данных и диаграммам (показывающим скорости), которые в настоящее время генерируются при выполнении кода.
Но эти 2 вкладки должны расходиться по мере их дальнейшего развития с точки зрения других кнопок действий на боковой панели и с точки зрения кнопок действий, появляющихся в верхней части основных панелей для каждой из соответствующих вкладок. Для простого примера я хотел бы добавить кнопку действия «Тест» в модуль «Обязательства», но не в модуль «Процентные ставки».
Как бы я добавил несколько условий на условную панель, чтобы в этом случае кнопка действия «Тест» отображалась в модуле «Обязательства», но не во вкладках «Процентные ставки»? Как показано на рисунке внизу.
Моя скромная попытка сделать это отмечена # ПОПЫТКА # в приведенном ниже MWE; естественно, это не работает, поэтому мне пришлось это прокомментировать.
Код MWE:
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
matrix4Input <- function(x, matrix4Input) {
matrixInput(
x,
value = matrix4Input,
rows = list(extend = FALSE, names = TRUE),
cols = list(
extend = FALSE,
names = FALSE,
editableNames = FALSE
),
class = "numeric"
)
}
vectorBaseRate <- function(x, y) {
a <- rep(y, x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
}
vectorBaseRatePlot <- function(w, x, y, z) {
plot(
w[, 1],
sapply(w[, 2], function(x)
gsub("%", "", x)),
main = x,
xlab = y,
ylab = z
)
}
ui <- pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(fluidRow(helpText(h5(
strong("Base Input Panel")
))), uiOutput("Panels")),
mainPanel(tabsetPanel(
tabPanel(
"Liabilities module",
value = 4,
fluidRow(
radioButtons(
inputId = "showRates4",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
uiOutput('showTab4Results')
)
),
# close tab panel
tabPanel(
"Interest rates",
value = 5,
fluidRow(
radioButtons(
inputId = "showRates5",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
uiOutput('showTab5Results')
)
),
# close tab panel
id = "tabselected"
))
) # close tabset panel, main panel, page with sidebar
server <- function(input, output, session) {
matrix4 <- reactive(input$matrix4)
baseRate <-
function() {
vectorBaseRate(60, input$matrix4[1, 1])
} # Must remain in server section
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'),
# ATTEMPT # condition = "input.tabselected==4", actionButton('test','Test')
) # close conditional panel
}) # close renderUI
vectorRates <- reactive({
if (is.null(input$modRates)){DF <- NULL}
else {
if (input$modRates < 1) {DF <- cbind(Period = 1:60, BaseRate = 0.2)}
else {
req(input$matrix4)
DF <- cbind(Period = 1:60, BaseRate = baseRate()[, 2])
} # close 2nd else
} # close 1st else
DF
}) # close reactive
observeEvent(input$resetRatesStruct, {updateMatrixInput(session, 'matrix4', matrix4Default)})
output$table5 <- output$table4 <- renderTable({vectorRates()})
output$graph5 <- output$graph4 <- renderPlot({
vectorBaseRatePlot(vectorRates(), "A Variable", "Period", "Rate")
})
output$showTab4Results <- renderUI({
if (input$showRates4 == 'Rates values'){tableOutput("table4")}
else {plotOutput("graph4")}
})
output$showTab5Results <- renderUI({
if (input$showRates5 == 'Rates values'){tableOutput("table5")}
else {plotOutput("graph5")}
})
observeEvent(input$modRates,
{
showModal(modalDialog(
matrix4Input("matrix4", if (is.null(input$matrix4))
matrix4Default
else
input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct", "Reset"),
modalButton("Close")
)
))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
} # close server
shinyApp(ui, server)
Ответ №1:
Вы можете просто добавить еще conditionalPanel один, используя другое условие.
Кроме того, я отбросил все renderUI , так как нет необходимости создавать панели условий на стороне сервера. Это должно привести к более быстрому пользовательскому интерфейсу.
Я добавил еще несколько кнопок, чтобы показать концепцию:
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
matrix4Input <- function(x, matrix4Input) {
matrixInput(
x,
value = matrix4Input,
rows = list(extend = FALSE, names = TRUE),
cols = list(
extend = FALSE,
names = FALSE,
editableNames = FALSE
),
class = "numeric"
)
}
vectorBaseRate <- function(x, y) {
a <- rep(y, x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
}
vectorBaseRatePlot <- function(w, x, y, z) {
plot(
w[, 1],
sapply(w[, 2], function(x)
gsub("%", "", x)),
main = x,
xlab = y,
ylab = z
)
}
ui <- pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(fluidRow(helpText(h5(
strong("Base Input Panel")
))),
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates')
), # close conditional panel
conditionalPanel(
condition = "input.tabselected==4", actionButton('test1','Test')
)
),
mainPanel(
conditionalPanel(
condition = "input.tabselected==4", actionButton('test2','A mainPanel test button')
),
conditionalPanel(
condition = "input.tabselected==5", actionButton('test3','Another mainPanel test button')
),
tabsetPanel(
selected = 4,
conditionalPanel(
condition = "input.tabselected==4", actionButton('test4','A tabsetPanel test button')
),
conditionalPanel(
condition = "input.tabselected==5", actionButton('test5','Another tabsetPanel test button')
),
tabPanel(
"Liabilities module",
value = 4,
fluidRow(
radioButtons(
inputId = "showRates4",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
conditionalPanel(condition = "input.showRates4 == 'Rates values'", tableOutput("table4")),
conditionalPanel(condition = "input.showRates4 == 'Rates plots'", plotOutput("graph4"))
)
),
# close tab panel
tabPanel(
"Interest rates",
value = 5,
fluidRow(
radioButtons(
inputId = "showRates5",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
conditionalPanel(condition = "input.showRates5 == 'Rates values'", tableOutput("table5")),
conditionalPanel(condition = "input.showRates5 == 'Rates plots'", plotOutput("graph5"))
)
),
# close tab panel
id = "tabselected"
))
) # close tabset panel, main panel, page with sidebar
server <- function(input, output, session) {
matrix4 <- reactive(input$matrix4)
baseRate <- function() {
vectorBaseRate(60, input$matrix4[1, 1])
} # Must remain in server section
vectorRates <- reactive({
if (is.null(input$modRates)){DF <- NULL}
else {
if (input$modRates < 1) {DF <- cbind(Period = 1:60, BaseRate = 0.2)}
else {
req(input$matrix4)
DF <- cbind(Period = 1:60, BaseRate = baseRate()[, 2])
} # close 2nd else
} # close 1st else
DF
}) # close reactive
observeEvent(input$resetRatesStruct, {updateMatrixInput(session, 'matrix4', matrix4Default)})
output$table5 <- output$table4 <- renderTable({vectorRates()})
output$graph5 <- output$graph4 <- renderPlot({
vectorBaseRatePlot(vectorRates(), "A Variable", "Period", "Rate")
})
observeEvent(input$modRates,
{
showModal(modalDialog(
matrix4Input("matrix4", if (is.null(input$matrix4))
matrix4Default
else
input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct", "Reset"),
modalButton("Close")
)
))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
} # close server
shinyApp(ui, server)
Комментарии:
1. Спасибо, вы также показываете, как добавлять дополнительные кнопки в разных возможных местах, и именно к этому я и веду. Также вы показываете, как у вас может быть несколько условных панелей для одного и того же «условия =». Работает в разделе пользовательского интерфейса. Чтобы сделать это в renderUI, я публикую другой ответ (я больше возился с ним), в который вы можете вложить условные панели. Причина, по которой я визуализировал панели в разделе сервера с помощью renderUI, заключалась в том, чтобы остановить эту странную вспышку при первом вызове приложения. Но я попробую ваше предложение о перемещении условных панелей обратно в пользовательский интерфейс и посмотрю, есть ли еще мигание вызова.
2. По моему опыту, использование consitionalPanel является наиболее гибким решением для введения условных элементов пользовательского интерфейса. С
renderUIвами нужно дождаться сервера и завершения всей необходимой связи. До сих пор я не видел никаких вспышек в приложениях, которые я создал.3. Я конвертирую свой код not-MWE, как вы рекомендуете, устраняя renderUI и перемещая все условные панели в раздел пользовательского интерфейса. Это, безусловно, течет лучше и интуитивно имеет больше смысла. Я проверю мигание вызова в коде not-MWE (я его уже вижу) и опубликую этот код, чтобы узнать, есть ли другой способ справиться с миганием блестящего вызова. РендерУИ действительно накладывает некоторые ограничения и рад отойти от этого!
4. Звучит хорошо — дайте мне знать, если у вас есть MWE, показывающий эту проблему с миганием. Овации
5. Я закончил переносить все условные панели с сервера в раздел пользовательского интерфейса, устраняя renderUI и его сложности в полном модуле, из которого был извлечен этот MWE. Никаких вспышек вызова! По крайней мере, для этого модуля «Обязательства». Я собираюсь попробовать те же модификации для другого связанного модуля, надеюсь, в этом случае не будет мигания вызова. Этому методу пользовательского интерфейса, безусловно, легче следовать.
Ответ №2:
Вы можете использовать оператор if, так как вы визуализируете пользовательский интерфейс на сервере. В качестве альтернативы вы можете создать всю боковую панель на сервере, что даст вам немного больше гибкости. Теперь вы можете фактически удалить всю условную панель и просто сгенерировать кнопки для использования в пользовательском интерфейсе, используя значения, выбранные на вкладке «Ввод», в качестве условий, это зависит от вас.
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5",
actionButton('modRates', 'Modify Rates'),
if(input$tabselected == 4){
actionButton('test','Test')
}
# ATTEMPT # condition = "input.tabselected==4", actionButton('test','Test')
) # close conditional panel
}) # close renderUI
Комментарии:
1. Привет, Винсент, это помещает кнопку действия «Тест» на вкладку 4, а не на вкладку 5, как предполагалось. Однако до этого изменения любые изменения на вкладке 4 (путем нажатия кнопки «Изменить ставки» на боковой панели и внесения изменений во входную сетку в модальном диалоговом окне) мгновенно отражались в обеих таблицах/графиках на вкладках 4 и 5. И наоборот. Но с вашим изменением изменение на вкладке 4 не отображается на вкладке 5 до тех пор, пока снова не будет нажата кнопка «Изменить ставки», и наоборот. Знаете ли вы, как восстановить реактивность, которая была там раньше?
Ответ №3:
Ниже приведен полный код MWE для решения этой проблемы при одновременном отображении условных панелей в server разделе с использованием renderUI (возможно, я ошибаюсь, еще немного протестирую, но этот renderUI метод, я думаю, решил некоторые проблемы с миганием вызова приложения).
Вот вложенность условных панелей, которая решила эту проблему для меня:
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'),
conditionalPanel(
condition = "input.tabselected==4", actionButton('test', 'Test'),
) # close 2nd conditional panel
) # close 1st conditional panel
}) # close renderUI
Завершите MWE, включив вышеуказанное:
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
matrix4Input <- function(x, matrix4Input) {
matrixInput(
x,
value = matrix4Input,
rows = list(extend = FALSE, names = TRUE),
cols = list(
extend = FALSE,
names = FALSE,
editableNames = FALSE
),
class = "numeric"
)
}
vectorBaseRate <- function(x, y) {
a <- rep(y, x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
}
vectorBaseRatePlot <- function(w, x, y, z) {
plot(
w[, 1],
sapply(w[, 2], function(x)
gsub("%", "", x)),
main = x,
xlab = y,
ylab = z
)
}
ui <- pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(fluidRow(helpText(h5(
strong("Base Input Panel")
))), uiOutput("Panels")),
mainPanel(tabsetPanel(
tabPanel(
"Liabilities module",
value = 4,
fluidRow(
radioButtons(
inputId = "showRates4",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
uiOutput('showTab4Results')
)
),
# close tab panel
tabPanel(
"Interest rates",
value = 5,
fluidRow(
radioButtons(
inputId = "showRates5",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
uiOutput('showTab5Results')
)
),
# close tab panel
id = "tabselected"
))
) # close tabset panel, main panel, page with sidebar
server <- function(input, output, session) {
matrix4 <- reactive(input$matrix4)
baseRate <-
function() {vectorBaseRate(60, input$matrix4[1, 1])} # Must remain in server section
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'),
conditionalPanel(
condition = "input.tabselected==4", actionButton('test', 'Test'),
) # close 2nd conditional panel
) # close 1st conditional panel
}) # close renderUI
vectorRates <- reactive({
if (is.null(input$modRates)){DF <- NULL}
else {
if (input$modRates < 1) {DF <- cbind(Period = 1:60, BaseRate = 0.2)}
else {
req(input$matrix4)
DF <- cbind(Period = 1:60, BaseRate = baseRate()[, 2])
} # close 2nd else
} # close 1st else
DF
}) # close reactive
observeEvent(input$resetRatesStruct, {updateMatrixInput(session, 'matrix4', matrix4Default)})
output$table5 <- output$table4 <- renderTable({vectorRates()})
output$graph5 <- output$graph4 <- renderPlot({
vectorBaseRatePlot(vectorRates(), "A Variable", "Period", "Rate")
})
output$showTab4Results <- renderUI({
if (input$showRates4 == 'Rates values'){tableOutput("table4")}
else {plotOutput("graph4")}
})
output$showTab5Results <- renderUI({
if (input$showRates5 == 'Rates values'){tableOutput("table5")}
else {plotOutput("graph5")}
})
observeEvent(input$modRates,
{
showModal(modalDialog(
matrix4Input("matrix4", if (is.null(input$matrix4))
matrix4Default
else
input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct", "Reset"),
modalButton("Close")
)
))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
} # close server
shinyApp(ui, server)