I have a dataframe of points and plotted it using plot. Now I want to add a RasterLayer of AnnualTemp. Can you please assist in completing the code?
library(raster)
MinTemp_plots <- data.frame(
Station = c( "Labasa", "Laucala", "Lautoka", "Levuka", "Matei", "Matuku",
"Nabouwalu", "Nacocolevu", "Nadi", "Nausori", "Ono-I-Lau", "Penang",
"Savusavu", "UduPoint", "Viwa", "Yasawa"),
Latitude = c(-16.43, -18.15, -17.6, -17.68, -16.69, -19.15, -16.98,
-18.1, -17.75, -18.03, -20.65, -17.37, -16.78, -16.11,
-17.14, -16.78 ),
Longitude = c(179.36, 178.45, 177.45, 178.83, 180, 179.76, 178.7, 177.55,
177.45, 178.56, 178.7, 178.15, 179.34, 180, 176.93,
177.5),
AnnualTempMin = c(1.722, 1.711, 0.042, 0.135, 0.264, 0.276, 0.625, 1.215,
1.522, 0.917, 0.617, 0.072, 0.509, 1.057, 1.201, 0.123))
plot(y= MinTemp_plots$Latitude, x= MinTemp_plots$Longitude)
r <- raster(xmn=1790828.61, xmx=2337149.40, ymn=3577110.39, ymx=4504717.19, res=100000)
crs(r) = crs("+init=epsg:3460")
I am not entirely sure what your question is, but here goes:
Add values to the example RasterLayer for plotting
values(r) <- 1:ncell(r)
Create a SpatialPointsDataFrame
x <- MinTemp_plots
coordinates(x) <- ~ Longitude + Latitude
crs(x) <- "+proj=longlat"
Transform it to the same coordinate reference system as the raster
y <- spTransform(x, crs(r))
And now plot
plot(r)
points(y)
Related
I'm trying to interpolate my dataset using spatio-temporal kriging approach from gstat and spacetime packages. For the plotting of the results, I use STplot function.
I want to use the mode 'xt' which produce the space/time plots. But when I read about this from the STplot documentation, it states that:
" Beware: when the x-coordinate is plotted, and for each (x,t) [x-coordinate and time - author] element multiple y-coordinates are sent to the plot, it is not clear which (x,y,t) value becomes the plotted value, so slicing single y values is adviced -- no checking is done. "
So how do I do the slicing? It is very much appreciated if anyone can show some examples. Thanks.
my data:
structure(list(LAT = c(-27.6516, -28.125, -28.0402, -30.7834,
-30.3186, -26.799, -29.1691, -27.8048, -32.0287, -30.7785, -26.8046,
-28.4746, -33.7363, -27.8916, -27.1171, -28.5705, -31.5168, -26.2128,
-29.4817, -30.6332, -27.502, -30.0559, -29.9606, -28.3372, -29.8045,
-30.5696, -28.0601, -32.124, -27.901, -27.1366), LONG = c(122.3147,
123.9281, 120.8122, 122.4, 119.0079, 117.9917, 117.6532, 120.7011,
119.9546, 121.8267, 120.268, 117.8563, 117.2423, 121.2715, 119.2709,
119.0009, 120.4255, 120.3706, 119.7581, 119.3093, 121.1075, 119.3646,
119.4459, 121.1211, 119.8226, 121.4668, 119.5071, 119.024, 121.1539,
118.2815), AGE_MA = c(2719L, 2717L, 2712L, 2711L, 2711L, 2711L,
2710L, 2709L, 2708L, 2705L, 2704L, 2704L, 2702L, 2702L, 2701L,
2701L, 2701L, 2700L, 2699L, 2699L, 2699L, 2698L, 2697L, 2695L,
2693L, 2692L, 2691L, 2691L, 2690L, 2689L), EHFI_new = c(1.015,
0.945, 1.02, -3.165, -2.565, -0.865, -0.65, 0.065, -4.52, -0.375,
-2.76, 1.44, -2.03, 2.07, -7.915, -5.215, -2.115, 1.575, -8.785,
-3.185, 2.015, -5.87, -7.855, 2.575, -8.095, 1.42, -6.665, -3.965,
2.45, 0.665)), row.names = c(NA, 30L), class = "data.frame")
Preparing the session
library("spacetime")
library("gstat")
library("sp")
library("xts")
library("rgdal")
#setting the working directory and load the data
mydata <- read.csv("2627.csv")
df <- data.frame(mydata)
values <- df[, c('EHFI_new')]
time <- df[, c('AGE_MA')]
#Assigning the coordinates and projection
coordinates(df) <- c("LONG","LAT")
proj4string(df) <- CRS("+init=epsg:4326")
#Transform the projection
sp.df <- spTransform(df,CRSobj = "+proj=utm +zone=51 +south
+datum=WGS84
+units=m +no_defs")
Creating object STIDF format
#STIDF consist of dataframe (spatialpoint, temporal, data)
#spatialPoint 0bject
sp_sp <- SpatialPoints(sp.df#coords, CRS("+proj=utm +zone=51 +south
+datum=WGS84 +units=m +no_defs"))
#temporal Object
t <- as.POSIXct(time*60*60*24, origin = "1970-01-01")
#data values
data <- data.frame(values=df$EHFI_new)
#'Merging' the objects into the STIDF format
#Creating the STIDF Object - spatial and temporal object, values
stidf <- STIDF(sp_sp, t, data = data)
Making the prediction grid - space and time grid
#space grid
x.range_1 <- as.numeric(c(-608380.858, 860489.815))
y.range_1 <- as.numeric(c(6080795, 7383164))
grd <- expand.grid(x = seq(from = x.range_1[1], to = x.range_1[2], by
= 10000), y = seq(from = y.range_1[1], to = y.range_1[2], by =
10000))
coordinates(grd) <- ~x + y
grd <- SpatialPixels(grd, proj4string = "+proj=utm +zone=51 +south
+datum=WGS84 +units=m
+no_defs")
#time grid
n <- 5
tgrd <- xts(1:n, seq(min(t)-10, max(t)+100, length = n))
#space-time grid
pred.grd <- STF(grd, tgrd)
Variogram model
vs1 <- variogramST(values~1, stidf, tunit="days",
tlags=seq(0,100, length = 7),
assumeRegular = F,
na.omit = T,
cores = 4)
#fitting Variogram modell
ssm <- vgmST("simpleSumMetric",
space = vgm(9,"Gau", 136417, 1.6),
time = vgm(3,"Gau", 18, 7.5),
joint = vgm(3,"Gau", 500, 2),
nugget=1.6, stAni= 18677.26)
ssm_vgm <- fit.StVariogram(vs1, ssm, fit.method = 7,
method = "L-BFGS-B")
STKriging interpolation
EHFI_krg <- krigeST(values~1, data=stidf, newdata=pred.grd,
modelList=ssm_vgm, nmax = 30, stAni = 18677.26,
bufferNmax=3, progress=TRUE)
Space/time plot using STplot
STmap <- stplot(EHFI_krg, mode = "xt", as.table = T, scaleX = 1)
Is there a way with the mapview library to plot the size of point symbols using a non-linear scale? For example, with geometric intervals, a custom vector of intervals, or intervals based on something like the Jenks' natural breaks method? (mapview's 'setting point size 'cex' linearly': https://r-spatial.github.io/mapview/articles/articles/mapview_02-advanced.html )
My use case is plotting many points of river gage flow data, but enormously high and low values at the coast from ocean tides dominate the scale, to a point that essentially all of the non-coastal locations appear to have symbol sizes (representing river flow) that are barely discernibly different, whereas I'm hoping the user can easily visualize differences like creeks vs rivers (eg here, three groups with values in the 1000s, another in the 5000s, and another in the 9000s).
library(mapview)
library(sf)
lat <- seq(1, 20, 1)
lon <- lat
value_to_visualize <- c(461000, 1500, 1400, 1450, 1350, 1100, 1400, 2000, 9040, 9060,
9080, 9990, 9995, 5750, 5500, 5400, 5300, 5100, 5050, -60000)
df <- data.frame(lat,lon, value_to_visualize)
df <- st_as_sf(df, coords = c("lon", "lat"), crs = 4326)
m <- mapview(df["value_to_visualize"],
cex = "value_to_visualize",
legend = TRUE,
layer.name = "cfs")
m
library(mapview)
library(sf)
lat <- seq(1, 20, 1)
lon <- lat
value_to_visualize <- c(461000, 1500, 1400, 1450, 1350, 1100, 1400, 2000, 9040, 9060,
9080, 9990, 9995, 5750, 5500, 5400, 5300, 5100, 5050, -60000)
cluster_to_visualize <- dplyr::case_when(value_to_visualize<1000 ~ 1,
value_to_visualize<5000 ~ 3,
value_to_visualize<9000 ~ 5,
value_to_visualize>9000 ~ 7)
df <- data.frame(lat,lon, cluster_to_visualize, value_to_visualize)
df <- st_as_sf(df, coords = c("lon", "lat"), crs = 4326)
m <- mapview(df["value_to_visualize"],
cex = df$cluster_to_visualize,
legend = TRUE,
layer.name = "cfs")
Created on 2019-06-05 by the reprex package (v0.3.0)
I'd like to eliminate the white space between my two forest plots that I plotted side-by-side using grid.arrange().
Before you vote down or redirect - Before asking this question, I have spent hours attempting every solution posed in each of the responses I've seen here for similar questions without achieving my desired result.
First, here is my dataset and code:
library(meta)
library(grid)
library(gridExtra)
df <- structure(list(study = 1:7,
sens = c(0.88, 0.86, 0.75, 0.9, 0.91, 0.93, 0.98),
sens.se = c(0.13, 0.08, 0.2, 0.06, 0.13, 0.15, 0.66),
sens2 = c(0.76, 0.68, 0.9, 0.82, 0.76, 0.85, 0.76),
sens.se2 = c(0.14, 0.08, 0.2, 0.06, 0.14, 0.15, 0.66)),
class = "data.frame",
row.names = c(NA, -7L))
## setting up meta-analysis model using library(meta)
res1 <- metagen(TE=sens, seTE=sens.se, data=df, studlab=study)
res2 <- metagen(TE=sens2, seTE=sens.se2, data=df, studlab=study)
## changing plots to grid graphical objects to use grid.arrange
fp1 <- grid.grabExpr(forest(res1, data=df, method.tau="REML",
comb.random=TRUE, leftcols="studlab",
rightcols=c("effect", "ci")))
fp2 <- grid.grabExpr(forest(res2, data=df, method.tau="REML",
comb.random=TRUE, leftcols="studlab",
rightcols=c("effect", "ci")))
## arranging plots side by side:
grid.arrange(fp1, fp2, ncol = 2)
When I have attempted to use code suggested in responses to similar questions, I get the "only grobs allowed in gList" error code, even though R recognizes the plots as "gTrees" because I used the grid.grabExpr function. I've tried coercing the gTrees into grobs via:
p1 <- as.grob(fp1)
p2 <- as.grob(fp2)
, which only creates null values in the global environment.
I would greatly appreciate some help with this!
Perhaps this does what you are looking for:
grid.grabExpr(
forest(
res1, data=df, method.tau="REML",
comb.random=TRUE, leftcols="studlab",
rightcols=c("effect", "ci")
),
height = 1, width = 2
) -> fp1
grid.grabExpr(
forest(
res2, data=df, method.tau="REML",
comb.random=TRUE, leftcols="studlab",
rightcols=c("effect", "ci")
),
height = 1, width = 2
) -> fp2
grid.arrange(fp1, fp2, ncol = 2, vp=viewport(width=1, height=1, clip = TRUE))
I have been trying to create a density plot in R that looks similar to the picture below.
In my code below, I have created a stat_density_2D plot that successfully plots my data, however, it fails to recognize my fill variable (in this case exitspeed) and only plots one color.
Upon further research, I believe the reason for this is because stat_density_2d bins the fill into levels. The problem I am having is that my fill variable has multiple values for the points within a particular level ultimately resulting in a density plot that only displays one color. Does anyone know how to bin my data so that my density plot can recognize the fill variable (exitspeed)? Please see below for the dataset and R code. Thanks in advance!
Data:
structure(list(platelocheight = c(2.594, 3.803, 3.254, 3.599,
3.617, 3.297, 2.093, 3.611, 2.842, 3.316, 2.872, 3.228, 3.633,
4.28, 3.309, 2.8, 2.632, 3.754, 2.207, 3.604, 3.443, 2.188, 3.452,
2.553, 3.382, 3.067, 2.986, 2.785, 2.567, 3.804), platelocside = c(0.059,
-1.596, -0.65, -0.782, -0.301, -0.104, 0.057, -0.807, 0.003,
1.661, 0.088, -0.32, -1.115, -0.146, -0.364, -0.952, 0.254, 0.109,
-0.671, -0.803, -0.212, -0.069, -0.09, -0.472, 0.434, 0.337,
0.723, 0.508, -0.197, -0.635), exitspeed = c(69.891, 73.352,
83.942, 85.67, 79.454, 85.277, 81.078, 73.573, 77.272, 59.263,
97.343, 91.436, 76.264, 83.479, 47.576, 84.13, 60.475, 61.093,
84.54, 69.959, 88.729, 88.019, 82.18, 83.684, 86.296, 90.605,
79.945, 59.899, 62.522, 77.75)), .Names = c("platelocheight",
"platelocside", "exitspeed"), row.names = c(NA, 30L), class = "data.frame")
R-Code:
library(RODBC)
library(ggplot2)
con=odbcConnect('username',uid='userid', pwd = 'password')
df=sqlQuery(con,"select platelocheight, platelocside, exitspeed from tm_sample where pitchcall='InPlay'
and exitspeed is not null")
topKzone <- 3.5
botKzone <- 1.6
inKzone <- -0.95
outKzone <- 0.95
kZone <- data.frame(
x=c(inKzone, inKzone, outKzone, outKzone, inKzone),
y=c(botKzone, topKzone, topKzone, botKzone, botKzone)
)
df$h <- round(df$platelocheight)
df$s <- round(df$platelocside)
df$es<- round(df$exitspeed)
ggplot(kZone, aes(x,y)) +
stat_density_2d(data=df, aes(x=s, y=h, fill=es),geom="polygon") +
scale_fill_distiller(palette = "Spectral") +
geom_path(lwd=1.5, col="black") +
coord_fixed()
I have this dataset:
sample <- structure(list(A = c(1415.6, 1345.3, 1321.7, 1234.5, 1567.8,
1476.6, 1610.1, 1422.6, 1209.1, 1249.3, 1377.5, 1525.7, 1683.7,
1500.1, 1565.3, 1737.4, 1321, 1477.8, 1642, 1608.1, 1427.8, 1608.2,
1404.4, 1688.3, 1795.4), B = c(98, 457, 756, 971, 1148, 4260,
16307, 42614, 69787, 76301, 80491, 82267, 83975, 85310, 86322,
94492, 98798, 102514, 126045.986, 160848.998, 183607.7625, 212747.9255,
249117.2874, 306092.91, 339609.8663), C = c(1.2397, 1.5526, -0.1829,
-0.3298, -0.1945, 2.8669, 1.3536, 0.781, 0.0324, -1.4283, -0.4413,
-0.8583, -0.039, -0.2464, -0.277, 2.0885, -0.6405, -0.1474, 1.8457,
0.3913, -0.4248, 0.2472, 0.2216, 0.4489, -0.5306)), .Names = c("A",
"B", "C"), class = "data.frame", row.names = c(NA, -25L))
and I want to change the plot region colour in vis.gam function (invert the grey colour - the higher the number in the plot contours the darker the colour of the plot region and vice versa):
library(mgcv)
m0 <-gam(C ~ A + B, data = sample)
vis.gam(m0, plot.type="contour", color="gray")
I would like to just invert the colour palette. If not possible, change it manually.
I've tried somethoing like this (I choosed names only by chance)
vis.gam(m0,plot.type="contour", col=c("#FFFFFF", "#F7F7F7", "666666"))
vis.gam(m0,plot.type="contour", col=("grey25", "grey26", "grey27"))
but that is not working.
Unfortunately the definition of vis.gam doesn't allow what you want. Fortunately, it is fairly easy to modify this function to do what you want:
# first get the definition of vis.gam
newDef <- deparse(vis.gam)
# change the line defining the direction of the grey gradient
newDef[grep("gray\\(seq\\(",newDef)] <- " pal <- gray(seq(0.9, 0.1, length = nCol))"
# then define a new function with this new definition
vis.gam2 <- eval(parse(text=newDef))
Now using vis.gam2 will do what you want:
vis.gam2(m0, plot.type="contour", color="gray")