#r #plot #vector #shiny
Вопрос:
При первом вызове приведенного ниже кода MWE на главной панели отображается таблица значений по умолчанию из 2 столбцов: 60 периодов, перечисленных в левом столбце, и значения 20,0% для каждого из 60 периодов в правом столбце. Это работает правильно и показано на 1 — м изображении ниже.
Когда пользователь нажимает кнопку действия «Векторные графики» на главной панели, должен появиться график, показывающий те же значения 0,2 для 60 периодов. Вместо этого, как показано на 2-м изображении ниже, я получаю график значений 1-60 (из 1-го столбца таблицы), а затем значений 20 для периодов 61-120. Это неверно.
Объект, созданный в приведенном ниже MWE, является общим как для таблицы, так и для графика vectorsAll
.
Как мне указать правильный столбец (2-й столбец) vectorsAll
для построения графика? В настоящее время он строит первую колонку (1-60), и я не знаю, почему она заканчивается на 120.
Я пытаюсь сделать это на родном языке Shiny, никаких других сюжетных пакетов, таких как ggplot.
При работе с этим приложением, если пользователь нажимает кнопку действия «Ввод обязательств» на боковой панели, в модальном диалоговом окне появляется сетка матрицы ввода. В этом MWE работает только 1-я строка «A». Если пользователь изменит значение в R, оно мгновенно отобразится в таблице главной панели (работает правильно) и на графике.
Я сократил этот код достаточно, чтобы пакет shinyWidgets не требовался-я думаю.
Обратите внимание, что строка ниже output$graph1 <-renderPlot(plot(sapply
… удаляет знак % с vectorsAll
объекта.
Код MWE:
library(shiny)
library(shinyjs)
library(shinyMatrix)
matrix1Input <- function(x){
matrixInput(x,
value = matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL)),
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=FALSE,names=FALSE,editableNames=FALSE),
class = "numeric")}
pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage
vectorBase <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
style="margin-top:-15px;margin-bottom:5px")),
# Panels rendered with uiOuput amp; renderUI in server to stop flashing at invocation
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("Liabilities module", value=4,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showVectorValueBtn','Vector values'),
actionButton('showVectorPlotBtn','Vector plots'),
), # close fluid row
div(style = "margin-top: 5px"),
# Shows outputs on each page of main panel
uiOutput('showResults')),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
base_input <- reactive(input$base_input)
showResults <- reactiveValues()
yield <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
# --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ------------>
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==4",
actionButton('showLiabilityGrid','Input Liabilities',style='width:100%;background-color:LightGrey'),
setShadow(id='showLiabilityGrid'),
div(style = "margin-bottom: 10px"),
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
# --- Below defines the vectorsAll object before user clicks on actionButton "Input Liabilities" ---->
vectorsAll <- reactive({
if (is.null(input$showLiabilityGrid)){df <- NULL}
else {
if(input$showLiabilityGrid < 1){df <- cbind(Period = 1:60,Yld_Rate = pct(0.2))} # define what you want to display by default
else {
req(input$base_input)
df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
} # close 2nd else
} # close 1st else
df
}) # close reactive
output$table1 <- renderTable({vectorsAll()})
# --- Below produces vector values after clicking "Vector Values" button; see above for pre-click ---->
observeEvent(input$showVectorValueBtn,{showResults$showme<-tagList(tableOutput("table1"))},ignoreNULL=FALSE)
# --- Below produces vector plots -------------------------------------------------------------------->
output$graph1 <-renderPlot(plot(sapply(vectorsAll(),function(x)gsub("%","",x))))
observeEvent(input$showVectorPlotBtn,{showResults$showme <- plotOutput("graph1")})
# --- Below sends both vector plots and vector values to UI section above ---------------------------->
output$showResults <- renderUI({showResults$showme})
# --- Below for modal dialog inputs ------------------------------------------------------------------>
observeEvent(input$showLiabilityGrid,
{showModal(modalDialog(matrix1Input("base_input"),div(style = "margin-top: 0px"),useShinyjs(),
))}) # close modalDialog, showModal, showModal function, and observeEvent, in that order
}) # close server
shinyApp(ui, server)
Ответ №1:
Возможно, это все решит.
output$graph1 <-renderPlot(plot(vectorsAll()[,1],sapply(vectorsAll()[,2], function(x)gsub("%", "", x)) ))
Комментарии:
1. Это отлично работает, спасибо. Я пытался vectorsAll([,2]), но теперь я вижу, что локатор строк/столбцов в [ ] должен следовать ( ), а не находиться внутри ( ). Таким образом,правильный синтаксис-object( )[r, c]. Повторяя это, может быть, я наконец вспомню. Я взял 2-недельный отпуск и, казалось, многое забыл за это время.