I have run a factor analysis on a spatial dataset, and I would like to plot the results on a map so that the color of each individual point (location) is a combination in a RGB/HSV space of the scores at that location of the three factors extracted.
I am using base R to plot the locations, which are in a SpatialPointsDataFrame created with the spdep package:
Libraries
library(sp)
library(classInt)
Sample Dataset
fas <- structure(list(MR1 = c(-0.604222013102789, -0.589631093835467,
-0.612647301042234, 2.23360319770647, -0.866779007222414), MR2 = c(-0.492209397489792,
-0.216810726717787, -0.294487678489753, -0.60466348557844, 0.34752411748663
), MR3 = c(-0.510065798219453, -0.61303212834454, 0.194263734935779,
0.347461766159926, -0.756375966467285), x = c(1457543.717, 1491550.224,
1423185.998, 1508232.145, 1521316.942), y = c(4947666.766, 5001394.895,
4948766.5, 4950547.862, 5003955.997)), row.names = c("Acqui Terme",
"Alagna", "Alba", "Albera Ligure", "Albuzzano"), class = "data.frame")
Create spatial object
fas <- SpatialPointsDataFrame(fas[,4:5], fas,
proj4string = CRS("+init=EPSG:3003"))
Plotting function
map <- function(f) {
pal <- colorRampPalette(c("steelblue","white","tomato2"), bias = 1)
collist <- pal(10)
class <- classIntervals(f, 8, style = "jenks")
color <- findColours(class, collist)
plot(fas, pch=21,cex=.8, col="black",bg=color)
}
#example usage
#map(fas$MR1)
The above code works well for producing a separate plot for each factor. What I would like is a way to produce a composite map of the three factors together.
Many thanks in advance for any suggestion.
I found a solution through this post! With the data shown above, it goes like this:
#choose columns to map to color
colors <-fas#data[,c(1:3)]
#set range from 0 to 1
range_col <- function(x){(x-min(x))/(max(x)-min(x))}
colors_norm <- range_col(colors)
print(colors_norm)
#convert to RGB
colors_rgb <- rgb(colors_norm)
print(colors_rgb)
#plot
plot(fas, main="Color Scatterplot", bg=colors_hex,
col="black",pch=21)
Related
i.e. use the region.id of class nb from the spdep package rather than ignoring it as spdep::nb2INLA does?
I've been trying to link a column in my data containing these regions as a factor, to an INLA model with a graph describing their spatial arrangement.
#something like this
f(rgn16cd,
model = "bym2",
graph = inla_graphs$gb_regions)
It works if I coerce rgn16cd from factor to numeric. Is there a way to get the region names into the graph file?
Where nbs is a list of class nb, made using an spatial polygons object with row.names given values from a column of the #data slot of the spatial polygons object.
This code should return a graph with named element as shown.
inla_graphs <- purrr::imap(nbs, ~ {
spdep::nb2INLA(file = glue::glue("{.y}.graph"), nb = .x$nb)
x <- INLA::inla.read.graph(glue::glue("{.y}.graph"))
x$nbs <- lapply(x$nbs, FUN = function(X) {
row.names(.x$mat)[X]
})
names(x$nbs) <- row.names(.x$mat)
unlink(glue::glue("{.y}.graph"))
x
})
I created a choropleth with base R but I'm struggling with the colors. First, the colors don't follow the same order as the intervals and second, two of the intervals are using the same color, all of which makes the graph hard to read. This happens regardless of how many colors I use. It also doesn't matter whether I'm using brewer.pal or base colors.Here is a map with its respective legend illustrating the issue.
Below are the statements that I use to create the graph once data has been downloaded:
#Relevant packages:
library(dplyr)
library(RColorBrewer)
library(rgdal)
#create colors vector
pop_colors <- brewer.pal(8,"Purples")
#create breaks/intervals
pop_breaks <- c(0,20000,40000,60000,80000,100000,120000)
#apply breaks to population
cuts <- cut(cal_pop$Pop2016, pop_breaks, dig.lab = 6)
#create a vector with colors by population according to the interval they belong to:
color_breaks <- pop_colors[findInterval(cal_pop$Pop2016,vec = pop_breaks)]
Create choropleth
plot(cal_pop,col = color_breaks, main = "Calgary Population (2016)")
#create legend
legend("topleft", fill = color_breaks, legend = levels(cuts), title = "Population")
I used readOGR() command to read the shape file, which I'm linking here in case anybody is interested in taking a look at the data.
I'd appreciate any advice you could give me.
Thanks!
Your error is in this line:
color_breaks <- pop_colors[findInterval(cal_pop$Pop2016,vec = pop_breaks)]
I can't read your data file, so I'll use a built-in one from the sf package.
library(sf)
nc <- readOGR(system.file("shapes/", package="maptools"), "sids")
str(nc#data)
colors <- brewer.pal(8,"Purples")
#create breaks/intervals
sid_breaks <- c(0,2,4,6,8,10,12,20,60)
#apply breaks to population
sid_cuts <- cut(nc$SID79, sid_breaks, dig.lab = 6, include=TRUE)
#create a vector with colors by population according to the interval they belong to:
sid_colors <- colors[sid_cuts]
#Create choropleth
par(mar=c(0,0,0,0))
plot(nc, col = sid_colors)
legend("bottomleft", fill = colors, legend = levels(sid_cuts), nc=2, title = "SID (1979)", bty="n")
I am foresting with combination of data sets from fpp2 package and forecasting function from the forecast package. Output from this forecasting is object list with SNAIVE_MODELS_ALL. This object contain data separate for two series, where first is Electricity and second is Cement.
You can see code below :
# CODE
library(fpp2)
library(dplyr)
library(forecast)
library(gridExtra)
library(ggplot2)
#INPUT DATA
mydata_qauselec <- qauselec
mydata_qcement <- window(qcement, start = 1956, end = c(2010, 2))
# Мerging data
mydata <- cbind(mydata_qauselec, mydata_qcement)
colnames(mydata) <- c("Electricity", "Cement")
# Test Extract Name
mydata1 <- data.frame(mydata)
COL_NAMES <- names(mydata1)
rm(mydata_qauselec, mydata_qcement)
# FORCASTING HORIZON
forecast_horizon <- 12
#FORCASTING
BuildForecast <- function(Z, hrz = forecast_horizon) {
timeseries <- msts(Z, start = 1956, seasonal.periods = 4)
forecast <- snaive(timeseries, biasadj = TRUE, h = hrz)
}
frc_list <- lapply(X = mydata1, BuildForecast)
#FINAL FORCASTING
SNAIVE_MODELS_ALL<-lapply(frc_list, forecast)
So my intention here is to put this object SNAIVE_MODELS_ALL into autoplot function in order to get two plots like pic below.
With code below I draw both plots separate, but my main intention is to do this with function autoplot and some function like apply or something similar, which can automatically draw this two chart like pic above.This is only small example in real example I will have maybe 5 or 10 charts.
#PLOT 1
P_PLOT1<-autoplot(SNAIVE_Electricity,main = "Snaive Electricity forecast",xlab = "Year", ylab = "in billion kWh")+
autolayer(SNAIVE_Electricity,series="Data")+
autolayer(SNAIVE_Electricity$fitted,series="Forecasts")
# PLOT 2
P_PLOT2<-autoplot(SNAIVE_Cement,main = "Snaive Cement forecast",xlab = "Year", ylab = "in millions of tonnes")+
autolayer(SNAIVE_Cement,series="Data")+
autolayer(SNAIVE_Cement$fitted,series="Forecasts")
#UNION PLOTS (PLOT 1 AND PLOT 2)
SNAIVE_PLOT_ALL<-grid.arrange(P_PLOT1,P_PLOT2)
So can anybody help me with this code ?
If I understand in a proper way, one of the difficulties with that problem is that each plot should have a specific title and y label. One of the possible solutions is to set the plot titles and y-lables as function arguments:
PlotForecast <- function(df_pl, main_pl, ylab_plt){
autoplot(df_pl,
main = main_pl,
xlab = "Year", ylab = ylab_plt)+
autolayer(df_pl,series="Data")+
autolayer(df_pl$fitted,series="Forecasts")
}
Prepare lists of the plot labels to be used with PlotForecast():
main_lst <- list("Snaive Electricity forecast", "Snaive Cement forecast")
ylab_lst <- list("in billion kWh", "in millions of tonnes")
Construct a list of plot-objects using a base Map() function:
PL_list <- Map(PlotForecast, df_pl = SNAIVE_MODELS_ALL, main_pl = main_lst,
ylab_plt= ylab_lst)
Then all we have to do is to call grid.arrange() with the plot list:
do.call(grid.arrange, PL_list)
Note, please, that main_lst and ylab_lst are created manually for demonstration purposes, but it is not the best way if you work with a lot of charts. Ideally, the labels should be generated automatically using the original SNAIVE_PLOT_ALL list.
I'm trying to overlay some spatial data from a bigger SpatialPolygonsDataFrame (world size) to a smaller (country size), by doing these:
x <- c("rgdal", "dplyr",'ggplot2')
apply(x, library, character.only = TRUE)
est<-readOGR(dsn='/estados_2010',layer='estados_2010')
est_f<-fortify(est)
est$id<-row.names(est)
est_f<-left_join(est_f,est#data)
zon<-readOGR(dsn='/Zonas Homogeneas/gyga_ed_poly.shp',layer='gyga_ed_poly')
zon_f<-fortify(zon)
zon$id<-row.names(zon)
zon_f<-left_join(zon_f,zon#data)
t<-ggplot()+geom_polygon(data=zon_f,aes(x=long,y=lat,group=group,fill=GRID_CODE))
t+geom_polygon(data=est_f,aes(x=long,y=lat,group=group),fill=NA,color='red')+coord_fixed(xlim=est_f$long,ylim=est_f$lat,1)
Which is resulting in this:
I'm want to select only what is being plotted inside the polygon with the red lines.
If someone could help me with this issue, I'll appreciate
PS.: For those who want to reproduce the example completely by yourselves, the files are available in the links above to my google drive:
https://drive.google.com/open?id=0B6XKeXRlyyTDakx2cmJORlZqNUE
Thanks in advance.
Since you are using polygons to display the raster values, you can use a spatial selection via [ like in this reproducible example:
library(raster)
library(rgdal)
bra <- getData("GADM", country = "BRA", level = 1)
r <- getData("worldclim", res = 10, var = "bio")
r <- r[[1]]
r <- crop(r, bra)
r <- rasterToPolygons(r)
# bra and raster (now as polygons) have to have the same projection, thusly reproject!
bra <- spTransform(bra, CRSobj = proj4string(r))
here comes the magic!!
r <- r[bra, ]
let's look at the results:
library(ggplot2)
t <- ggplot()+
geom_polygon(data=r,aes(x=long,y=lat,group=group, fill = rep(r$bio1, each = 5)))
t +
geom_polygon(data=bra,aes(x=long,y=lat,group=group),fill=NA,color='red') + coord_map()
I have used the script below to generate this betadisper plot between 2 communities.
In my "df", the first column is station names (x13)
I have 2 questions:
There is a point behind the "ABC" label, so how do I make the label transparent? Preferably adding different colours to each community?
How do I add the station names next to each point so I can visually compare which stations are most similar?
Script:
df <-read.csv("NMDS matrix_csv_NEW.csv", header=T, row.names=1, sep= ",")
df
Label<-rownames(df)
Label
dis <- vegdist(df)
groups <- factor(c(rep(1,8), rep(2,5)), labels = c("ABC","DEF"))
groups
mod <- betadisper(dis, groups)
mod
anova(mod)
permutest(mod, pairwise = TRUE)
plot(mod)
plot(mod, ellipse = TRUE, hull = FALSE, main= "MultiVariate Permutation")
To answer 2), here's how to plot the station names on top of the points.
text(mod$vectors[,1:2], label=Label)
Here is a possibile solution to your problem.
Download the myplotbetadisp.r file from this link and place the file in the working directory (warning, do not save the file as myplotbetadisp.r.txt!).
Some additional options are available in myplotbetadisper function:
fillrect, filling color of the box where centroid labels are printed;
coltextrect, vector of colors for centroid labels;
alphaPoints, alpha trasparency for centroid points;
labpoints, vectors of labels plotted close to points;
poslabPoints, position specifier for the text in labpoints.
library(vegan)
# A dummy data generation process
set.seed(1)
n <- 100
df <- matrix(runif(13*n),nrow=13)
# Compute dissimilarity indices
dis <- vegdist(df)
groups <- factor(c(rep(1,8), rep(2,5)), labels = c("ABC","DEF"))
# Analysis of multivariate homogeneity of group dispersions
mod <- betadisper(dis, groups)
source("myplotbetadisp.r")
labPts <- LETTERS[1:13]
col.fill.rect <- addAlpha(col2rgb("gray65"), alpha=0.5)
col.text.rect <- apply(col2rgb(c("blue","darkgreen")), 2, addAlpha, alpha=0.5)
transp.centroids <- 0.7
myplotbetadisper(mod, ellipse = TRUE, hull = FALSE,
fillrect=col.fill.rect, coltextrect=col.text.rect,
alphaPoints=transp.centroids, labPoints=labPts,
main= "MultiVariate Permutation")
Here is the plot
Hope it can help you.