R Shiny: 响应式错误

Question

我正在构建我的第一个Shiny应用程序，旨在创建一个按揭计算器和可调节的分期付款计划表。我能够使用runApp()函数呈现以下代码，但它没有功能（即不输出任何值，也不显示图形）。此外，它会在RStudio控制台中生成以下错误：

"Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)"

背景是：我正在运行： Win 7，64位操作系统| R v3.1.1 | RStudio v0.98.944

我已尝试实施此处定义的程序，但没成功：
Shiny Tutorial Error in R
R Shiny - Numeric Input without Selectors

ui.R

library(shiny)
shinyUI(
      pageWithSidebar(
      headerPanel(
            h1('Amoritization Simulator for Home Mortgages'), 
            windowTitle = "Amoritization Simulator"
      ),
      sidebarPanel(
            h3('Mortgage Information'),
            h4('Purchase Price'),
            p('Enter the total sale price of the home'),
            textInput('price', "Sale Price ($USD)", value = ""),
            h4('Percent Down Payment'),
            p('Use the slider to select the percent of the purchase price you 
              intend to pay as a down payment at the time of purchase'),
            sliderInput('per.down', "% Down Payment", value = 20, min = 0, max = 30, step = 1),
            h4('Interest Rate (APR)'),
            p('Use the slider to select the interest rate of the loan expressed
              as an Annual Percentage Rate (APR)'),
            sliderInput('apr', "APR", value = 4, min = 0, max = 8, step = 0.125),
            h4('Term Length (Years)'),
            p('Use the buttons to define the term of the loan'),
            radioButtons('term', "Loan Term (Years)", choices = c(15, 30), selected = 30),
            submitButton('Calculate')
            ),
      mainPanel(
            h3('Payment and Amoritization Simulation'),
            p('Use this tool to determine your monthly mortgage payment, 
              how much interest you will owe over the life of the loan, and how 
              you can reduce that amount with additional payment'),
            h4('Monthly Payment (Principal and Interest)'),
            p('This is the amount (in $USD) you would pay each month for a 
              mortgage under the terms you defined'),
            verbatimTextOutput("base.monthly.payment"),
            h4('Total Interest Over Life of Loan'),
            p('If paying just that amount per month, this is the total amount 
              in $USD you will spend on interest for that loan'),
            verbatimTextOutput("base.total.interest"),
            h4('Additional Principal Simulation'),
            p('One way to reduce the interest expense is to pay more principal 
              each month. Use the slider below to select an additional amount to
              include with your payment and see the reduction in interest expense
              for the life of the loan.'),
            sliderInput('add', "Additional Principal ($USD)", value = 250, min = 0, max = 1000, step = 25),
            p('Interest costs saved with this additional principal (in $USD)'),
            verbatimTextOutput("savings"),
            p('You will also pay the loan off the loan this many months early'),
            verbatimTextOutput("early"),
            plotOutput('plot')
            )
      )
)

服务器.R

library(shiny)
library(ggplot2)
library(scales)
shinyServer(
function(input, output) {
## determine baseline payment and interest total
price <- reactive({as.numeric(input$price)})
per.down <- reactive({input$per.down / 100})
int <- reactive({input$apr / 1200})
n <- reactive({input$term * 12})
base.monthly.payment <- (int() * price() * (1 - per.down()) * ((1 + int())^n())) / (((1 + int())^n()) - 1)
output$base.monthly.payment <- renderPrint({base.monthly.payment})
base.total.interest <- (base.monthly.payment * n()) - (price() * (1 - per.down()))
output$base.total.interest <- renderPrint({base.total.interest})
## create dataframe to populate with increments of additional payment
schedule <- data.frame(matrix(data = NA, nrow = 41, ncol = 6, 
                         dimnames = list(1:41, c("add", "add.n",
                                                "prin", "add.total.interest", 
                                                "savings", "early"))))
## initialize 'for' loop to populate possible amoritization totals
c <- 1
for (i in seq(0, 1000, 25)) {
      schedule$add[c] <- i
      schedule$add.n[c] <- log(((base.monthly.payment + i) / int()) / (((base.monthly.payment + i) / int()) - (price() * (1 - per.down())))) / log(1 + int())
      schedule$prin[c] <- round(price() * (1 - per.down()), digits = 2)
      schedule$add.total.interest[c] <- round(((base.monthly.payment + i) * schedule$add.n[c]) - schedule$prin[c], digits = 2)
      schedule$savings[c] <- round(base.total.interest - schedule$add.total.interest[c], digits = 2)
      schedule$early[c] <- round(n() - schedule$add.n[c], digits = 0)
      c <- c + 1
}
add <- reactive({input$add})
output$savings <- renderPrint({schedule$savings[which(schedule$add == add())]})
output$early <- renderPrint({schedule$early[which(schedule$add == add())]})
## create data.frame suitable for plotting
graph.data <- data.frame(matrix(data = NA, nrow = 82, ncol = 3, 
                                dimnames = list(1:82, c("add", "amount", "type"))))
c <- 1
for (i in seq(0, 1000, 25)) {
      graph.data$add[c] <- i
      graph.data$add[c + 1] <- i
      graph.data$amount[c] <- schedule$prin[which(schedule$add == i)]
      graph.data$amount[c + 1] <- schedule$add.total.interest[which(schedule$add == i)]
      graph.data$type[c] <- "Principal" 
      graph.data$type[c + 1] <- "Interest"
      c <- c + 2
}
## create plot of amoritization with line for additional principal amount
output$plot <- renderPlot({
ggplot(graph.data, aes(x = add, y = amount), color = type)
+ geom_area(aes(fill = type), position = 'stack', alpha = 0.75)
+ geom_vline(xintercept = add(), color="black", linetype = "longdash", size = 1)
+ labs(x = "Additional Principal/Month", y = "Total Cost")
+ scale_fill_manual(values=c("firebrick3", "dodgerblue3"), name = "Payment Component")
+ theme(axis.title.x = element_text(face = "bold", vjust = -0.7, size = 16), 
        axis.title.y = element_text(face = "bold", vjust = 2, size = 16),
        axis.text.x = element_text(size = 14), 
        axis.text.y = element_text(size = 14), 
        panel.margin = unit(c(5, 5, 5, 5), "mm"),
        plot.margin = unit(c(5, 5, 5, 5), "mm"),
        panel.background = element_blank(),
        panel.grid.major.y = element_line(colour = "gray"),
        panel.grid.minor.y = element_line(colour = "gray86"),
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank())
+ scale_x_continuous(labels = dollar)
+ scale_y_continuous(labels = dollar)
})
})

提前感谢任何帮助！

- Ryan S

---

不确定错误在哪里，但我认为您需要将 print() 包装在 ggplot() 调用周围。 (参见) - GSee

@GSee - 谢谢你的提示；我已经做出了更改。 - Ryan S

Answer 1

你的错误在这样的代码行中：

base.monthly.payment <- (int() * price() * (1 - per.down()) * 
  ((1 + int())^n())) / (((1 + int())^n()) - 1)

base.monthly.payment使用了int()、n()、per.down()和price()，它们都是响应式的。因此，base.monthly.payment也将是响应式的。所以当你创建它/赋值时，需要像这样用reactive包装它：

base.monthly.payment <- reactive ({
  (int() * price() * (1 - per.down()) * ((1 + int())^n())) / (((1 + int())^n()) - 1)
})

并且将其称为 base.monthly.payment()，就像您对 n()、int()等函数一样。

对于代码中的许多其他对象也是如此，例如： schedule、base.total.interest、graph.data。

- John Paul

---

非常感谢，我差不多可以开始了。您的编辑使我能够获得所有除最后一个滑块和图表之外的功能。这些部分，特别是add()反应式，被错误提示“Error in *tmp*$more：对象类型'closure'不可子集化”所困扰。我将继续以更清晰的眼睛进行故障排除，但如果这听起来很熟悉，我再次感谢您提供的任何帮助。谢谢！ - Ryan S

“object of type closure is not subsettable” 错误通常意味着您有一个反应式对象，并且在处理它们时忘记添加括号，例如，您使用了 object$column 而不是 object()$column。滑块问题是什么？您可能需要将其作为新问题发布 - 滑块过去有点不稳定。 - John Paul

我认为滑块本身没有实际问题，而是代码之前的某些部分未能正常运行，这就使得滑块没有任何作用。感谢您对此的帮助，我已经解决了除数据框和图表外的所有问题。我决定放弃应用程序中的这些元素，只报告数字。 - Ryan S