lineup-checks-dashboard.Rmd

---
title: "Lineup Checks"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    social: menu
    theme: paper
    vertical_layout: scroll
    runtime: shiny
---


```{r setup, include=FALSE}
library(flexdashboard)
library(ggplot2)
library(plotly)
library(collapse)
library(fst)
library(joyn)
library(data.table)
library(RColorBrewer)
```


```{r}
source("R/utils.R")
pl <- 2.15

# Aggregates
dt_agg_old <- pipr::get_wb(povline = pl) |> 
  qDT()
dt_agg_new <- load_from_repo("aggregates.fst") 


# Survey years
dt_survey_old <- pipr::get_stats(povline = pl) |> 
  qDT()
dt_survey_new <- load_from_repo("syears.fst") 

# aggregates
dt_lineup_old <- pipr::get_stats(povline = pl, 
                                 fill_gaps = TRUE) |> 
  qDT()
dt_lineup_new <- load_from_repo("lyears.fst") 
```


Compare data schema
===========================================================


Aggregate
===========================================================



Column {data-width=650}
-----------------------------------------------------------------------


```{r}
# Load and prepare the OLD agg estimates
dt_agg_old_samuel <- dt_agg_old

# Load and prepare the NEW agg estimates
dt_agg_new_samuel <- dt_agg_new
agg_indicators    <- dt_agg_new |> fselect(headcount:spr) |> colnames()
# Merging OLD and NEW data 
aggs_merged <- joyn::joyn(x             = dt_agg_new_samuel, 
                              y             = dt_agg_old_samuel, 
                              by            = c("region_code", 
                                                "reporting_year", 
                                                "poverty_line"), 
                              match_type    = "1:1",
                              keep          = "full", 
                              update_values = FALSE,
                              all           = FALSE, 
                              verbose       = FALSE, 
                              y_vars_to_keep = TRUE, 
                              suffixes = c(".x", ".y"), 
                              keep_common_vars = TRUE)
```



Column {data-width=100}
-----------------------------------------------------------------------
```{r sidebar-plot-agg-3}
# Select Indicator
selectInput("agg_indicator", 
            label = "Compare indicator:",
            choices = agg_indicators,
            selected = "headcount")

# Select countries
selectInput("agg_country", 
            label = "Economies:",
            choices = c("All", aggs_merged$region_code |> funique()),
            selected = "COL", 
            multiple = TRUE)


# Select countries
selectInput("agg_percentage", 
            label = "Percentage (i.t.o old) or real difference:",
            choices = c("Percentage change", "Real difference", "Ratio"),
            selected = "Percentage", 
            multiple = FALSE)


# Select countries
numericInput(
  "agg_outlier",
  label = "Outlier detection - sd threshold",
  value = 2,
  min   = 0,
  max   = 5,
  step = 0.1,
  width = NULL
)

selectInput(
  "agg_outlier_yes", 
  label = "Is outlier", 
  choices = c("Yes", "No"), 
  selected = "Yes", 
  multiple = FALSE
)

```

