I'd like to create sort of levitating objects with rayshader, but I don't know how to do so.
Here's an example:
test <- structure(list(id = c(1, 2), hauteur = c(10, 20), geometry = structure(list(
structure(list(structure(c(-1.36168948095423, -1.36169305908512,
-1.36002570022701, -1.36004117161482, -1.35912195131564,
-1.35914242955086, -1.35844923534243, -1.35839833680255,
-1.36168948095423, -5.9860092862187, -5.98515370941195, -5.98506767037104,
-5.98478743024393, -5.98471158140101, -5.98501879708984,
-5.98503042065794, -5.98583965411611, -5.9860092862187), .Dim = c(9L,
2L))), class = c("XY", "POLYGON", "sfg")), structure(list(
structure(c(-1.36155282525813, -1.36162688579707, -1.36039531642929,
-1.36034993206991, -1.35927629531794, -1.35922529091398,
-1.35867417902484, -1.35873070423009, -1.36155282525813,
-5.98803180168874, -5.98714267345713, -5.98707450596375,
-5.98665348482721, -5.98666278591778, -5.98713469051296,
-5.9872853456686, -5.98795683043924, -5.98803180168874
), .Dim = c(9L, 2L))), class = c("XY", "POLYGON", "sfg"
))), n_empty = 0L, crs = structure(list(input = "WGS 84",
wkt = "GEOGCRS[\"WGS 84\",\n DATUM[\"World Geodetic System 1984\",\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"latitude\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"longitude\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n ID[\"EPSG\",4326]]"), class = "crs"), class = c("sfc_POLYGON",
"sfc"), precision = 0, bbox = structure(c(xmin = -1.36169305908512,
ymin = -5.98803180168874, xmax = -1.35839833680255, ymax = -5.98471158140101
), class = "bbox"))), row.names = c(NA, -2L), class = c("sf",
"data.frame"), sf_column = "geometry", agr = structure(c(id = NA_integer_,
hauteur = NA_integer_), class = "factor", .Label = c("constant",
"aggregate", "identity")))
Code:
library(ggplot2)
library(rayshader)
metro <- ggplot(test, aes(fill = hauteur)) +
geom_sf() +
theme_bw()
plot_gg(metro)
As you can see in the rayshader plot, the height dimension starts at 10 while I'd like it to strart from another level, such as 15 for example, so it give the impression one of the two object is flying, while the other is still "on the ground".
Thanks for your help!
Related
I want to convert my dataframe from wide to long but based on the character vector in one column (based on residents number from the following dput.)
From the following dput, the outcome should have a total of three rows showing all the 3 residents. Is there a way to do it? I tried using seperate rows but the output is not what I desire.
Tried using
Building_Details_Trial_50 %>% tidyr::separate_rows(residents)
dput
structure(list(time = "Mar 22", buildingId = "50", region = "Central",
geometry = structure(list(structure(list(structure(c(-447.361154068258,
-447.557850744738, -533.811390293442, -536.961556093902,
-443.736917153567, -447.361154068258, 5919.51770006977, 5906.87385860642,
5908.2156806004, 5958.8966109417, 5959.54382538916, 5919.51770006977
), dim = c(6L, 2L))), class = c("XY", "POLYGON", "sfg"))), class = c("sfc_POLYGON",
"sfc"), precision = 0, bbox = structure(c(xmin = -536.961556093902,
ymin = 5906.87385860642, xmax = -443.736917153567, ymax = 5959.54382538916
), class = "bbox"), crs = structure(list(input = NA_character_,
wkt = NA_character_), class = "crs"), n_empty = 0L),
count = 3L, geom_points = structure(list(structure(c(-490.403818453599,
5933.7360887923), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT",
"sfc"), precision = 0, bbox = structure(c(xmin = -490.403818453599,
ymin = 5933.7360887923, xmax = -490.403818453599, ymax = 5933.7360887923
), class = "bbox"), crs = structure(list(input = NA_character_,
wkt = NA_character_), class = "crs"), n_empty = 0L),
long = -490.403818453599, lat = 5933.7360887923, residents = list(
c("556", "155", "143"))), row.names = 1L, sf_column = "geometry", agr = structure(c(time = NA_integer_,
buildingId = NA_integer_, region = NA_integer_, count = NA_integer_,
long = NA_integer_, lat = NA_integer_, residents = NA_integer_
), levels = c("constant", "aggregate", "identity"), class = "factor"), class = c("sf",
"tbl_df", "tbl", "data.frame"))
Ideal output
Residents
buildingId
Region
556
50
Central
155
50
Central
143
50
Central
I have a forty year monthly timeseries dataset. I would like to create 3 new columns (AvgTMean, AvgTMin, AvgTMax) that would be the average of tmean, Tmin and TMax for each point in the data (each point will have its own unique average value) respectively. I will then map these average values from any of the 3 average value columns on an interactive.
The purpose is to create a map that shows the 40 year average temperature values.
How can I calculate the average of each point?
Sample data (sf):
structure(list(Info = c(NA_character_, NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_), tmean = c(22.2395992279053, 22.7657985687256,
24.4260005950928, 19.601001739502, 21, 24, 26, 21.45, 27.6), Variable = c("tmean", "tmean",
"tmean", "tmean", "tmax", "tmax", "tmax", "tmax", "tmax"),
year = c(2021L, 2021L, 1980L, 1980L, 2021L, 2021L,
2021L, 2021L, 2021L), month = c(11L, 12L, 0L, 1L, 6L, 7L,
8L, 9L, 10L), TMin = c(15, 15.23, 16.12, 13.45, 16.46, 12.11, 11.55, 9.78, 10.56), TMax = c(0,
39.69, 40.001, 43.2, 40.6976985931396, 41.7550983428955, 42.1988983154297,
41.6512985229492, 40.2621994018555), geometry = structure(list(
structure(c(-80.2083333327448, 26.2083333333333), class = c("XY",
"POINT", "sfg")), structure(c(-80.2083333327448, 26.2083333333333
), class = c("XY", "POINT", "sfg")), structure(c(-80.2083333327448,
26.2083333333333), class = c("XY", "POINT", "sfg")),
structure(c(-80.2083333327448, 26.2083333333333), class = c("XY",
"POINT", "sfg")), structure(c(-80.2083333327448, 26.0416666666667
), class = c("XY", "POINT", "sfg")), structure(c(-80.2083333327448,
26.0416666666667), class = c("XY", "POINT", "sfg")),
structure(c(-80.2083333327448, 26.0416666666667), class = c("XY",
"POINT", "sfg")), structure(c(-80.2083333327448, 26.0416666666667
), class = c("XY", "POINT", "sfg")), structure(c(-80.2083333327448,
26.0416666666667), class = c("XY", "POINT", "sfg"))), precision = 0, bbox = structure(c(xmin = -80.2083333327448,
ymin = 26.0416666666667, xmax = -80.2083333327448, ymax = 26.2083333333333
), class = "bbox"), crs = structure(list(input = "WGS 84",
wkt = "GEOGCRS[\"WGS 84\",\n DATUM[\"World Geodetic System 1984\",\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"latitude\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"longitude\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L, class = c("sfc_POINT",
"sfc"))), row.names = c(NA, 9L), sf_column = "geometry", agr = structure(c(Info = NA_integer_,
tmean = NA_integer_, CITYNAME = NA_integer_, Model = NA_integer_,
Variable = NA_integer_, Datatype = NA_integer_, Resolution = NA_integer_,
year = NA_integer_, month = NA_integer_, TMin = NA_integer_,
TMax = NA_integer_), class = "factor", .Label = c("constant",
"aggregate", "identity")), class = c("sf", "data.frame"))
Code:
library(tidyverse)
library(sf)
sf_avg = sf %>%
summarise(AvgTMean = mean(tmean),
AvgTMin = mean(TMin),
AvgTMax = mean(TMax)) # Returns the same average value for both the points
# Test static map
qtm(df_df, fill ="AvgTMean", legend = TRUE) +
tm_add_legend(labels = dff$AvgTMean)
I had trouble with your example so I make a small reproducible example. You will probably need to adapt it for your needs.
# loading lib
library(sf)
library(dplyr)
# data is in tidy format so you have a replicate of 3 points
pnt_attribute <- data.frame(year = rep(seq(from = 2022 - 40, to = 2021, by = 1),3)
, temp1 = c(rnorm(40, mean = 20, sd = 5)
, rnorm(40, mean = 20, sd = 10)
, rnorm(40, mean = 15, sd = 5))
)
# this create a table with 3 points replicate 40 times
pnts <- data.frame(
id = c(rep(1, 40),
rep(2, 40),
rep(3,40))
, x = c(rep(5, 40),
rep(1, 40),
rep(0, 40))
, y = c(rep(2, 40),
rep(3, 40),
rep(1, 40)))
# combine the two df then transorm into sf
rep_example <- st_as_sf(cbind(pnts, pnt_attribute), coords = c("x", "y"))
Then you create your summary:
rep_example_agg <- rep_example |>
group_by(id) |>
summarize(AvgTMean = mean(temp1, na.rm = TRUE),
AvgTMin = min(temp1, na.rm = TRUE),
AvgTMax = max(temp1, na.rm = TRUE))
# the result
# Simple feature collection with 3 features and 4 fields
# Geometry type: POINT
# Dimension: XY
# Bounding box: xmin: 0 ymin: 1 xmax: 5 ymax: 3
# CRS: NA
# # A tibble: 3 × 5
# id AvgTMean AvgTMin AvgTMax geometry
# <dbl> <dbl> <dbl> <dbl> <POINT>
# 1 1 19.4 5.92 29.2 (5 2)
# 2 2 20.0 -1.34 40.8 (1 3)
# 3 3 14.6 3.37 26.1 (0 1)
I think you either needed the group_by of your data are in an other structure.
Good resource: https://geocompr.robinlovelace.net/attr.html#vector-attribute-aggregation
I have geometric data that I would like to plot in leaflet. In my geometry column, one row is a geometry collection, containing a line and some points, the other row only contains points. I know that if it was just lines/points I could use addPolylines/addMarkers.
How can I plot both of these geometries in leaflet?
My data:
structure(list(combination = c(1, 2), geometry = structure(list(
structure(list(structure(c(1.00223626569548, 52.8556265508789
), class = c("XY", "POINT", "sfg")), structure(c(1.00326623395723,
52.8573368002252), class = c("XY", "POINT", "sfg")), structure(c(1.00429620221897,
52.8566371609111), class = c("XY", "POINT", "sfg")), structure(c(1.00527520850952,
52.8586496729252), class = c("XY", "POINT", "sfg")), structure(c(1.01609106327471,
1.01909513737114, 1.01921315456779, 1.01921315456779, 52.7752838744008,
52.7755824285876, 52.775679782771, 52.7756862730421), .Dim = c(4L,
2L), class = c("XY", "LINESTRING", "sfg"))), class = c("XY",
"GEOMETRYCOLLECTION", "sfg")), structure(c(0.867595713389035,
1.00619833369932, 1.00794400647932, 1.01899857784703, 1.01899857784703,
1.07326277775903, 1.07332446856619, 1.07332446856619, 1.07390650792255,
1.07418277545098, 1.07426860613946, 1.07547291798711, 1.0765835751637,
1.07800224108829, 1.07894637866155, 52.0181779309727, 52.8610140394857,
52.8581400758993, 52.7756018997388, 52.7756051448803, 52.8668154271298,
52.8611112609685, 52.8616812795274, 52.8676314804611, 52.8611630811469,
52.8615776403463, 52.8678128235613, 52.8685576174324, 52.8612926313222,
52.8671738019108), .Dim = c(15L, 2L), class = c("XY", "MULTIPOINT",
"sfg"))), n_empty = 0L, crs = structure(list(input = "EPSG:4326",
wkt = "GEOGCRS[\"WGS 84\",\n DATUM[\"World Geodetic System 1984\",\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"geodetic latitude (Lat)\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"geodetic longitude (Lon)\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n USAGE[\n SCOPE[\"unknown\"],\n AREA[\"World\"],\n BBOX[-90,-180,90,180]],\n ID[\"EPSG\",4326]]"), class = "crs"), class = c("sfc_GEOMETRY",
"sfc"), precision = 0, bbox = structure(c(xmin = 0.867595713389035,
ymin = 52.0181779309727, xmax = 1.07894637866155, ymax = 52.8685576174324
), class = "bbox"), classes = c("GEOMETRYCOLLECTION", "MULTIPOINT"
))), row.names = 1:2, class = c("sf", "data.frame"), sf_column = "geometry", agr =
structure(c(combination = 2L), .Label = c("constant",
"aggregate", "identity"), class = "factor"))
You should try to transform your sf or sp object to geojson then to use:
addGeoJSON(args)
That will show point with marker, polygons and lines
I have a fairly simple problem where I want to create a gif which loops through departure_hour and colors the lines based on link volumes. One caveat is the number of rows between states (i.e. departure_hour) may be different.
Here is the code I am trying:
vol <- ggplot() +
geom_sf(data = test, aes(color=link_volume)) +
scale_color_distiller(palette = "OrRd", direction = 1) +
ggtitle("{frame_time}") +
transition_time(departure_hour) +
ease_aes("linear") +
enter_fade() +
exit_fade()
animate(vol, fps = 10, width = 750, height = 450)
However, when I do this I am getting the error:
Error in tween_state(as.data.frame(full_set$from), as.data.frame(full_set$to),:
identical(classes, col_classes(to)) is not TRUE
First, I do not understand if the error is referring to column classes or color classes? If it is color classes am I correct in assuming that the color scales between each plot may be different and that is the reason for this error?
Second, how do I fix this error? There seems to be just one more question on this issue and it has no solution.
Sample data:
> dput(head(test,5))
structure(list(linkid = c(12698L, 26221L, 36429L, 36430L, 47315L
), departure_hour = c(14, 19, 11, 0, 18), link_volume = c(500L,
1550L, 350L, 100L, 550L), geometry = structure(list(structure(c(1065088.71736072,
1065084.18813218, 1253892.13487564, 1253935.59094818), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1060907.62521458,
1060984.50834787, 1237578.71728528, 1237818.59111698), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1063031.34624456,
1062955.36965935, 1241210.04281066, 1241498.76584417), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1063031.34624456,
1063034.73081084, 1241210.04281066, 1241198.98905491), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg")), structure(c(1058112.52771678,
1058131.02887377, 1236388.96345761, 1236342.13157851), .Dim = c(2L,
2L), class = c("XY", "LINESTRING", "sfg"))), class = c("sfc_LINESTRING",
"sfc"), precision = 0, bbox = structure(c(xmin = 1058112.52771678,
ymin = 1236342.13157851, xmax = 1065088.71736072, ymax = 1253935.59094818
), class = "bbox"), crs = structure(list(epsg = 5070L, proj4string = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=23 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr = structure(c(linkid = NA_integer_,
departure_hour = NA_integer_, link_volume = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), row.names = c(NA,
5L), class = c("sf", "data.table", "data.frame"))
I have the following map of Mexico. It shows all of its municipalities and around 400 weather stations.
I want to create a 10km buffer around each station and eventually, associate each municipality to a station that is located within each radius.
The map and the stations are stored on separate sf objects. I tired the following:
buffers <- st_buffer(stations, dist = 1)
I thought the dist argument was set to kilometers, so I tried dist = 10. Unfortunately, this returned HUGE buffers for each station. That's why I am using dist = 1, but even these buffers are as big as a state! This question, suggests I transform my stations to Irish Grid, but I couldn't replicate the accepted answer. I am now wondering what unit the dist argument is set to.
From the aforementioned question, I assume it's set to degrees. How can I set a 10km buffer around each station?
Additional info:
My CRS is set to 4326 on both objects (the Mexican map and the stations).
This is my stations data:
> dput(head(stations))
structure(list(station_number = c(1004L, 1005L, 1008L, 1012L,
1017L, 1018L), station_alt = c(1925, 1844, 2323, 1589, 2172,
2053), month = c(9L, 9L, 9L, 9L, 9L, 9L), Mean_min = c(11.6,
12.75, 12.25, 13.9666666666667, 12.9, 12.6833333333333), Mean_max = c(26.9333333333333,
26.85, 24.0833333333333, 29.0333333333333, 24.8666666666667,
26.1333333333333), months_observed = c(5L, 5L, 5L, 5L, 5L, 5L
), geometry = structure(list(structure(c(-102.199, 22.001), class = c("XY",
"POINT", "sfg")), structure(c(-102.372, 21.781), class = c("XY",
"POINT", "sfg")), structure(c(-102.135, 22.203), class = c("XY",
"POINT", "sfg")), structure(c(-102.802, 21.794), class = c("XY",
"POINT", "sfg")), structure(c(-102.444, 22.233), class = c("XY",
"POINT", "sfg")), structure(c(-102.415, 22.141), class = c("XY",
"POINT", "sfg"))), class = c("sfc_POINT", "sfc"), precision = 0, bbox = structure(c(xmin = -102.802,
ymin = 21.781, xmax = -102.135, ymax = 22.233), class = "bbox"), crs = structure(list(
epsg = NA_integer_, proj4string = NA_character_), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr = structure(c(station_number = NA_integer_,
station_alt = NA_integer_, month = NA_integer_, Mean_min = NA_integer_,
Mean_max = NA_integer_, months_observed = NA_integer_), .Label = c("constant",
"aggregate", "identity"), class = "factor"), row.names = c(NA,
6L), class = c("sf", "data.frame"))
Your coordinates are long/lat, so the distance will be in degrees. You should first project to a spatial reference in meter units and then take 10 000 meters.
The manual of st_buffer says this about the dist argument:
in case dist is a units object, it should be convertible to
arc_degree if x has geographic coordinates, and to st_crs(x)$units
otherwise
If you leave the coordinates in 4326 you should be able to take something like 0.1 which should be about 11 km for Mexico, but you will see a warning message:
In st_buffer.sfc(st_geometry(x), dist, nQuadSegs, endCapStyle =
endCapStyle, : st_buffer does not correctly buffer
longitude/latitude data
So first convert to another projection (in meter) and enter the distance in meters. This should work, which uses EPSG 7801:
library(sf)
pois <- st_as_sf(stations)
st_crs(pois) <- 4326
pois <- st_transform(pois, crs = 7801)
plot(st_geometry(pois))
buff <- st_buffer(pois, dist = 10000)
plot(st_geometry(buff), add = TRUE)
Control with leaflet and the measure tool:
buff <- st_transform(buff, crs = 4326)
library(leaflet)
leaflet() %>%
addTiles() %>%
addMeasure(primaryLengthUnit = "meters") %>%
addMarkers(data = pois) %>%
addPolygons(data = buff)