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

Avatar
Posted on Jul 24, 2015

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.

mot

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})
    
  })

 

 

 

 

About Author

Leave a Comment

Avatar
iphone 7 plus cases rugged November 2, 2016
Hello, everything is goinjg sound here and ofcourse every one is sharing information, that's truly excellent, ksep up writing.

View Posts by Categories


Our Recent Popular Posts


View Posts by Tags

#python #trainwithnycdsa 2019 airbnb Alex Baransky alumni Alumni Interview Alumni Reviews Alumni Spotlight alumni story Alumnus API Application artist aws beautiful soup Best Bootcamp Best Data Science 2019 Best Data Science Bootcamp Best Data Science Bootcamp 2020 Best Ranked Big Data Book Launch Book-Signing bootcamp Bootcamp Alumni Bootcamp Prep Bundles California Cancer Research capstone Career Career Day citibike clustering Coding Course Demo Course Report D3.js data Data Analyst data science Data Science Academy Data Science Bootcamp Data science jobs Data Science Reviews Data Scientist Data Scientist Jobs data visualization Deep Learning Demo Day Discount dplyr employer networking feature engineering Finance Financial Data Science Flask gbm Get Hired ggplot2 googleVis Hadoop higgs boson Hiring hiring partner events Hiring Partners Industry Experts Instructor Blog Instructor Interview Job Job Placement Jobs Jon Krohn JP Morgan Chase Kaggle Kickstarter lasso regression Lead Data Scienctist Lead Data Scientist leaflet linear regression Logistic Regression machine learning Maps matplotlib Medical Research Meet the team meetup Networking neural network Neural networks New Courses nlp NYC NYC Data Science nyc data science academy NYC Open Data NYCDSA NYCDSA Alumni Online Online Bootcamp Open Data painter pandas Part-time Portfolio Development prediction Prework Programming PwC python python machine learning python scrapy python web scraping python webscraping Python Workshop R R language R Programming R Shiny r studio R Visualization R Workshop R-bloggers random forest Ranking recommendation recommendation system regression Remote remote data science bootcamp Scrapy scrapy visualization seaborn Selenium sentiment analysis Shiny Shiny Dashboard Spark Special Special Summer Sports statistics streaming Student Interview Student Showcase SVM Switchup Tableau team TensorFlow Testimonial tf-idf Top Data Science Bootcamp twitter visualization web scraping Weekend Course What to expect word cloud word2vec XGBoost yelp