```{r agg-data-reactive}
agg_indicator <- reactive({
  
  # Copy data table
  agg_indicator <- copy(aggs_merged)
  ind <- paste(input$agg_indicator)
  
  if (!input$agg_percentage == "Ratio") {
    # indicator
    agg_indicator <- agg_indicator |> 
      fmutate(New_minus_old = get(paste0(ind, ".x")) - 
                        get(paste0(ind, ".y")))
    

    
    if (input$agg_percentage == "Percentage") {
      agg_indicator <- agg_indicator |> 
        fmutate(New_minus_old = 100*New_minus_old/get(paste0(ind, ".y")))
    }
  } else {
      agg_indicator <- agg_indicator |> 
          fmutate(New_minus_old = get(paste0(ind, ".x"))/get(paste0(ind, ".y")))
  }
  
  if (!"All" %chin% input$agg_country) {
    agg_indicator <- agg_indicator |> 
      fsubset(region_code %in% input$agg_country)
  }
  
  # Tooltip
  agg_indicator[
    , 
    text_tooltip := 
      paste0(
        "Economy: ", region_code, "\n",
        "Region: ", region_name.x, "\n", 
        "Value: ", round(New_minus_old, 4), "\n", 
        "Year: ", reporting_year 
        
      )
  ]
  
  agg_indicator
  
})

agg_baltman <- reactive({
  
  # Copy data table
  agg_indicator <- copy(aggs_merged)
  ind <- paste(input$agg_indicator)
  
  if (!"All" %chin% input$agg_country) {
    agg_indicator <- agg_indicator |> 
      fsubset(region_code %in% input$agg_country)
  }
  agg_indicator[, 
                 `:=`(diff = get(paste0(ind, ".x")) - 
                        get(paste0(ind, ".y")),
                      mean_btw = (get(paste0(ind, ".x")) +
                        get(paste0(ind, ".y")))/2)]
  # Tooltip
  agg_indicator[
    , 
    text_tooltip := 
      paste0(
        "Economy: ", region_code, "\n",
        "Region: ", region_name.x, "\n", 
        "Mean old and new: ", round(mean_btw, 4), "\n", 
        "Difference: ", round(diff, 4), "\n", 
        "Year: ", reporting_year 
      )
  ]
  agg_indicator
  
})

agg_outlier <- reactive({
  amnt <- input$agg_outlier
  # Copy data table
  agg_indicator <- copy(aggs_merged)
  ind <- paste(input$agg_indicator)
  
  # 
  aggs_merged[, new_old := get(paste0(ind, ".x")) / get(paste0(ind, ".y"))]
  aggs_merged[, 
                 `:=`(thres_new_old_lo = mean(aggs_merged$new_old, na.rm = TRUE) - 
                          amnt * sd(aggs_merged$new_old, na.rm = TRUE),
                      thres_new_old_hi = mean(aggs_merged$new_old, na.rm = TRUE) + 
                          amnt * sd(aggs_merged$new_old, na.rm = TRUE))]
  

  if (input$agg_outlier_yes == "Yes") {
      aggs_merged[, 
                 new_old_out := !(new_old < thres_new_old_hi & 
                                    new_old > thres_new_old_lo)]
  } else {
          aggs_merged[, 
                 new_old_out := (new_old < thres_new_old_hi & 
                                    new_old > thres_new_old_lo)]
  }

  aggs_merged <- aggs_merged[new_old_out == TRUE]
  
  aggs_merged <- aggs_merged |> 
    fmutate(New = get(paste0(ind, ".x"))*100) |> 
    fmutate(Old = get(paste0(ind, ".y"))*100) |>
    fselect("region_code", "reporting_year", "Old", "New") 
 
  setnames(aggs_merged, 
           old = c("Old", "New"), 
           new = c(paste0(c("Old_", "New_"), ind)))
  
  aggs_merged

  
})

```



Column {data-width=2400}
-----------------------------------------------------------------------

### Chart A


```{r plot-agg}
renderPlotly({
  dt <- agg_indicator()
  g <- ggplot(data = dt, aes(x      = reporting_year, 
                             y      = New_minus_old, 
                             colour = region_code, 
                             group  = region_code)) +
          geom_point(aes(text = text_tooltip)) +
          geom_line() +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "New agg estimate minus old", 
         x     = "Reporting Year", 
         y     = paste0("Difference in ",
                        input$agg_indicator,
                        ifelse(input$agg_percentage == "Percentage", " %", ""),
                        " (new minus old)"))
  
  g <- ggplotly(g, tooltip = "text")
  
  g

})

```

### Scatterplot of old vs new estimates

```{r}
renderPlotly({
  dt  <- agg_indicator()
  ind <- input$agg_indicator 
  
  g <- ggplot(data = dt, 
              aes(x = get(paste0(ind, ".y")), 
                  y = get(paste0(ind, ".x")), 
                  color = region_code, 
                  group = region_code)) +
    geom_point(aes(text = text_tooltip)) +
    geom_abline(intercept = 0, slope = 1, linetype = "dashed", alpha = 0.3) +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "Scatter plot new agg estimate minus old", 
         x     = paste("Old", ind), 
         y     = paste("New", ind))
  
  g <- ggplotly(g, tooltip = "text")
  
  g
})
```


