MATH 2270 - Assignment 3

Introduction

The World Happiness Report is an annual report on the state of global happiness and is participated by 155 countries
While the data for this analysis is sourced from www.kaggle.com, the happiness scores and rankings use data from the Gallup World Poll (https://www.gallup.com/178667/gallup-world-poll-work.aspx)
The reports are based on answers to a series of real-life questions asked in the poll (1)
The concept of a ‘Cantril Ladder’ is used (1)
Respondents are asked to think of a ladder with best possible life being a 10 and worse being 0 (1)
The happiness rankings are determined from nationally representative samples (3)
A typical sample size of 1,000 people per nation is captured and use the Gallup weights to make the estimates representative. (1)

Data Source

kaggle.com. (n.d.). World Happiness Report. [online] Available at: https://www.kaggle.com/mathurinache/world-happiness-report?select=2020.csv

Dashboard URL

https://anahm1.shinyapps.io/Assignment3-HappyWorld/

Report URL

https://rpubs.com/anahm1/happyWorld

References

Worldhappiness.report. (2020). Home. [online] Available at: https://worldhappiness.report/.
kaggle.com. (n.d.). World Happiness Report. [online] Available at: https://www.kaggle.com/mathurinache/world-happiness-report?select=2020.csv
Inc, G. (2014). How Does the Gallup World Poll Work? [online] Gallup.com. Available at: https://www.gallup.com/178667/gallup-world-poll-work.aspx.

Code

library(shiny)
library(shinydashboard)

## 
## Attaching package: 'shinydashboard'

## The following object is masked from 'package:graphics':
## 
##     box

library(readr)
library(ggplot2)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(rgeos)

## Loading required package: sp

## rgeos version: 0.5-5, (SVN revision 640)
##  GEOS runtime version: 3.8.1-CAPI-1.13.3 
##  Linking to sp version: 1.4-2 
##  Polygon checking: TRUE

library(maptools)

## Checking rgeos availability: TRUE

library(ggmap)

## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.

## Please cite ggmap if you use it! See citation("ggmap") for details.

library(broom)
library(leaflet)
library(htmlwidgets)
library(htmltools)
library(ggbeeswarm)
library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggmap':
## 
##     wind

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(scales)

## 
## Attaching package: 'scales'

## The following object is masked from 'package:readr':
## 
##     col_factor

library(RColorBrewer)

#ui logic
ui <- dashboardPage( skin = "black",
                     dashboardHeader(title = "World Happiness Index"),
                     ## Sidebar content
                     dashboardSidebar(
                             sidebarMenu(id = "tabs",
                             menuItem("Dashboard", tabName = "Happy", icon = icon("smile")))),
                     ## Body content
                     dashboardBody(
                        fluidRow(
                             box(title = "Happiness Index Map", solidHeader = TRUE,leafletOutput("Map", height = 400), width = 7),
                             box(title = "Top 5 - Most Happiest Nations", soliderHeader = TRUE, plotlyOutput("top5", height =400),width =5),
                             box(title = "Happiness by Region",  solidHeader = TRUE, plotlyOutput("region", height = 320), width = 7),
                             box(title = "Bottom 5 - Least Happiest Nations",  solidHeader = TRUE, plotlyOutput("bottom5", height = 320), width = 5)
                      ),
                         tags$footer("Source: World Happiness Report 2020")
                     )
)


# Server logic
server <- function(input, output) {
    
    #data
    Happy2020<- read_csv("2020.csv")
    
    Happy2020_tidy <- Happy2020 %>% select(`Country name`, `Regional indicator`, `Ladder score`, 'Explained by: Log GDP per capita', 'Explained by: Social support', 'Explained by: Healthy life expectancy',     
                                           'Explained by: Freedom to make life choices', 'Explained by: Generosity', 'Explained by: Perceptions of corruption', 'Dystopia + residual' )
    
    Happy2020_tidy$`Country name` <- factor(Happy2020_tidy$`Country name`)
    Happy2020_tidy$`Regional indicator`<- factor(Happy2020_tidy$`Regional indicator`)
    
    Happy2020_tidy <-Happy2020_tidy %>% rename( NAME = "Country name", Region =  "Regional indicator", Score =   "Ladder score", GDP =   "Explained by: Log GDP per capita"  ,        
                                                SocialSupport = "Explained by: Social support", HealthLifeExpectancy = "Explained by: Healthy life expectancy", Freedom =   "Explained by: Freedom to make life choices",
                                                Generosity = "Explained by: Generosity",  Corruption = "Explained by: Perceptions of corruption", "DystopiaResidual"  =   "Dystopia + residual"      )
    
    #map leaflet
    output$Map <- renderLeaflet({
        world.shp <- readShapeSpatial("TM_WORLD_BORDERS_SIMPL-0.3.shp")
        class(world.shp)
        
        
        bins <- seq(2,8,1)
        bins
        
        
        
        #ggplot(data = Happy2020_tidy, 
        #      aes(x = Score)) +
        # geom_histogram(colour = "white", bins = 40) + 
        #  geom_vline(
        #    xintercept = quantile(
        #      Happy2020_tidy$Score,
        #      probs = seq(0,1,0.2), na.rm = TRUE), 
        #    colour = "red", lwd = 1, lty = 2)
        
        
        pal <- colorBin(
            "RdYlGn",
            domain = Happy2020_tidy$Score, 
            bins = bins
        )
        
        
        p3 <- leaflet(merge.country.profiles) %>% 
            setView(lng = 15, lat = 30, zoom = 2)
        
        
        #legend
        labels <- sprintf(
            "<strong>%s</strong><br/>%g Score",
            merge.country.profiles$NAME, 
            round(merge.country.profiles$Score,2)
        ) %>% lapply(htmltools::HTML)
        
        
        
        p3 %>% addPolygons(
            fillColor = ~pal(Score),
            weight = 2,
            opacity = 1,
            color = "white",
            dashArray = "3",
            fillOpacity = 0.7,
            highlight = highlightOptions(
                weight = 5,
                color = "#666",
                dashArray = "",
                fillOpacity = 0.7,
                bringToFront = TRUE),
            label = labels,
            labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "15px",
                direction = "auto")) %>% 
            addLegend(pal = pal, 
                      values = ~Score, 
                      opacity = 0.9, title = "Happiness Score",
                      position = "bottomleft") 
        
        
        
        
        
    })
    
    # region
    output$region <- renderPlotly({
        p = ggplot(Happy2020_tidy, aes( x = Region, y = Score, fill = Region, text = NAME))
        p + geom_dotplot(binaxis = "y", binwidth = 1/6,
                         stackdir = "center", stackratio = 0.75,
                         aes(color = Region))
        
        p4 <- p + geom_beeswarm(aes(color = Region))  + 
            theme_classic() + 
            theme(legend.position = "none", axis.text.x=element_text( angle = 0)) +  
            scale_x_discrete(labels = wrap_format(10))+  
            scale_fill_brewer(palette = "Spectral") + 
            scale_color_brewer(palette = "Spectral")
        ggplotly(p4, tooltip = c("NAME","Score"))
        
        
        
    })
    
    #top 5
    output$top5 <- renderPlotly({
        
        Happy2020_tidy_top5 <- Happy2020_tidy %>% arrange(desc(Score)) %>% slice_head(n = 5)
        Happy2020_tidy_top5 <- Happy2020_tidy_top5 %>% select(NAME, Score, GDP, SocialSupport, HealthLifeExpectancy, Freedom, Generosity, Corruption, DystopiaResidual)
        Happy2020_tidy_top5 <- Happy2020_tidy_top5 %>% rename(Country = NAME) %>% droplevels()
        
        
        fig <- plot_ly(Happy2020_tidy_top5, x = ~Country, y = ~DystopiaResidual, type = 'bar', name = 'Unexplained')
        fig <- fig %>% add_trace(y = ~GDP, name = 'GDP')
        fig <- fig %>% add_trace(y = ~SocialSupport, name = 'Social Support')
        fig <- fig %>% add_trace(y = ~HealthLifeExpectancy, name = 'Life Expectancy')
        fig <- fig %>% add_trace(y = ~Freedom, name = 'Freedom')
        fig <- fig %>% add_trace(y = ~Generosity, name = 'Generosity')
        fig <- fig %>% add_trace(y = ~Corruption, name = 'Corruption')
        fig <- fig %>% layout(yaxis = list(title = 'Score'), barmode = 'stack')
        fig
        
    })
    
    #bottome 5
    output$bottom5<- renderPlotly({
        
        Happy2020_tidy_bottom5 <- Happy2020_tidy %>% arrange((Score)) %>% slice_head(n = 5)
        Happy2020_tidy_bottom5 <- Happy2020_tidy_bottom5 %>% select(NAME, Score, GDP, SocialSupport, HealthLifeExpectancy, Freedom, Generosity, Corruption, DystopiaResidual)
        Happy2020_tidy_bottom5 <- Happy2020_tidy_bottom5 %>% rename(Country = NAME) %>% droplevels()
        
        
        fig2 <- plot_ly(Happy2020_tidy_bottom5, y = ~DystopiaResidual, x = ~Country, colors = 'Reds', type = 'bar', name = 'Unexplained')
        fig2 <- fig2 %>% add_trace(y = ~GDP, name = 'GDP')
        fig2 <- fig2 %>% add_trace(y = ~SocialSupport, name = 'Social Support')
        fig2 <- fig2 %>% add_trace(y = ~HealthLifeExpectancy, name = 'Life Expectancy')
        fig2 <- fig2 %>% add_trace(y = ~Freedom, name = 'Freedom')
        fig2 <- fig2 %>% add_trace(y = ~Generosity, name = 'Generosity')
        fig2 <- fig2 %>% add_trace(y = ~Corruption, name = 'Corruption')
        fig2 <- fig2 %>% layout(yaxis = list(title = 'Score'), barmode = 'stack')
        
        
        fig2
        
    })
    
    
    
    
    
    
}
shinyApp(ui = ui, server = server)

## 
## Listening on http://127.0.0.1:5772

## Error : '2020.csv' does not exist in current working directory ('/private/var/folders/dh/_xjdw09x6rg9l3t5zq316gjc0000gp/T/RtmpQNwC0S/file39041026da23').

MATH 2270 - Assignment 3

Storytelling with Open Data

Sami Adnan Nayeem Ahmed (s3864915)

Introduction

Data Source

Dashboard URL

Report URL

References

Code