So I think I have a pretty simple question, but I can't find the answer anywhere.
I have a lot of data containing catches of lobsters. It all pretty much looks like this.
Trip.ID Latitude Longitude DateTime ML6 TotalNephropsLandings
16409 OTB_CRU_32-69_0_0DK102831 57.931 9.277 2012-10-04 19:02:00 OTB_CRU_32-69_0_0 0.2188619
16410 OTB_CRU_32-69_0_0DK102831 57.959 9.375 2012-10-04 21:02:00 OTB_CRU_32-69_0_0 0.2188619
16411 OTB_CRU_32-69_0_0DK102831 58.201 10.232 2012-10-04 02:00:00 OTB_CRU_32-69_0_0 0.2188619
16412 OTB_CRU_32-69_0_0DK102831 58.208 10.260 2012-10-04 03:00:00 OTB_CRU_32-69_0_0 0.2188619
16413 OTB_CRU_32-69_0_0DK102831 58.169 10.078 2012-10-03 23:00:00 OTB_CRU_32-69_0_0 0.2188619
16414 OTB_CRU_32-69_0_0DK102831 57.919 9.227 2012-10-04 18:00:00 OTB_CRU_32-69_0_0 0.2188619
What I would like to do is simply make a map with contours around areas based on the "ML6" column, which are different tools used for fishing.
I tried using geom_density2d, which looks like this:
However I really don't want to show density, only where they are present. So basically one line around a group of coordinates that are from the same level in ML6. Could anyone help me with this?
It would also be nice to have the alternative to fill these in as polygons as well. But perhaps that could simple be accomplished using "fill=".
If anyone knows how to do this without R, you are also welcome to help, but then I would possibly need more in depth information.
Sorry for not producing more of my data frame...
Of course I should have produced the code I had for the plot, so here it is basically:
#Get map
map <- get_map(location=c(left= 0, bottom=45, right=15 ,top=70), maptype = 'satellite')
ggmap(map, extent="normal") +
geom_density2d(data = df, aes(x=Longitude, y=Latitude, group=ML6, colour=ML6))
There are probably better way of doing this work. But, here is my approach for you. I hope this approach works with ggmap as well. Given time I have, this is my best for you. Since your sample data is way too small, I decided to use a part of my own data. What you want to do is to look into ggplot_build(objectname)$data[1]. (It seems that, when you use ggmap, data would be in ggplot_build(object name)$data[4].) For example, create an object like this.
foo <- ggmap(map, extent="normal") +
geom_density2d(data = df, aes(x=Longitude, y=Latitude, group=ML6, colour=ML6))
Then, type ggplot_build(foo)$data[1]. You should see a data frame which ggplot is using. There will be a column called level. Subset data with the minimum level value. I am using filter from dplyr. For example,
foo2 <- ggplot_build(foo)$data[1]
foo3 <- filter(foo2, level == 0.02)
foo3 now has data point which allows you to draw lines on your map. This data has the data points for the most outer circles of the level. You would see something like this.
# fill level x y piece group PANEL
#1 #3287BD 0.02 168.3333 -45.22235 1 1-001 1
#2 #3287BD 0.02 168.3149 -45.09596 1 1-001 1
#3 #3287BD 0.02 168.3197 -44.95455 1 1-001 1
Then, you would do something like the following. In my case, I do not have googlemap. I have a map data of New Zealand. So I am drawing the country with the first geom_path. The second geom_path is the one you need. Make sure you change lon and lat to x and y like below.In this way I think you have the circles you want.
# Map data from gadm.org
NZmap <- readOGR(dsn=".",layer="NZL_adm2")
map.df <- fortify(NZmap)
ggplot(NULL)+
geom_path(data = map.df,aes(x = long, y = lat, group=group), colour="grey50") +
geom_path(data = foo3, aes(x = x, y = y,group = group), colour="red")
UPDATE
Here is another approach. Here I used my answer from this post. You basically identify data points to draw a circle (polygon). I have some links in the post. Please have a look. You can learn what is happening in the loop. Sorry for being short. But, I think this approach allows you to draw all circles you want. Remind that the outcome may not be nice smooth circles like contours.
library(ggmap)
library(sp)
library(rgdal)
library(data.table)
library(plyr)
library(dplyr)
### This is also from my old answer.
### Set a range
lat <- c(44.49,44.5)
lon <- c(11.33,11.36)
### Get a map
map <- get_map(location = c(lon = mean(lon), lat = mean(lat)), zoom = 14,
maptype = "satellite", source = "google")
### Create pseudo data.
foo <- data.frame(x = runif(50, 11.345, 11.357),
y= runif(50, 44.4924, 44.4978),
group = "one",
stringsAsFactors = FALSE)
foo2 <- data.frame(x = runif(50, 11.331, 11.338),
y= runif(50, 44.4924, 44.4978),
group = "two",
stringsAsFactors = FALSE)
new <- rbind(foo,foo2)
### Loop through and create data points to draw a polygon for each group.
cats <- list()
for(i in unique(new$group)){
foo <- new %>%
filter(group == i) %>%
select(x, y)
ch <- chull(foo)
coords <- foo[c(ch, ch[1]), ]
sp_poly <- SpatialPolygons(list(Polygons(list(Polygon(coords)), ID=1)))
bob <- fortify(sp_poly)
bob$area <- i
cats[[i]] <- bob
}
cathy <- as.data.frame(rbindlist(cats))
ggmap(map) +
geom_path(data = cathy, aes(x = long, y = lat, group = area), colour="red") +
scale_x_continuous(limits = c(11.33, 11.36), expand = c(0, 0)) +
scale_y_continuous(limits = c(44.49, 44.5), expand = c(0, 0))
Related
below is an example of finding route, travel time and travel distance from 'One World Trade Center, NYC' to 'Madison Square Park, NYC' using osrm package in R. (I learnt it from Road Routing in R). The travel time here is 10.37 minutes.
I wanted to create an video for visualization.
Q. How can I create an animation of vehicle (represented by a marker) moving from 'One World Trade Center, NYC' to 'Madison Square Park, NYC' along the route ?
Ideally, we should know the speed in each road segment. But lets assume the vehicle moves non-stop at constant speed (= distance/time) between two location.
We can simply use tmap instead of leaflet also to create animation.
library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)
# 1. One World Trade Center, NYC
# 2. Madison Square Park, NYC
adresses <- c("285 Fulton St, New York, NY 10007",
"11 Madison Ave, New York, NY 10010")
# geocode the two addresses & transform to {sf} data structure
data <- tidygeocoder::geo(adresses, method = "osm") %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
osroute <- osrm::osrmRoute(loc = data,
returnclass = "sf")
summary(osroute)
library(leaflet)
leaflet(data = data) %>%
addProviderTiles("CartoDB.Positron") %>%
addMarkers(label = ~address) %>%
addPolylines(data = osroute,
label = "OSRM engine",
color = "red")
As an alternative to the tmap approach proposed by #mrhellman I offer an alternative built on ggplot, ggmap (for the basemap) and gganimate based workflow.
I have found the outcome of animations created via {gganimate} preferable, as {gganimate} gives me more control - such as the shadow_wake that in my opinion nicely illustrates the movement of a car along the line. If I remember correctly tmap uses gganimate under the hood.
ggmap does not support CartoDB basemaps - such as the Positron used above - but I have found the toner background adequate.
Note that ggmap does not play quite nicely with ggplot2::geom_sf() and I have found it easier to transform my workflow to old ggplot2::geom_point() approach - i.e. extract the x and y coordinates and map them via aes().
As there is only a single route to display it should be sufficient to calculate a technical variable seq that is used in the transition_reveal() to animate; this may be replaced by a time dimension if & when necessary (such as when displaying more routes with different travel time in a single animation).
library(sf)
library(dplyr)
library(tidygeocoder)
library(osrm)
# 1. One World Trade Center, NYC
# 2. Madison Square Park, NYC
adresses <- c("285 Fulton St, New York, NY 10007",
"11 Madison Ave, New York, NY 10010")
# geocode the two addresses & transform to {sf} data structure
data <- tidygeocoder::geo(adresses, method = "osm") %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
osroute <- osrm::osrmRoute(loc = data,
returnclass = "sf")
# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled <- st_sample(osroute, type = 'regular', size = 50) %>%
st_cast('POINT') %>%
st_as_sf()
library(ggplot2)
library(ggmap) # warning: has a naming conflict with tidygeocoder!
library(gganimate)
# ggmap does not quite like geom_sf(),
# the "old school" geom_point will be easier to work with
osroute_xy <- osroute_sampled %>%
mutate(seq = 1:nrow(.),
x = st_coordinates(.)[,"X"],
y = st_coordinates(.)[,"Y"])
# basemap / the bbox depends on yer area of interest
NYC <- get_stamenmap(bbox = c(-74.05, 40.68, -73.9, 40.8),
zoom = 13,
maptype = "toner-background")
# draw a map
animation <- ggmap(NYC) +
geom_point(data = osroute_xy,
aes(x = x, y = y),
color = "red",
size = 4) +
theme_void() +
transition_reveal(seq) +
shadow_wake(wake_length = 1/6)
# create animation
gganimate::animate(animation,
nframes = 2*(nrow(osroute_xy)+1),
height = 800,
width = 760,
fps = 10,
renderer = gifski_renderer(loop = T))
# save animation
gganimate::anim_save('animated_nyc.gif')
Here's a {mapdeck} approach, which gives you an interactive map (like leaflet), and animated trips, and it can easily handle thousands of trips at a time
library(mapdeck)
set_token( secret::get_secret("MAPBOX") )
mapdeck(
location = as.numeric( data[1, ]$geometry[[1]] ) ## for 'trips' you need to specify the location
, zoom = 12
, style = mapdeck_style("dark")
) %>%
add_trips(
data = sf
, stroke_colour = "#FFFFFF" #white
, trail_length = 12
, animation_speed = 8
, stroke_width = 50
)
the add_trips() function takes an sf linestring object with the Z and M dimensions (z = elevation, m = time). So you can have a timestamp assocaited with each coordinate
library(mpadeck)
library(sfheaders)
df_route <- sfheaders::sf_to_df(osroute, fill = TRUE)
## Assume 'duration' is constant
## we want the cumulative time along the rute
df_route$cumtime <- cumsum(df_route$duration)
## and we also need a Z component.
## since we don't know the elevation, I'm setting it to '0'
df_route$elevation <- 0
## Build the 'sf' object wtih the Z and M dimensions
sf <- sfheaders::sf_linestring(
obj = df_route
, x = "x"
, y = "y"
, z = "elevation"
, m = "cumtime"
)
The website has more details.
Sample the route (a LINESTRING) with the number of points you would like to have, then use an lapply function to make the map objects, and use tmap_animate to animate them.
Adding to your code above:
library(tmap)
library(gifski)
# sample osroute 50 times regularly, cast to POINT, return sf (not sfc) object
osroute_sampled <- st_sample(osroute, type = 'regular', size = 50) %>%
st_cast('POINT') %>%
st_as_sf()
# use lapply to crate animation maps. taken from reference page:
# https://mtennekes.github.io/tmap/reference/tmap_animation.html
m0 <- lapply(seq_along(1:nrow(osroute_sampled)), function(point){
x <- osroute_sampled[point,] ## bracketted subsetting to get only 1 point
tm_shape(osroute) + ## full route
tm_sf() +
tm_shape(data) + ## markers for start/end points
tm_markers() +
tm_shape(x) + ## single point
tm_sf(col = 'red', size = 3)
})
# Render the animation
tmap_animation(m0, width = 300, height = 600, delay = 10)
It's been a while since I've used tmap, so I'm not up to date on adding provider tiles. Shouldn't be too hard for you to add those into the lapply function.
Imagine I have data foo below. Each row contains a measurement (y) on a species and each species is paired with another (species.pair). So in the example below, species a is paired with e, b with f, and so on. The number of observations for each species varies. I'd like to plot the density of each species's distribution along with its partner's distribution in its own facet. Below I hand coded this with the column sppPairs. The species are all unique and each has a match in species.pair. I'm unsure of how to make the grouping column sppPairs below. I'm sure there is some clever way to do this with {dplyr} but I can't figure out what to do. Some kind of pasting species to species.pair I imagine? Any help much appreciated.
foo <- data.frame(species = rep(letters[1:8],each=10),
species.pair = rep(letters[c(5:8,1:4)],each=10),
y=rnorm(80))
# species and species pair match exactly
all(unique(foo$species) %in% unique(foo$species.pair))
# what I want
foo$sppPairs <- c(rep("a:e",10),
rep("b:f",10),
rep("c:g",10),
rep("d:h",10),
rep("a:e",10),
rep("b:f",10),
rep("c:g",10),
rep("d:h",10))
p1 <- ggplot(foo,aes(y,fill=species))
p1 <- p1 + geom_density(alpha=0.5)
p1 <- p1 + facet_wrap(~sppPairs)
p1
Yes, you can use apply on the appropriate columns to paste the sorted elements together in the correct order (otherwise a:e is different from e:a and so on, and you end up with 8 groups instead of 4):
library(ggplot2)
foo <- data.frame(species = rep(letters[1:8], each = 10),
species.pair = rep(letters[c(5:8, 1:4)], each = 10),
y = rnorm(80))
foo$sppPairs <- apply(foo[c("species", "species.pair")], 1,
function(x) paste(sort(x), collapse = ":"))
ggplot(foo, aes(y, fill = species)) +
geom_density(alpha = 0.5) +
facet_wrap(~sppPairs)
Created on 2020-10-05 by the reprex package (v0.3.0)
I have a picture of 2 colors. Red color pixels are in form of cluster. I would like to know the max dimension of each cluster to compare with the acceptable tolerance. How to do? Is there any function to perform it?
For this kind of image analysis, you can check out EBImage:
install.packages("BiocManager")
BiocManager::install("EBImage")
Your workflow might look something like this. First, load the packages and read in your image. We'll also display it to show we're on the right track:
library(EBImage)
library(ggplot2)
dots <- readImage("https://i.stack.imgur.com/3RU7u.png")
display(dots, method = "raster")
Now we can use the computeFeatures functions to get the centroids and maximum diameter of each cluster:
dots_bw <- getFrame(dots, 1)
labelled_dots <- bwlabel(dots_bw)
df <- as.data.frame(cbind(computeFeatures.moment(labelled_dots)[, 1:2],
computeFeatures.shape(labelled_dots)[, 5:6]))
df
#> m.cx m.cy s.radius.min s.radius.max
#> 1 65.73316 25.69588 11.095535 40.69698
#> 2 156.24181 129.77241 19.377341 33.83485
#> 3 483.60853 155.23006 9.419478 16.28808
#> 4 277.21467 409.62152 20.411710 28.77508
#> 5 397.36817 607.47749 8.424518 18.53617
#> 6 224.93790 623.28266 8.530353 15.26678
Now we want to find out which dimension matches which blob, so let's plot the raster in ggplot, and write the maximum pixel dimension above each blob.
img_df <- reshape2::melt(as.matrix(as.raster(as.array(dots))))
ggplot(img_df, aes(Var1, Var2, fill = value)) +
geom_raster() +
scale_fill_identity() +
scale_y_reverse() +
geom_text(inherit.aes = FALSE, data = df, color = "white",
aes(x = m.cx, y = m.cy, label = round(s.radius.max, 1))) +
coord_equal()
If you would rather have the total number of pixels than the maximum diameter in pixels, you can also get this from computeFeatures
First, I have a data with two categorical variables into like this:
nombre <- c("A","B","C","A","D","F","F","H","I","J")
sexo <- c(rep("man",4),rep("woman",6))
edad <- c (25,14,25,76,12,90,65,45,56,43)
pais <- c(rep("spain",3),rep("italy",4),rep("portugal",3))
data <- data.frame(nombre=nombre,sexo=sexo,edad=edad,pais=pais)
If I use:
prop.table(table(data$sexo,data$pais), margin=1)
I can see the relative frequency of the levels, for example for Italy (Man=0.25 Woman=0.5)
but the problem is that when I try to plot the prop.table(table(x)) I get something different
ggplot(as.data.frame(prop.table(table(data),margin=1)), aes(x=pais ,y =Freq, fill=sexo))+geom_bar(stat="identity")
On the Y axis from 0 to 3 and for example in the bar Italy (Woman=2 Man=2.5)
I don't need that (and I don't know what is showing), I want the same with as I had with the table of the prop.table(table(x))
I think the problem is something related with the margin=1
Thanks you!
You need to make the same table
tab = prop.table(table(data$sexo,data$pais), margin=1)
tab = as.data.frame(tab)
Then plot:
ggplot(tab,aes(x=Var2,y=Freq,fill=Var1)) + geom_col()
Or simply:
barplot(prop.table(table(data$sexo,data$pais), margin=1))
You're probably looking for something like position = "dodge"
If I run the following on your data :
P <- prop.table(table(data$sexo,data$pais), margin=1)
ggplot(as.data.frame(P), aes(x = Var2, y = Freq, fill = Var1)) +
geom_bar(stat="identity", position = "dodge")
I output the following graph :
I have a data frame which contains point daily precipitation for 4 station for 2 years. I want to interpolate to 50m resoulution and write them in to 2 raster images. I used following code to achieve this...
library(ggplot2)
library(gstat)
library(maptools)
library(raster)
library(rgdal)
xcord<-c(100,200,300,400)
ycord<-c(100,200,300,400)
value1<-c(1,2,3,1)
value2<-c(2,5,7,3)
datas<-data.frame(xcord,ycord,value1,value2)
coordinates(datas) = ~xcord+ycord
mesh <- expand.grid(x=seq(0,500,50),y=seq(0,500,50))
coordinates(mesh)=~x+y
gridded(mesh) <- TRUE
oneidw = idw(value1~1,datas,mesh)
spplot(oneidw["var1.pred"], main = " inverse distance weighted interpolations")
It worked. but i want to apply a loop to do it for another variable value2 (and so on...) without doing it manually.
and i used this
sym<-paste("value", 1:2,sep="")
variable=as.vector(print(sym,quote=FALSE))
for (i in 3:ncol(datas)){
one<-idw((print(variable[i],quote=FALSE))~1,datas,mesh)
}
but i got error too many spatial dimensions........
can anybody help me with this....
I'm not too familiar with spplot, but this worked for me using ggplot.
library(ggplot2)
library(gstat)
library(sp)
library(maptools)
library(maps)
library(dplyr)
library(rgdal)
xcord<-c(100,200,300,400)
ycord<-c(100,200,300,400)
value1<-c(1,2,3,1)
value2<-c(2,5,7,3)
datas<-data.frame(xcord,ycord,value1,value2)
new_datas <- select(datas, xcord, ycord)
parse_by <- colnames(datas)[3:4] #change according to designated value columns
for ( i in parse_by ) {
variable <- datas[i]
new_datas2 <- cbind(new_datas, variable) #combine single variable col w/ coordinates
colnames(new_datas2)[3] = "variable" #rename so that you can call to in idw formula
coordinates(new_datas2) = ~xcord+ycord
mesh <- expand.grid(x=seq(0,500,50),y=seq(0,500,50))
coordinates(mesh)=~x+y
gridded(mesh) = TRUE
plot(mesh) #plot background so ggplot can use later
points(new_datas2) #points for ggplot to use later
one<-idw(formula = variable~1, locations = new_datas2, newdata = mesh) #idw formula
one.output <- as.data.frame(one)
names(one.output)[1:3] <- c("xcord", "ycord", "var1.pred") #rename for ggplot geom_tile
ggplot() + geom_tile(data = one.output, alpha = 1, aes(x = xcord, y = ycord, fill = var1.pred)) +
geom_point(data = new_datas, aes(x = xcord, y = ycord)) +
labs(fill = "inverse distance weighted interpolations")
ggsave(paste(i,".png",sep="")) #save as .png according to variable name
}