Skip to content

Instantly share code, notes, and snippets.

@Sulejman
Last active January 1, 2016 11:59
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Sulejman/0a9fc84301f286b1d5c3 to your computer and use it in GitHub Desktop.
Save Sulejman/0a9fc84301f286b1d5c3 to your computer and use it in GitHub Desktop.
This is kriging script that i used tointerpolate and draw temperature and humidity heatmaps of Bosnia and Herzegovina. http://www.sule.io/heatmaps/
doAllYear <- function(weather){
for (i in 1:12 ){
month <- getDataForMonth(weather, i)
krigeAndPlot(month)
}
print("JOB DONE")
}
krigeAndPlot <- function(data){
require(geoR)
require(fields)
data <- addExtremePoints(data)
month = intToMonth(data[1, "month"])
points <- cbind(data$longitude, data$latitude)
temperature_model <- likfit(data = data$temperature, coords = points,
fix.nugget = F, cov.model = "exponential" , ini = c(30, 5), nugget = 5)
print(paste("[", month, "] Temperature model summary: "))
print(summary(temperature_model))
precipitation_model <- likfit(data = data$precipitation, coords = points,
fix.nugget = F, cov.model = "exponential" , ini = c(30, 5), nugget = 5)
print(paste("[", month, "] Precipitation model summary: "))
print(summary(precipitation_model))
longitude <- seq(min(points[,1]), max(points[,1]), length = 1000)
latitude <- seq(min(points[,2]), max(points[,2]), length = 1000)
spatial <- expand.grid(longitude, latitude)
print(paste("[", month, "] Temperature kriging started..."))
temperature_prediction <- krige.conv(data=data$temperature,coords=points,locations=spatial,
krige=krige.control(cov.model="exponential",
cov.pars=c(temperature_model$sigmasq , temperature_model$phi),
nugget = temperature_model$nugget))
print(paste("[", month, "] Temperature kriging ended."))
print(paste("[", month, "] Precipitation kriging started..."))
precipitation_prediction <- krige.conv(data=data$precipitation,coords=points,locations=spatial,
krige=krige.control(cov.model="exponential",
cov.pars=c(precipitation_model$sigmasq , precipitation_model$phi),
nugget = precipitation_model$nugget))
print(paste("[", month, "] Precipitation kriging ended."))
print(paste("[", month, "] Cutting needless points from prediction..."))
temperature_prediction <- cutShape(spatial, temperature_prediction)
precipitation_prediction <- cutShape(spatial, precipitation_prediction)
print(paste("[", month, "] Plotting..."))
image.plot(longitude,latitude,matrix(temperature_prediction$predict,1000,1000),
legend.lab=paste("Prosjecna temperatura za mjesec ", month, " 2014 (Celsius)"), zlim = (range(-7, 25)),
bg = "transparent",
legend.args=list( text="°C",col="magenta", cex=1.5, side=4, line=2))
image.plot(longitude,latitude,matrix(precipitation_prediction$predict,1000,1000),
legend.lab=paste("Prosjecne padavine za mjesec ", month, " 2014. (mm/m2)"), zlim = (range(15, 290)),
border = "grey", lwd=2, col = two.colors(n=256, start="red", end="blue", middle = "white"),
bg = "transparent", legend.args=list( text="mm/m2",col="magenta", cex=1, side=6, line=1))
save(temperature_model, precipitation_model, file = paste("/Users/sulejmansararajlija/R_data/" , month , "_models.RData"))
save(temperature_prediction, precipitation_prediction,
file = paste("/Users/sulejmansararajlija/R_data/" , month , "_predictions.RData"))
spatial$temperature <- temperature_prediction$predict
spatial$precipitation <- precipitation_prediction$predict
names(spatial)[names(spatial)=="Var1"] <- "longitude"
names(spatial)[names(spatial)=="Var2"] <- "latitude"
write.table(spatial, paste("/Users/sulejmansararajlija/R_data/" , month , ".csv"), sep="\t")
}
cutShape <- function(set, prediction){
require(SDMTools)
require(raster)
polygon <- getData('GADM', country="Bosnia and Herzegovina", level=0)
intersection <- pnt.in.poly(set, polygon@polygons[[1]]@Polygons[[1]]@coords)
for(s in 1:nrow(set)){
if(intersection[s,"pip"] == FALSE)
prediction$predict[s] <- NA
}
return(prediction)
}
getDataForMonth <- function(weather, month){
monthly_weather <- weather[0,]
for (i in 1:nrow(weather)) {
if(weather[i, "month"] == month){
monthly_weather <- rbind(monthly_weather, weather[i,])
}
}
return(monthly_weather)
}
addExtremePoints <- function(month){
month <- rbind( month, data.frame("latitude" = 45.27 , "longitude" = 15.73, "precipitation" = month[100,
"precipitation"], "altitude" = month[100, "altitude"], "station_id" = month[100,
"station_id"],"month" = month[100, "month"],"temperature" = month[100, "temperature"],
"row.names" = 0))
month <- rbind( month, data.frame("latitude" = 44.2 , "longitude" = 19.61, "precipitation" = month[12,"precipitation"],
"altitude" = month[12, "altitude"], "station_id" = month[12, "station_id"],
"month" = month[12, "month"],"temperature" = month[12, "temperature"],
"row.names" = 0))
month <- rbind( month, data.frame("latitude" = 42.57, "longitude" = 18.4, "precipitation" = month[97,"precipitation"],
"altitude" = month[97, "altitude"], "station_id" = month[97, "station_id"],
"month" = month[97, "month"],"temperature" = month[97, "temperature"],
"row.names" = 0))
return(month)
}
intToMonth <- function(number){
options(warn=-1)
if (number == 1)
month = "januar"
else if (number == 2)
month = "februar"
else if (number == 3)
month = "mart"
else if (number == 4)
month = "april"
else if (number == 5)
month = "maj"
else if (number == 6)
month = "jun"
else if (number == 7)
month = "jul"
else if (number == 8)
month = "august"
else if (number == 9)
month = "septembar"
else if (number == 10)
month = "oktobar"
else if (number == 11)
month = "novembar"
else if (number == 12)
month = "decembar"
else
print("Wrong number")
return(month)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment