I am a green-hand on R code. Now I meet some trouble in plotting contour figure by using R code.
I have checked help(filled.contour) which tells that if you want to plot the contour, x,y should be both in ascending order. Actually, I receive the data randomly, like:
latitude, longitude, value
37.651098 140.725082 9519
37.650765 140.725248 9519
37.692738 140.749118 23600
37.692737 140.749118 9911
37.692695 140.749107 16591
37.692462 140.74902 6350
37.692442 140.749052 5507
37.692413 140.749148 5476
37.692383 140.74929 7069
37.692357 140.749398 6152
37.692377 140.749445 6170
37.692355 140.749587 7163
37.692298 140.749672 6831
37.692292 140.749787 6194
37.692283 140.749903 6696
37.692342 140.750007 8204
37.692585 140.750037 2872
37.692648 140.749948 3907
37.692655 140.749827 4891
37.692667 140.749687 4899
How can I plot the contour figure!?
Here is my code:
args <- commandArgs(trailingOnly = TRUE)
data1 <- args[1]
outputDir <- args[2]
outputFig = paste(outputDir, "Cs13x.jpeg",sep="");
jpeg(file = outputFig, width = 800,height=600, pointsize=20)
pinkcol <- rgb(1,0.7,0.7)
gpsdata <- read.table(file=data1,sep=" ");
lat <- as.vector(gpsdata[,1]);
lon <- as.vector(gpsdata[,2]);
datas <- as.vector(gpsdata[,3]);
datas <- abs(datas)
#---Convert gpsdata into x,y coordinate---#
# Convert degree into value
lat_pi <- lat*pi/180;
lon_pi <- lon*pi/180;
# calculate the value into corresponding x,y coordinate
x = cos(lat_pi) * cos(lon_pi);
y = cos(lat_pi) * sin(lon_pi);
#----------#
dataMatrix = matrix(datas, nrow = length(datas), ncol=length(datas));
plot.new()
filled.contour(sort(x),sort(y, decreasing = TRUE),dataMatrix, col = rainbow(100), main="Contour Figure of Cs13x"); (**WRONG HERE!!!**)
dev.off()
<-------------- FINISH LINE ----------->
The 'akima' package will do it. It is designed to handle irregularly spaced z values. The first two points were widely separated from the rest and that made the results from the whole dataset look rather sketchy, so I omitted them.
require(akima)
gps.interp <- with( gpsdata[-(1:2), ], interp(x=latitude, y=longitude, z=value))
contour(gps.interp)
Related
Imagine a regular 0.5° grid across the Earth's surface. A 3x3 subset of this grid is shown below. As a stylized example of what I'm working with, let's say I have three polygons—yellow, orange, and blue—that for the sake of simplicity all are 1 unit in area. These polygons have attributes Population and Value, which you can see in the legend:
I want to turn these polygons into a 0.5° raster (with global extent) whose values are based on the weighted-mean Value of the polygons. The tricky part is that I want to weight the polygons' values based on not their Population, but rather on their included population.
I know—theoretically—what I want to do, and below have done it for the center gridcell.
Multiply Population by Included (the area of the polygon that is included in the gridcell) to get Pop. included. (Assumes population is distributed evenly throughout polygon, which is acceptable.)
Divide each polygon's Included_pop by the sum of all polygons' Included_pop (32) to get Weight.
Multiply each polygon's Value by Weight to get Result.
Sum all polygons' Result to get the value for the center gridcell (0.31).
Population
Value
Frac. included
Pop. included
Weight
Result
Yellow
24
0.8
0.25
6
0.1875
0.15
Orange
16
0.4
0.5
8
0.25
0.10
Blue
18
0.1
1
18
0.5625
0.06
32
0.31
I have an idea of how to accomplish this in R, as described below. Where possible, I've filled in code that I think will do what I want. My questions: How do I do steps 2 and 3? Or is there a simpler way to do this? If you want to play around with this, I have uploaded old_polygons as a .rds file here.
library("sf")
library("raster")
Calculate the area of each polygon: old_polygons$area <- as.numeric(st_area(old_polygons))
Generate the global 0.5° grid as some kind of Spatial object.
Split the polygons by the grid, generating new_polygons.
Calculate area of the new polygons: new_polygons$new_area <- as.numeric(st_area(new_polygons))
Calculate fraction included for each new polygon: new_polygons$frac_included <- new_polygons$new_area / new_polygons$old_area
Calculate "included population" in the new polygons: new_polygons$pop_included <- new_polygons$pop * new_polygons$frac_included
Calculate a new attribute for each polygon that is just their Value times their included population. new_polygons$tmp <- new_polygons$Value * new_polygons$frac_included
Set up an empty raster for the next steps: empty_raster <- raster(nrows=360, ncols=720, xmn=-180, xmx=180, ymn=-90, ymx=90)
Rasterize the polygons by summing this new attribute together within each gridcell. tmp_raster <- rasterize(new_polygons, empty_raster, "tmp", fun = "sum")
Create another raster that is just the total population in each gridcell: pop_raster <- rasterize(new_polygons, empty_raster, "pop_included", fun = "sum")
Divide the first raster by the second to get what I want:
output_raster <- empty_raster
values(output_raster) <- getValues(tmp_raster) / getValues(pop_raster)
Any help would be much appreciated!
Example data:
library(terra)
f <- system.file("ex/lux.shp", package="terra")
v <- vect(f)
values(v) <- data.frame(population=1:12, value=round(c(2:13)/14, 2))
r <- rast(ext(v)+.05, ncols=4, nrows=6, names="cell")
Illustrate the data
p <- as.polygons(r)
plot(p, lwd=2, col="gray", border="light gray")
lines(v, col=rainbow(12), lwd=2)
txt <- paste0(v$value, " (", v$population, ")")
text(v, txt, cex=.8, halo=TRUE)
Solution:
# area of the polygons
v$area1 <- expanse(v)
# intersect with raster cell boundaries
values(r) <- 1:ncell(r)
p <- as.polygons(r)
pv <- intersect(p, v)
# area of the polygon parts
pv$area2 <- expanse(pv)
pv$frac <- pv$area2 / pv$area1
Now we just use the data.frame with the attributes of the polygons to compute the polygon-cover-weighted-population-weighted values.
z <- values(pv)
a <- aggregate(z[, "frac", drop=FALSE], z[,"cell",drop=FALSE], sum)
names(a)[2] <- 'fsum'
z <- merge(z, a)
z$weight <- z$population * z$frac / z$fsum
z$wvalue <- z$value * z$weight
b <- aggregate(z[, c("wvalue", "weight")], z[, "cell", drop=FALSE], sum)
b$bingo <- b$wvalue / b$weight
Assign values back to raster cells
x <- rast(r)
x[b$cell] <- b$bingo
Inspect results
plot(x)
lines(v)
text(x, digits=2, halo=TRUE, cex=.9)
text(v, "value", cex=.8, col="red", halo=TRUE)
This may not scale very well to large data sets, but you could perhaps do it in chunks.
This is fast and scalable:
library(data.table)
library(terra)
# make the 3 polygons with radius = 5km
center_points <- data.frame(lon = c(0.5, 0.65, 1),
lat = c(0.75, 0.65, 1),
Population = c(16, 18, 24),
Value = c(0.4, 0.1, 0.8))
polygon <- vect(center_points, crs = "EPSG:4326")
polygon <- buffer(polygon, 5000)
# make the raster
my_raster <- rast(nrow = 3, ncol = 3, xmin = 0, xmax = 1.5, ymin = 0, ymax = 1.5, crs = "EPSG:4326")
my_raster[] <- 0 # set the value to 0 for now
# find the fractions of cells in each polygon
# "cells" gives you the cell ID and "weights" (or "exact") gives you the cell fraction in the polygon
# using "exact" instead of "weights" is more accurate
my_Table <- extract(my_raster, polygon, cells = TRUE, weights = TRUE)
setDT(my_Table) # convert to datatable
# merge the polygon attributes to "my_Table"
poly_Table <- setDT(as.data.frame(polygon))
poly_Table[, ID := 1:nrow(poly_Table)] # add the IDs which are the row numbers
merged_Table <- merge(my_Table, poly_Table, by = "ID")
# find Frac_included
merged_Table[, Frac_included := weight / sum(weight), by = ID]
# find Pop_included
merged_Table[, Pop_included := Frac_included * Population]
# find Weight, to avoid confusion with "weight" produced above, I call this "my_Weight"
merged_Table[, my_Weight := Pop_included / sum(Pop_included), by = cell]
# final results
Result <- merged_Table[, .(Result = sum(Value * my_Weight)), by = cell]
# add the values to the raster
my_raster[Result$cell] <- Result$Result
plot(my_raster)
I am trying to figure our the proportion of an area that has a slope of 0, +/- 5 degrees. Another way of saying it is anything above 5 degrees and below 5 degrees are bad. I am trying to find the actual number, and a graphic.
To achieve this I turned to R and using the Raster package.
Let's use a generic country, in this case, the Philippines
{list.of.packages <- c("sp","raster","rasterVis","maptools","rgeos")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)}
library(sp) # classes for spatial data
library(raster) # grids, rasters
library(rasterVis) # raster visualisation
library(maptools)
library(rgeos)
Now let's get the altitude information and plot the slopes.
elevation <- getData("alt", country = "PHL")
x <- terrain(elevation, opt = c("slope", "aspect"), unit = "degrees")
plot(x$slope)
Not very helpful due to the scale, so let's simply look at the Island of Palawan
e <- drawExtent(show=TRUE) #to crop out Palawan (it's the long skinny island that is roughly midway on the left and is oriented between 2 and 8 O'clock)
gewataSub <- crop(x,e)
plot(gewataSub, 1)## Now visualize the new cropped object
A little bit better to visualize. I get a sense of the magnitude of the slopes and that with a 5 degree restriction, I am mostly confined to the coast. But I need a little bit more for analysis.
I would like Results to be something to be in two parts:
1. " 35 % (made up) of the selected area has a slope exceeding +/- 5 degrees" or " 65 % of the selected area is within +/- 5 degrees". (with the code to get it)
2. A picture where everything within +/- 5 degrees is one color, call it good or green, and everything else is in another color, call it bad or red.
Thanks
There are no negative slopes, so I assume you want those that are less than 5 degrees
library(raster)
elevation <- getData('alt', country='CHE')
x <- terrain(elevation, opt='slope', unit='degrees')
z <- x <= 5
Now you can count cells with freq
f <- freq(z)
If you have a planar coordinate reference system (that is, with units in meters or similar) you can do
f <- cbind(f, area=f[,2] * prod(res(z)))
to get areas. But for lon/lat data, you would need to correct for different sized cells and do
a <- area(z)
zonal(a, z, fun=sum)
And there are different ways to plot, but the most basic one
plot(z)
You can use reclassify from the raster package to achieve that. The function assigns each cell value that lies within a defined interval a certain value. For example, you can assign cell values within interval (0,5] to value 0 and cell values within the interval (5, maxSlope] to value 1.
library(raster)
library(rasterVis)
elevation <- getData("alt", country = "PHL")
x <- terrain(elevation, opt = c("slope", "aspect"), unit = "degrees")
plot(x$slope)
e <- drawExtent(show = TRUE)
gewataSub <- crop(x, e)
plot(gewataSub$slope, 1)
m <- c(0, 5, 0, 5, maxValue(gewataSub$slope), 1)
rclmat <- matrix(m, ncol = 3, byrow = TRUE)
rc <- reclassify(gewataSub$slope, rclmat)
levelplot(
rc,
margin = F,
col.regions = c("wheat", "gray"),
colorkey = list(at = c(0, 1, 2), labels = list(at = c(0.5, 1.5), labels = c("<= 5", "> 5")))
)
After the reclassification you can calculate the percentages:
length(rc[rc == 0]) / (length(rc[rc == 0]) + length(rc[rc == 1])) # <= 5 degrees
[1] 0.6628788
length(rc[rc == 1]) / (length(rc[rc == 0]) + length(rc[rc == 1])) # > 5 degrees
[1] 0.3371212
Hello
I am attempting to plot segmented lines and connect them by matching values.
I have already plotted segments by the "Start" and "End" values as x coordinates and the Group as the y coordinates in R. I would like to connect these segments with a line if they share the same "id", as indicated by my sample dataset data:
Name Start End Group ID
TP1 363248 366670 7 98
TP2 365869 369291 11 98
TP3 366459 369881 1 98
AB1 478324 481599 11 134
AB2 478855 482130 1 134
AB3 480681 483956 10 134
JD1 166771 169764 6 214
JD2 386419 389244 7 214
JD2 389025 391850 11 214
What I have so far using data is:
x <- seq(0, 4100000, length = 200)
y <- seq(0, 15, length = 200)
plot(x,y,type="n");
start.x <- (data[,2])
end.x <- (data[,3])
end.y <- start.y <- (data[,4]) # from and to y coords the same
segments(x0 = start.x, y0 = start.y, x1 = end.x, y1 = end.y)
lines(data[,1], data[,5])
My segments are plotted just fine, but my connecting lines do not appear. Any suggestions as to how I can draw connecting lines? Thank you very much.
In my code below I zoomed in the plot using the xlim and ylim parameters so we can get a better look at the plotted data.
As you can see, I'm using a for loop to iterate over each unique ID value. For each value, I get the combinations of all pairs of records in the group using combn(). I then iterate over each combination using apply(). For each combination I call segments() to draw a segment between the centers of the two (original) segments. I use a different color for each group so they can easily be distinguished.
df <- data.frame(Name=c('TP1','TP2','TP3','AB1','AB2','AB3','JD1','JD2','JD2'),Start=c(363248,365869,366459,478324,478855,480681,166771,386419,389025),End=c(366670,369291,369881,481599,482130,483956,169764,389244,391850),Group=c(7,11,1,11,1,10,6,7,11),ID=c(98,98,98,134,134,134,214,214,214));
xlim <- c(min(df$Start),max(df$End));
ylim <- c(min(df$Group),max(df$Group));
plot(NA,xlim=xlim,ylim=ylim,xlab='x',ylab='y');
start.x <- df[,'Start'];
end.x <- df[,'End'];
end.y <- start.y <- df[,'Group'];
segments(start.x,start.y,end.x,end.y);
uid <- unique(df$ID);
cols <- rainbow(length(uid));
for (i in seq_along(uid)) {
df.sub <- subset(df,ID==uid[i]);
col <- cols[i];
apply(combn(nrow(df.sub),2),2,function(ris) {
r1 <- df.sub[ris[1],];
r2 <- df.sub[ris[2],];
segments(mean(c(r1$Start,r1$End)),r1$Group,mean(c(r2$Start,r2$End)),r2$Group,col=col);
});
};
Using the following code:
library("ggplot2")
require(zoo)
args <- commandArgs(TRUE)
input <- read.csv(args[1], header=F, col.names=c("POS","ATT"))
id <- args[2]
prot_len <- nrow(input)
manual <- prot_len/100 # 4.3
att_name <- "Entropy"
att_zoo <- zoo(input$ATT)
att_avg <- rollapply(att_zoo, width = manual, by = manual, FUN = mean, align = "left")
autoplot(att_avg, col="att1") + labs(x = "Positions", y = att_name, title="")
With data:
> str(input)
'data.frame': 431 obs. of 2 variables:
$ POS: int 1 2 3 4 5 6 7 8 9 10 ...
$ ATT: num 0.652 0.733 0.815 1.079 0.885 ...
I do:
I would like to upload input2 which has different lenght (therefore, different x-axis) and overlap the 2 curves in the same plot (I mean overlap because I want the two curves in the same plot size, so I will "ignore" the overlapped axis labels and tittles), I would like to compare the shape, regardles the lenght of input.
First I've tried by generating toy input2 changing manual value, so that I have att_avg2 in which manual equals e.g. 7. In between original autoplot and new autoplot-2 I add par(new=TRUE), but this is not my expected output. Any hint on how doing this? Maybe it's better to save att_avg from zoo series to data.frame and not use autoplot? Thanks
UPDATE, response to G. Grothendieck:
If I do:
[...]
att_zoo <- zoo(input$ATT)
att_avg <- rollapply(att_zoo, width = manual, by = manual, FUN = mean, align = "left") #manual=4.3
att_avg2 <- rollapply(att_zoo, width = 7, by = 7, FUN = mean, align = "left")
autoplot(cbind(att_avg, att_avg2), facet=NULL) +
labs(x = "Positions", y = att_name, title="")
I get
and a warning message:
Removed 1 rows containing missing values (geom_path).
par is used with classic graphics, not for ggplot2. If you have two zoo series just cbind or merge the series together and autoplot them using facet=NULL:
library(zoo)
library(ggplot2)
z1 <- zoo(1:3) # length 3
z2 <- zoo(5:1) # length 5
autoplot(cbind(z1, z2), facet = NULL)
Note: The question omitted input2 so there could be some additional considerations from aspects not shown.
I am trying to create a spatial dataset from a txt file imported in R and structured as follows:
CitiesTXTSel=
COM City_NAME LONGI_DMS LATI_DMS
445 VILLEMOTIER 51916 462046
98 CHAZEY-BONS 54054 454811
57 BOZ 45434 462425
When I use the function below I get the following error message:
"Error in .checkNumericCoerce2double(obj) : non-finite coordinates"
Cities= SpatialPointsDataFrame(coords=CitiesTXTSel[,3:4], data=CitiesTXTSel[,1:2], proj4string=CRS("+proj=longlat +datum=wgs84"))
I guess the pre-formatting of the cooridnates is not correct but I cannot figure out how to fix this. Please can you help? The imported coordinates are in Lat/long DMS.
# Reproducing your data frame
CitiesTXTSel <- data.frame(
COM = c(445, 98, 7),
City_NAME = c("VILLEMOTIER", "CHAZEY-BONS", "BOZ"),
LONGI_DMS = c(51916, 54054, 45434),
LATI_DMS = c(462046, 454811, 462425),
stringsAsFactors = FALSE
)
# a function to convert your input to decimal degrees
convert_DMS_dec <- function(DMS) {
DMS_pad <- sprintf("%7s", DMS)
deg <- substr(DMS_pad, 1, 3)
deg <- gsub(" ", "", deg) # remove leading whitespace
min <- substr(DMS_pad, 4, 5)
sec <- substr(DMS_pad, 6, 7)
DMS_split <- paste(deg, min, sec)
dec_deg <- conv_unit(DMS_split, "deg_min_sec", "dec_deg")
round(as.numeric(dec_deg), 4) # precision to about one arc-second
}
CitiesTXTSel$long <- convert_DMS_dec(CitiesTXTSel$LONGI_DMS)
CitiesTXTSel$lat <- convert_DMS_dec(CitiesTXTSel$LATI_DMS)
# re-order the data frame so columns three and four match your code
CitiesTXTSel <- CitiesTXTSel[, c(1:2, 5:6, 3:4)]
# Your code, indented a little for clarity
Cities= SpatialPointsDataFrame(
coords=CitiesTXTSel[,3:4],
data=CitiesTXTSel[,1:2],
proj4string=CRS("+proj=longlat +datum=wgs84")
)
and here's the resulting output of Cities:
coordinates COM City_NAME
(5.3211, 46.3461) 445 VILLEMOTIER
(5.6817, 45.8031) 98 CHAZEY-BONS
(4.9094, 46.4069) 7 BOZ