Static and Motion Bubble Charts in Shiny for Exploring the Relationship between Population Growth, GDP per Capita, and Gini Coefficient

Open R shiny App from a new window here! (Note: Charts in the "Inspiration and Bubbles in Motion" panel take a couple seconds to load. Please be patient! :-))

Play with the App here:

===============================================================================
There has been a continuing debate about population growth and development. Some maintain that population has a negative impact on economic development while others are convinced the effect is positive or can be mitigated with a better distribution of resources and by technological change. Recently, there has also been growing concern over countries where population growth is negative. With fewer workers to maintain the tax base and productivity necessary to support a decent standard of living and aging populations an economic crisis materializes. That is why zero population growth is widely considered an ideal that countries and the world in general should strive for. The main and enduring question regarding this relationship concerns the direction of causality. Does economic development cause population growth or does a decrease in population cause economic development?

Using RStudio’s Shiny web application framework, I coded visualizations for users to explore the relationship between total population, population growth, GDP per Capita, and the Gini Coefficient. Using World Bank data I developed five bubble charts:

1. Groups countries by World Bank regions, 1960-2014
2. Groups countries by World Bank income groups, 1960-2014
3. Countries for which a Gini Coefficient was available, 2002-2012
4. Motion bubble chart of all countries, 1960-2014
5. Motion bubble chart of countries for which a Gini Coefficient was available, 2002-2012

The first three bubble charts are static and allow the user to brush over points to see the precise values outputted in a data table. Users also have the option to choose y-axis and bubble size variables and control the range of years. The last two visualizations of the bubbles in motion across years combine all these capabilities and more: log/lin option on the axes, country selection, coloring by any variable, speed of motion, pausing, etc.

Although not conclusive, these visualizations demonstrate a clear pattern—a decreased population growth rate is correlated with higher GDP per capita and less income inequality.  This is intuitive since growth in GDP must exceed the population growth rate for GDP per capita to increase. However, you’ll find cases where an increase in the population growth rate is correlated with more equality but those are countries where population growth is increasing from less than 1% or negative (i.e. Ukraine, Uruguay, Moldova, Belarus, El  Salvador).

#UI FILE

region <- readRDS("Data/region.RDS")
income <- readRDS("Data/income.RDS")
gini <- readRDS("Data/gini.RDS")
grouping <- readRDS("Data/grouping.RDS")
reginc <- readRDS("Data/regionandincome.RDS")