### Bland-Altman plot

```{r}
renderPlotly({
  dt  <- agg_baltman()
  ind <- input$agg_indicator
  
  g <- ggplot(data = dt, 
              aes(x = mean_btw, 
                  y = diff, 
                  color = region_code.x)) +
        geom_point(aes(text = text_tooltip)) +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "Bland-Altman Plot", 
         x     = paste("Mean of old and new", ind), 
         y     = paste("Difference between old and new", ind))
  
  g <- ggplotly(g, tooltip = "text")
  
  g
})
```








### Table of outliers


```{r}
renderTable({
  agg_outlier()
})

```















Survey years
===========================================================


Column {data-width=650}
-----------------------------------------------------------------------


```{r}
# Load and prepare the OLD survey estimates
dt_survey_old_samuel <- dt_survey_old

# Load and prepare the NEW survey estimates
dt_survey_new_samuel <- dt_survey_new
survey_indicators    <- dt_survey_new |> fselect(headcount:decile10, spl, spr) |> colnames()
# Merging OLD and NEW data 
surveys_merged <- joyn::joyn(x             = dt_survey_new_samuel, 
                              y             = dt_survey_old_samuel, 
                              by            = c("country_code", 
                                                "reporting_year", 
                                                "welfare_type", 
                                                "poverty_line", 
                                                "reporting_level"), 
                              match_type    = "1:1",
                              keep          = "full", 
                              update_values = FALSE,
                              all           = FALSE, 
                              verbose       = FALSE, 
                              y_vars_to_keep = TRUE, 
                              suffixes = c(".x", ".y"), 
                              keep_common_vars = TRUE)
```



Column {data-width=100}
-----------------------------------------------------------------------
```{r sidebar-plot-survey-3}
# Select Indicator
selectInput("survey_indicator", 
            label = "Compare indicator:",
            choices = survey_indicators,
            selected = "headcount")

# Select countries
selectInput("survey_country", 
            label = "Economies:",
            choices = c("All", surveys_merged$country_code |> funique()),
            selected = "COL", 
            multiple = TRUE)


# Select countries
selectInput("survey_percentage", 
            label = "Percentage (i.t.o old) or real difference:",
            choices = c("Percentage change", "Real difference", "Ratio"),
            selected = "Percentage", 
            multiple = FALSE)


# Select countries
numericInput(
  "survey_outlier",
  label = "Outlier detection - sd threshold",
  value = 2,
  min   = 0,
  max   = 5,
  step = 0.1,
  width = NULL
)

selectInput(
  "survey_outlier_yes", 
  label = "Is outlier", 
  choices = c("Yes", "No"), 
  selected = "Yes", 
  multiple = FALSE
)

```

