I have a transaction data at country level.
Data Sample:
TransID CountryOrigin(CO) CountryDestination(CD) COLat COLong CDLat CDLong
1 India Australia 20.593684 78.962880 -25.274398 133.775136
Now i want to link the Country origin and destination with the number of transactions.If the transaction is high then the width of the line will be bigger than the low transaction zone.
I want the visualization more similar to below image
(With the country name label in worldmap)
I am not quite sure, but as far as I understand you are looking for something like this:
http://flowingdata.com/2011/05/11/how-to-map-connections-with-great-circles/
If you want the width of the line bigger in higher transaction zones, you have to set the lwd parameter higher in these lines:
#Load packages
install.packages("maps")
install.packages("geosphere")
library(maps)
library(geosphere)
#Create a Map
xlim <- c(55.593, 140.9628)
ylim <- c(-30.2743, 40.775)
map("world", col="#f2f2f2", fill=TRUE, bg="white", lwd=0.05, xlim=xlim, ylim=ylim)
#create a line
lat_india <- 20.5936
lon_india <- 78.96288
lat_aussie <- -25.2743
lon_aussie <- 133.77
inter <- gcIntermediate(c(lon_india, lat_india), c(lon_aussie, lat_aussie), n=50, addStartEnd=TRUE)
#plot the line (lwd represents the width of the line)
lines(inter, lwd=3)
Related
i'm trying to show the relation between the users (based on there roles), and i want to color them based on their team. i have the following code;
#get library's
install.packages("igraph")
library("igraph")
install.packages('reshape')
library(reshape)
#connecting to DB
data <- rxDataStep(dsSqlServerData)
head(data)
users <- rxDataStep(dsSqlServerData)
head(users)
#making the matrix
data1<-cast(data, acentralacc ~ bcentralacc, value="rol",fun.aggregate= length)
net2 <- graph_from_incidence_matrix(data1)
net2.bp <- bipartite.projection(net2)
head(net2.bp$proj1,4)
head(net2)
#making the plot
pal2 <- rainbow(5, alpha=.5)
#plot(net2.bp$proj1,margin = 0,vertex.size=5,vertex.label="",vertex.color=pal2) #only shows very little data points
plot(net2,margin = 0,vertex.size=5,vertex.label="",vertex.color=pal2)
legend("topleft", c(users$Team), pch=21,col="#777777", pt.bg=pal2, pt.cex=2, cex=.8, bty="n", ncol=1)
dataframe: data: metadata
acentralacc
rol
bcentralacc
dataframe: users: metadata
CentralAccount (same as acentral and b central)
Team
One of the problems i have is that i have alot of data points (3000 ish).
My attempt at getting the legenda with the teams. My guess is that it can't present the legenda since does not know the relation between the 2 tables
legend("topleft", c(users$Team), pch=21,col="#777777", pt.bg=pal2, pt.cex=2, cex=.8, bty="n", ncol=1)
coloring the plot, i need the same color for each team
vertex.color=pal2
I am unsuccessfully trying to plot lines on a world map with Mollweide projection. I also plotted points on that same map, and it worked out fine. For the lines, I tried to adapt this example to my needs: http://flowingdata.com/2011/05/11/how-to-map-connections-with-great-circles/.
I failed with the pre-test (Step 4 in the ex.) already. In the following code, the line is supposed to connect Kenya and Australia. It runs without errors, but there's no line in the output. (I also tested the example without mapproj and the line is there.)
library("maps")
library("mapproj")
library("geosphere")
map("world",proj="mollweide", orientation= c(90,0,0), fill=TRUE, col="white", bg="lightblue")
lon_ke <- 38
lat_ke <- 1
lon_aus <- 133
lat_aus <- -27
inter <- gcIntermediate(c(mapproject(lon_ke,lat_ke), proj="mollweide", orientation= c(90,0,0)),
c(mapproject(lon_aus,lat_aus), proj="mollweide", orientation= c(90,0,0)),
n=50, addStartEnd=TRUE)
lines(inter)
I found a solution to my problem, based on Thomas Rahlf's book (see comment). Here's my script (it helps visualizing where authors publish articles).
library(maps)
library(geosphere)
library(mapproj)
#load data
locations <- read.csv("articles-authors-locations.csv", header=TRUE, check.names = FALSE)
#plot map with Mollweide projection
myProj.type<-"mollweide"
myProj.orient<-c(90,0,0)
x<-map(proj=myProj.type,orient=myProj.orient,wrap=T,fill=TRUE, col="white", bg="lightblue",xlim=range(locations$ArticleLong),ylim=range(locations$ArticleLat)
)
#plot jittered points for authors' locations
myStartP<-mapproject(jitter(locations$AuthorLong,amount=3),jitter(locations$AuthorLat, amount=1),proj=myProj.type,orient=myProj.orient)
points(myStartP,col="darkblue",pch=20,cex=1)
#set transparent colors
myTColour<-rgb(0,0,0,50,maxColorValue=255)
red_transp <- adjustcolor("red", alpha.f = 0.4)
#plot lines and jittered points, connecting authors' and articles locations
for (i in 1:nrow(locations))
{
myGC1<-gcIntermediate(c(locations$AuthorLong[i],locations$AuthorLat[i]),c(locations$ArticleLong[i],locations$ArticleLat[i]),addStartEnd=T, n=50)
moll<-mapproject(myGC1[,1],myGC1[,2],projection=myProj.type,orientation=myProj.orient)
lines(moll$x,moll$y,lwd=2.5,col=myTColour)
myDestP<-mapproject(
jitter(locations$ArticleLong[i], amount=3),
jitter(locations$ArticleLat[i], amount=1),
proj=myProj.type,orient=myProj.orient)
points(myDestP,col=red_transp,pch=20,cex=1)
}
I use the following code to plot my data:
library(dismo)
#download occurence data from gbif
taxus_occurence <- gbif("taxus", "wallichiana*", geo=FALSE)
View(taxus_occurence)
head(taxus_occurence)
dim(taxus_occurence)
#select the records that have longitude and latitude data
colnames(taxus_occurence)
tx_coordinates <- subset(taxus_occurence, !is.na(lon) & !is.na(lat))
dim(tx_coordinates)
# extract columns containing lat, long and country names
# select variables v1, v2, v3
myvars <- c("lat", "lon", "country")
newdata <- taxus_occurence[myvars]
newdata
#make a map of the occurrence localities
library(maptools)
## Checking rgeos availability: TRUE
data(wrld_simpl)
raster-taxus <- plot(wrld_simpl, xlim=c(-100,100), ylim=c(-100,100),
axes=TRUE, col="light green")
# restore the box around the map
box()
# add the points
points(tx_coordinates$lon, tx_coordinates$lat, col='orange', pch=20,
cex=0.75)
# plot points again to add a border, for better visibility
points(tx_coordinates$lon, tx_coordinates$lat, col='red', cex=0.75)
I get the fine result.
Now instead of using the whole world map, I have my own shape file on my laptop for my area of interest. How can I import the shape file using the same package?
I'm trying to plot some path/connection based maps but am unable to figure out how.
I see a lot of possibilities for one point based metrics (crime hotspots in London, etc. with googleVis, ggmap, etc.) but I can't find too many examples of two points based metrics (immigrations between cities, train routes, etc.) There is an example with the package geosphere, but it seems to not be available for R 3.0.2.
Ideally I would like something like this D3 example and would also like to customise the thickness, colour, etc. of the lines and the circles.
PS: I don't suppose rCharts can do this just yet, right?
Here's something I started last year and never got around to polishing properly but hopefully it should answer your question of joining points on a map with great circle lines, with the flexibility to customise lines, circles etc.
I use the (my) rworldmap package for mapping, WDI for world bank data and geosphere for the great circle lines. The aim was to plot aid flows from all donor countries to all recipient countries (one plot per donor). Below is an example plot, and below that the code. Hope it helps. Would be nice to find time to pick it up again!
Andy
library(rworldmap)
library(WDI) # WORLD BANK INDICATORS
## lines of either type may obscure more than they add
##**choose line option here
addLines <- 'gc' #'none''straight' 'gc'
if ( addLines == 'gc' ) library(geosphere)
# setting background colours
oceanCol = rgb(7,0,30,maxColorValue=255)
landCol = oceanCol
#produces a list of indicator IDs and names as a matrix
indicatorList <- WDIsearch('aid flows')
#setting up a world map shaped plot window
#*beware this is windows specific
mapDevice('windows',width=10,height=4.5)
year <- 2000
#for(indNum in 1:2)
for(indNum in 1:nrow(indicatorList))
{
indID <- indicatorList[indNum][1]
donorISO3 <- substr(indID,start=8,stop=10)
dFdonor <- WDI(indicator=indID,start=year,end=year)
#divide by 10^6 for million dollars
dFdonor[indID] <- dFdonor[indID] * 1/10^6
sPDFdonor <- joinCountryData2Map(dFdonor,nameJoinColumn='country',joinCode='NAME')
#take out Antarctica
sPDFdonor <- sPDFdonor[-which(row.names(sPDFdonor)=='Antarctica'),]
legendTitle=paste("aid flow from",donorISO3,year,"(millions US$)")
mapBubbles(sPDFdonor, nameZSize=indID, plotZeroVals=FALSE, legendHoriz=TRUE, legendPos="bottom", fill=FALSE, legendTitle=legendTitle, oceanCol=oceanCol, landCol=landCol,borderCol=rgb(50,50,50,maxColorValue=255),lwd=0.5,lwdSymbols=1)
#removed because not working , main=paste('donor', donorISO3,year)
#now can I plot lines from the centroid of the donor to the centroids of the recipients
xDonor <- sPDFdonor$LON[ which(sPDFdonor$ISO3==donorISO3) ]
yDonor <- sPDFdonor$LAT[ which(sPDFdonor$ISO3==donorISO3) ]
xRecips <- sPDFdonor$LON[ which(sPDFdonor[[indID]] > 0) ]
yRecips <- sPDFdonor$LAT[ which(sPDFdonor[[indID]] > 0) ]
amountRecips <- sPDFdonor[[indID]][ which(sPDFdonor[[indID]] > 0) ]
## straight lines
if ( addLines == 'straight' )
{
for(line in 1:length(xRecips))
{
#col <- 'blue'
#i could modify the colour of the lines by the size of the donation
#col=rgb(1,1,1,alpha=amountRecips[line]/max(amountRecips))
#moving up lower values
col=rgb(1,1,0,alpha=sqrt(amountRecips[line])/sqrt(max(amountRecips)))
lines(x=c(xDonor,xRecips[line]),y=c(yDonor,yRecips[line]),col=col, lty="dotted", lwd=0.5) #lty = "dashed", "dotted", "dotdash", "longdash", lwd some devices support <1
}
}
## great circle lines
## don't work well when donor not centred in the map
## also the loop fails at CEC & TOT because not ISO3 codes
if ( addLines == 'gc' & donorISO3 != "CEC" & donorISO3 != "TOT" )
{
for(line in 1:length(xRecips))
{
#gC <- gcIntermediate(c(xDonor,yDonor),c(xRecips[line],yRecips[line]), n=50, breakAtDateLine=TRUE)
#30/10/13 lines command failed with Error in xy.coords(x, y) :
#'x' is a list, but does not have components 'x' and 'y'
#adding sp=TRUE solved
gC <- gcIntermediate(c(xDonor,yDonor),c(xRecips[line],yRecips[line]), n=50, breakAtDateLine=TRUE, sp=TRUE)
#i could modify the colour of the lines by the size of the donation
#col=rgb(1,1,1,alpha=amountRecips[line]/max(amountRecips))
#moving up lower values
col=rgb(1,1,0,alpha=sqrt(amountRecips[line])/sqrt(max(amountRecips)))
lines(gC,col=col,lwd=0.5)
}
}
#adding coasts in blue looks nice but may distract
data(coastsCoarse)
plot(coastsCoarse,add=TRUE,col='blue')
#repeating mapBubbles with add=T to go on top of the lines
mapBubbles(sPDFdonor, nameZSize=indID, plotZeroVals=FALSE, fill=FALSE, addLegend=FALSE, add=TRUE, ,lwd=2)
#removed because not working : , main=paste('donor', donorISO3,year)
#looking at adding country labels
text(xRecips,yRecips,sPDFdonor$NAME[ which(sPDFdonor[[indID]] > 0) ],col=rgb(1,1,1,alpha=0.3),cex=0.6,pos=4) #pos=4 right (1=b,2=l,3=ab)
#add a title
nameDonor <- sPDFdonor$NAME[ which(sPDFdonor$ISO3==donorISO3) ]
mtext(paste("Aid flow from",nameDonor,year), cex = 1.8, line=-0.8)
#savePlot(paste("C:\\rProjects\\aidVisCompetition2012\\Rplots\\greatCircles\\wdiAidFlowLinesDonor",donorISO3,year,sep=''),type='png')
#savePlot(paste("C:\\rProjects\\aidVisCompetition2012\\Rplots\\greatCircles\\wdiAidFlowLinesDonor",donorISO3,year,sep=''),type='pdf')
} #end of indNum loop
I have been trying for a few days to create the contour and then plot the shapefile and contour on the same file. Now, that I am able to create the contour and shapefile on the same plot. I want to clip the contour with the shapefile an only show the shapefile.
The data temp.csv can be found on this link https://www.dropbox.com/s/mg2bo4rcr6n3dks/temp.csv
Shapefile can be found on the following location: https://www.dropbox.com/sh/ztvmibsslr9ocmc/YOtiwB8p9p
The script file image.scale.R can be found on the following location "https://www.dropbox.com/s/2f5s7cc02fpozk7/image.scale.R "
The code that I have used so far is as follows:
## Required packages
library(maptools)
library(rgdal)
library(sp)
library(maptools)
library(sm)
require(akima)
require(spplot)
library(raster)
library(rgeos)
## Set Working Directory
setwd("C:\\Users\\jdbaba\\Documents\\R working folder\\shape")
## Read Data from a file
age2100 <- read.table("temp.csv",header=TRUE,sep=",")
x <- age2100$x
y <- age2100$y
z <- age2100$z
####################################
##Load the shape file
#####################################
shapefile <- readShapePoly("Export_Output_4.shp")
fld <- interp(x,y,z)
par(mar=c(5,5,1,1)) filled.contour(fld)
###Import the image.scale
source source("image.scale.R")
# http://menugget.blogspot.de/2011/08/adding-scale-to-image-plot.html
x11(width=8, height=7)
layout(matrix(c(1,2), nrow=1, ncol=2), widths=c(6,1), height=6, respect=TRUE)
layout.show(2)
par(mar=c(4,4,1,2))
image(fld,axes=T)
contour(fld, add=TRUE)
#points(age2100$x,age2100$y, pch=".", cex=2,legend=F)
plot(shapefile,add=T,lwd=2)
box()
par(mar=c(4,0,1,4))
image.scale(fld, xlab="Eastings", ylab="Northings", xaxt="n", yaxt="n", horiz=FALSE)
axis(4)
mtext("Salinity", side=4, line=2.5)
The output of the above code is as follows:
Now, I want to get rid of the colored gradients and the contours from the polygon shapefile and only leave the intersection part.
Any help is highly appreciated.
Research: I found this link https://gis.stackexchange.com/questions/25112/clip-depth-contour-with-spatial-polygon on Stack exchange Gis and I tried to follow this method I always get error while creating the contour.
I found another similar thread on https://stat.ethz.ch/pipermail/r-sig-geo/2009-May/005793.html . But I couldn't make it work on my dataset.
I would like to acknowledge Marc in the box for helping me in getting to this point.
Thanks.
Indeed, #baptiste gave you a strong hint for the solution, the recent paper by Paul Murrell. Paul was generous to provide us with the code for his entire paper manuscript, which you can get from his personal website. On the side topic, Paul shows beautiful example of reproducible research with this paper. Generally, I took the following approach:
extract latitude and longitude coordinates from the shapefile (a function to do this is here, by Paul Hiemstra),
plot everything with your code,
and use polypath to remove everything outside the boundaries defined by shapefile, using extracted coordinates as a baseline.
#function to extract coordinates from shapefile (by Paul Hiemstra)
allcoordinates_lapply = function(x) {
polys = x#polygons
return(do.call("rbind", lapply(polys, function(pp) {
do.call("rbind", lapply(pp#Polygons, coordinates))
})))
}
q = allcoordinates_lapply(shapefile)
#extract subset of coordinates, otherwise strange line connections occur...
lat = q[110:600,1]
long = q[110:600,2]
#define ranges for polypath
xrange <- range(lat, na.rm=TRUE)
yrange <- range(long, na.rm=TRUE)
xbox <- xrange + c(-20000, 20000)
ybox <- yrange + c(-20000, 20000)
#plot your stuff
plot(shapefile, lwd=2)
image(fld, axes=F, add=T)
contour(fld, add=T)
#and here is the magic
polypath(c(lat, NA, c(xbox, rev(xbox))),
c(long, NA, rep(ybox, each=2)),
col="white", rule="evenodd")