inst/shiny-examples/uws_app/server.R

In o1i/UWS: Umwandlungssatz in der zweiten Säule

# load('/home/oliver/Documents/projects/altersvorsorge/uws/data/lc_x.rda')
# load('/home/oliver/Documents/projects/altersvorsorge/uws/data/lc_y.rda')
# load('/home/oliver/Documents/projects/altersvorsorge/uws/data/qx.rda')
# load('/home/oliver/Documents/projects/altersvorsorge/uws/data/qy.rda')
# load('/home/oliver/Documents/projects/altersvorsorge/uws/data/i_7_rolling.rda')
# load('/home/oliver/Documents/projects/altersvorsorge/uws/data/i_min.rda')
# source('/home/oliver/Documents/projects/altersvorsorge/uws/R/biometrics.R')
# source('/home/oliver/Documents/projects/altersvorsorge/uws/R/mortality_tables.R')
# source('/home/oliver/Documents/projects/altersvorsorge/uws/R/present_values.R')
library(devtools)

if ("uws" %in% installed.packages()) {
  library("uws")
}else{
  devtools::install_github('o1i/UWS')
  library('uws')
}

ages <- 60:104

qx <- qx[as.character(ages), ]
qy <- qy[as.character(ages), ]

max_year_proj <- 2060
start_year <- 1960
last_year <- 2016
n_proj <- max_year_proj - last_year + nrow(qx) + 1
i_length <- last_year - start_year + 1 + n_proj + nrow(qx) + 1
show_gens <- 1950:2000

# Colors
col_past = rgb(0, 0, 1)
col_future = rgb(1, 0, 0)
col_i_rolling <- rgb(0, 1, 1)
col_i_used <- rgb(1, 0, 1)
col_x <- rgb(0.5, 0.5, 1)
col_y <- rgb(1, 0.5, 0.5)

