# Load package(s)
library(ggplot2)
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.2.1 --
## v tibble 2.1.1 v purrr 0.3.2
## v tidyr 0.8.3 v dplyr 0.8.0.1
## v readr 1.3.1 v stringr 1.4.0
## v tibble 2.1.1 v forcats 0.4.0
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(dplyr)
library(maps)
##
## Attaching package: 'maps'
## The following object is masked from 'package:purrr':
##
## map
library(sp)
library(sf)
## Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3
library(maptools)
## Checking rgeos availability: FALSE
## Note: when rgeos is not available, polygon geometry computations in maptools depend on gpclib,
## which has a restricted licence. It is disabled by default;
## to enable gpclib, type gpclibPermit()
library(cowplot)
##
## Attaching package: 'cowplot'
## The following object is masked from 'package:ggplot2':
##
## ggsave
library(shades)
library(truncnorm)
# Read in the dataset(s)
nh_dem_results<-
read_delim(file = "data/NH_2016pp_dem.txt",
delim = "|")
## Parsed with column specification:
## cols(
## .default = col_double(),
## county = col_character()
## )
## See spec(...) for full column specifications.
nh_rep_results<-
read_delim(file = "data/NH_2016pp_rep.txt",
delim = "|")
## Parsed with column specification:
## cols(
## .default = col_double(),
## county = col_character()
## )
## See spec(...) for full column specifications.
# Setup NH map dataset
nh_dat <- maps::map(
database = "county",
regions = "new hampshire",
plot = FALSE,
fill = TRUE
) %>%
# The st_as_sf() function transforms outside material into simple feature objects.
st_as_sf() %>%
# str_remove indicates the removal of a certiain strings from the dataset, and in this case, it may possibly remove values below 1. Replace ID with
mutate(ID = str_remove(ID, ".*,")) %>%
# We are replacing ID with county.
rename(county = ID)
nh_dem<-nh_dem_results %>%
gather(key = candidate, value = votes, -county) %>%
group_by(county) %>%
summarise(ratio = max(votes) / nth(votes, 2, desc(votes))) %>%
left_join(nh_dat)
p1<-ggplot(nh_dem, aes(geometry = geometry, fill = ratio)) +
ggtitle("Democratic Presidential Primary") +
geom_sf() +
theme_void() +
theme(legend.position = c(0,0.7),
legend.justification = c(0,0.7)) +
scale_fill_continuous(na.value = "grey",
low = "white", high = "black",
limit = c(1.0, 3.0),
breaks = c(1.0, 1.5, 2.0, 2.5, 3.0))+
coord_sf(datum = NA) +
labs(subtitle = "New Hampshire(2016)", fill = "Sanders to Clinton \nRatio")
nh_rep<-nh_rep_results %>%
gather(key = candidate, value = votes, -county) %>%
group_by(county) %>%
summarise(ratio = max(votes) / nth(votes, 2, desc(votes))) %>%
left_join(nh_dat)
p2<-ggplot(nh_rep, aes(geometry = geometry, fill = ratio)) +
ggtitle("Republic Presidential Primary") +
geom_sf() +
theme_void() +
theme(legend.position = c(0,0.7),
legend.justification = c(0,0.7)) +
scale_fill_continuous(na.value = "grey",
low = "white", high = "black",
limit = c(1.0, 3.0),
breaks = c(1.0, 1.5, 2.0, 2.5, 3.0)) +
coord_sf(datum = NA) +
labs(subtitle = "New Hampshire(2016)", fill = "Trump to Kasich* \nRatio")
#Here, I have combined the two plots into one using the plot_grid() function.
plot_grid(p1,p2, align = "h")
This mapping shows a couple interpretations. First, it seems that where the Democratic party is strong, the Republic party is weak, and the opposite works as well. Where the Republic party does well, the Democratic party is weak. Secondly, in the areas where Sanders is going strong, Trump seems to be weak. In the area where Trump seems to go strong, Sanders seems to do week. Based on the ratio maps, the two primaries of Democratic and Republican seems to perform oppositely of each other. That is, where one is weak of one candidate, one is strong of one candidate.
#I have set the seed to 7 so that it will generate the same random numbers each time.
set.seed(7)
#Here, I am creating the dataset for Low values.
x<-rtruncnorm(20, a = 0, b = 3, sd = 0.5)
y<-x + rnorm(20, mean = 0)
Low = data.frame(x, y)
Low$newcolumn<-"Low"
names(Low)[3]<-"Group"
#Here, I am creating the dataset for Medium values.
x<-rtruncnorm(20, a = 1.5, b = 4.5, sd = 1)
y<-x + rnorm(20, mean = 0)
Medium= data.frame(x,y)
Medium$newcolumn<-"Medium"
names(Medium)[3]<-"Group"
#Here, I am creating the dataset for High values.
x<-rtruncnorm(20, a = 3, b = 6, sd = 2)
y<-x + rnorm(20, mean = 0)
High = data.frame(x, y)
High$newcolumn<-"High"
names(High)[3]<-"Group"
#Here, I have combined Low, Medium, High value datasets to create one dataset.
Exercise2<-rbind(Low,Medium,High)
ggplot(Exercise2, aes(x, y)) +
geom_point(aes(size = 0.9, shape = Group, colour = Group)) +
stat_ellipse(geom = "polygon", alpha = 0.2,
aes(fill = Group, colour = Group)) +
guides(size = FALSE,
shape = guide_legend(override.aes = list(size = 4))) +
theme(legend.position = c(0.07, 0.8),
legend.key = element_rect(size = 0.9),
legend.key.width = unit(0.9, "cm"),
legend.key.height = unit(0.9, "cm"))
#Here, I have created the x values that range from -1 to 1 by 0.01, and have repeated the sequence of those values.
xvalue <- seq(-1, 1, by = 0.01)
x<-rep(xvalue, 201)
#Here, I have created the y values that range from -1 to 1 by 0.01, and have repeated each number by 201 times.
yvalue <- seq(-1, 1, by = 0.01)
y<-rep(yvalue, each = 201)
#Here, I have created the Exercise3 dataset that includes x,y, and fill_amount columns and their distinctive values.
Exercise3<-data.frame(x,y)
Exercise3$newColumn<-"fill_amount"
names(Exercise3)[3]<-"fill_amount"
#Here, I have set fill_amount to equal x^3-y.
Exercise3$fill_amount<-(Exercise3$x)^3-Exercise3$y
#Here, I have combined red and blue to form the color of the line of the function of x^3.
functioncolour <- addmix("red", "blue")
#Here, I have created an equation that will help create the x^3 line function.
equation <- function(x) {x^3}
ggplot(Exercise3, aes(x,y)) +
geom_tile(aes(fill = fill_amount)) +
theme_minimal() +
scale_fill_gradientn(limits = c(-2, 2),
colours = c("red", "white", "blue")) +
stat_function(fun = equation, aes(color = "functioncolour")) +
guides(colour = FALSE) +
theme(legend.text = element_text(size = 9),
panel.grid = element_blank()) +
labs(fill = "") +
annotate(geom = "text", x = 0,y = 0.2, size = 8,
#parse enables us to plot x^3 properly on the panel.
parse = TRUE,
label = as.character(expression(x^{3})))