Heat Map of Earthquake by Geocodes - r

I would like to plot the heat of earthquake acceleration at Gilroy California. The following is my data; geocodes of each point is in decimal.
lon lat Acc.
-121.5897466 36.98443922 0.308722537
-121.5776472 36.98446622 0.343560598
-121.5657399 36.98449289 0.316238725
-121.5528172 36.98452208 0.289579654
-121.5397651 36.98455121 0.278277577
-121.6022388 36.9957913 0.321904187
-121.5897466 36.99578578 0.346187454
-121.57767 36.99578046 0.323865427
-121.5657514 36.99577518 0.296775313
-121.5528643 36.99576944 0.281054324
-121.5398582 36.99576372 0.270957516
-121.6264404 37.00268339 0.3504049
-121.614493 37.00268494 0.343426824
-121.6022388 37.00268646 0.34803746
-121.5897466 37.00268806 0.316975267
-121.5776805 37.00268967 0.300399358
-121.5657618 37.00269118 0.290519468
-121.5528861 37.0026927 0.27529488
-121.5399123 37.00269441 0.264715439
-121.6264404 37.01301756 0.352218819
-121.614493 37.01301354 0.342255779
-121.6022388 37.01300933 0.333444018
-121.5897466 37.01300512 0.315921346
-121.5777013 37.01300115 0.302762624
-121.5657723 37.01299709 0.291672835
-121.5529293 37.01299261 0.266912813
-121.614493 37.0204378 0.327864875
-121.6022388 37.0204297 0.321358226
-121.5897466 37.0204215 0.305797414
-121.5777125 37.02041366 0.293992548
-121.5657835 37.0204058 0.283948148
-121.614493 37.0299123 0.313950088
-121.6022388 37.02991694 0.303625182
-121.5897466 37.02992166 0.291511686
-121.5777299 37.02992617 0.282628812
-121.5657949 37.02993068 0.271427682
The following is my code:
GilroyMap= qmap(location = c(lon = -121.5837188, lat = 37.007846),zoom=12,color="color",legend="topleft",maptype = "terrain", darken=0.0, extent = "device")
data$C <- cut(data$Acc., breaks=10)
Q=GilroyMap+stat_density2d(data = data, aes(x = lon, y = lat,fill = Acc. ), colour = NA, alpha = 0.5) +
scale_fill_distiller(palette =1 , breaks = pretty_breaks(n = 10)) +
labs(fill = "") +
theme_nothing(legend = TRUE) +guides(fill = guide_legend(reverse = TRUE, override.aes = list(alpha = 1)))
It does not work!

How about a solution using Google Maps (to use it you need an api key)?
library(googleway)
mapKey <- 'your_api_key'
google_map(key = mapKey) %>%
add_heatmap(data = df, weight = "Acc.", option_radius = 0.02)