server <- function(input, output){

    # --- Volatile things that change with the user input
    qx_proj <- shiny::reactive({
      project_LC(qx, lc_x, input$improvement_force, n_proj + diff(range(ages)) + 1)
    })
    qy_proj <- reactive({
      project_LC(qy, lc_y, input$improvement_force, n_proj + diff(range(ages)) + 1)
    })
    qx_proj_g <- shiny::reactive({per2gen(qx_proj())})
    qy_proj_g <- shiny::reactive({per2gen(qy_proj())})
    i_proj <- shiny::reactive({
      if (input$fixed) {
        setNames(rep(input$i , i_length), start_year - 1 + 1:i_length)
      }else{
        setNames(c(rep(i_7_rolling[1],
                       as.numeric(names(i_7_rolling)[1]) - start_year),
                   i_7_rolling,
                   approx(x = c(as.numeric(rev(names(i_7_rolling))[1]),
                              start_year + i_length - 1),
                          y = c(rev(i_7_rolling)[1], input$i_final),
                          xout = (as.numeric(rev(names(i_7_rolling))[1]) +
                                    1):(start_year + i_length - 1))$y) +
                   input$i,
                 start_year:(start_year + i_length - 1))
      }
    })
    äx_user <- shiny::reactive({äx(qx_proj_g(), i_proj() / 100, 12, 0)})
    äy_user <- shiny::reactive({äx(qy_proj_g(), i_proj() / 100, 12, 0)})
    äxw_user <- shiny::reactive({äxw(qx_proj_g(), äy_user(), i_proj() / 100, yx, hx, 12, 0)})
    äyw_user <- shiny::reactive({äxw(qy_proj_g(), äx_user(), i_proj() / 100, xy, hy, 12, 0)})
    äxk_user <- shiny::reactive({äk(qx_proj_g(), i_proj() / 100, 12, 0)})
    äyk_user <- shiny::reactive({äk(qy_proj_g(), i_proj() / 100, 12, 0)})

    total_x <- shiny::reactive({(äx_user() +
                             (input$wr_size / 100) * äxw_user() +
                             (input$kr_size / 100) * äxk_user()) *
        (1 + input$k / 100)})
    total_y <- reactive({(äy_user() +
                             (input$wr_size / 100) * äyw_user() * input$witwer +
                             (input$kr_size / 100) * äyk_user()) *
        (1 + input$k / 100)})



    # --- First Page: Mortalities ----------------------------------------------
    qx2scale <- function(x) (log10(x) + 3) / 2.5
    year_marks <- seq(1800, 2100, by = 25)
    qx_marks <-  c(0.001, 0.01, 0.1)
    ages <- seq(60, 90, by = 10)

  output$qx <- shiny::renderPlot({
    plot(NULL, xlim = c(start_year, max_year_proj), ylim = c(0, 1), axes = F,
         xlab = 'Jahr', ylab = 'Sterbewahrsch. Männer eines fixen Alters')
    axis(1, at = year_marks, lty = 0)
    abline(v = year_marks, lty = 3)
    axis(2, at = qx2scale(qx_marks),
         labels = paste0(qx_marks * 100, '%'), lty = 0)
    abline(h = qx2scale(qx_marks), lty = 3)
    for (i in as.character(ages)) {
    lines(start_year:last_year,
          qx2scale(qx_proj()[i, as.character(start_year:last_year)]), col = col_past, lwd = 2)
    lines(last_year:max_year_proj,
          qx2scale(qx_proj()[i, as.character(last_year:max_year_proj)]), col = col_future, lwd = 2)
    }
    text(x = start_year - 2, y = qx2scale(qx[as.character(ages), as.character(start_year)]), labels = as.character(ages))
    text(x = last_year, y = 1, labels = "Beobachtet", col = col_past, pos = 2, adj = 1)
    text(x = last_year, y = 1, labels = "Projiziert", col = col_future, pos = 4, adj = 0)
    })

  output$qy <- shiny::renderPlot({
    plot(NULL, xlim = c(start_year, max_year_proj), ylim = c(0, 1), axes = F,
         xlab = 'Jahr', ylab = 'Sterbewahrsch. Frauen eines fixen Alters')
    axis(1, at = year_marks, lty = 0)
    abline(v = year_marks, lty = 3)
    axis(2, at = qx2scale(qx_marks),
         labels = paste0(qx_marks * 100, '%'), lty = 0)
    abline(h = qx2scale(qx_marks), lty = 3)
    for (i in as.character(ages)) {
      lines(start_year:last_year,
            qx2scale(qy_proj()[i, as.character(start_year:last_year)]), col = col_past, lwd = 2)
      lines(last_year:max_year_proj,
            qx2scale(qy_proj()[i, as.character(last_year:max_year_proj)]), col = col_future, lwd = 2)
    }
    text(x = start_year - 2, y = qx2scale(qy[as.character(ages), as.character(start_year)]), labels = as.character(ages))
    text(x = last_year, y = 1, labels = "Beobachtet", col = col_past, pos = 2, adj = 1)
    text(x = last_year, y = 1, labels = "Projiziert", col = col_future, pos = 4, adj = 0)
  })

  # --- Second Page: Interest rates --------------------------------------------
  output$zinsen <- shiny::renderPlot({
    x_pos <- seq(0, 4, by = 2)
    plot(NULL, xlim = c(1994, 2040), ylim = c(-1, 5), axes = F, xlab = "Jahr", ylab = "Zins")
    abline(h = x_pos, lty = 3)
    lines(i_7_rolling, x = as.numeric(names(i_7_rolling)), col = col_i_rolling, lwd = 2)
    lines(i_proj(), x = as.numeric(names(i_proj())), col = col_i_used, lwd = 2)
    mtext(at = x_pos, text = paste0(x_pos, "%"), side = 2, las = 1)
    axis(1, at = c(2000, 2018, 2030), lty = 0)
  })

  # --- Third Page: Conversion rate --------------------------------------------
  plot_function <- function(){
    plot(NULL, xlim = range(show_gens), ylim = c(0.04, 0.08),
         xlab = "Geburtsjahr", ylab = "Umwandlungssatz", axes = F)
    abline(h = 0.068, lty = 3)
    lines(show_gens, 1 / total_x()[as.character(input$startalter), as.character(show_gens)], lwd = 2, col = col_x)
    lines(show_gens, 1 / total_y()[as.character(input$startalter), as.character(show_gens)], lwd = 2, col = col_y)
    axis(1, at = 10 * round(show_gens %/% 10))
    labels_at <- c(0.04, 0.05, 0.06, 0.068, 0.075)
    axis(2, at = labels_at, labels = 100 * labels_at)
  }
  output$uws1 <- shiny::renderPlot({
    plot_function()
  })
  output$uws2 <- shiny::renderPlot({
    plot_function()
  })
  output$uws3 <- shiny::renderPlot({
    plot_function()
  })

}