A discounting app

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(ggplot2)
library(plotly)

# Define UI for application that draws a histogram
ui <- fluidPage(
   
   # Application title
   titlePanel("Diskontierung"),
   
   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
         numericInput("i",
                     "Zinsrate:",
                     min = .001,
                     max = 10,
                     value = 5,
                     step = .01)
      ,
      numericInput("tt",
                  "Zeitraum:",
                  min = 1,
                  max = 100,
                  value = 10,
                  step = 1)
      ,
      numericInput("t",
                  "Berechnung des Gegenwartswertes zum Zeitpunkt:",
                  min = 1,
                  max = 100,
                  value = .5,
                  step = 1)
      ,
      numericInput("u_n",
                  "Berechnung des Gegenwartswertes von:",
                  min = 1,
                  max = 10000,
                  value = 1000,
                  step = 1)
      ),
   
      
      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("Plot1"),
         plotOutput("Plot2"),
         plotOutput("Plot3")
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
   
   output$Plot1 <- renderPlot({
      # generate bins based on input$bins from ui.R
      i <- input$i
      a <- i
      tt <- input$tt
      n <- seq(0,tt,tt/100) # Anzahl der Jahre
      d_e <- 1/(1+i)^n # Diskontierungsfaktor exponentiell
      d_s <- exp(-(i*n)) # Diskontiernugsfaktor stetig
      d_h <- 1/(1+(a*n)) # Diskontierungsfaktor hyperbolisch
      u_n <- input$u_n # Endwert
      u_0h <- u_n * d_h # Gegenwartswert hyperbolisch
      u_0e <- u_n * d_e # Gegenwartswert exponentiell
      u_0s <- u_n * d_s # Gegenwartswert stetisch
      
      # Berechnung des Gegenwartswertes von u_n zu Zeitpunkt n = t
      t = input$t
      u_ts <- u_n * exp(-(i*t))
      u_te <- u_n * 1/(1+i)^t
      u_th <- u_n * 1/(1+i*t)
      
      
      ggplot() +
        geom_line(aes(x = n, y = u_0e)) + # exponentiell
        #  geom_line(aes(x = n, y = u_0h), linetype = "dashed") + # hyperbolisch
        #  geom_line(aes(x = n, y = u_0s), linetype = "dotted") + # stetig
        scale_x_continuous(expand = c(0,0)) +
        scale_y_continuous(expand = c(0,0)) +
        geom_segment(aes(x = t, y =0, xend = t, yend = u_te)) + # exponentiell
        geom_segment(aes(x = 0, y = u_te, xend = t, yend = u_te)) + # exponentiell
        #  geom_segment(aes(x = t, y =0, xend = t, yend = u_th), linetype = "dashed") + # hyperbolisch
        #  geom_segment(aes(x = 0, y = u_th, xend = t, yend = u_th), linetype = "dashed") + # hyperbolisch
        #  geom_segment(aes(x = t, y =0, xend = t, yend = u_ts), linetype = "dotted") + # stetig
        #  geom_segment(aes(x = 0, y = u_ts, xend = t, yend = u_ts), linetype = "dotted") + # stetig
        #  geom_text(aes(x = t, y = u_t, label = paste("V_0 = ", round(u_t,2), "\nn = ", t))) +
        xlab("Jahre (n)") +
        ylab("Gegenwartswert (V_0)") +
        ggtitle(label = "Exponentiell", subtitle = paste("Bei einem exponentiellen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR\nin", t, "Jahr(en) gezahlt werden, damit KonsumentInnen", "sofort auf\n", round(u_te,2), "EUR Konsum verzichten.\n" 
                                                         #                                                  "Bei einem hyperbolischen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR\nin", t, "Jahr(en) gezahlt werden, damit KonsumentInnen", "sofort auf\n", round(u_th,2), "EUR Konsum verzichten.\n"
                                             #                                                              "Bei einem stetigen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR in", t, "Jahr(en)\ngezahlt werden, damit KonsumentInnen", "sofort auf", round(u_ts,2), "EUR\nKonsum verzichten."
        )) +
        theme_bw()
      
   })
   output$Plot2 <- renderPlot({
     # generate bins based on input$bins from ui.R
     i <- input$i
     a <- i
     tt <- input$tt
     n <- seq(0,tt,tt/100) # Anzahl der Jahre
     d_e <- 1/(1+i)^n # Diskontierungsfaktor exponentiell
     d_s <- exp(-(i*n)) # Diskontiernugsfaktor stetig
     d_h <- 1/(1+(a*n)) # Diskontierungsfaktor hyperbolisch
     u_n <- input$u_n # Endwert
     u_0h <- u_n * d_h # Gegenwartswert hyperbolisch
     u_0e <- u_n * d_e # Gegenwartswert exponentiell
     u_0s <- u_n * d_s # Gegenwartswert stetisch
     
     # Berechnung des Gegenwartswertes von u_n zu Zeitpunkt n = t
     t = input$t
     u_ts <- u_n * exp(-(i*t))
     u_te <- u_n * 1/(1+i)^t
     u_th <- u_n * 1/(1+i*t)
     
     
     ggplot() +
       # geom_line(aes(x = n, y = u_0e)) + # exponentiell
       geom_line(aes(x = n, y = u_0h), linetype = "dashed") + # hyperbolisch
       #  geom_line(aes(x = n, y = u_0s), linetype = "dotted") + # stetig
       scale_x_continuous(expand = c(0,0)) +
       scale_y_continuous(expand = c(0,0)) +
       #geom_segment(aes(x = t, y =0, xend = t, yend = u_te)) + # exponentiell
       #geom_segment(aes(x = 0, y = u_te, xend = t, yend = u_te)) + # exponentiell
       geom_segment(aes(x = t, y =0, xend = t, yend = u_th), linetype = "dashed") + # hyperbolisch
       geom_segment(aes(x = 0, y = u_th, xend = t, yend = u_th), linetype = "dashed") + # hyperbolisch
       #  geom_segment(aes(x = t, y =0, xend = t, yend = u_ts), linetype = "dotted") + # stetig
       #  geom_segment(aes(x = 0, y = u_ts, xend = t, yend = u_ts), linetype = "dotted") + # stetig
       #  geom_text(aes(x = t, y = u_t, label = paste("V_0 = ", round(u_t,2), "\nn = ", t))) +
       xlab("Jahre (n)") +
       ylab("Gegenwartswert (V_0)") +
       ggtitle(label = "Hyperbolisch", subtitle = paste(#"Bei einem hyperbolischen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR\nin", t, "Jahr(en) gezahlt werden, damit KonsumentInnen", "sofort auf\n", round(u_te,2), "EUR Konsum verzichten.\n" 
                                                        "Bei einem hyperbolischen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR\nin", t, "Jahr(en) gezahlt werden, damit KonsumentInnen", "sofort auf\n", round(u_th,2), "EUR Konsum verzichten.\n"
                                                        #                                                              "Bei einem stetigen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR in", t, "Jahr(en)\ngezahlt werden, damit KonsumentInnen", "sofort auf", round(u_ts,2), "EUR\nKonsum verzichten."
       )) +
       theme_bw()
     
   })
   
   output$Plot3 <- renderPlot({
     # generate bins based on input$bins from ui.R
     i <- input$i
     a <- i
     tt <- input$tt
     n <- seq(0,tt,tt/100) # Anzahl der Jahre
     d_e <- 1/(1+i)^n # Diskontierungsfaktor exponentiell
     d_s <- exp(-(i*n)) # Diskontiernugsfaktor stetig
     d_h <- 1/(1+(a*n)) # Diskontierungsfaktor hyperbolisch
     u_n <- input$u_n # Endwert
     u_0h <- u_n * d_h # Gegenwartswert hyperbolisch
     u_0e <- u_n * d_e # Gegenwartswert exponentiell
     u_0s <- u_n * d_s # Gegenwartswert stetisch
     
     # Berechnung des Gegenwartswertes von u_n zu Zeitpunkt n = t
     t = input$t
     u_ts <- u_n * exp(-(i*t))
     u_te <- u_n * 1/(1+i)^t
     u_th <- u_n * 1/(1+i*t)
     
     
     ggplot() +
        geom_line(aes(x = n, y = u_0e)) + # exponentiell
       geom_line(aes(x = n, y = u_0h), linetype = "dashed") + # hyperbolisch
       #  geom_line(aes(x = n, y = u_0s), linetype = "dotted") + # stetig
       scale_x_continuous(expand = c(0,0)) +
       scale_y_continuous(expand = c(0,0)) +
       geom_segment(aes(x = t, y =0, xend = t, yend = u_te)) + # exponentiell
       geom_segment(aes(x = 0, y = u_te, xend = t, yend = u_te)) + # exponentiell
       geom_segment(aes(x = t, y =0, xend = t, yend = u_th), linetype = "dashed") + # hyperbolisch
       geom_segment(aes(x = 0, y = u_th, xend = t, yend = u_th), linetype = "dashed") + # hyperbolisch
       #  geom_segment(aes(x = t, y =0, xend = t, yend = u_ts), linetype = "dotted") + # stetig
       #  geom_segment(aes(x = 0, y = u_ts, xend = t, yend = u_ts), linetype = "dotted") + # stetig
       #  geom_text(aes(x = t, y = u_t, label = paste("V_0 = ", round(u_t,2), "\nn = ", t))) +
       xlab("Jahre (n)") +
       ylab("Gegenwartswert (V_0)") +
       ggtitle(label = "Hyperbolisch", subtitle = paste("Bei einem hyperbolischen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR\nin", t, "Jahr(en) gezahlt werden, damit KonsumentInnen", "sofort auf\n", round(u_te,2), "EUR Konsum verzichten.\n", 
         "Bei einem hyperbolischen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR\nin", t, "Jahr(en) gezahlt werden, damit KonsumentInnen", "sofort auf\n", round(u_th,2), "EUR Konsum verzichten.\n"
         #                                                              "Bei einem stetigen Zinssatz von", i*100, "Prozent müssen", u_n, "EUR in", t, "Jahr(en)\ngezahlt werden, damit KonsumentInnen", "sofort auf", round(u_ts,2), "EUR\nKonsum verzichten."
       )) +
       theme_bw()
     
   })
}

# Run the application 
shinyApp(ui = ui, server = server)

Related

Previous