You may want to use ggplot and ggmap packages:
library(ggmap)
library(ggplot2)
gilroy <- get_map(location = 'gilroy', zoom =12)
ggmap(gilroy)
rbPal <- colorRampPalette(c('blue','red'))
mydata$Col <- rbPal(10)[as.numeric(cut(mydata$Acc.,breaks = 10))]
ggmap(gilroy, extent = "device") + geom_point(aes(x = lon, y = lat), colour = mydata$Col,
alpha = mydata$Acc., size = 6, shape = 15, data = mydata)
This will give us:
You can also do this using plotly package in reference to Maps in R;
library(plotly)
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
showland = TRUE,
landcolor = toRGB("gray95"),
subunitcolor = toRGB("gray85"),
countrycolor = toRGB("gray85"),
countrywidth = 0.5,
subunitwidth = 0.5)
p <- plot_geo(mydata, lat = ~lat, lon = ~lon) %>%
add_markers( text = ~paste(lat, lon, Acc.,sep = "<br />"),
color = ~Acc., symbol = I("square"), size = I(8), hoverinfo = "Acc."
) %>%
colorbar(title = "Acc.") %>%
layout(
title = 'California Earthquake', geo = g)
Data:
#42-: "It would, however, be better practice to change all instances of data to a name that was not also an R-function name" (i.e. mydata).
read.table(text='lon lat Acc.
-121.5897466 36.98443922 0.308722537
-121.5776472 36.98446622 0.343560598
-121.5657399 36.98449289 0.316238725
-121.5528172 36.98452208 0.289579654
-121.5397651 36.98455121 0.278277577
-121.6022388 36.9957913 0.321904187
-121.5897466 36.99578578 0.346187454
-121.57767 36.99578046 0.323865427
-121.5657514 36.99577518 0.296775313
-121.5528643 36.99576944 0.281054324
-121.5398582 36.99576372 0.270957516
-121.6264404 37.00268339 0.3504049
-121.614493 37.00268494 0.343426824
-121.6022388 37.00268646 0.34803746
-121.5897466 37.00268806 0.316975267
-121.5776805 37.00268967 0.300399358
-121.5657618 37.00269118 0.290519468
-121.5528861 37.0026927 0.27529488
-121.5399123 37.00269441 0.264715439
-121.6264404 37.01301756 0.352218819
-121.614493 37.01301354 0.342255779
-121.6022388 37.01300933 0.333444018
-121.5897466 37.01300512 0.315921346
-121.5777013 37.01300115 0.302762624
-121.5657723 37.01299709 0.291672835
-121.5529293 37.01299261 0.266912813
-121.614493 37.0204378 0.327864875
-121.6022388 37.0204297 0.321358226
-121.5897466 37.0204215 0.305797414
-121.5777125 37.02041366 0.293992548
-121.5657835 37.0204058 0.283948148
-121.614493 37.0299123 0.313950088
-121.6022388 37.02991694 0.303625182
-121.5897466 37.02992166 0.291511686
-121.5777299 37.02992617 0.282628812
-121.5657949 37.02993068 0.271427682', header=TRUE, quote='"') ->
mydata #named to have both code sections work and avoid a function name.

Related

How to add additional statistics on top of a combined ggplot2 graph that uses a multi-variable object or two separate objects

I have a ggplot2 graph which plots two separate violin plots onto one graph, given by this example (thanks to #jared_mamrot for providing it):
library(tidyverse)
data("Puromycin")
head(Puromycin)
dat1 <- Puromycin %>%
filter(state == "treated")
dat2 <- Puromycin %>%
filter(state == "untreated")
mycp <- ggplot() +
geom_violin(data = dat1, aes(x= state, y = conc, colour = "Puromycin (Treatment1)")) +
geom_violin(data = dat2, aes(x= state, y = conc, colour = "Puromycin (Treatment2)"))
mycp
I would like to add a boxplot or other summary statistics such as those in http://www.sthda.com/english/wiki/ggplot2-violin-plot-quick-start-guide-r-software-and-data-visualization and https://www.maths.usyd.edu.au/u/UG/SM/STAT3022/r/current/Misc/data-visualization-2.1.pdf, but trying the code suggested in those places does not change the original plot.
mycp + geom_boxplot()
Thanks for reading and hopefully this makes sense!
UPDATE ==========================================================================
So the above example does not reflect exactly my situation I realize now. Essentially, I want to apply statistics onto a combined ggplot2 graph that uses two separate objects as its variables (here TNBC_List1 and ER_List1) Here is an example that does (sorry for the longer example, I will admit I am having trouble creating a simpler reproducible example and I am very new to coding in general):
# Libraries -------------------------------------------------------------
library(BiocManager)
library(GEOquery)
library(plyr)
library(dplyr)
library(Matrix)
library(devtools)
library(Seurat)
library(ggplot2)
library(cowplot)
library(SAVER)
library(metap)
library(multtest)
# Loading Raw Data into RStudio ----------------------------------
filePaths = getGEOSuppFiles("GSE75688")
tarF <- list.files(path = "./GSE75688/", pattern = "*.tar", full.names = TRUE)
tarF
untar(tarF, exdir = "./GSE75688/")
gzipF <- list.files(path = "./GSE75688/", pattern = "*.gz", full.names = TRUE)
ldply(.data = gzipF, .fun = gunzip)
list.files(path = "./GSE75688/", full.names = TRUE)
list.files(path = "./GSE75688/", pattern = "\\.txt$",full.names = TRUE)
# full matrix ----------------------------------------------------------
fullmat <- read.table(file = './GSE75688//GSE75688_GEO_processed_Breast_Cancer_raw_TPM_matrix.txt',
sep = '\t', header = FALSE, stringsAsFactors = FALSE)
fullmat <- data.frame(fullmat[,-1], row.names=fullmat[,1])
colnames(fullmat) <- as.character(fullmat[1, ])
fullmat <- fullmat[-1,]
fullmat <- as.matrix(fullmat)
# BC01 ER+ matrix -----------------------------------------------------------
BC01mat <- grep(pattern =c("^BC01") , x = colnames(fullmat), value = TRUE)
BC01mat = fullmat[,grepl(c("^BC01"),colnames(fullmat))]
BC01mat = BC01mat[,!grepl("^BC01_Pooled",colnames(BC01mat))]
BC01mat = BC01mat[,!grepl("^BC01_Tumor",colnames(BC01mat))]
BC01pdat <- data.frame("samples" = colnames(BC01mat), "treatment" = "ER+")
# BC07 TNBC matrix -----------------------------------------------------------
BC07mat <- grep(pattern =c("^BC07") , x = colnames(fullmat), value = TRUE)
BC07mat <- fullmat[,grepl(c("^BC07"),colnames(fullmat))]
BC07mat <- BC07mat[,!grepl("^BC07_Pooled",colnames(BC07mat))]
BC07mat <- BC07mat[,!grepl("^BC07_Tumor",colnames(BC07mat))]
BC07mat <- BC07mat[,!grepl("^BC07LN_Pooled",colnames(BC07mat))]
BC07mat <- BC07mat[,!grepl("^BC07LN",colnames(BC07mat))]
BC07pdat <- data.frame("samples" = colnames(BC07mat), "treatment" = "TNBC")
#merge samples together =========================================================================
joined <- cbind(BC01mat, BC07mat)
pdat_joined <- rbind(BC01pdat, BC07pdat)
#fdat ___________________________________________________________________________________
fdat <- grep(pattern =c("gene_name|gene_type") , x = colnames(fullmat), value = TRUE)
fdat <- fullmat[,grepl(c("gene_name|gene_type"),colnames(fullmat))]
fdat <- as.data.frame(fdat, stringsAsFactors = FALSE)
fdat <- setNames(cbind(rownames(fdat), fdat, row.names = NULL),
c("ensembl_id", "gene_short_name", "gene_type"))
rownames(pdat_joined) <- pdat_joined$samples
rownames(fdat) = make.names(fdat$gene_short_name, unique=TRUE)
rownames(joined) <- rownames(fdat)
# Create Seurat Object __________________________________________________________________
joined <- as.data.frame(joined)
sobj_pre <- CreateSeuratObject(counts = joined)
sobj_pre <-AddMetaData(sobj_pre,metadata=pdat_joined)
head(sobj_pre#meta.data)
#gene name input
sobj_pre[["RNA"]]#meta.features<-fdat
head(sobj_pre[["RNA"]]#meta.features)
#Downstream analysis -------------------------------------------------------
sobj <- sobj_pre
sobj <- FindVariableFeatures(object = sobj, mean.function = ExpMean, dispersion.function = LogVMR, nfeatures = 2000)
sobj <- ScaleData(object = sobj, features = rownames(sobj), block.size = 2000)
sobj <- RunPCA(sobj, npcs = 100, ndims.print = 1:10, nfeatures.print = 5)
sobj <- FindNeighbors(sobj, reduction = "pca", dims = 1:4, nn.eps = 0.5)
sobj <- FindClusters(sobj, resolution = 1, n.start = 10)
umap.method = 'umap-learn'
metric = 'correlation'
sobj <- RunUMAP(object = sobj, reduction = "pca", dims = 1:4,min.dist = 0.5, seed.use = 123)
p0 <- DimPlot(sobj, reduction = "umap", pt.size = 0.1,label=TRUE) + ggtitle(label = "Title")
p0
# ER+ score computation -------------------
ERlist <- list(c("CPB1", "RP11-53O19.1", "TFF1", "MB", "ANKRD30B",
"LINC00173", "DSCAM-AS1", "IGHG1", "SERPINA5", "ESR1",
"ILRP2", "IGLC3", "CA12", "RP11-64B16.2", "SLC7A2",
"AFF3", "IGFBP4", "GSTM3", "ANKRD30A", "GSTT1", "GSTM1",
"AC026806.2", "C19ORF33", "STC2", "HSPB8", "RPL29P11",
"FBP1", "AGR3", "TCEAL1", "CYP4B1", "SYT1", "COX6C",
"MT1E", "SYTL2", "THSD4", "IFI6", "K1AA1467", "SLC39A6",
"ABCD3", "SERPINA3", "DEGS2", "ERLIN2", "HEBP1", "BCL2",
"TCEAL3", "PPT1", "SLC7A8", "RP11-96D1.10", "H4C8",
"PI15", "PLPP5", "PLAAT4", "GALNT6", "IL6ST", "MYC",
"BST2", "RP11-658F2.8", "MRPS30", "MAPT", "AMFR", "TCEAL4",
"MED13L", "ISG15", "NDUFC2", "TIMP3", "RP13-39P12.3", "PARD68"))
sobj <- AddModuleScore(object = sobj, features = ERlist, name = "ER_List")
#TNBC computation -------------------
tnbclist <- list(c("FABP7", "TSPAN8", "CYP4Z1", "HOXA10", "CLDN1",
"TMSB15A", "C10ORF10", "TRPV6", "HOXA9", "ATP13A4",
"GLYATL2", "RP11-48O20.4", "DYRK3", "MUCL1", "ID4", "FGFR2",
"SHOX2", "Z83851.1", "CD82", "COL6A1", "KRT23", "GCHFR",
"PRICKLE1", "GCNT2", "KHDRBS3", "SIPA1L2", "LMO4", "TFAP2B",
"SLC43A3", "FURIN", "ELF5", "C1ORF116", "ADD3", "EFNA3",
"EFCAB4A", "LTF", "LRRC31", "ARL4C", "GPNMB", "VIM",
"SDR16C5", "RHOV", "PXDC1", "MALL", "YAP1", "A2ML1",
"RP1-257A7.5", "RP11-353N4.6", "ZBTB18", "CTD-2314B22.3", "GALNT3",
"BCL11A", "CXADR", "SSFA2", "ADM", "GUCY1A3", "GSTP1",
"ADCK3", "SLC25A37", "SFRP1", "PRNP", "DEGS1", "RP11-110G21.2",
"AL589743.1", "ATF3", "SIVA1", "TACSTD2", "HEBP2"))
sobj <- AddModuleScore(object = sobj, features = tnbclist, name = "TNBC_List")
#ggplot2 issue ----------------------------------------------------------------------------
sobj[["ClusterName"]] <- Idents(object = sobj)
sobjlists <- FetchData(object = sobj, vars = c("ER_List1", "TNBC_List1", "ClusterName"))
library(reshape2)
melt(sobjlists, id.vars = c("ER_List1", "TNBC_List1", "ClusterName"))
p <- ggplot() + geom_violin(data = sobjlists, aes(x= ClusterName, y = ER_List1, fill = ER_List1, colour = "ER+ Signature"))+ geom_violin(data = sobjlists, aes(x= ClusterName, y = TNBC_List1, fill = TNBC_List1, colour="TNBC Signature"))
Extension ======================================================================
If you want to do this but with two objects (sobjlists1 and sobjlists2, for example) instead of what my example showed (two variables but one object), rbind the two and then do what #StupidWolf says
library(reshape2)
sobjlists1= melt(sobjlists1, id.vars = "treatment")
sobjlists2= melt(sobjlists2, id.vars = "treatment")
combosobjlists <- rbind(sobjlists1, sobjlists2)
and then continue on with their code using combosobjlists:
ggplot(combosobjlists,aes(x= ClusterName, y = value)) +
geom_violin(aes(fill=variable)) +
geom_boxplot(aes(col=variable),
width = 0.2,position=position_dodge(0.9))
Hope this thread helps!
Try to include just the minimum code to show your problem. Like in your example, there's no need to start with the whole seurat processing. You can just provide the data.frame with dput() and we can see the issue with ggplot2 , see this post.
Create some example data:
library(Seurat)
library(ggplot2)
genes = c(unlist(c(ERlist,tnbclist)))
mat = matrix(rnbinom(500*length(genes),mu=500,size=1),ncol=500)
rownames(mat) = genes
colnames(mat) = paste0("cell",1:500)
sobj = CreateSeuratObject(mat)
sobj = NormalizeData(sobj)
Add some made-up cluster:
sobj$ClusterName = factor(sample(0:1,ncol(sobj),replace=TRUE))
Add your module score:
sobj = AddModuleScore(object = sobj, features = tnbclist,
name = "TNBC_List",ctrl=5)
sobj = AddModuleScore(object = sobj, features = ERlist,
name = "ER_List",ctrl=5)
We get the data, what you need to do is to pivot it long correctly. Plotting it twice with ggplot2 is going to cause all kinds of problem:
sobjlists = FetchData(object = sobj, vars = c("ER_List1", "TNBC_List1", "ClusterName"))
head(sobjlists)
ER_List1 TNBC_List1 ClusterName
cell1 -0.05391108 -0.008736057 1
cell2 0.07074816 -0.039064126 1
cell3 0.08688374 -0.066967324 1
cell4 -0.12503649 0.120665057 0
cell5 0.05356685 -0.072293651 0
cell6 -0.20053804 0.178977042 1
Should look like this:
library(reshape2)
sobjlists = melt(sobjlists, id.vars = "ClusterName")
ClusterName variable value
1 1 ER_List1 -0.05391108
2 1 ER_List1 0.07074816
3 1 ER_List1 0.08688374
4 0 ER_List1 -0.12503649
5 0 ER_List1 0.05356685
6 1 ER_List1 -0.20053804
Now we plot:
ggplot(sobjlists,aes(x= ClusterName, y = value)) +
geom_violin(aes(fill=variable)) +
geom_boxplot(aes(col=variable),
width = 0.2,position=position_dodge(0.9))
for you to be able to use the data within a plot without specifying it (like geom_boxplot() ), you need to put the data in the ggplot() function call. Then the following functions are able to inherit them.
You also do not need an extra violin plot per color
library(tidyverse)
data("Puromycin")
head(Puromycin)
mycp <- ggplot(Puromycin,aes(x= state, y = conc, colour=state))+geom_violin()
mycp + geom_boxplot(width=0.1, color= "black") +
scale_color_discrete(
labels= c("Puromycin (Treatment1)","Puromycin (Treatment2)")
)
Result:

I want to plot a line over four bargraphs of data in ggplot using geom_line.

I keep getting an error becasue the bargraphs are used for quaterly data and the line is going to be data from the entire year so it will have many points.
The only issue is with the geom_line function which I am new to using. The error is -->
Error in scale_fill_manual(values = c("green", "yellow")) + geom_line(aes(x = dts2, : non-numeric argument to binary operator
t="DG"
fin=getFinancials(t, auto.assign = F)
dts = labels(fin$BS$A)[[2]]
dts2 = paste(substr(dts,1,7),"::",dts, sep="")
stockprices = getSymbols(t, auto.assign = F)
price = rep(0,NROW(dts))
for(i in 1:NROW(price))
{
price[i]=as.vector(last(stockprices[dts2[i],6]))
}
yr= as.numeric(substr(dts,1,4))
pastyr = yr -2
betayr = paste(pastyr,"::",yr,sep="")
os = fin$BS$A["Total Common Shares Outstanding", ]
gw= fin$BS$A["Goodwill, Net", ]
ta= fin$BS$A["Total Assets", ]
td= fin$BS$A["Total Debt", ]
ni= fin$IS$A["Net Income", ]
btax = fin$IS$A["Income Before Tax", ]
atax = fin$IS$A["Income After Tax",]
intpaid = fin$CF$A["Cash Interest Paid, Supplemental",]
gw[is.na(gw)]=0
intpaid[is.na(intpaid)]=0
taa = (ta - gw)/os
Rd = rep(0,NROW(dts))
for(i in 1:NROW(dts))
{
if(td[i]!=0)
{
Rd[i] = intpaid[i]/td[i]
}
}
gspc = getSymbols("^GSPC", auto.assign = F)
gs5 = getSymbols("GS5", src = "FRED", auto.assign = F)
marketRisk = rep(0,NROW(dts))
riskFree = rep(0,NROW(dts))
beta = rep(0,NROW(dts))
for(i in 1:NROW(dts))
{
marketRisk[i]= mean(yearlyReturn(gspc[betayr[i]]))
riskFree[i] = mean(gs5[betayr[i]])
gspc.weekly = weeklyReturn(gspc[betayr[i]])
stockprices.weekly = weeklyReturn(stockprices[betayr[i]])
beta[i] = CAPM.beta(stockprices.weekly,gspc.weekly)
}
Re = (riskFree/100) + beta * (marketRisk-(riskFree/100))
E = os*price
V=E+td
Tc = (btax - atax)/btax
wacc = (E/V)*Re + (td/V)*Rd*(1-Tc)
margin = (ni/wacc)/os - taa
taadf = data.frame(dts,val = taa,cat="ta")
margindf = data.frame(dts,val = margin ,cat="margin")
mdf=rbind(margindf,taadf)
#linrng = paste(dts[NROW(dts)],"::",dts[1],sep="")
#dfdt = data.frame(stockprices[linrng,6])
#dfdt2 = data.frame(dt = labels(dfdt)[[1]],dfdt$AAPL.Adjusted,cat="taa")
#names(dfdt2)=c("dt,price,cat")
pricedf = data.frame(as.vector((stockprices[dts2[i],6])))
ggplot(mdf, aes(x=dts,y=val,fill=cat)) + geom_bar(stat="identity",color="black")
scale_fill_manual(values = c("green","yellow")) +
geom_line(aes(x=dts2, y=stockprices), stat = "identity",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE)
Note, the object stockprices is An ‘xts’ object. So, you can't use inside ggplot scale. I picked the fist variable of stockprices object to show the code, but you probabli want another one.
library(dplyr)
library(quantmod)
library(PerformanceAnalytics)
library(ggplot2)
stockprices_df <- as.data.frame(stockprices) %>%
mutate(date = rownames(.)) %>%
filter(date %in% dts)
ggplot() +
geom_col(
data = mdf,
aes(x = dts,y = val,fill = cat)
) +
geom_line(
data = stockprices_df,
aes(x = date, y = DG.Open, group = 1 )
) +
scale_fill_manual(values = c("green","yellow"))
[

R Programming: Using ISO Country Codes in LeafLet

I am working on creating a client dashboard. I have ISO country codes for the clients also I have plotted the same in the map using rworldmap package, but the UI is not very good.
So, I want to use the leaflet package. How can I use these ISO Country Codes ALPHA 2 in creating the map.
Thanks!
Leaflet does not accept ISO Alpa2 code rather accepts ISO Alpha3 codes. After going through almost everywhere I tried this and it solved my problem.
output$myMapOne = renderPlotly({
height = 1000
units="px"
clientName = input$clientSelector
conWiseSub = subset(conData, conData$GCA_CSTMR_DS == clientName)
defOne = aggregate(CNT ~ CODE, conWiseSub, sum)
d = defOne$CODE
e = defOne$CNT
# light grey boundaries
l <- list(color = toRGB("grey"), width = 0.5)
# specify map projection/options
g <- list(
showframe = TRUE,
showcoastlines = FALSE,showland = TRUE,showcountries = TRUE,
countrycolor = toRGB("white"),
landcolor = toRGB("grey85"),
projection = list(type = 'Mercator', scale =1)
)
plot_ly(defOne, z = e, text = d,locations = d, type = 'choropleth',
color = e, colors = 'PuBu', marker = list(line = l), colorbar = list(title = "SOI Distribution")
) %>%
layout( geo = g,title= paste("Region Wise SOI Distribution of", clientName , sep = " "))
})
Click Here to View the Map Created By the Code
Hope this helps!!

Plot two sets of coordinates on geographical map

I created two sets of vectors to plot two sets of data on a map.
Everytime I run, R Studio crashes.
What am I missing?
library(ggmap)
setwd("d:/GIS/31R")
sep <- read.csv("California_SEP_assets_csv.csv")
Sub1 <- sep[grep("SEP.11", names(sep))]
sep$newCol <- 100*rowSums(Sub1)/rowSums(sep[4:7])
library(sp)
lst <- split(sep, sep[,8] >= 50)
under50 <- lst[[1]]
over50 <- lst[[2]]
coords <- cbind(Longitude = as.numeric(as.character(under50$Longitude)),Latitude=as.numeric(as.character(under50$Latitude)))
coords2 <- cbind(Longitude2 = as.numeric(as.character(over50$Longitude)),Latitude2=as.numeric(as.character(over50$Latitude)))
map <- qmap('Yorba Linda', zoom = 11, maptype = 'hybrid')
map + geom_point(data=under50, aes(x = Longitude, y = Latitude), color="red", size = 5, alpha = 0.5) + geom_point(data=over50, aes(x = Longitude2, y = Latitude2), color="green", size = 5, alpha = 0.5)
Original Code
My original code plotted all points
library(ggmap)
setwd("d:/GIS/31R")
sep <- read.csv("California_SEP_assets_csv.csv")
library(sp)
coords <- cbind(Longitude = as.numeric(as.character(sep$Longitude)),Latitude=as.numeric(as.character(sep$Latitude)))
sep.pts <- SpatialPointsDataFrame(coords,sep[,-(2:3)],proj4string = CRS("+init=epsg:4326"))
plot(sep.pts, pch=".",col="darkred")
map <- qmap('Yorba Linda', zoom = 11, maptype = 'hybrid')
map + geom_point(data=sep, aes(x = Longitude, y = Latitude), color="red", size = 5, alpha = 0.5)
Gave this
I am able to plot points standalone, i.e.
library(ggmap)
setwd("d:/GIS/31R")
sep <- read.csv("California_SEP_assets_csv.csv")
Sub1 <- sep[grep("SEP.11", names(sep))]
sep$newCol <- 100*rowSums(Sub1)/rowSums(sep[4:7])
library(sp)
lst <- split(sep, sep[,8] >= 50)
under50 <- lst[[1]]
over50 <- lst[[2]]
coords <- cbind(Longitude = as.numeric(as.character(under50$Longitude)),Latitude=as.numeric(as.character(under50$Latitude)))
under50.pts <- SpatialPointsDataFrame(coords, under50[, -(2:3)], proj4string = CRS("+init=epsg:4326"))
coords2 <- cbind(Longitude2 = as.numeric(as.character(over50$Longitude)),Latitude2=as.numeric(as.character(over50$Latitude)))
over50.pts <- SpatialPointsDataFrame(coords2, over50[, -(2:3)], proj4string = CRS("+init=epsg:4326"))
plot(over50.pts, pch = 22, col = "darkgreen")
and I replace the last line, plot(...
with
plot(under50.pts, pch = 22, col = "darkred")
If think you are making things more complicated than needs to be. If you want to color the points to a certain grouping variable, just create such a variable. Based on the data you posted in this question, you can do this as follows:
library(ggmap)
library(ggplot2)
# create a new grouping variable
sep$newvar <- ifelse(sep[,8] >= 50, "Over 50", "Under 50")
# get the map
map <- get_map('Yorba Linda', zoom = 11, maptype = 'hybrid')
# plot the map and use the grouping variable for the fill inside the aes
ggmap(map) +
geom_point(data=sep, aes(x = Longitude, y = Latitude, color=newvar), size=7, alpha=0.6) +
scale_color_manual(breaks=c("Over 50", "Under 50"), values=c("green","red"))
this gives:
Used data:
sep <- structure(list(Site = structure(1:6, .Label = c("31R001", "31R002", "31R003", "31R004", "31R005", "31R006"), class = "factor"),
Latitude = c(33.808874, 33.877256, 33.820825, 33.852373, 33.829697, 33.810274),
Longitude = c(-117.844048, -117.700135, -117.811845, -117.795516, -117.787532, -117.830429),
Windows.SEP.11 = c(63L, 174L, 11L, 85L, 163L, 71L),
Mac.SEP.11 = c(0L, 1L, 4L, 0L, 0L, 50L),
Windows.SEP.12 = c(124L, 185L, 9L, 75L, 23L, 5L),
Mac.SEP.12 = c(0L, 1L, 32L, 1L, 0L, 50L),
newCol = c(33.6898395721925, 48.4764542936288, 26.7857142857143, 52.7950310559006, 87.6344086021505, 68.75),
newvar = c("Under 50", "Under 50", "Under 50", "Over 50", "Over 50", "Over 50")),
.Names = c("Site", "Latitude", "Longitude", "Windows.SEP.11", "Mac.SEP.11", "Windows.SEP.12", "Mac.SEP.12","newCol", "newvar"),
row.names = c(NA, 6L), class = "data.frame")
I fixed the code. However, if you can post more elegant code and explain it, I will mark as solution.
library(ggmap)
setwd("d:/GIS/31R")
sep <- read.csv("California_SEP_assets_csv.csv")
Sub1 <- sep[grep("SEP.11", names(sep))]
sep$newCol <- 100*rowSums(Sub1)/rowSums(sep[4:7])
library(sp)
lst <- split(sep, sep[,8] >= 50)
under50 <- lst[[1]]
over50 <- lst[[2]]
coords <- cbind(Longitude = as.numeric(as.character(under50$Longitude)),Latitude=as.numeric(as.character(under50$Latitude)))
under50.pts <- SpatialPointsDataFrame(coords, under50[, -(2:3)], proj4string = CRS("+init=epsg:4326"))
coords2 <- cbind(Longitude = as.numeric(as.character(over50$Longitude)),Latitude=as.numeric(as.character(over50$Latitude)))
over50.pts <- SpatialPointsDataFrame(coords2, over50[, -(2:3)], proj4string = CRS("+init=epsg:4326"))
map <- qmap('Yorba Linda', zoom = 11, maptype = 'hybrid')
map + geom_point(data=over50, aes(x = Longitude, y = Latitude), color="green", size = 5, alpha = 0.5) + geom_point(data=under50, aes(x = Longitude, y = Latitude), color="red", size = 5, alpha = 0.5)
Format of the .csv file
Site Latitude Longitude Windows.SEP.11 Mac.SEP.11 Windows.SEP.12 Mac.SEP.12 newCol
1 31R001 33.80887 -117.8440 63 0 124 0 33.68984
2 31R002 33.87726 -117.7001 174 1 185 1 48.47645
3 31R003 33.82082 -117.8118 11 4 9 32 26.78571
4 31R004 33.85237 -117.7955 85 0 75 1 52.79503
5 31R005 33.82970 -117.7875 163 0 23 0 87.63441
6 31R006 33.81027 -117.8304 71 50 5 50 68.75000

Getting lat and lon coordinates for ggmap in R

I have data from the iOS Moves app which is in the form:
timeAtSite location
800.52 {"lat": 38.87212, "lon": -94.61764}
116.40 {"lat": 38.91571, "lon": -94.64835}
14.48 {"lat": 38.91461, "lon": -94.64795}
I have tried a variety of unsucessful methods to get the location data into separate lat and lon columns (example below):
al1 = get_map(location = c(lon: -94.61764, lat: 38.87212), zoom = 2, maptype = 'roadmap')
al1MAP = ggmap(al1)
al1MAP
al1MAP <- ggmap(al1)+ geom_point(data=c(moves$Location["lat"],moves$Location["lon"]))
TIA
You could try
library(stringr)
df[c('lat', 'lon')] <- do.call(rbind,lapply(str_extract_all(df$location,
'[-0-9.]+'), as.numeric))
Or
library(tidyr)
df1 <- extract(df, location, c('lat', 'lon'), '([-0-9.]+)[^-0-9.]+([-0-9.]+)',
convert=TRUE)
df1
# timeAtSite lat lon
#1 800.52 38.87212 -94.61764
#2 116.40 38.91571 -94.64835
#3 14.48 38.91461 -94.64795
Once you extracted the location,
center <- paste(min(df1$lat)+(max(df1$lat)-min(df1$lat))/2,
min(df1$lon)+(max(df1$lon)-min(df1$lon))/2, sep=" ")
df1$id <- 1:3
library(ggmap)
al1 <- get_map(location = center, zoom = 11, maptype = "roadmap" )
p <- ggmap(al1)
p <- p + geom_text(data=df1,aes(x = lon, y = lat, label=id),
colour="red",size=4,hjust=0, vjust=0)+
theme(legend.position = "none")
p <- p + geom_point(data=df1,aes(x=lon, y=lat),colour="black",size=2)
p
data
df <- structure(list(timeAtSite = c(800.52, 116.4, 14.48), location =
c("{\"lat\": 38.87212, \"lon\": -94.61764}", "{\"lat\": 38.91571,
\"lon\": -94.64835}", "{\"lat\": 38.91461, \"lon\": -94.64795}"
)), .Names = c("timeAtSite", "location"), class = "data.frame", row.names =
c(NA, -3L))

Resources