```{r survey-data-reactive}
survey_indicator <- reactive({
  
  # Copy data table
  survey_indicator <- copy(surveys_merged)
  ind <- paste(input$survey_indicator)
  
  if (!input$survey_percentage == "Ratio") {
    # indicator
    survey_indicator <- survey_indicator |> 
      fmutate(New_minus_old = get(paste0(ind, ".x")) - 
                        get(paste0(ind, ".y")))
    

    
    if (input$survey_percentage == "Percentage") {
      survey_indicator <- survey_indicator |> 
        fmutate(New_minus_old = 100*New_minus_old/get(paste0(ind, ".y")))
    }
  } else {
      survey_indicator <- survey_indicator |> 
          fmutate(New_minus_old = get(paste0(ind, ".x"))/get(paste0(ind, ".y")))
  }
  
  if (!"All" %chin% input$survey_country) {
    survey_indicator <- survey_indicator |> 
      fsubset(country_code %in% input$survey_country)
  }
  
  # Tooltip
  survey_indicator[
    , 
    text_tooltip := 
      paste0(
        "Economy: ", country_code, "\n",
        "Region: ", region_name.x, "\n", 
        "Value: ", round(New_minus_old, 4), "\n", 
        "Year: ", reporting_year 
        
      )
  ]
  
  survey_indicator
  
})

survey_baltman <- reactive({
  
  # Copy data table
  survey_indicator <- copy(surveys_merged)
  ind <- paste(input$survey_indicator)
  
  if (!"All" %chin% input$survey_country) {
    survey_indicator <- survey_indicator |> 
      fsubset(country_code %in% input$survey_country)
  }
  survey_indicator[, 
                 `:=`(diff = get(paste0(ind, ".x")) - 
                        get(paste0(ind, ".y")),
                      mean_btw = (get(paste0(ind, ".x")) +
                        get(paste0(ind, ".y")))/2)]
  # Tooltip
  survey_indicator[
    , 
    text_tooltip := 
      paste0(
        "Economy: ", country_code, "\n",
        "Region: ", region_name.x, "\n", 
        "Mean old and new: ", round(mean_btw, 4), "\n", 
        "Difference: ", round(diff, 4), "\n", 
        "Year: ", reporting_year 
      )
  ]
  survey_indicator
  
})

survey_outlier <- reactive({
  amnt <- input$survey_outlier
  # Copy data table
  survey_indicator <- copy(surveys_merged)
  ind <- paste(input$survey_indicator)
  
  # 
  surveys_merged[, new_old := get(paste0(ind, ".x")) / get(paste0(ind, ".y"))]
  surveys_merged[, 
                 `:=`(thres_new_old_lo = mean(surveys_merged$new_old, na.rm = TRUE) - 
                          amnt * sd(surveys_merged$new_old, na.rm = TRUE),
                      thres_new_old_hi = mean(surveys_merged$new_old, na.rm = TRUE) + 
                          amnt * sd(surveys_merged$new_old, na.rm = TRUE))]
  

  if (input$survey_outlier_yes == "Yes") {
      surveys_merged[, 
                 new_old_out := !(new_old < thres_new_old_hi & 
                                    new_old > thres_new_old_lo)]
  } else {
          surveys_merged[, 
                 new_old_out := (new_old < thres_new_old_hi & 
                                    new_old > thres_new_old_lo)]
  }

  surveys_merged <- surveys_merged[new_old_out == TRUE]
  
  surveys_merged <- surveys_merged |> 
    fmutate(New = get(paste0(ind, ".x"))*100) |> 
    fmutate(Old = get(paste0(ind, ".y"))*100) |>
    fselect("country_code", "reporting_year", "welfare_type", "Old", "New") 
 
  setnames(surveys_merged, 
           old = c("Old", "New"), 
           new = c(paste0(c("Old_", "New_"), ind)))
  
  surveys_merged

  
})

```



Column {data-width=2400}
-----------------------------------------------------------------------

### Chart A


```{r plot-survey}
renderPlotly({
  dt <- survey_indicator()
  g <- ggplot(data = dt, aes(x      = reporting_year, 
                             y      = New_minus_old, 
                             colour = country_code, 
                             group  = country_code)) +
          geom_point(aes(text = text_tooltip)) +
          geom_line() +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "New survey estimate minus old", 
         x     = "Reporting Year", 
         y     = paste0("Difference in ",
                        input$survey_indicator,
                        ifelse(input$survey_percentage == "Percentage", " %", ""),
                        " (new minus old)"))
  
  g <- ggplotly(g, tooltip = "text")
  
  g

})

```

### Scatterplot of old vs new estimates

```{r}
renderPlotly({
  dt  <- survey_indicator()
  ind <- input$survey_indicator 
  
  g <- ggplot(data = dt, 
              aes(x = get(paste0(ind, ".y")), 
                  y = get(paste0(ind, ".x")), 
                  color = country_code, 
                  group = country_code)) +
    geom_point(aes(text = text_tooltip)) +
    geom_abline(intercept = 0, slope = 1, linetype = "dashed", alpha = 0.3) +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "Scatter plot new survey estimate minus old", 
         x     = paste("Old", ind), 
         y     = paste("New", ind))
  
  g <- ggplotly(g, tooltip = "text")
  
  g
})
```


### Bland-Altman plot

```{r}
renderPlotly({
  dt  <- survey_baltman()
  ind <- input$survey_indicator
  
  g <- ggplot(data = dt, 
              aes(x = mean_btw, 
                  y = diff, 
                  color = region_code.x)) +
        geom_point(aes(text = text_tooltip)) +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "Bland-Altman Plot", 
         x     = paste("Mean of old and new", ind), 
         y     = paste("Difference between old and new", ind))
  
  g <- ggplotly(g, tooltip = "text")
  
  g
})
```








