# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
BACI.diff.log <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1))), infer=TRUE)
BACI.ratio    <- summary(pairs(fit.emmo, type="response"))
list(fit=fit,
BACI.diff.log=BACI.diff.log,
BACI.ratio=BA.ratio)
})
# Get all of the fits and store them in a list with the emmeans computatons
baci.fits <- plyr::dlply(cue.data, c("Watershed","Species","AgeClass"), function(x){
#browser()
x$YearF <- factor(x$Year)
# If we use the log() in the fit, the emmeans package can do the back transform automatically for us
fit <- lmerTest::lmer(log(CUE+offset) ~ BA + CI + BA:CI + (1|YearF) +(1|Stream) +(1|YearF:Stream), data=x)
# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
BACI.diff.log <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1))), infer=TRUE)
BACI.ratio    <- summary(pairs(fit.emmo, type="response"))
list(fit=fit,
BACI.diff.log=BACI.diff.log,
BACI.ratio=BACI.ratio)
})
# Show the results for the first fit
baci.fits[[1]]$fit
# Get all of the fits and store them in a list with the emmeans computatons
baci.fits <- plyr::dlply(cue.data, c("Watershed","Species","AgeClass"), function(x){
browser()
x$YearF <- factor(x$Year)
# If we use the log() in the fit, the emmeans package can do the back transform automatically for us
fit <- lmerTest::lmer(log(CUE+offset) ~ BA + CI + BA:CI + (1|YearF) +(1|Stream) +(1|YearF:Stream), data=x)
# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
BACI.diff.log <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1))), infer=TRUE)
BACI.ratio    <- summary(pairs(fit.emmo, type="response"))
list(fit=fit,
BACI.diff.log=BACI.diff.log,
BACI.ratio=BACI.ratio)
})
x$YearF <- factor(x$Year)
# If we use the log() in the fit, the emmeans package can do the back transform automatically for us
fit <- lmerTest::lmer(log(CUE+offset) ~ BA + CI + BA:CI + (1|YearF) +(1|Stream) +(1|YearF:Stream), data=x)
# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
n.streams <- plyr::ddply(cue.data, "Watershed", plyr::summarize,
n.control  =length(unique(Stream[ CI=="C"])),
n.treatment=length(unique(Stream[ CI=="T"])))
n.streams
watershed.exclude <- n.streams[ n.streams$n.control==0 | n.streams$n.treatment==0,]
watershed.exclude
dim(cue.data)
dim(cue.data.red)
dim(cue.data)
cue.data.red <- cue.data[ !cue.data$Watershed %in% watershed.exclude$Watershed, ]
dim(cue.data.red)
# Get all of the fits and store them in a list with the emmeans computatons
baci.fits <- plyr::dlply(cue.data, c("Watershed","Species","AgeClass"), function(x){
#browser()
x$YearF <- factor(x$Year)
# If we use the log() in the fit, the emmeans package can do the back transform automatically for us
fit <- lmerTest::lmer(log(CUE+offset) ~ BA + CI + BA:CI + (1|YearF) +(1|Stream) +(1|YearF:Stream), data=x)
# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
BACI.diff.log <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1))), infer=TRUE)
BACI.ratio    <- summary(pairs(fit.emmo, type="response"))
list(fit=fit,
BACI.diff.log=BACI.diff.log,
BACI.ratio=BACI.ratio)
})
# Get all of the fits and store them in a list with the emmeans computatons
baci.fits <- plyr::dlply(cue.data.red, c("Watershed","Species","AgeClass"), function(x){
#browser()
x$YearF <- factor(x$Year)
# If we use the log() in the fit, the emmeans package can do the back transform automatically for us
fit <- lmerTest::lmer(log(CUE+offset) ~ BA + CI + BA:CI + (1|YearF) +(1|Stream) +(1|YearF:Stream), data=x)
# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
BACI.diff.log <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1))), infer=TRUE)
BACI.ratio    <- summary(pairs(fit.emmo, type="response"))
list(fit=fit,
BACI.diff.log=BACI.diff.log,
BACI.ratio=BACI.ratio)
})
# Show the results for the first fit
baci.fits[[1]]$fit
baci.fits[[1]]$BACI.diff.log
baci.fits[[1]]$BACI.ratio
# Get all of the fits and store them in a list with the emmeans computatons
baci.fits <- plyr::dlply(cue.data.red, c("Watershed","Species","AgeClass"), function(x){
#browser()
x$YearF <- factor(x$Year)
# If we use the log() in the fit, the emmeans package can do the back transform automatically for us
fit <- lmerTest::lmer(log(CUE+offset) ~ BA + CI + BA:CI + (1|YearF) +(1|Stream) +(1|YearF:Stream), data=x)
# we create the emmeans object and then find the pairwise difference
fit.emmo <- emmeans::emmeans(fit, ~BA:CI)
BACI.diff.log <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1))), infer=TRUE)
BACI.ratio    <- summary(contrast(fit.emmo,list(baci=c(1,-1,-1,1)), type="response"))
list(fit=fit,
BACI.diff.log=BACI.diff.log,
BACI.ratio=BACI.ratio)
})
# Show the results for the first fit
baci.fits[[1]]$fit
baci.fits[[1]]$BACI.diff.log
baci.fits[[1]]$BACI.ratio
# Get all of the fits and store them in a list with the emmeans computatons
baci.effs <- plyr::ldply(baci.fits, function(x){x$BACI.diff.log})
head(baci.effs)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(p.value, eps=.0001), aes(x=-Inf))+
facet_grid(Species~AgeClass)
head(baci.effs)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf))+
facet_grid(Species~AgeClass)
help(geom_text
)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf), nudge_x=.1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf), nudge_x=.2)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf), hjust=1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf), hjust=-.1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf), hjust=-.01)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, eps=.0001), aes(x=-Inf), hjust=-.01, vjust=.1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=3,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=.1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=3,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=.5)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=3,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=3,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=1.1)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=3,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=1.5)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci and p-value")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=3,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=1.5)+
facet_grid(Species~AgeClass)
ggplot(data=baci.effs, aes(y=Watershed, x=estimate))+
ggtitle("Estimated BACI effects (log scale)")+
geom_point()+
geom_errorbarh( aes(xmin=lower.CL, xmax=upper.CL), height=.01)+
xlab("Estimated BACI effect (log-scale) and 95% ci and p-value")+
ylab("Watershed")+
geom_vline(xintercept=0)+
geom_text( label=format.pval(baci.effs$p.value, digits=2,eps=.0001), aes(x=-Inf), hjust=-.01, vjust=1.5)+
facet_grid(Species~AgeClass)
source("http:://www.stat.sfu.ca/~cschwarz/Stat-650/Notes/MyPrograms/schwarz.functions.r")
source("http:://www.stat.sfu.ca/~cschwarz/Stat-650/Notes/MyPrograms/schwarz.functions.R")
source("http://www.stat.sfu.ca/~cschwarz/Stat-650/Notes/MyPrograms/schwarz.functions.R")
source("http://www.stat.sfu.ca/~cschwarz/Stat-650/Notes/MyPrograms/schwarz.functions.r")
# The dianostic plot is produced for the first fit as a demonstration
plyr::l_ply(ba.fits[1], function(x){
diag.plot <- sf.autoplot.lmer(x$fit)
plot(diag.plot)
})
# The dianostic plot is produced for the first fit as a demonstration
plyr::l_ply(ba.fits[1], function(x){
diag.plot <- sf.autoplot.lmer(x$fit)
plot(diag.plot)
})
# The dianostic plot is produced for the first fit as a demonstration
plyr::l_ply(ba.fits[2], function(x){
diag.plot <- sf.autoplot.lmer(x$fit)
plot(diag.plot)
})
# The dianostic plot is produced for the first fit as a demonstration
plyr::l_ply(baci.fits[1], function(x){
diag.plot <- sf.autoplot.lmer(x$fit)
plot(diag.plot)
})
setwd("~/Dropbox/Stat-R/CourseNotes/Rcode")
# R code for spatial data processing
library(ggplot2)
library(sf)
library(spData)
# Look at the world dataset
library(spData)
head(world)
str(world)
plot1 <- ggplot()+
geom_sf(data=world, aes(fill=lifeExp))+
ggtitle("Life Expectancy")
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","world-001.png"), h=4, w=6, units="in",dpi=300)
# select only Africa
africa <- world[ world$continent=="Africa",]
plot2 <- ggplot()+
geom_sf(data=africa, aes(fill=lifeExp))+
ggtitle("Life Expectancy in Africa")
ggsave(plot2,
file=file.path("..","..","MyStuff","Images","Spatial","world-002.png"), h=4, w=6, units="in",dpi=300)
plot3 <- ggplot()+
geom_sf(data=africa, aes(fill=lifeExp))+
ggtitle("Life Expectancy in part of Africa")+
xlim(0,40)+ylim(0,-40)
plot3
ggsave(plot3,
file=file.path("..","..","MyStuff","Images","Spatial","world-003.png"), h=4, w=6, units="in",dpi=300)
# Create your own spatial features
# First location of SFU
SFU.sf <- sf::st_point(  c(-122.917957, 49.276765 ))
str(SFU.sf)
my.drive.csv <- textConnection("
long, lat
-122.84378900000002, 49.29009199999999
-122.82799615332033, 49.28426960031931
-122.82696618505861, 49.27755059244836
-122.86679162451173, 49.27676664856581
-122.88790597387697, 49.26276555269492
-122.90833367773439, 49.26534205263451
-122.92532815405275, 49.273518748310764
-122.91434182592775, 49.27766258341439")
my.drive <- read.csv(my.drive.csv, header=TRUE, as.is=TRUE, strip.white=TRUE)
my.drive.sf <- sf::st_linestring(as.matrix(my.drive[, c("long","lat")]))
str(my.drive.sf)
plot1 <- ggplot() +
ggtitle("My drive to work")+
geom_sf(data=SFU.sf, color="red", size=4)+
geom_sf(data=my.drive.sf, color="black", size=2, inherits.aes=FALSE)+
ylab("Latitude")+xlab("Longitude")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","my-drive-001.png"),
h=4, w=6, units="in", dpi=300)
### Adding a background map
library(ggmap)
sfu.coord <- c(-122.917957, 49.276765 )
# get the map from stamen. You can fiddle with the zoom to get the right scale
my.commute.map.dl <- ggmap::get_map(c(left=sfu.coord[1]-.02, bottom=sfu.coord[2]-.02, right=sfu.coord[1]+.12, top=sfu.coord[2]+.03),
maptype="watercolor",  source="stamen")
my.commute.map <- ggmap(my.commute.map.dl)
# careful, ggmap uses lon/lat but sf uses long/lat
# you need to not use the aed from the ggmap
plot1 <- my.commute.map +
ggtitle("My drive to work")+
geom_sf(data=SFU.sf, color="red", size=4, inherit.aes=FALSE)+
geom_sf(data=my.drive.sf, color="black", size=2, inherit.aes=FALSE)+
ylab("Latitude")+xlab("Longitude")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","my-drive-002.png"),
h=4, w=6, units="in", dpi=300)
#################
#  Exercise I
# Plot the mean location of accidents over time for fatal accidents
# Read in the accident data and get the date and fatality variables set
accidents <- read.csv(file.path("..","sampledata","Accidents","road-accidents-2010.csv"), header=TRUE,
as.is=TRUE, strip.white=TRUE)
# Convert date to internal date format
accidents$mydate <- as.Date(accidents$Date, format="%d/%m/%Y")
# Create the fatality variable
accidents$Fatality <- accidents$Accident_Severity == 1
accidents[1:5,]
accidents$month <- lubridate::month(accidents$mydate)
# Find the mean location by month
library(dplyr)
mean.fatal.location <-
accidents %>%
filter( Fatality==1) %>%
group_by(month) %>%
summarize( mean.long=mean(Longitude), mean.lat=mean(Latitude))
mean.fatal.location
mean.fatal.location.path.sf <- sf::st_linestring( as.matrix(mean.fatal.location[,c("mean.long","mean.lat")]))
plot0 <- ggplot()+
geom_sf(data=mean.fatal.location.sf, color="red")+
geom_text(data=mean.fatal.location, aes(x=mean.long, y=mean.lat, label=month))
plot0
ggsave(plot0,
file=file.path("..","..","MyStuff","Images","Spatial","mean-accident-location-000.png"),
h=4, w=6, units="in", dpi=300)
mean.lat <- mean(accidents$Latitude)
mean.long<- mean(accidents$Longitude)
my.map.dl <- ggmap::get_map(c(left  =min(accidents$Longitude), bottom=min(accidents$Latitude),
right =max(accidents$Longitude), top   =max(accidents$Latitude)),
maptype="watercolor",  source="stamen", zoom=6)
my.map <- ggmap(my.map.dl)
plot1 <- my.map +
ggtitle("Mean location of fatal accidents by month")+
geom_sf(data=mean.fatal.location.sf, color="red", inherit.aes=FALSE)+
geom_text(data=mean.fatal.location, aes(x=mean.long, y=mean.lat, label=month))+
ylab("Latitude")+xlab("Longitude")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","mean-accident-location-001.png"),
h=4, w=6, units="in", dpi=300)
##################
# What is the CRS/
library(spData)
head(world)
str(world)
sf::st_crs(world)
luxembourg = world[world$name_long == "Luxembourg", ]
st_area(luxembourg)
# careful about setting units
# right number but wrong units
st_area(luxembourg) / 1000000
#> 2414 [m^2]
# right number with right units
units::set_units(st_area(luxembourg), km^2)
#> 2414 [km^2]
# Setting and converting CRS
st_crs(my.commute.map)
st_crs(my.drive.sf)
st_crs(4326)
my.drive.sf2 <- st_sf(geometry=st_sfc(my.drive.sf, crs=4326))
st_crs(my.drive.sf2)
st_length(my.drive.sf2)
st_length(my.drive.sf)
######################################################
############################################################################################################
######################################################
# Attribute operations
names(world)
my.world <- world
my.world$pop.density <- my.world$pop / my.world$area_km2
plot1 <- ggplot()+
geom_sf(data=my.world, aes(fill=pop.density))+
ggtitle("Population density")+
scale_fill_gradient(na.value="white", trans="reverse")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","world-pop-density.png"), h=4, w=6, units="in",dpi=300)
library(spData)
names(coffee_data)
setdiff(my.world$name_long, coffee_data$name_long)
setdiff(coffee_data$name_long, my.world$name_long)
coffee_data$name_long[ coffee_data$name_long=="Congo, Dem. Rep. of"] <- "Democratic Republic of the Congo"
setdiff(coffee_data$name_long, my.world$name_long)
my.world2 <- merge(my.world, coffee_data, all.x=TRUE)
plot1 <- ggplot()+
geom_sf(data=my.world2, aes(fill=coffee_production_2016))+
scale_fill_gradient(trans="reverse", na.value="white")+
ggtitle("Coffee production 2016")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","world-coffee-2016.png"), h=4, w=6, units="in",dpi=300)
# Show what happens if forget to use all.x=TRUE
my.world3 <- merge(my.world, coffee_data)
plot1 <- ggplot()+
geom_sf(data=my.world3, aes(fill=coffee_production_2016))+
ggtitle("Coffee production 2016")
plot1
#########################################################
#  Aggregate populations to continent and compute density of resulting continents
names(world)
cont <-
world %>%
group_by(continent) %>%
summarize(
total.pop =sum(pop,na.rm=TRUE),
total.area=sum(area_km2, na.rm=TRUE),
density = total.pop / total.area)
str(cont)
cont
plot1 <- ggplot()+
geom_sf(data=cont, aes(fill=continent))
scale_fill_gradient(trans="reverse", na.value="white")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","world-cont.png"), h=4, w=6, units="in",dpi=300)
plot1 <- ggplot()+
geom_sf(data=cont, aes(fill=density))+
scale_fill_gradient(trans="reverse", na.value="white")
plot1
ggsave(plot1,
file=file.path("..","..","MyStuff","Images","Spatial","world-cont-density.png"), h=4, w=6, units="in",dpi=300)
#################################################################################
#################################################################################
#################################################################################
#################################################################################
# Look at proportion never married from the 2016 census at the FSA level
tempdir()
help(unzip)
# Get the FSA
# We unzip the compressed file to a temporary directory, and then point to the shape file
fsa.dir <- tempdir()
unzip(file.path("..","sampledata","2016-census","FSA","lfsa000b16a_e.zip",  exdir=fsa.dir))
fsa.dir
unzip(file.path("..","sampledata","2016-census","FSA","lfsa000b16a_e.zip"),  exdir=fsa.dir)
fsa <- sf::st_read(file.path(fsa.dir,"lfsa000b16a_e.shp"), stringsAsFactors=FALSE)
head(fsa)
# Extract only bc in the lower mainland
xtabs(~PRNAME, data=fsa, exclude=NULL, na.action=na.pass)
fsa <- fsa[ substr(fsa$CFSAUID,1,2) %in% c("V3","V4","V5","V6","V7"),]
fsa <- sf::st_simplify(fsa, dTolerance=200)
plot1 <- ggplot()+
geom_sf(data=fsa, aes(fill=NULL))
plot1
# Get the FSA
# We unzip the compressed file to a temporary directory, and then point to the shape file
fsa.dir <- tempdir()
unzip(file.path("..","sampledata","2016-census","FSA","lfsa000b16a_e.zip"),  exdir=fsa.dir)
fsa <- sf::st_read(file.path(fsa.dir,"lfsa000b16a_e.shp"), stringsAsFactors=FALSE)
setwd("~/Dropbox/Stat-R/CourseNotes/Rcode/Rcourse-shiny/050-temperature-by-city-map")
# get map of Canada
# This is stored in zip file that contains the shape file.
# We unzip to a temporary directory; read the shape file etc.
# The temporary directory will then disappear at the end of the session.
canada.map.dir <- tempdir()
unzip(file.path("..","sampledata","Climate-Daily-Canada","CanadaMap","gpr_000b11a_e.zip"),  exdir=canada.map.dir)
unzip(file.path("..","..","..","sampledata","Climate-Daily-Canada","CanadaMap","gpr_000b11a_e.zip"),  exdir=canada.map.dir)
unzip(file.path("..","..","..","sampledata","Climate-Daily-Canada-2018","CanadaMap","gpr_000b11a_e.zip"),  exdir=canada.map.dir)
canada <- sf::st_read(file.path(canada.map.dir,"gpr_000b11a_e.shp"), stringsAsFactors=FALSE)
canada <- sf::st_simplify(canada, dTolerance=units::set_units(.1, degree))
shiny::runApp()
