---
title: "World Values Survey data"
output:
flexdashboard::flex_dashboard:
css: style.css
orientation: columns
social: menu
source_code: embed
theme: spacelab
---
```{r libraries, include=FALSE}
library(flexdashboard)
library(tidyverse) #data wrangling
library(dplyr)
library(rio) #data import
library(here) #call data
library(janitor) #clean data col names
library(stringr) #
library(forcats) #
library(ggplot2) #plotting data
library(esvis) #effect size
#here() #look at the path
library(reactable)
library(htmltools)
library(leaflet)
library(rgdal)
library(sf)
library(reactablefmtr)
library(nflfastR)
library(gganimate)
library(colorspace)
library(colorblindr)
library(magick)
library(beepr)
library(ggimage)
library(png)
library(grid)
library(gridExtra)
#install.packages("scales")
```
```{r data_cleaning,include=FALSE, echo=TRUE, eval=TRUE, include=FALSE}
#use this code when forking for importing data
#--------
# dl = drive_download(
# "World_Values_Survey_Wave_7_Inverted_R_v1_5.rdata")
#
# raw.data = import("World_Values_Survey_Wave_7_Inverted_R_v1_5.rdata", setclass = "tb_df") %>%
# characterize() %>%
# clean_names()
#--------
raw.data = import(here("data", "World_Values_Survey_Wave_7_Inverted_R_v1_5.rdata"), setclass = "tb_df") %>%
characterize() %>%
clean_names()
#names(raw.data)
#q262 - age
#q263 - 1. Born in this [country]; 2. Immigrant to this [country] (born outside this country)
#renaming, recoding levels in the data for required variables
clean.data = raw.data %>%
#step 1 = select variables to be used
select(b_country_alpha, q106, q107, q108, q109, q111, q289cs9, q262, q152, q170p, q173p, q169p, q238p, q21p, o1_longitude, o2_latitude, q260, q262, q263) %>%
#step 2 = rename variables being used
mutate(country = factor(b_country_alpha),
rel.denom = factor(q289cs9),
Age = as.numeric(q262)) %>%
#drop those NAs, no missing values
drop_na() %>%
#reverse coding
mutate(q107r = 11 - q107,
q109r = 11 - q109) %>%
#recode levels to something you understand
mutate(rel.denom = recode(rel.denom,
`-5`= "Other missing",
`-4`="Not asked",
`-2`="No answer",
`-1`="Dont know",
`10000000` = "Catholic, not further defined",
`10100000` = "Roman Catholic",
`10203000` = "Latin Church",
`10205010` = "Byzantine Rite",
`20000000` = "Maronite Church",
`20200000` = "Protestant, not further defined",
`20206022` = "Lutheran, not further defined",
`20222370` = "Protestant Free Church of Germany",
`20302000` = "Evangelical Lutheran Church in Russia, Ukraine, Kazakhstan",
`20400000` = "Presbyterianism",
`20600000` = "Anglican, not further defined",
`20636010` = "Baptist, not further defined",
`20700000` = "Evangelical Baptist Union of Ukraine",
`20720060` = "Methodist, not further defined",
`20804000` = "The Salvation Army",
`20805000` = "Adventist movement (Sunday observing)",
`20805020` = "Adventist movement (Seventh Day Sabbath/Saturday observing) Seventh-day Adventist Church",
`21000000` = "Plymouth Brethren, not further defined",
`21101010` = "New Apostolic Church",
`21200000` = "Pentecostal and Charismatic, not further defined",
`21212050` = "Australian Christian Church (Asemblies of God)",
`21218000` = "Celestial Church of Christ",
`21226000` = "Church of the Foursquare Gospel",
`21283005` = "Churches of Christ in Australia",
`21285030` = "Born Again Movement",
`21319000` = "United Church of Christ in the Philippines",
`21320000` = "Uniting Church in Australia",
`21321050` = "United Evangelical Church in Nigeria",
`21401250` = "Assembly of God",
`21603100` = "Brotherhood of the Cross and Star",
`21621100` = "Protestant Churches without free churches (Germany)",
`30100000` = "Eastern Orthodox, not further defined",
`30106000` = "Russian Orthodox Church",
`30108000` = "Serbian Orthodox Church",
`30111000` = "Cypriot Orthodox Church",
`30112000` = "Orthodox Church of Greece",
`30117000` = "Orthodox Church of Ukraine",
`30202001` = "Armenian Apostolic Church",
`30202009` = "Ethiopian Orthodox Tewahedo Church",
`40000000` = "Judaism",
`50000000` = "Islam, not further defined",
`50101000` = "Sunni",
`50202000` = "Shia",
`50302000` = "Ibadi",
`50500010` = "Druze",
`50500060` = "Bahai Faith",
`50500080` = "Second Advent; Parousia",
`60000000` = "Hindu",
`70000000` = "Buddhist",
`70200000` = "Hoahaoism",
`80000000` = "Other Christian, not further defined",
`80213100` = "American Israelism and Latter Day Saint movement",
`80213122` = "Mormons",
`80213139` = "World Missionary Movement",
`80213304` = "Jehovah's Witnesses",
`80213401` = "La Luz del Mundo",
`80213501` = "Iglesia ni Cristo (Church of Christ)",
`80213502` = "Members Church of God International",
`80217003` = "Church of God (Seventh-Day)",
`80400035` = "Evangelicalism",
`80400037` = "Gnosticism",
`80502002` = "Cao Đài",
`80502010` = "Santeria",
`90000000` = "Other; nfd",
`90101000` = "Taoism (Han Chinese)",
`90102000` = "Confucianists",
`90103000` = "Yiguandao",
`90104000` = "Xuanyuan jiao",
`90105000` = "Cihui Tang",
`90200000` = "Ethnic religions excluding some in separate categories",
`90201115` = "Wicca-Pagan` Witchcraft",
`90202120` = "Mandaeism",
`90300000` = "African traditional religions",
`90400000` = "Sikhism",
`90500000` = "Spiritism",
`90800000` = "Neo-paganism",
`100000020`= "Noneligious",
`100000030`= "Agnostic",
`100000040`= "Atheist"),
country = recode(b_country_alpha,
"AND" = "Andorra",
"ARG" = "Argentina",
"AUS" = "Australia",
"BGD" = "Bangladesh",
"BOL" = "Bolivia",
"BRA" = "Brazil",
"CHL" = "Chile",
"CHN" = "China",
"COL" = "Colombia",
"CYP" = "Cyprus",
"ECU" = "Ecuador",
"EGY" = "Egypt",
"ETH" = "Ethiopia",
"DEU" = "Germany",
"GRC" = "Greece",
"GTM" = "Guatemala",
"HKG" = "Hong Kong SAR",
"IDN" = "Indonesia",
"IRN" ="Iran",
"IRQ" = "Iraq",
"JPN" = "Japan",
"JOR" = "Jordan",
"KAZ" = "Kazakhstan",
"KGZ" = "Kyrgyzstan",
"LBN" = "Lebanon",
"MAC" = "Macau.SAR",
"MYS" = "Malaysia",
"MEX" = "Mexico",
"MMR" = "Myanmar",
"NZL" = "New Zealand",
"NIC" = "Nicargua",
"NGA" = "Nigeria",
"PAK" = "Pakistan",
"PER" = "Peru",
"PHL" = "Philippines",
"PRI" = "Puerto.Rico",
"ROU" = "Romania",
"RUS" = "Russia",
"SRB" = "Serbia",
"KOR" = "South.Korea",
"TWN" = "Taiwan ROC",
"TJK" = "Tajikistan",
"THA" = "Thailand",
"TUN" = "Tunisia",
"TUR" = "Turkey",
"UKR" = "Ukraine",
"USA" = "United States",
"VNM" = "Vietnam",
"ZWE" = "Zimbabwe"),
Native = recode(q263,
"1" = "native",
"2" = "immigrant"),
Sex = recode(q260,
`1` ="Male",
`2` = "Female"))
```
Country Stats
=========================
Sidebar {.sidebar}
------------
**_Data Description:_** This project utilizes data from the Wave 7 (2017-2021) of [World Value Survey](https://www.worldvaluessurvey.org/WVSNewsShowMore.jsp?evYEAR=2020&evMONTH=-1). The WVS project aims to assess impact values and their stability and change over time. It also focuses on the social, political and economic impact of these values on countries, societies and cultures.
Column {.tabset}
-----------------------------------------------------------------------
### Draft 3
```{r}
#Male.perc = Male/sum(Male, Female)
table.data.Sex = clean.data %>%
select(country, Sex) %>%
as_tibble() %>%
rename(Country = country) %>%
group_by(Country) %>%
count(Sex) %>%
pivot_wider(names_from = Sex, values_from = n) %>%
rowwise() %>%
mutate(Female.perc = Female/sum(Female, Male)) %>%
select(Country, Female.perc)
table.data.Native = clean.data %>%
select(country, Native) %>%
as_tibble() %>%
rename(Country = country) %>%
group_by(Country) %>%
count(Native) %>%
pivot_wider(names_from = Native, values_from = n) %>%
dplyr::mutate(immigrant = replace_na(immigrant, 0)) %>%
rowwise() %>%
mutate(native.perc = native/sum(native, immigrant)) %>%
select(Country, native.perc)
table.data.Age = clean.data %>%
select(country, Age) %>%
as_tibble() %>%
rename(Country = country) %>%
group_by(Country) %>%
mutate(Age.mean = round(mean(Age))) %>%
select(Country, Age.mean) %>%
unique()
d1 = left_join(table.data.Sex, table.data.Native, "Country")
table.data = left_join(d1, table.data.Age, "Country") #Final table for descriptives
# Render a bar chart with a label on the left
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"), label, chart)
}
tbl = reactable(
table.data,
defaultPageSize = 10, ## change pagination size from 10 to 20
defaultSorted = "Country",
columns = list(
#Col1
Country = colDef(
name = "Country",
format = colFormat(prefix = "#"),
defaultSortOrder = "asc",
minWidth = 200,
headerStyle = list(fontWeight = 700),
cell = function(value) {
div(
class = "country",
image <- img(class = "flag",
alt =value,
src = paste0("images/", value, ".png"),
height = "35px", width = "42px"),
tagList(
div(style = list(display = "inline-block", width = "24px")),
value
))
}
),
#Col2
Female.perc = colDef(
name = "Female",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
bar_chart(value, width = value, fill = "#7fcdbb", background = "#e1e1e1")
},
# And left-align the columns
align = "left",
format = colFormat(digits = 1)
),
#Col4
Age.mean = colDef(
name = "Mean Age",
defaultSortOrder = "desc",
cell = data_bars_pos_neg(
table.data,
colors = c("#fcc5f5", "#f882ea", "#f362e2")),
align = "center" ## align column header
),
#Col5
native.perc = colDef(
name = "Native",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
bar_chart(value, width = value, fill = "#2c7fb8", background = "#e1e1e1")
},
# And left-align the columns
align = "left"
)
),
theme = reactableTheme(
borderColor = "#ece2f0",
stripedColor = "#f6f8fa",
highlightColor = "#f0f5f9",
cellPadding = "8px 12px",
style = list(fontFamily = "sans-serif"),
searchInputStyle = list(width = "10%"))
)
# Add the title and subtitle
div(class = "country-data",
div(class = "country-header",
div(class = "country-title", "Countries Descriptives"),
"Countries includedin the World Value Survey-Wave 7 (2017-2021)"
),
tbl
)
```
### Draft 2
```{r}
#Male.perc = Male/sum(Male, Female)
table.data.Sex = clean.data %>%
select(country, Sex) %>%
as_tibble() %>%
rename(Country = country) %>%
group_by(Country) %>%
count(Sex) %>%
pivot_wider(names_from = Sex, values_from = n) %>%
rowwise() %>%
mutate(Female.perc = Female/sum(Female, Male)) %>%
select(Country, Female.perc)
table.data.Native = clean.data %>%
select(country, Native) %>%
as_tibble() %>%
rename(Country = country) %>%
group_by(Country) %>%
count(Native) %>%
pivot_wider(names_from = Native, values_from = n) %>%
dplyr::mutate(immigrant = replace_na(immigrant, 0)) %>%
rowwise() %>%
mutate(native.perc = native/sum(native, immigrant)) %>%
select(Country, native.perc)
table.data.Age = clean.data %>%
select(country, Age) %>%
as_tibble() %>%
rename(Country = country) %>%
group_by(Country) %>%
mutate(Age.mean = round(mean(Age))) %>%
select(Country, Age.mean) %>%
unique()
d1 = left_join(table.data.Sex, table.data.Native, "Country")
table.data = left_join(d1, table.data.Age, "Country") #Final table for descriptives
# Render a bar chart with a label on the left
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"), label, chart)
}
# Col 1 codes
# headerStyle = list(fontWeight = 700),
# cell = function(value, index) {
# div(
# class = "Country",
# img(class = "Country", alt = value, src = sprintf("images/%s.png"), value), width="42", height="42", style="vertical-align:bottom")
# }
# #Col3
# Male.perc = colDef(
# name = "Male",
# defaultSortOrder = "desc",
# # Render the bar charts using a custom cell render function
# cell = function(value) {
# # Format as percentages with 1 decimal place
# value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
# bar_chart(value, width = value, fill = "#2c7fb8", background = "#e1e1e1")
# },
# # And left-align the columns
# align = "left"
# ),
reactable(
table.data,
defaultSorted = "Country",
columns = list(
#Col1
Country = colDef(
name = "Country",
format = colFormat(prefix = "#"),
defaultSortOrder = "asc",
minWidth = 200,
headerStyle = list(fontWeight = 700),
cell = function(value) {
div(
class = "country",
img(class = "flag",
alt = paste(value, "flag"),
src = paste0("images/", value, ".png"))
)
}
),
#Col2
Female.perc = colDef(
name = "Female",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
bar_chart(value, width = value, fill = "#7fcdbb", background = "#e1e1e1")
},
# And left-align the columns
align = "left",
format = colFormat(digits = 1)
),
#Col4
Age.mean = colDef(
name = "Mean Age",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- format(round(value, 2), nsmall = 2)
bar_chart(value, width = value, fill = "#2c7fb8", background = "#e1e1e1")
},
# And left-align the columns
align = "left"
),
#Col5
native.perc = colDef(
name = "Native",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
bar_chart(value, width = value, fill = "#2c7fb8", background = "#e1e1e1")
},
# And left-align the columns
align = "left"
)
),
theme = reactableTheme(
borderColor = "#ece2f0",
stripedColor = "#f6f8fa",
highlightColor = "#f0f5f9",
cellPadding = "8px 12px",
style = list(fontFamily = "sans-serif"),
searchInputStyle = list(width = "10%"))
)
```
### Draft 1
```{r}
table.data = clean.data %>%
select(country, q260) %>%
mutate(q260 = recode(q260,
`1` ="Male",
`2` = "Female")) %>%
as_tibble() %>%
rename(Sex = q260,
Country = country) %>%
group_by(Country) %>%
count(Sex) %>%
pivot_wider(names_from = Sex, values_from = n) %>%
rowwise() %>%
mutate(Female.perc = Female/sum(Female, Male),
Male.perc = Male/sum(Male, Female)) %>%
select(Country, Female.perc, Male.perc)
# Render a bar chart with a label on the left
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"), label, chart)
}
reactable(
table.data,
defaultSorted = "Country",
columns = list(
#Col1
Country = colDef(
name = "Country",
format = colFormat(prefix = "#"),
defaultSortOrder = "asc",
minWidth = 200
),
#Col2
Female.perc = colDef(
name = "Female",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
bar_chart(value, width = value, fill = "#7fcdbb", background = "#e1e1e1")
},
# And left-align the columns
align = "left",
format = colFormat(digits = 1)
),
#Col3
Male.perc = colDef(
name = "Male",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(round(value * 100, 2), nsmall = 2), "%")
bar_chart(value, width = value, fill = "#2c7fb8", background = "#e1e1e1")
},
# And left-align the columns
align = "left"
)
),
theme = reactableTheme(
borderColor = "#ece2f0",
stripedColor = "#f6f8fa",
highlightColor = "#f0f5f9",
cellPadding = "8px 13px",
style = list(
fontFamily = "sans-serif"
),
searchInputStyle = list(width = "10%")
)
)
```
World Map
=========================
Sidebar {.sidebar}
------------
The map displays the percentage of participants in every country who consider 'Defense forces' as the most important consideration for their respective countries in the next 10 years.
**_Question:_**
People sometimes talk about what the aims of this country should be for the next ten years. On this ‘card are listed some of the goals which different people would give top priority. Would you please say which one of these you, yourself, consider the most important?
1. A high level of economic growth
2. Making sure this country has strong defense forces
3. Seeing that people have more say about how things are done at their jobs and in their communities
4. Trying to make our cities and countryside more beautiful
Percentages for every country were computed by considering the number of participants who selected option 2. and dividing that value with the total number of participants from the said country. This value is further multiplied by 100.
The icons indicate the defense spending budget of the countries and their ranks.
Column {.tabset}
-----------------------------------------------------------------------
### Draft 3
```{r}
country_coord = clean.data %>%
select(country, o1_longitude, o2_latitude) %>%
group_by(country) %>%
summarise(mean_long = mean(o1_longitude),
mean_lat = mean(o2_latitude))
df1 = clean.data %>%
select(country, q152) %>%
group_by(country, q152) %>%
count() %>%
pivot_wider(names_from = "q152", values_from = n) %>%
mutate(`4` = replace_na(`4`, 0)) %>% #replace the pesky NA with 0
mutate(total.n = sum(`1`, `2`, `3`, `4`)) %>%
pivot_longer(cols = c(`1`, `2`, `3`, `4`), names_to = "q152", values_to = "importance") %>%
mutate("perc.imp" = (importance/total.n)*100) %>%
filter(q152 == "2") %>% #defense is important
arrange(desc(perc.imp)) %>%
data.frame()%>%
as_tibble() %>%
#Recoding to match those in the GEO file for adding polygons in the map
mutate(country = recode(country,
"Hong Kong SAR" = "Hong Kong",
"Iran" = "Iran (Islamic Republic of)",
"Macau.SAR" = "Macau",
"Myanmar" = "Burma",
"Nicargua" = "Nicaragua",
"Taiwan ROC" = "Taiwan",
"Vietnam" = "Viet Nam")) %>%
arrange(desc(perc.imp))
df1.map = left_join(country_coord, df1, "country")
# Code to create and load world polygon shapefiles
#dir.create(here("shapefile"))
#download.file("http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip" ,
# destfile = here("shapefile", "world_shape_file.zip"))
# unzip(here("shapefile", "world_shape_file.zip"),
# exdir = here("shapefiles"))
world_spdf <- readOGR(
dsn = here("shapefiles"),
layer = "TM_WORLD_BORDERS_SIMPL-0.3",
verbose = FALSE
) %>%
st_as_sf()
d <- left_join(world_spdf, df1, by = c("NAME" = "country"))
# create palette
pal <- colorNumeric(palette = colorRamp(c("#DCDCD4", "#3F7299"), interpolate="spline"),
domain = na.omit(d$perc.imp),
na.color = "transparent")
#Icon URL for defense
IconURL= 'https://icons.iconarchive.com/icons/icons8/windows-8/48/Military-Rifle-icon.png'
#title
tag.map.title <- tags$style(HTML("
.leaflet-control.map-title {
transform: translate(-30%,50%);
position: fixed !important;
left: 50%;
text-align: center;
padding-left: 20px;
padding-right: 20px;
background: #FFF;
font-weight: bold;
font-size: 20px;
font: 20px Georgia, monospace;
}
"))
title <- tags$div(
tag.map.title, HTML("Aim of the Country for the next 10 years - Strong Defense forces ")
)
leaflet(d) %>%
addTiles() %>%
setView(lat = 25, lng = 50 , zoom = 2.2) %>%
addPolygons(fillColor = ~pal(perc.imp), stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1) %>%
addLegend("bottomright", pal = pal, values = ~perc.imp, title = "% of Defense Imp.", labFormat = labelFormat(suffix = "%"), opacity = 1) %>%
addControl(title, position = "topleft", className="map-title") %>%
#USA
addMarkers(
lng = -100.4458825, lat = 39.7837304,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#1. USA $740Bn.
ref") %>%
#China
addMarkers(
lng = 104.195397, lat = 35.86166,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#2. China $178.2Bn.
ref") %>%
#Russia
addMarkers(
lng = 105.318756, lat = 61.52401,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#11. Russia $42.12Bn.
ref") %>%
#Iran
addMarkers(
lng = 53.688046, lat = 32.427908,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#20. Iran $14.1Bn.
ref") %>%
#Pakistan
addMarkers(
lng = 69.345116, lat = 30.375321,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#24. Pakistan $12.27Bn.
ref") %>%
#Iraq
addMarkers(
lng = 43.679291, lat = 33.223191,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#39. Iraq $6Bn.
ref")
```
### Draft 2
```{r}
country_coord = clean.data %>%
select(country, o1_longitude, o2_latitude) %>%
group_by(country) %>%
summarise(mean_long = mean(o1_longitude),
mean_lat = mean(o2_latitude))
df1 = clean.data %>%
select(country, q152) %>%
group_by(country, q152) %>%
count() %>%
pivot_wider(names_from = "q152", values_from = n) %>%
mutate(`4` = replace_na(`4`, 0)) %>% #replace the pesky NA with 0
mutate(total.n = sum(`1`, `2`, `3`, `4`)) %>%
pivot_longer(cols = c(`1`, `2`, `3`, `4`), names_to = "q152", values_to = "importance") %>%
mutate("perc.imp" = (importance/total.n)*100) %>%
filter(q152 == "2") %>% #defense is important
arrange(desc(perc.imp)) %>%
data.frame()%>%
as_tibble() %>%
#Recoding to match those in the GEO file for adding polygons in the map
mutate(country = recode(country,
"Hong Kong SAR" = "Hong Kong",
"Iran" = "Iran (Islamic Republic of)",
"Macau.SAR" = "Macau",
"Myanmar" = "Burma",
"Nicargua" = "Nicaragua",
"Taiwan ROC" = "Taiwan",
"Vietnam" = "Viet Nam")) %>%
arrange(desc(perc.imp))
df1.map = left_join(country_coord, df1, "country")
# Code to create and load world polygon shapefiles
#dir.create(here("shapefile"))
#download.file("http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip" ,
# destfile = here("shapefile", "world_shape_file.zip"))
# unzip(here("shapefile", "world_shape_file.zip"),
# exdir = here("shapefiles"))
world_spdf <- readOGR(
dsn = here("shapefiles"),
layer = "TM_WORLD_BORDERS_SIMPL-0.3",
verbose = FALSE
) %>%
st_as_sf()
d <- left_join(world_spdf, df1, by = c("NAME" = "country"))
# create palette
pal <- colorNumeric(palette = colorRamp(c("#DCDCD4", "#3F7299"), interpolate="spline"),
domain = na.omit(d$perc.imp),
na.color = "transparent")
#Icon URL for defense
IconURL= 'https://icons.iconarchive.com/icons/icons8/windows-8/48/Military-Rifle-icon.png'
RefURL = 'https://www.globalfirepower.com/defense-spending-budget.php'
#title
tag.map.title <- tags$style(HTML("
.leaflet-control.map-title {
transform: translate(-50%,30%);
position: center;
left: 50%;
text-align: center;
padding-left: 12px;
padding-right: 12px;
background: #e9e4e2;
font-weight: bold;
font-size: 14px;
font: italic 10px/15px Helvetica, serif;
}
"))
title <- tags$div(
tag.map.title, HTML("Aim of the Country for the next 10 years - Strong Defense forces ")
)
leaflet(d) %>%
addTiles() %>%
setView(lat = 25, lng = 50 , zoom = 2.2) %>%
addPolygons(fillColor = ~pal(perc.imp), stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1) %>%
addLegend("bottomright", pal = pal, values = ~perc.imp, title = "% of Defense Imp.", labFormat = labelFormat(suffix = "%"), opacity = 1) %>%
addControl(title, position = "topleft", className="map-title") %>%
#USA
addMarkers(
lng = -100.4458825, lat = 39.7837304,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#1. USA $740Bn.
ref") %>%
#China
addMarkers(
lng = 104.195397, lat = 35.86166,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#2. China $178.2Bn.
ref") %>%
#Russia
addMarkers(
lng = 105.318756, lat = 61.52401,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#11. Russia $42.12Bn.
ref") %>%
#Iran
addMarkers(
lng = 53.688046, lat = 32.427908,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#20. Iran $14.1Bn.
ref") %>%
#Pakistan
addMarkers(
lng = 69.345116, lat = 30.375321,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#24. Pakistan $12.27Bn.
ref") %>%
#Iraq
addMarkers(
lng = 43.679291, lat = 33.223191,
icon = list(
iconUrl= IconURL,
iconSize= c(12,12)),
labelOptions = labelOptions(noHide = T),
popup="#39. Iraq $6Bn.
ref")
```
### Draft 1
```{r}
country_coord = clean.data %>%
select(country, o1_longitude, o2_latitude) %>%
group_by(country) %>%
summarise(mean_long = mean(o1_longitude),
mean_lat = mean(o2_latitude))
df1 = clean.data %>%
select(country, q152) %>%
group_by(country, q152) %>%
count() %>%
pivot_wider(names_from = "q152", values_from = n) %>%
mutate(`4` = replace_na(`4`, 0)) %>% #replace the pesky NA with 0
mutate(total.n = sum(`1`, `2`, `3`, `4`)) %>%
pivot_longer(cols = c(`1`, `2`, `3`, `4`), names_to = "q152", values_to = "importance") %>%
mutate("perc.imp" = (importance/total.n)*100) %>%
filter(q152 == "2") %>% #defense is important
arrange(desc(perc.imp)) %>%
data.frame()%>%
as_tibble() %>%
arrange(desc(perc.imp))
df1.map = left_join(country_coord, df1, "country")
# Code to create and load world polygon shapefiles
#dir.create(here("shapefile"))
#download.file("http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip" ,
# destfile = here("shapefile", "world_shape_file.zip"))
# unzip(here("shapefile", "world_shape_file.zip"),
# exdir = here("shapefiles"))
world_spdf <- readOGR(
dsn = here("shapefiles"),
layer = "TM_WORLD_BORDERS_SIMPL-0.3",
verbose = FALSE
) %>%
st_as_sf()
d <- left_join(world_spdf, df1, by = c("NAME" = "country"))
# create palette
pal <- colorNumeric(palette = colorRamp(c("#002bb8", "#99ffd5"), interpolate="spline"),
domain = na.omit(d$perc.imp),
na.color = "transparent")
leaflet(d) %>%
addTiles() %>%
setView(lat = 25, lng = 50 , zoom = 1) %>%
addPolygons(fillColor = ~pal(perc.imp), stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1) %>%
addLegend("bottomright", pal = pal, values = ~perc.imp, title = "% of Defense Imp.", labFormat = labelFormat(suffix = "%"), opacity = 1) %>%
addMarkers(
lng = -100.4458825, lat = 39.7837304,
labelOptions = labelOptions(noHide = T),
popup="USA $740Bn.
ref")
```
Economic Values
=========================
Sidebar {.sidebar}
------------
This figure indicates the effect sizes of the difference between Capitalism values in USA and other countries in the dataset. A postmaterial capitalism index was computed. Higher the score higher the levels of Capitalism.
The Gross Domestic per Capita (GDPPC) Ranking [data](https://www.worldometers.info/gdp/gdp-by-country/) for 2017 was obtained to highlight those countries which are in the Top 20 ranking and those having a rank lower than 20.
Thouse countries extending on the left indicate the difference between the mean values of US and the respective country, wherein the mean value of US (reference group) is greater than the non-reference group country, as indicated on the Y axis. Those countries extending on the right, indicate mean values greater than that of US
Column {.tabset}
-----------------------------------------------------------------------
### Draft 3
```{r}
capitalism.d = clean.data %>%
filter(q111 %in% c("1", "2")) %>%
rowwise() %>%
#Score on Capitalism - Higher score, higher C
mutate(capitalism = sum(q106, q107r, q108, q109r, q111)) %>%
mutate(capitalism = as.integer(capitalism)) %>%
select(country, capitalism, rel.denom, q262)
cd = coh_d(capitalism.d, capitalism~country) #compute effect sizes for all country pairs
cd1 = cd %>%
filter(country_ref == "United States") %>%
# mutate(highlight = ifelse(country_foc == 'Chile', T, F)) %>%
select(country_foc, coh_d, coh_se)
new.df = tribble(
~Culture, ~country_foc, ~GCP, ~Rank,
"no data", "Andorra", 39128, 159,
"collective", "Argentina", 14508, 21,
"collective", "Bangladesh", 1564, 43,
"collective", "Bolivia", 3351, 94,
"collective", "China", 8612, 2,
"collective", "Colombia", 6429, 38,
"no data", "Cyprus", 18695, 109,
"collective", "Ecuador", 6124, 62,
"collective", "Ethiopia", 757, 66,
"collective", "Greece", 19214, 51,
"collective", "Hong Kong SAR", 46733, 33,
"collective", "Indonesia", 3837, 16,
"collective", "Iran", 5628, 26,
"collective", "Iraq", 5114, 52,
"collective", "Jordan", 4095, 88,
"collective", "Kazakhstan", 9009, 55,
"no data", "Kyrgyzstan", 1222, 144,
"collective", "Lebanon", 7857, 80,
"no data", "Macau.SAR", 80890, 82,
"collective", "Malaysia", 10118, 37,
"collective", "Mexico", 9224, 15,
"no data", "Myanmar", 1256, 71,
"no data", "Nicargua", 2164, 12,
"collective", "Nigeria", 1969, 30,
"collective", "Pakistan", 1467, 40,
"collective", "Philippines", 2982, 39,
"collective", "Romania", 10781, 48,
"collective", "Russia", 10846, 11,
"collective", "Taiwan ROC", 25062, 22,
"no data", "Tajikistan", 805, 145,
"collective", "Thailand", 6579, 25,
"collective", "Tunisia", 3494, 89,
"collective", "Vietnam", 2366, 45,
"no data", "Zimbabwe", 1548, 110
)
#data frame for making a character vector according to Ranking
df = new.df %>%
mutate(Ranking = ifelse(Rank %in% 1:20, "Top 20","Lower than 20"))
final.df = left_join(cd1, df, "country_foc")
# USA
vertical.lines = c(-0.50,-0.25, 0,0.25,0.50)
#Color palette for bars
accent_OkabeIto <- palette_OkabeIto[c(3, 5, 7, 1)]
accent_OkabeIto[1:4] <- desaturate(lighten(accent_OkabeIto[1:4], .4), .8)
#Color palette for country names
label_color <- final.df %>%
arrange(abs(coh_d)) %>%
mutate(new.var = ifelse(country_foc == "China"| country_foc == "Russia", "#6d98c0", "gray30")) %>%
select(new.var) %>%
unlist()
#Font palette for country names
label_face <- final.df %>%
arrange(abs(coh_d)) %>%
mutate(new.var = ifelse(country_foc == "China" | country_foc == "Russia", "bold", "plain")) %>%
select(new.var) %>%
unlist()
#Annotate
annot = data.frame(
text = c("Ref. country greater", "Non-ref. country greater"),
x = c(3.5, 3.5),
y = c(-.65,.055)
)
#Plot
#Add background picture to the plot
m <- readPNG("money.png")
w <- matrix(rgb(m[,,1],m[,,2],m[,,3], m[,,4] * 0.1), nrow=dim(m)[1]) #0.1 is alpha to change the transparency of the image
final.df%>%
ggplot(aes(x = fct_reorder(country_foc, abs(coh_d)), y = coh_d)) +
annotation_custom(rasterGrob(w,
width = unit(1,"npc"),
height = unit(1,"npc")),
-Inf, Inf, -Inf, Inf) +
geom_bar(stat = "identity", aes(fill = Ranking), alpha = .8)+
#China in blue
geom_bar(stat = "identity",data = filter(final.df, country_foc == "China"), fill = "#6d98c0")+
#Russia in blue
geom_bar(stat = "identity",data = filter(final.df, country_foc == "Russia"), fill = "#6d98c0")+
#Add error bars
geom_errorbar(aes(x= fct_reorder(country_foc, abs(coh_d)), ymin=coh_d-coh_se, ymax=coh_d+coh_se), width=0.15, color="#5c5c5c", alpha=0.5, size=.15)+
scale_fill_manual(values = accent_OkabeIto)+
guides(fill=guide_legend(title="GDPPC Gross Ranking"))+
theme_minimal(base_size = 8)+
scale_y_continuous(breaks = c(-0.50,-0.25, 0,0.25,0.50),
labels = c("-0.50","-0.25", "0","0.25","0.50"))+
coord_flip() +
labs(x = "Countries",
y = "Cohen's d",
title = "Captalism Values - Effect size Plot",
subtitle = "Reference Country - United States",
caption = "Data Source: World Values Survey")+
geom_text(data = annot, aes(x=x, y=y, label = text, fontface=3), color="#817d79", hjust=0, size=3, inherit.aes = FALSE)+
theme(panel.grid.minor = element_blank(),
axis.text.y = element_text(color = label_color,
face = label_face),
panel.grid.major.x = element_line(colour = "grey90", linetype = 2, size = 0.5),
panel.grid.major.y = element_line(colour = "grey90", linetype = 1, size = 0.13),
text=element_text(size=10, family="Times"))
#Codes for gif which do not render in flexdashboard!
#ggsave("capitalism.png")
# # Set up a plot area with no plot
# plot(1:2, type='n', main="", xlab="x", ylab="y")
#
# lim <- par()
# rasterImage(CAPplot,
# xleft=1, xright=2,
# ybottom=1.3, ytop=1.7)
# grid()
#
#
#
# # Print over another graphic
# plot(plot1)
# rasterImage(CAPplot , 21, 0, 25, 80)
#wizgif <- image_read("giphy.gif")
#frames <- image_composite(CAPplot, wizgif, offset = "+2000+70")
#animation <- image_animate(frames, fps = 10)
#image_write(animation, "beachwiz.gif")
#beep()
```
### Draft 2
```{r}
capitalism.d = clean.data %>%
filter(q111 %in% c("1", "2")) %>%
rowwise() %>%
#Score on Capitalism - Higher score, higher C
mutate(capitalism = sum(q106, q107r, q108, q109r, q111)) %>%
mutate(capitalism = as.integer(capitalism)) %>%
select(country, capitalism, rel.denom, q262)
cd = coh_d(capitalism.d, capitalism~country) #compute effect sizes for all country pairs
cd1 = cd %>%
filter(country_ref == "United States") %>%
# mutate(highlight = ifelse(country_foc == 'Chile', T, F)) %>%
select(country_foc, coh_d, coh_se)
new.df = tribble(
~Culture, ~country_foc, ~GCP, ~Rank,
"no data", "Andorra", 39128, 159,
"collective", "Argentina", 14508, 21,
"collective", "Bangladesh", 1564, 43,
"collective", "Bolivia", 3351, 94,
"collective", "China", 8612, 2,
"collective", "Colombia", 6429, 38,
"no data", "Cyprus", 18695, 109,
"collective", "Ecuador", 6124, 62,
"collective", "Ethiopia", 757, 66,
"collective", "Greece", 19214, 51,
"collective", "Hong Kong SAR", 46733, 33,
"collective", "Indonesia", 3837, 16,
"collective", "Iran", 5628, 26,
"collective", "Iraq", 5114, 52,
"collective", "Jordan", 4095, 88,
"collective", "Kazakhstan", 9009, 55,
"no data", "Kyrgyzstan", 1222, 144,
"collective", "Lebanon", 7857, 80,
"no data", "Macau.SAR", 80890, 82,
"collective", "Malaysia", 10118, 37,
"collective", "Mexico", 9224, 15,
"no data", "Myanmar", 1256, 71,
"no data", "Nicargua", 2164, 12,
"collective", "Nigeria", 1969, 30,
"collective", "Pakistan", 1467, 40,
"collective", "Philippines", 2982, 39,
"collective", "Romania", 10781, 48,
"collective", "Russia", 10846, 11,
"collective", "Taiwan ROC", 25062, 22,
"no data", "Tajikistan", 805, 145,
"collective", "Thailand", 6579, 25,
"collective", "Tunisia", 3494, 89,
"collective", "Vietnam", 2366, 45,
"no data", "Zimbabwe", 1548, 110
)
df = new.df %>%
mutate(Ranking = ifelse(Rank %in% 1:20, "Top 20","Higher than 20"))
final.df = left_join(cd1, df, "country_foc")
# USA
vertical.lines = c(-0.50,-0.25, 0,0.25,0.50)
#Color palette for bars
accent_OkabeIto <- palette_OkabeIto[c(1, 2, 7, 4)]
accent_OkabeIto[1:4] <- desaturate(lighten(accent_OkabeIto[1:4], .4), .8)
#Color palette for country names
label_color <- final.df %>%
arrange(abs(coh_d)) %>%
mutate(new.var = ifelse(country_foc == "China"| country_foc == "Russia", "#6d98c0", "gray30")) %>%
select(new.var) %>%
unlist()
#Font palette for country names
label_face <- final.df %>%
arrange(abs(coh_d)) %>%
mutate(new.var = ifelse(country_foc == "China" | country_foc == "Russia", "bold", "plain")) %>%
select(new.var) %>%
unlist()
#Plot
final.df%>%
ggplot(aes(x = fct_reorder(country_foc, abs(coh_d)), y = coh_d)) +
geom_bar(stat = "identity", aes(fill = Ranking), alpha = .8)+
#China in blue
geom_bar(stat = "identity",data = filter(final.df, country_foc == "China"), fill = "#6d98c0")+
#Russia in blue
geom_bar(stat = "identity",data = filter(final.df, country_foc == "Russia"), fill = "#6d98c0")+
#Add error bars
geom_errorbar(aes(x= fct_reorder(country_foc, abs(coh_d)), ymin=coh_d-coh_se, ymax=coh_d+coh_se), width=0.15, color="#5c5c5c", alpha=0.5, size=.15)+
scale_fill_manual(values = accent_OkabeIto)+
guides(fill=guide_legend(title="GDPPC Gross Ranking"))+
theme_minimal(base_size = 8)+
scale_y_continuous(breaks = c(-0.50,-0.25, 0,0.25,0.50),
labels = c("-0.50","-0.25", "0","0.25","0.50"))+
coord_flip() +
labs(x = "Countries",
y = "Cohen's d",
title = "Effect size Plot",
subtitle = "Reference Country - United States",
caption = "Data Source: World Values Survey")+
theme(panel.grid.minor = element_blank(),
axis.text.y = element_text(color = label_color,
face = label_face),
panel.grid.major.x = element_line(colour = "grey90", linetype = 2, size = 0.5),
panel.grid.major.y = element_line(colour = "grey90", linetype = 1, size = 0.13),
text=element_text(size=10, family="Palatino"))
```
### Draft 1
```{r}
capitalism.d = clean.data %>%
filter(q111 %in% c("1", "2")) %>%
rowwise() %>%
mutate(capitalism = sum(q106, q107r, q108, q109r, q111)) %>%
mutate(capitalism = as.integer(capitalism)) %>%
select(country, capitalism, rel.denom, q262) %>%
data_frame()
cd = coh_d(capitalism.d, capitalism~country) #compute effect sizes for all country pairs
# USA
cd %>%
filter(country_ref == "United States") %>%
mutate(highlight = ifelse(country_foc == 'Chile', T, F)) %>%
select(country_foc, coh_d, highlight) %>%
ggplot(aes(x = fct_reorder(country_foc, abs(coh_d)), y = coh_d, fill = highlight)) +
geom_bar(stat = "identity", aes(fill = highlight), alpha = .8)+
scale_fill_manual(values = c("cornflowerblue", rep("coral1", 46)))+
theme_minimal(base_size = 8)+
coord_flip() +
labs(x = "Countries",
y = "Cohen's d",
title = "Distance from USA")+
guides(fill=FALSE)
```