### Table of outliers


```{r}
renderTable({
  survey_outlier()
})

```





Lineup years
===========================================================







```{r}
# Load and prepare the OLD lineup estimates
dt_lineup_old_samuel <- dt_lineup_old

# Load and prepare the NEW lineup estimates
dt_lineup_new_samuel <- dt_lineup_new
lineup_indicators    <- dt_lineup_new |> fselect(headcount:decile10, spl, spr) |> colnames()
# Merging OLD and NEW data
lineups_merged <- joyn::joyn(x             = dt_lineup_new_samuel,
                              y             = dt_lineup_old_samuel,
                              by            = c("country_code",
                                                "reporting_year",
                                                "welfare_type",
                                                "poverty_line",
                                                "reporting_level"),
                              match_type    = "1:1",
                              keep          = "full",
                              update_values = FALSE,
                              all           = FALSE,
                              verbose       = FALSE,
                              y_vars_to_keep = TRUE,
                              suffixes = c(".x", ".y"),
                              keep_common_vars = TRUE)
```



Column {data-width=100}
-----------------------------------------------------------------------
```{r sidebar-plot-lineup-3}
# Select Indicator
selectInput("lineup_indicator",
            label = "Compare indicator:",
            choices = lineup_indicators,
            selected = "headcount")

# Select countries
selectInput("lineup_country",
            label = "Economies:",
            choices = c("All", lineups_merged$country_code |> funique()),
            selected = "COL",
            multiple = TRUE)


# Select countries
selectInput("lineup_percentage",
            label = "Percentage (i.t.o old) or real difference:",
            choices = c("Percentage change", "Real difference", "Ratio"),
            selected = "Percentage",
            multiple = FALSE)


# Select countries
numericInput(
  "lineup_outlier",
  label = "Outlier detection - sd threshold",
  value = 2,
  min   = 0,
  max   = 5,
  step = 0.1,
  width = NULL
)

selectInput(
  "lineup_outlier_yes",
  label = "Is outlier",
  choices = c("Yes", "No"),
  selected = "Yes",
  multiple = FALSE
)

```

