2014-10-19 2 views
3

Я строю свое первое приложение Shiny с целью создания калькулятора ипотеки и настраиваемого графика аморитизации. Я могу получить следующий код для рендеринга с помощью runApp(), но он не работает (т. Е. Не выводит никаких значений и не отображает график). Кроме того, в консоли RStudio генерируется следующая ошибка:R Shiny: Reactive Error

Ошибка в .getReactiveEnvironment() $ currentContext(): Операция не разрешена без активного реактивного контекста. (Вы пытались сделать что-то, что можно сделать только изнутри реактивное выражение или наблюдатель.) «

Для фона я запускаю: Win 7, 64-bit OS | 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') 
      ) 
    ) 
) 

server.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) 
}) 
}) 

Спасибо заранее за любую помощь!

+0

Не уверен в ошибке, но я думаю, вам нужно обернуть 'print()' вокруг вызова 'ggplot()'. ([см. также] (http://stackoverflow.com/questions/18038947/shiny-not-displaying-my-ggplot-as-id-expect)) – GSee

+0

@GSee - спасибо за этот отзыв; Я сделал смену –

ответ

7

Ваша ошибка в линии, как это:

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.

+0

благодаря кучке, я почти готов к работе. Ваше редактирование позволило мне получить все, кроме последнего ползунка и графика. Эти части, в частности реакция add(), устраняются ошибкой с сообщением «Ошибка в' * tmp * '$ more: объект типа« закрытие »не является подмножеством». Я продолжу устранять это с более ясными глазами, но если это звучит знакомо, я бы еще раз оценил любую помощь, которую вы предоставили бы. Благодаря! –

+0

Ошибка 'объекта типа закрытия не является подмножеством', как правило, означает, что у вас есть реактивный объект, и для того, чтобы добавить скобки при работе с ними, например. у вас был 'object $ column' вместо' object() $ column'. Что такое проблема с ползунком? Возможно, вам придется опубликовать его в качестве нового вопроса - слайдеры в прошлом были немного ошибочными. –

+0

Я не думаю, что была проблема с ползунком, но не функциональность предыдущих частей кода помешала ползунку не иметь никакого эффекта. Спасибо за вашу помощь по этому поводу, поскольку я смог получить все, кроме data.frames и моего графика, чтобы работать. Я решил поддразнивать эти элементы приложения и просто сообщить номер. –

Смежные вопросы