I have two data frame as below:
PickUP <- data.frame(pickuplong = c(-73.93909 ,-73.94189 ,-73.93754,-73.91638,-73.92792 ,-73.88634), pickuplat =c(40.84408,40.83841,40.85311,40.84966,40.86284,40.85628))
Dropoff <- data.frame(pickuplong = c(-73.93351 ,-73.93909 ,-73.93909 ,-73.80747,-73.95722,-73.91880), pickuplat =c(40.76621,40.84408,40.85311,40.69951,40.68877,40.75917), Droplong =c(-73.91300,-73.96259 ,-73.94870,-73.93860,-73.93633, -73.90690), Droplat =c(40.77777,40.77488 ,40.78493,40.84463,40.75977,40.77013))
I try to find the pickup coordinations (longtitude and latitude) in the pickup data frame which are repeated in dropoff dataframe. I have the below code but I got the error on this:
library(sp)
library(rgdal)
library(leaflet)
library(mapview)
library(dplyr)
a <- semi_join(Dropoff , PickUP , by = c("pickuplong","pickuplat"))
a$ID <- 1:nrow(a)
Dropoff_p <- a[, c("ID", "Pickup_longitude", "Pickup_latitude")]
Dropoff_d <- a[, c("ID", "Dropoff_longitude", "Dropoff_latitude")]
coordinates(Dropoff_p) <- ~Pickup_longitude + Pickup_latitude
coordinates(Dropoff_d) <- ~Dropoff_longitude + Dropoff_latitude
proj4string(Dropoff_p) <- CRS("+init=epsg:4326")
proj4string(Dropoff_d) <- CRS("+init=epsg:4326")
map_p <- mapview(Dropoff_p, color = "red")
map_d <- mapview(Dropoff_d, color = "blue")
map_p + map_d
My error is:
Error in $<-.data.frame (tmp, "ID", value = c(1L, 0L)) :
replacement has 2 rows, data has 0 Error during wrapup: cannot open the
connection
When subsetting the data frame, you have to use the same column names. I changed the column name in the Dropoff_p, Dropoff_d, coordinates(Dropoff_p), and proj4string(Dropoff_d), and then your script works.
In addition, the mapview package just has a new update. If you want, you can update your mapview to version 2.0.1. You can also add col.regions = "red" and col.regions = "blue" because it seems like under the new version the color argument will only change the outline of a point. To change the fill color, use col.regions.
library(sp)
library(rgdal)
library(leaflet)
library(mapview)
library(dplyr)
a <- semi_join(Dropoff , PickUP , by = c("pickuplong","pickuplat"))
a$ID <- 1:nrow(a)
Dropoff_p <- a[, c("ID", "pickuplong", "pickuplat")]
Dropoff_d <- a[, c("ID", "Droplong", "Droplat")]
coordinates(Dropoff_p) <- ~pickuplong + pickuplat
coordinates(Dropoff_d) <- ~Droplong + Droplat
proj4string(Dropoff_p) <- CRS("+init=epsg:4326")
proj4string(Dropoff_d) <- CRS("+init=epsg:4326")
map_p <- mapview(Dropoff_p, color = "red", col.regions = "red")
map_d <- mapview(Dropoff_d, color = "blue", col.regions = "blue")
map_p + map_d
Related
I have sample file with csv that describe some stock exchange indexes. I have already managed to:
Create for loop statement to tidy the data in a way that I have those data as DFs in a list.
In each index I calculated using loop OLSSlope, Log values, Percent Change, STDSlope etc.
Create XTS objects that are stored inside list.
I want to write such for loop/ lapply code that will take each xts object inside list, create plot using (dygraph) library and then save this graph in an output file. So that the goal is to have graph for each index that is inside this list of xts objects. I don't have problem with creating one graph for one object but to make it universal inside loop. Code for graph that I want is:
wig20tr_d_xts <- xts(x = wig20tr_d$Zamkniecie,
order.by = wig20tr_d$Date)
wig20tr_d_ols <- xts(x = wig20tr_d$OLSSlope,
order.by = wig20tr_d$Date)
wig20tr_d_stdup <- xts(x = wig20tr_d$OneSTDup,
order.by = wig20tr_d$Date)
wig20tr_d_stduptwo <- xts(x = wig20tr_d$TwoSTDup,
order.by = wig20tr_d$Date)
wig20tr_d_stddown <- xts(x = wig20tr_d$OneSTDdown,
order.by = wig20tr_d$Date)
wig20tr_d_stddowntwo <- xts(x = wig20tr_d$TwoSTDdown,
order.by = wig20tr_d$Date)
wig20 <- cbind(wig20tr_d_xts, wig20tr_d_ols, wig20tr_d_stdup, wig20tr_d_stduptwo, wig20tr_d_stddown, wig20tr_d_stddowntwo)
wig20_graph <- dygraph(wig20, main = "WIG 20 TR", ylab = "Total return in zł") %>%
dySeries("wig20tr_d_xts", color = "black") %>%
dySeries("wig20tr_d_ols", strokeWidth = 2, strokePattern = "dashed", color = "blue") %>%
dySeries("wig20tr_d_stdup", color = "green") %>%
dySeries("wig20tr_d_stduptwo", color = "green") %>%
dySeries("wig20tr_d_stddown", color = "red") %>%
dySeries("wig20tr_d_stddowntwo", color = "red") %>%
dyRangeSelector() %>%
dyUnzoom() %>%
dyOptions(axisLineColor = "navy",
gridLineColor = "lightblue") %>%
dyCrosshair(direction = "vertical")
wig20_graph
htmltools::save_html(wig20_graph, file = "C:/DATA_output/wig20_graph.html")
As you can see I use this addition to the graph:
dyCrosshair <- function(dygraph,
direction = c("both", "horizontal", "vertical")) {
dyPlugin(
dygraph = dygraph,
name = "Crosshair",
path = system.file("plugins/crosshair.js",
package = "dygraphs"),
options = list(direction = match.arg(direction))
)
}
Loop to create list of xts objects is like this:
for(i in 1:length(xts_list)){
df <- xts_list[i]
df <- as.data.frame(df)
colnames(df) <- c("Date", "Zamkniecie", "Trend", "OLSSlope", "LogClose", "LogCloseOLS", "LogCloseOLSSlope", "PercentChange", "LogChange", "OneSTDup", "OneSTDdown", "TwoSTDup", "TwoSTDdown")
time_series <- xts(x = df$Zamkniecie,
order.by = df$Date)
ols <- xts(x = df$OLSSlope,
order.by = df$Date)
stdup <- xts(x = df$OneSTDup,
order.by = df$Date)
stduptwo <- xts(x = df$TwoSTDup,
order.by = df$Date)
stddown <- xts(x = df$OneSTDdown,
order.by = df$Date)
stddowntwo <- xts(x = df$TwoSTDdown,
order.by = df$Date)
time_series_full <- cbind(time_series, ols, stdup, stduptwo, stddown, stddowntwo)
xts_list[[i]] <- time_series_full
print(i)
}
I have problem with adding part with graph inside this last for loop. So that the HTML graph would be named after the index. In this example the index is wig20tr_d
I downloaded a monthly data from [NASA data][1] and saved in .txt and .asc format. I am trying to plot and extract the data from the ASCII file, but unfortunately I am unable to do so. I tried the following:
1.
infile <- "OMI/L3feb09.txt"
data <- as.matrix(read.table(infile, skip = 3, header = FALSE, sep = "\t"))
data[data == -9999] = NA
rr <- raster(data, crs = "+init=epsg:4326")
extent(rr) = c(179.375, 179.375+1.25*288, -59.5, -59.5+1*120)
Tried to extract for australia
adm <- getData("GADM", country="AUS", level=1)
rr = mask(rr, adm)
plot(rr)
library(rgdal)
r = raster("OMI/L3feb09.txt")
plot(r)
library(raster)
r = raster("OMI/L3feb09.txt")
plot(r)
4.Also tried,
df1 <- read.table("OMI/L3feb09.txt", skip = 11, header = FALSE, sep = "\t")
Tried the following from
Stackoverflow link 1
Stackoverflow link 2
The problem is there are strings in the file in between number, such as "lat = -55.5"
Appreciate any kind of help. Thank you
[2]: https://stackoverflow.com/questions/42064943/opening-an-ascii-file-using-r
So, I downloaded one file and played around with it! It is not the best solution, however, I hope it can give you an idea.
library(stringr)
# read data
data<-read.csv("L3_tropo_ozone_column_oct04",header = FALSE, skip = 3,sep = "")
# this "" will seperate lat = -59.5 to 3 rows, and will be easier to remove.
#Also each row in the data frame constrained by 2 rows of "lat", represents #data on the later "lat".
lat_index<-which(data[,1]=="lat")
#you need the last row that contains data not "lat string
lat_index<-lat_index-1
#define an empty array for results.
result<-array(NA, dim = c(120,288),dimnames = list(lat=seq(-59.5,59.5,1),
lon=seq(-179.375,179.375,1.25)))
I assumed data -on 3 three digits- on each latituide is dividable by 3 resulting in 288, which equals the lon grid number. Correct me if I'm wrong.
# function to split a string into a vector in which each string has three letter/numbers
split_n_parts<-function(input_string,n){
# dislove it to many elements or by number
input_string_1<-unlist(str_extract_all(input_string,boundary("character")))
output_string<-vector(length = length(input_string_1)/n)
for ( x in 1:length(output_string)){
output_string[x]<-paste0(input_string_1[c(x*3-2)],
input_string_1[c(x*3-1)],
input_string_1[c(x*3)])
}
return(as.numeric(output_string))
}
Here, the code loops, collects, write each lat data in the result array
# loop over rows constrainted by 2 lats, process it and assign to an array
for (i in 1:length(lat_index)){
if(i ==1){
for(j in 1:lat_index[i]){
if(j==1){
row_j<-paste0(data[j,])
}else{
row_j<-paste0(row_j,data[j,])
}
}
}else{
ii<-i-1
lower_limit<-lat_index[ii]+4
upper_limit<-lat_index[i]
for(j in lower_limit:upper_limit){
if(j==lower_limit){
row_j<-paste0(data[j,])
}else{
row_j<-paste0(row_j,data[j,])
}
}
}
result[i,]<-split_n_parts(row_j,3)
}
Here, is the final array and image
#plot as image
image(result)
EDIT: To continue the solution and put the end-result:
# because data is IN DOBSON UNITS X 10
result<-result/10
#melt to datafrome
library(plyr)
result_df<-adply(result, c(1,2))
result_df$lat<-as.numeric(as.character(result_df$lat))
result_df$lon<-as.numeric(as.character(result_df$lon))
# plotting
library(maps)
library(ggplot2)
library(tidyverse)
world_map <- map_data("world")
#colors
jet.colors <-colorRampPalette(c("white", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
ggplot() +
geom_raster(data=result_df,aes(fill=V1,x=lon,y=lat))+
geom_polygon(data = world_map, aes(x = long, y = lat, group = group),
fill=NA, colour = "black")+
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0))+
scale_fill_gradientn(colors = jet.colors(7))
I want to plot the stock price time series for several stocks on individual plots. I've used plotfun but am unable to change to x-axis from Index to Date. I was wondering if I've missed something or is there better way to achieve this. Below is the code that I've created thus far and one of the two plotfun plots.
enter image description hereThanks for your time and consideration in advance.
library("quantmod")
library("ggplot2")
library("BatchGetSymbols")
library("magrittr")
library("broom")
library("dplyr")
library("zoo")
library("xts")
library("tidyverse")
library("tidyquant")
library("TSstudio")
library("rlang")
GetMySymbols <- function(x) {
getSymbols(x,
src ="yahoo",
from = "2010-07-01",
to = "2016-06-30",
auto.assign = FALSE)}
tickers <- c('TLS.AX','WOW.AX')
prices_Close <- map(tickers, GetMySymbols) %>% map(Cl) %>% reduce(merge.xts)
names(prices_Close) <- tickers
##plot.zoo(prices_Close, plot.type = 'multiple')
##plot.xts(prices_Close)
##plot.ts(df)
##df <- fortify(prices_Close)
mydf <- as.Data.frame(prices_Close)
plotfun <- function(col)
plot(mydf[,col], ylab = names(mydf[col]), type = "l")
par(ask = FALSE)
sapply(seq(1, length(mydf), 1), plotfun)
I've found the solution to the problem above:
for (i in 2:ncol(df)){
print(ggplot(df, aes_string(x = "Index", y= df[,i])) + geom_line() + xlab("Date"))
}
I am plotting multiple shapefiles using spplot. Here's a data to construct that
library(raster)
library(randomcoloR)
my.shp <- getData('GADM', country = 'BRA', level = 2)
my.shp$ID<- 1:nrow(my.shp)
My data consists of a variable X for 10 years as shown where each column is a year
df <- matrix(sample(100:5000, 55040, replace = T), nrow = 5504, ncol = 10)
df <- data.frame(ID = 1:nrow(my.shp), df)
my.dat <- merge(my.shp, df, by = "ID")
variable.names <- paste0("X",1:10)
spplot(my.dat, rev(variable.names), col = NA, at = seq(from = 100, to = 5000, by = 500),
col.regions = distinctColorPalette(length(seq(from = 100, to = 5000, by = 500))),
main = list(label = "TEST"))
My problem is this plot takes so much time (around an hour) to get plotted and was wondering if there is something inherently wrong in the code itself that it is taking too long to plot. My laptop has a 32 GB RAM.
Thanks
I haven't compared this plot to your spplot because I don't want to spend an hour waiting for it.
Instead I'm proposing to use library(mapdeck) to plot an interactive map, which takes a matter of seconds.
Two things to note
You need a Mapbox Access token
You need to convert the sp object to sf
library(raster)
my.shp <- getData('GADM', country = 'BRA', level = 2)
my.shp$ID <- 1:nrow(my.shp)
df <- matrix(sample(100:5000, 55040, replace = T), nrow = 5504, ncol = 10)
df <- data.frame(ID = 1:nrow(my.shp), df)
my.dat <- merge(my.shp, df, by = "ID")
library(sf)
sf <- sf::st_as_sf( my.dat )
library(mapdeck)
set_token( "YOUR_MAPBOX_TOKEN" )
mapdeck() %>%
add_sf(
data = sf
, fill_colour = "GID_2"
)
Are you willing/able to switch to sf instead of sp?
The sf plot function is considerably faster than spplot, although the layout differs a bit.
library(sf)
my.dat_sf <- st_as_sf(my.dat)
plot(my.dat_sf[rev(variable.names)], max.plot=10, breaks=c(seq(from = 100, to = 5000, by = 500),5000),
pal = distinctColorPalette(length(seq(from = 100, to = 5000, by = 500))),
main = "TEST", border=NA, key.pos=4)
Additionally, you could try to simplify the polygon with rmapshaper::ms_simplify() for Spatial*-objects or sf::st_simplify() for SimpleFeatures, which lets you reduce the object size by quite a bit, depending on the given dTolerance. Thus plotting, will also be faster with simplified polygons.
The original SpatialPolygon:
format(object.size(my.dat_sf), units="Kb")
"25599.2 Kb"
and a simplified SimpleFeature:
dat_sf_simple <- st_transform(my.dat_sf, crs = 3035)
dat_sf_simple <- st_simplify(dat_sf_simple, dTolerance = 1000, preserveTopology = T)
dat_sf_simple <- st_transform(dat_sf_simple, crs = 4326)
format(object.size(dat_sf_simple), units="Kb")
"7864.2 Kb"
Plot the simplified SimpleFeature, which takes about 1 minute on my machine with 8GB RAM.
plot(dat_sf_simple[rev(variable.names)], max.plot=10, breaks=c(seq(from = 100, to = 5000, by = 500),5000),
pal = distinctColorPalette(length(seq(from = 100, to = 5000, by = 500))),
main = "TEST", border=NA, key.pos=4)
You could also try out with ggplot2, but I am pretty sure the most performant solution will be the sf plot.
library(ggplot2)
library(dplyr)
library(tidyr)
dat_sf_simple_gg <- dat_sf_simple %>%
dplyr::select(rev(variable.names), geometry) %>%
gather(VAR, SID, -geometry)
ggplot() +
geom_sf(data = dat_sf_simple_gg, aes(fill=SID)) +
facet_wrap(~VAR, ncol = 2)
I recently found this shape file of NYC bus routes shape file of NYC bus routes (zip file) that I am interested in plotting with the leaflet package in R.
When I attempt to do so, some routes do not show up on the map. I can tell they're missing because I overlay the bus stop data and some do not line up with the routes.
When I read in the shape file, I notice that the spatial lines data frame that is created has nested lists, which I think leaflet is not mapping.
What do I need to do so that leaflet reads coordinates of these missing routes? Below is the code I used to produce the map with missing routes:
bus <- readOGR(dsn = path.expand("bus_route_shapefile"), layer = "bus_route_shapefile")
bus.pj <- spTransform(bus, CRS("+proj=longlat +datum=WGS84"))
bus.st <- readOGR(dsn = path.expand("bus_stop_shapefile"), layer = "bus_stop_shapefile")
bus.st.pj <- spTransform(bus.st, CRS("+proj=longlat +datum=WGS84"))
bus_map <- leaflet() %>%
setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
addPolylines(data = bus.pj, color = "black", opacity = 1) %>%
addCircles(data=bus.st.pj#data,~stop_lon, ~stop_lat, color = "red") %>%
addTiles()
bus_map
It would be easier to help you if you provided not only bus_routes but also bus_stop (zip file). You can solve it by converting bus.pj into new SpatialLinesxxx obj where each class Lines has only one class Line. SLDF below code makes doesn't have bus.pj#data$trip_heads because of unknown.
library(dplyr); library(sp); library(leaflet)
## resolve bus.pj#lines into list(Line.objs) (Don't worry about warnings)
Line_list <- lapply(bus.pj#lines, getLinesLinesSlot) %>% unlist()
## If you want just Lines infromation, finish with this line.
SL <- sapply(1:length(Line_list), function(x) Lines(Line_list[[x]], ID = x)) %>%
SpatialLines()
## make new ids (originalID_nth)
ori_id <- getSLLinesIDSlots(bus.pj) # get original ids
LinLS <- sapply(bus.pj#lines, function(x) length(x#Lines)) # how many Line.obj does each Lines.obj has
new_id <- sapply(1:length(LinLS), function(x) paste0(x, "_", seq.int(LinLS[[x]]))) %>%
unlist()
## make a new data.frame (only route_id)
df <- data.frame(route_id = rep(bus.pj#data$route_id, times = LinLS))
rownames(df) <- new_id
## integrate Line.objs, ids and a data.frame into SpatialLinesDataFrame.obj
SLDF <- mapply(function(x, y) Lines(x, ID = y), x = Line_list, y = new_id) %>%
SpatialLines() %>% SpatialLinesDataFrame(data = df)
leaflet() %>%
setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
addPolylines(data = SLDF, color = "black", opacity = 1, weight = 1) %>%
addCircles(data=bus.st.pj#data,~stop_lon, ~stop_lat, color = "red", weight = 0.3)