```{r lineup-data-reactive}
lineup_indicator <- reactive({

  # Copy data table
  lineup_indicator <- copy(lineups_merged)
  ind <- paste(input$lineup_indicator)

  if (!input$lineup_percentage == "Ratio") {
    # indicator
    lineup_indicator <- lineup_indicator |>
      fmutate(New_minus_old = get(paste0(ind, ".x")) -
                        get(paste0(ind, ".y")))



    if (input$lineup_percentage == "Percentage") {
      lineup_indicator <- lineup_indicator |>
        fmutate(New_minus_old = 100*New_minus_old/get(paste0(ind, ".y")))
    }
  } else {
      lineup_indicator <- lineup_indicator |>
          fmutate(New_minus_old = get(paste0(ind, ".x"))/get(paste0(ind, ".y")))
  }

  if (!"All" %chin% input$lineup_country) {
    lineup_indicator <- lineup_indicator |>
      fsubset(country_code %in% input$lineup_country)
  }

  # Tooltip
  lineup_indicator[
    ,
    text_tooltip :=
      paste0(
        "Economy: ", country_code, "\n",
        "Region: ", region_name.x, "\n",
        "Value: ", round(New_minus_old, 4), "\n",
        "Year: ", reporting_year

      )
  ]

  lineup_indicator

})

lineup_baltman <- reactive({

  # Copy data table
  lineup_indicator <- copy(lineups_merged)
  ind <- paste(input$lineup_indicator)

  if (!"All" %chin% input$lineup_country) {
    lineup_indicator <- lineup_indicator |>
      fsubset(country_code %in% input$lineup_country)
  }
  lineup_indicator[,
                 `:=`(diff = get(paste0(ind, ".x")) -
                        get(paste0(ind, ".y")),
                      mean_btw = (get(paste0(ind, ".x")) +
                        get(paste0(ind, ".y")))/2)]
  # Tooltip
  lineup_indicator[
    ,
    text_tooltip :=
      paste0(
        "Economy: ", country_code, "\n",
        "Region: ", region_name.x, "\n",
        "Mean old and new: ", round(mean_btw, 4), "\n",
        "Difference: ", round(diff, 4), "\n",
        "Year: ", reporting_year
      )
  ]
  lineup_indicator

})

lineup_outlier <- reactive({

  amnt <- input$lineup_outlier
  # Copy data table
  lineup_indicator <- copy(lineups_merged)

  ind <- paste(input$lineup_indicator)

  #
  lineup_indicator[, new_old := get(paste0(ind, ".x")) / get(paste0(ind, ".y"))]
  lineup_indicator[,
                 `:=`(thres_new_old_lo = mean(lineups_merged$new_old, na.rm = TRUE) -
                          amnt * sd(lineups_merged$new_old, na.rm = TRUE),
                      thres_new_old_hi = mean(lineups_merged$new_old, na.rm = TRUE) +
                          amnt * sd(lineups_merged$new_old, na.rm = TRUE))]

# 
#   if (input$lineup_outlier_yes == "Yes") {
#       lineup_indicator[,
#                  new_old_out := !(new_old < thres_new_old_hi &
#                                     new_old > thres_new_old_lo)]
#   } else {
#           lineup_indicator[,
#                  new_old_out := (new_old < thres_new_old_hi &
#                                     new_old > thres_new_old_lo)]
#   }
# 
#   lineup_indicator <- lineup_indicator[new_old_out == TRUE]
# 
#   lineup_indicator <- lineup_indicator |>
#     fmutate(New = get(paste0(ind, ".x"))*100) |>
#     fmutate(Old = get(paste0(ind, ".y"))*100) |>
#     fselect("country_code", "reporting_year", "welfare_type", "Old", "New")
# 
#   setnames(lineup_indicator,
#            old = c("Old", "New"),
#            new = c(paste0(c("Old_", "New_"), ind)))

  lineup_indicator


})

```



Column {data-width=2400}
-----------------------------------------------------------------------

### Chart A


```{r plot-lineup}
renderPlotly({
  dt <- lineup_indicator()
  g <- ggplot(data = dt, aes(x      = reporting_year,
                             y      = New_minus_old,
                             colour = country_code,
                             group  = country_code)) +
          geom_point(aes(text = text_tooltip)) +
          geom_line() +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "New lineup estimate minus old",
         x     = "Reporting Year",
         y     = paste0("Difference in ",
                        input$lineup_indicator,
                        ifelse(input$lineup_percentage == "Percentage", " %", ""),
                        " (new minus old)"))

  g <- ggplotly(g, tooltip = "text")

  g

})

```

### Scatterplot of old vs new estimates

```{r}
renderPlotly({
  dt  <- lineup_indicator()
  ind <- input$lineup_indicator

  g <- ggplot(data = dt,
              aes(x = get(paste0(ind, ".y")),
                  y = get(paste0(ind, ".x")),
                  color = country_code,
                  group = country_code)) +
    geom_point(aes(text = text_tooltip)) +
    geom_abline(intercept = 0, slope = 1, linetype = "dashed", alpha = 0.3) +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "Scatter plot new lineup estimate minus old",
         x     = paste("Old", ind),
         y     = paste("New", ind))

  g <- ggplotly(g, tooltip = "text")

  g
})
```


### Bland-Altman plot

```{r}
renderPlotly({
  dt  <- lineup_baltman()
  ind <- input$lineup_indicator

  g <- ggplot(data = dt,
              aes(x = mean_btw,
                  y = diff,
                  color = region_code.x)) +
        geom_point(aes(text = text_tooltip)) +
    theme_classic() +
    scale_color_brewer(palette = "Dark2") +
    labs(title = "Bland-Altman Plot",
         x     = paste("Mean of old and new", ind),
         y     = paste("Difference between old and new", ind))

  g <- ggplotly(g, tooltip = "text")

  g
})
```








### Table of outliers


```{r}
renderTable({
  lineup_outlier()
})

```