【问题标题】:R Shiny: Reactive ErrorR Shiny:反应性错误
【发布时间】:2014-12-14 18:48:34
【问题描述】:

我正在构建我的第一个 Shiny 应用程序,目的是创建一个抵押贷款计算器和可调整的摊销计划。我能够获得以下代码以使用 runApp() 进行渲染,但它不起作用(即,不输出任何值,也不显示图形)。此外,它会在 RStudio 的控制台中生成以下错误:

“.getReactiveEnvironment()$currentContext() 中的错误: 如果没有活动的反应上下文,则不允许操作。 (您试图做一些只能在反应式表达式或观察者内部完成的事情。)"

对于背景,我正在运行: 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)
})
})

提前感谢您的帮助!

【问题讨论】:

  • 不确定错误,但我认为您需要将print() 包裹在ggplot() 调用周围。 (see also)
  • @GSee - 也感谢您的提示;我做了改变

标签: r shiny shiny-reactivity


【解决方案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() 等所做的一样。

代码中的许多其他对象也是如此,例如:schedulebase.total.interestgraph.data

【讨论】:

  • 非常感谢,我差不多可以走了。您的编辑使我能够获得除最终滑块和图形之外的所有功能。这些部分,特别是 add() 反应,被错误声明“*tmp*$more 中的错误:'closure' 类型的对象不是子集的”。我将继续以更清晰的眼光解决此问题,但如果这听起来很熟悉,我将再次感谢您提供的任何帮助。谢谢!
  • object of type closure is not subsettable 错误通常意味着您有一个反应性对象,并且在使用它们时必须添加括号,例如你有object$column 而不是object()$column。什么是滑块问题?您可能需要将其作为一个新问题发布 - 滑块过去有一些问题。
  • 我不认为滑块存在实际问题,而是代码前面部分的非功能性阻止了滑块产生任何效果。感谢您在这方面的帮助,因为除了 data.frames 和我的图表之外,我能够得到所有的东西。我决定把这些元素放在应用程序上,只报告数字。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2020-07-07
  • 1970-01-01
  • 2020-09-17
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多