Assignment 3
Deconstruct, Reconstruct Web Report
Lokubanda Dassanayake (s4046340)
Click the Original, Code and Reconstruction tabs to read about the issues and how they were fixed.
HTML_Document link: https://rpubs.com/Dassa_Dml/1067365
Original
Objective
This Dashboard analyses the Loans provided by IBRD (World Bank) to All Countries.
It analyses the total loans provided to each country up to each year and the outstanding loan amount by each country each year. Secondly, it tries to normalise and compare the outstanding loan amounts by each country based on the amount owed by a unit person and finally, it provides a tool to select any country to visualise its growth of loan overtime.
Reference
Code
The following code was used for data cleansing.
library(googleCharts)
library(shiny)
library(dplyr)
library(stringr)
library(tidyr)
# library(tinytex)
library(readr)
# setwd('C:/Dassa/RMIT/MATH2404 - Data Vis & Com/Asses_3')
Loans <- read_csv('IBRD_Statement_Of_Loans_-_Historical_Data.csv') # Better as it converts data types etc.
population <- read_csv('population.csv') # Better as it converts data types etc.
# spec(Loans)
# Loans <- Loans %>% select('End of Period', 'Country', 'Loan Type', 'Loan Status'
# , 'Original Principal Amount', 'Cancelled Amount'
# , 'Due to IBRD', 'Agreement Signing Date'
# , 'Closed Date (Most Recent)')
Loans$AgreementDate <- as.Date(substr(Loans$`Agreement Signing Date`, 1, 10
), format = "%m/%d/%Y")
Loans$ClosedDate <- as.Date(substr(Loans$`Closed Date (Most Recent)`, 1, 10
), format = "%m/%d/%Y")
Loans$EndofPeriod <- as.Date(substr(Loans$`End of Period`, 1, 10
), format = "%m/%d/%Y")
Loans$year <- as.integer(format(Loans$EndofPeriod, "%Y"))
Loans$Country <- str_trim(Loans$Country, side = c("both"))
Loans$`Loan Type` <- str_squish(Loans$`Loan Type`)
Loans$`Loan Status` <- str_squish(Loans$`Loan Status`)
Loans$`Loan Number` <- str_squish(Loans$`Loan Number`)
Loans <- Loans %>% select('year', 'Country', 'Loan Number', 'Loan Type', 'Loan Status'
, 'Undisbursed Amount', 'Disbursed Amount'
, 'Loans Held','AgreementDate'
, 'ClosedDate', 'EndofPeriod')
max(Loans$`Loans Held`)## [1] 3.75e+09Loans$total_project_loan <- Loans$`Disbursed Amount` + Loans$`Undisbursed Amount`
#Group the data by year, country and project
Loans_proj_ag<-group_by(Loans, year, Country, `Loan Number`)
#Create a summarised dataset with max values for each project in each year
Loans_proj_ag <- summarise(Loans_proj_ag,
max_Loans_Held = max(`Loans Held`),
max_total_project_loan = max(total_project_loan))
# Now aggregate all loans and outstanding loans per Country per year
# Note that max values of each project can occur different times of the year.
# This calculation is an approximation of the loan status of each country.
# Can calculate actual loan status at specific changes for 100% accuracy; given enough time.
Loans_country_ag<-group_by(Loans_proj_ag, year, Country)
#Create a summarised dataset with total values for each country in each year
Loans_country_ag <- summarise(Loans_proj_ag,
total_Loans_Held = sum(max_Loans_Held),
total_project_loan = sum(max_total_project_loan))
# Read list of countries by Continent and trim String type fields
continents <- read.csv('list-of-countries-by-continent-2023.csv')
# trim String type fields
continents$Country <- str_trim(continents$Country)
continents$Continent <- str_trim(continents$Continent)
Loans_country_ag <- Loans_country_ag %>% left_join(continents, c("Country"))
# Read Population
population <- read_csv('population.csv')
spec(population)## cols(
## Country = col_character(),
## year = col_double(),
## Population = col_double()
## )# trim String type fields
population$Country <- str_trim(population$Country)
Loans_country_ag <- Loans_country_ag %>% left_join(population, c("Country", "year"))
# Convert to Log scale for graph
Loans_country_ag$log_Loans_held <- ifelse(
Loans_country_ag$total_Loans_Held > 0, log(Loans_country_ag$total_Loans_Held), 0
)
Loans_country_ag$log_total_loan <- ifelse(
Loans_country_ag$total_project_loan > 0, log(Loans_country_ag$total_project_loan), 0
)
Loans_country_ag$log_Population <- ifelse(
Loans_country_ag$Population > 0, log(Loans_country_ag$Population), 0
)
write.csv(Loans_country_ag, file="Loans_country_ag.csv", row.names = FALSE)The following code generates the Shiny App.
# More info:
# https://github.com/jcheng5/googleCharts
# Install:
# devtools::install_github("jcheng5/googleCharts")
library(googleCharts)
library(shiny)
library(dplyr)
library(readr)
library(plotly)
library(scales)
data <- read_csv('Loans_country_ag.csv') # Better as it converts data types etc.
data <- na.omit(data)
data$loans_held <- as.integer(data$total_Loans_Held / 1000000)
data$total_loan <- as.integer(data$total_project_loan / 1000000)
data$log_Population <- log(data$Population)
data$Pop_mil <- label_comma(accuracy = .01)(data$Population / 1000000)
data$perCapita_loans_held <- as.integer(data$total_Loans_Held / data$Population)
data$Continent <- as.factor(data$Continent)
data_latest <- data %>% filter((year == max(year)) & (perCapita_loans_held > 0))
# Use global max/min for axes so the view window stays
# constant as the user moves between years
xlim <- list(
min = min(data$total_loan) - 10000,
max = max(data$total_loan) + 10000
)
ylim <- list(
min = min(data$loans_held) - 10000,
max = max(data$loans_held) + 10000
)
ui <- fluidPage(
# This line loads the Google Charts JS library
googleChartsInit(),
# Use the Google webfont "Source Sans Pro"
tags$link(
href=paste0("http://fonts.googleapis.com/css?",
"family=Source+Sans+Pro:300,600,300italic"),
rel="stylesheet", type="text/css"),
tags$style(type="text/css",
"body {font-family: 'Source Sans Pro'}"
),
titlePanel("IBRD Statement Of Loans to All Countries - Historical Data"),
googleBubbleChart("chart",
width="100%", height = "375px",
# Set the default options for this chart; they can be
# overridden in server.R on a per-update basis. See
# https://developers.google.com/chart/interactive/docs/gallery/bubblechart
# for option documentation.
options = list(
fontName = "Source Sans Pro",
fontSize = 13,
# Set axis labels and ranges
hAxis = list(
title = "Total Loans Aquired ($USD millions)",
viewWindow = xlim
),
vAxis = list(
title = "Current Outstanding Loans ($USD millions)",
viewWindow = ylim
),
# The default padding is a little too spaced out
chartArea = list(
top = 50, left = 75,
height = "85%", width = "85%"
),
# Allow pan/zoom
explorer = list(),
# Set bubble visual props
bubble = list(
opacity = 0.4, stroke = "none",
# Hide bubble label
textStyle = list(
color = "none"
)
),
# Set fonts
titleTextStyle = list(
fontSize = 16
),
tooltip = list(
textStyle = list(
fontSize = 12
)
)
)
),
fluidRow(
shiny::column(6, offset = 6,
sliderInput("year", "Year",
min = min(data$year), max = max(data$year),
value = min(data$year), animate = TRUE)
)
# shiny::column(12, offset = 0,
# box("This Dashboard analyses the Loans provided by IBRD (World Bank) to All Countries. It analyses
# the total loans provided to each country up to each year and the outstanding loan amount
# by each country each eay.
#
# Secondly, it tries to normalise and compare the outstanding loan
# amounts by each country based on the amount owed by a unit person
# and finally, it provides a tool to select any country to visualise its growth of loan overtime.", height = "18vh")
# )
# shiny::column(12, offset = 0,
# box(verbatimTextOutput("selection"))
# )
),
fluidRow(
shiny::column(5, offset = 0,
plot_ly(data_latest, x = ~log_Population, y = ~perCapita_loans_held,
size = ~total_loan, color = ~Continent, type = "scatter", mode = "markers",
colors = "Set1", hoverinfo = "text",
text = paste("<b>Year</b> = ", data_latest$year,
"<br><b>Country</b> = ", data_latest$Country,
"<br><b>Population in Mils</b> = ", data_latest$Pop_mil,
"<br><b>Outstanding loans in USD$ Mils</b> = ", data_latest$loans_held,
"<br><b>Total loans to Date in USD$ Mils</b> = ", data_latest$total_loan,
"<br><b>perCapita Outstanding loans USD$</b> = ", data_latest$perCapita_loans_held)) %>%
layout(title ="PerCapita Outstanding Loans - Country in 2021",
yaxis = list(zeroline = FALSE, title = "Current Outstanding Loans per Person"),
xaxis = list(zeroline = FALSE, title = "Population (log scale)"))
),
shiny::column(6, offset = 1,
h3("Outstanding Loans Trend"),
h4("Select Continent & Country"),
selectInput("Continent", "CONTINENT", choices = unique(data$Continent)),
selectInput("Country", "COUNTRY", choices = unique(data$Country)),
plotlyOutput("plot", width = 250, height = 250)
# tableOutput("data")
)
),
fluidRow(
shiny::column(12, offset = 0,
h5("References:")
)
),
fluidRow(
shiny::column(12, offset = 0,
h6("Worldbank : ", a("IBRD Statement Of Loans", href = "https://finances.worldbank.org/Loans-and-Credits/IBRD-Statement-Of-Loans-Historical-Data/zucq-nrc3"))
)
),
fluidRow(
shiny::column(12, offset = 0,
h6("ourworldindata : ", a("population", href = "https://ourworldindata.org/grapher/population"))
)
),
fluidRow(
shiny::column(12, offset = 0,
h6("worldpopulationreview : ", a("list-of-countries-by-continent", href = "https://worldpopulationreview.com/country-rankings/list-of-countries-by-continent"))
)
)
)
server <- function(input, output, session) {
# Provide explicit colors for regions, so they don't get recoded when the
# different series happen to be ordered differently from year to year.
# http://andrewgelman.com/2014/09/11/mysterious-shiny-things/
defaultColors <- c("#3366cc", "#dc3912", "#ff9900", "#109618", "#990099", "#0099c6", "#dd4477")
# defaultColors <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", "#80b1d3", "#fdb462", "#b3de69")
series <- structure(
lapply(defaultColors, function(color) { list(color=color) }),
names = levels(data$Continent)
)
yearData <- reactive({
# Filter to the desired year, and put the columns
# in the order that Google's Bubble Chart expects
# them (name, x, y, color, size). Also sort by region
# so that Google Charts orders and colors the regions
# consistently.
df <- data %>%
filter(year == input$year) %>%
select(Country, total_loan, loans_held,
Continent, Population) %>%
arrange(Continent)
})
output$chart <- reactive({
# Return the data and options
list(
data = googleDataTable(yearData()),
options = list(
title = sprintf(
"Total Loans Aquired Vs. Current Outstanding Loan for year, %s",
input$year),
series = series
)
)
})
# output$selection <- renderPrint({
# "Click on the slider for chart activation"
# })
# Drop down selections for Country specific trendlines.
Continent <- reactive({
filter(data, Continent == input$Continent)
})
observeEvent(Continent(), {
choices <- unique(Continent()$Country)
updateSelectInput(inputId = "Country", choices = choices)
})
# # Table output - not used.
# output$data <- renderTable({
# req(input$Country)
# Continent() %>%
# filter(Country == input$Country) %>%
# select(Continent, Country, year, Population, total_Loans_Held, perCapita_loans_held)
# })
# Plotly Graph output with trend.
output$plot <- renderPlotly({
req(input$Country)
gg_data <- Continent() %>%
filter(Country == input$Country)
ggplotly(ggplot(
gg_data, aes(year, perCapita_loans_held)) +
geom_point(size=1.5, alpha=0.6, color="#fc4e2a") +
geom_smooth() +
xlab("Year") +
ylab("Outstanding Loans per Person") +
theme(plot.title = element_text(size=12),
axis.text=element_text(size=8), axis.title=element_text(size=10))
, width = 350, height = 300)
})
# Add plots from here.............
}
shinyApp(ui = ui, server = server)Shiny applications not supported in static R Markdown documents
Data Reference
Data, IMF DATAMAPPER, DATASETS, Global Debt Database Section (2023). General Government Debt. Retrieved July 23, 2023, from International Monetory Fund website: https://www.imf.org/external/datamapper/GGXWDG_NGDP@WEO/OEMDC/ADVEC/WEOWORLD/VEN?year=2023
List of Countries by Continent section (2023) List of Countries by Continent 2023. Retrieved July 23, 2023, from World Population Review website: https://worldpopulationreview.com/country-rankings/list-of-countries-by-continent
Reconstruction NHemisphere
The following plot fixes the main issues in the original.
Shiny applications not supported in static R Markdown documents