shinyUI(fluidPage(
  titlePanel("Total Population, Population Growth, GDP per Capita, and Gini Coefficient"),
    sidebarPanel(
      conditionalPanel(
        'input.stuff === "Region"',
        helpText("Explore the relationship between population, population growth 
                 and gdp per capita by World Bank Regions. Brush over points for datatable output."),
        selectInput('yax', 'Y-axis Variable', 
                    choices=c("Average GDP per Capita (Current $US)", "Average Population Growth (%)", "Total Population")),
        selectInput('bub', 'Bubble Size Variable', 
                    choices=c("Average GDP per Capita (Current $US)", "Average Population Growth (%)", "Total Population")),
        checkboxGroupInput('Region', 'Region', choices=(c('All', c(unique(region$Region)))),
                           selected = 'All'),
        sliderInput('year', 'Year', min = min(region$year), max = max(region$year), 
                    value = c(min(region$year),max(region$year)), sep = "", step=1)
        ),  # End of Conditional Panel
      
      conditionalPanel(
        'input.stuff === "Income Group"',
        helpText("Explore the relationship between population, population growth 
                 and gdp per capita by World Bank Income Groups. Brush over points for datatable output."),
        selectInput('yax2', 'Y-axis Variable', 
                    choices=c("Average GDP per Capita (Current $US)", "Average Population Growth (%)", "Total Population")),
        selectInput('bub2', 'Bubble Size Variable', 
                    choices=c("Average GDP per Capita (Current $US)", "Average Population Growth (%)", "Total Population")),
        checkboxGroupInput('Income', 'Income Group', choices=(c('All', c(unique(income$Income.group)))),
                           selected = 'All'),
        sliderInput('year2', 'Year', min = min(income$year), max = max(income$year), 
                    value = c(min(income$year),max(income$year)), sep = "", step=1)
        ),  # End of Conditional Panel
      
      conditionalPanel(
        'input.stuff === "Income Inequality"',
        helpText("Explore the relationship between population, population growth, 
                 gdp per capita, and income inequality by countries for which there's
                 a gini coefficient for most years 2002-2012. Brush over points for datatable output."),
        selectInput('yax3', 'Y-axis Variable', 
                    choices=c("GDP per Capita (Current $US)", "Population Growth (%)", "Total Population", "Gini Coefficient")),
        selectInput('bub3', 'Bubble Size Variable', 
                    choices=c("GDP per Capita (Current $US)", "Population Growth (%)", "Total Population", "Gini Coefficient")),
        selectInput('country', 'Country', choices=(c('All', c(unique(as.character(gini$Country))))),
                    selected = 'All'),
        sliderInput('year3', 'Year', min = round(min(gini$year), 0), max = round(max(gini$year), 0), 
                    value = c(round(min(gini$year), 0), round(max(gini$year), 0)), round= T, sep = "", step=1)
        ),
      
      conditionalPanel(
        'input.stuff === "Inspiration and Bubbles In Motion"',
        includeMarkdown("inspiration.md")
      ),
      
      conditionalPanel(
        'input.stuff === "Data Source, Classification and Definitions"',
        includeMarkdown("sourceclassdef.md")
      )
      
), # End of Sidebar Panel
    
    mainPanel(
      tabsetPanel(
        id = 'stuff',
        tabPanel('Region', plotOutput("gdppop", brush = "plot_brush")),
        tabPanel('Income Group', plotOutput("gdppopincome", brush = "plot_brush2")),
        tabPanel('Income Inequality', plotOutput("incomeineq", brush = "plot_brush3")),
        tabPanel('Inspiration and Bubbles In Motion', htmlOutput("motionchart"), br(), 
                 helpText("Adjust the speed of motion next to play button. Select x-axis, y-axis and 
                          size variable. Select log or lin for x or y-axis variable. And hover over 
                          bubble for more information about each country."), br(), 
                 htmlOutput("motionchartgini")),
        tabPanel('Data Source, Classification and Definitions', dataTableOutput("Grouping"))
        ),
      
      conditionalPanel(
        'input.stuff === "Region"',
        dataTableOutput("table")),
      
      conditionalPanel(
        'input.stuff === "Income Group"',
        dataTableOutput("table2")),
      
      conditionalPanel(
        'input.stuff === "Income Inequality"',
        dataTableOutput("table3"))
    
      ) # End of mainPanel
) # End of fluidPage
    )  # End of shinyUI

#SERVER FILE

region <- readRDS("Data/region.RDS")
income <- readRDS("Data/income.RDS")
gini <- readRDS("Data/gini.RDS")
grouping <- readRDS("Data/grouping.RDS")
reginc <- readRDS("Data/regionandincome.RDS")
library(ggplot2)
library(dplyr)
library(googleVis)
library(shiny)
library(DT)

shinyServer(
  function(input, output) {
    
    data <- reactive({
      if (input$Region == 'All'){
        df <- region %>%
          filter(year >= input$year[1], year<=input$year[2])  
      }
      else {
        df <- region %>%
          filter(year >= input$year[1], year<=input$year[2], Region==input$Region)
      }
    })
    
    output$gdppop <- renderPlot({
      if (input$yax == "Average GDP per Capita (Current $US)") {
        y_var = "gdpavg"
      } else {
        if (input$yax == "Average Population Growth (%)") {
          y_var = "popavg"
        } else {
          y_var= "sumpop"}
      }
      
      if (input$bub == "Average GDP per Capita (Current $US)") {
        size_var = "gdpavg"
      } else {
        if (input$bub == "Average Population Growth (%)") {
          size_var = "popavg"
        } else {
          size_var= "sumpop"}
      }
      
      output$table <- renderDataTable({
        dat <- data()
        res <- brushedPoints(dat, input$plot_brush)
        datatable(res, colnames = c("Region", "Year", 
                                    "Average GDP per Capita (Current $US)", 
                                    "Average Population Growth (%)", 
                                    "Total Population"))
      })

      ggplot(data(), aes_string(x = "year", y = y_var,
                         size = size_var, color="Region")) + 
        geom_point()+scale_size_continuous(range = c(4, 12))+
        scale_color_manual("Legend", values = c("East Asia & Pacific" = "blue3", 
                                                "Europe & Central Asia"= "palevioletred1", 
                                                "Latin America & Caribbean" = "orange", 
                                                "Middle East & North Africa" = "chartreuse4", 
                                                "North America"= "magenta3", 
                                                "South Asia" = "black", 
                                                "Sub-Saharan Africa" = "red"))+
        guides(colour = guide_legend(override.aes = list(size=5)))+
        ylab(input$yax)+xlab("Year")+labs(size=input$bub)
    })
    
    #TAB 2!
    
    data2 <- reactive({
      if (input$Income == 'All'){
        df <- income %>%
          filter(year >= input$year2[1], year<=input$year2[2])  
      }
      else {
        df <- income %>%
          filter(year >= input$year2[1], year<=input$year2[2], Income.group==input$Income)
      }
      
    })
    
    output$gdppopincome <- renderPlot({
      if (input$yax2 == "Average GDP per Capita (Current $US)") {
        y_var2 = "gdpavg"
      } else {
        if (input$yax2 == "Average Population Growth (%)") {
          y_var2 = "popavg"
        } else {
          y_var2 = "sumpop"}
      }
      
      if (input$bub2 == "Average GDP per Capita (Current $US)") {
        size_var2 = "gdpavg"
      } else {
        if (input$bub2 == "Average Population Growth (%)") {
          size_var2 = "popavg"
        } else {
          size_var2 = "sumpop"}
      }
      
      output$table2 <- renderDataTable({
        dat2 <- data2()
        res2 <- brushedPoints(dat2, input$plot_brush2)
        datatable(res2, colnames = c("Income Group", "Year", 
                                     "Average GDP per Capita (Current $US)", 
                                     "Average Population Growth (%)", 
                                     "Total Population"))
      })
      
      ggplot(data2(), aes_string(x = "year", y = y_var2,
                                 size = size_var2, color="Income.group")) + 
        geom_point()+scale_size_continuous(range = c(4, 12))+
        scale_color_manual("Legend", values = c("High income: nonOECD" = "blue3", 
                                                "High income: OECD"= "palevioletred1", 
                                                "Low income" = "red", 
                                                "Lower middle income" = "orange",
                                                "Upper middle income" = "chartreuse4"))+
        guides(colour = guide_legend(override.aes = list(size=5)))+
        ylab(input$yax2)+xlab("Year")+labs(size=input$bub2)
    })
    
    #TAB 3
    
    data3 <- reactive({
      if (input$country == 'All'){
        df <- gini %>%
          filter(year >= input$year3[1], year<=input$year3[2])  
      }
      else {
        df <- gini %>%
          filter(year >= input$year3[1], year<=input$year3[2], Country==input$country)
      }
    })
    
    output$incomeineq <- renderPlot({
      if (input$yax3 == "GDP per Capita (Current $US)") {
        y_var3 = "gdpcap"
      } else {
        if (input$yax3 == "Population Growth (%)") {
          y_var3 = "popgrowth"
        } else {
            if (input$yax3 == "Gini Coefficient") {
              y_var3 = "gini"
              } else {
                y_var3 = "population"
              }
        }
      }
      
      if (input$bub3 == "GDP per Capita (Current $US)") {
        size_var3 = "gdpcap"
      } else {
        if (input$bub3 == "Population Growth (%)") {
          size_var3 = "popgrowth"
        } else {
          if (input$bub3 == "Gini Coefficient") {
            size_var3 = "gini"
          } else {
            size_var3 = "population"
          }
        }
      }
      
      output$table3 <- renderDataTable({
        dat3 <- data3()
        res3 <- brushedPoints(dat3, input$plot_brush3)
        datatable(res3, colnames = c("Country", "Region",
                                     "Income Group", "Year",
                                     "GDP per Capita (Current $US)", 
                                     "Population Growth (%)", 
                                     "Total Population",
                                     "Gini Coefficient"))
      })
      
      ggplot(data3(), aes_string(x = "year", y = y_var3,
                                 size = size_var3, color="Country")) + 
        geom_point()+scale_size_continuous(range = c(4, 12))+
        guides(colour = guide_legend(override.aes = list(size=5)))+
        ylab(input$yax3)+xlab("Year")+labs(size=input$bub3)
    
    })
    
    #TAB 4
    
    output$motionchart <- renderGvis({
      names(reginc) <- c("Country", "Year", "GDP per Capita", "Population Growth", 
                         "Total Population", "Region", "Income Group")
      gvisMotionChart(reginc, idvar = "Country", timevar = "Year", xvar = "GDP per Capita",
                      yvar = "Population Growth", colorvar = "Region", sizevar = "Total Population",
                      options = list(width= 850, showChartButtons=TRUE))
    })
    
    output$motionchartgini <- renderGvis({
      names(gini) <- c("Country", "Region", "Income Group", "Year", "GDP per Capita", 
                      "Population Growth", "Total Population", "Gini Coefficient")
      gvisMotionChart(gini, idvar = "Country", timevar = "Year", xvar = "Gini Coefficient",
                      yvar = "Population Growth", colorvar = "Income Group", sizevar = "GDP per Capita",
                      options = list(width=850, showChartButtons=TRUE))
    })
    
    #TAB 5
    
    output$Grouping <- renderDataTable({grouping})
    
  })