R/createPlotFromDBQuery.R
In hollorol/AgroMo: The AgroMo GUI provider
Defines functions
agroMap
agroMapVector
trimColorSet
readQueryFromDB
Documented in
agroMapVector
readQueryFromDB
trimColorSet
#' readQueryFromDB
#'
#' This function reads the database file with a given query, results a vector with 1104 elements
#' @param connection Database connection
#' @param query SQL query on the given database
#' @param attachedDBS Further databases which can be joined
#' @importFrom RSQLite SQLite
#' @importFrom DBI dbConnect dbGetQuery
#' @importFrom showtext showtext_auto
#' @importFrom sysfonts font_add
#' @export
#'
readQueryFromDB <- function(connection, query, attachedDBS=NULL,
queryModifiers=NULL){
if(is.null(attachedDBS)) {
## Copy to grid!
if(!is.null(queryModifiers)){
sapply(names(queryModifiers),function(keys){
query <<- gsub(pattern = sprintf("\\{%s\\}",keys),
sprintf("%s",queryModifiers[[keys]]),
query)
})
}
res <- dbGetQuery(connection,query)[,1]
# dbDisconnect(connection)
# Check the result
if((length(res)!=1104 ) || (!is.numeric(res))){
stop("Something went wrong")
}
return(res)
} else {
stop("Not implemented yet: attachedDBS")
}
}
####
#' trimColorSet
#' The function trimColorSet
#' @author Roland Hollos, Erzsebet Kristof
#' @param nticks Number of colors in the colorscale (default setting is 6)
#' @param roundPrecision Number of decimal places to round off values on the colorbar
#' @param reverseColorScale If it is TRUE, the colorscale is reversed (default setting is FALSE)
#' @param colorset Name of the colorscale which is available in the list numBaseColors
#' @param center A number around which diverging colorscales will be centralised
#' @param minimum Minium value of the visualised dataset
#' @param maximum Maximum value of the visualised dataset
#' @param binwidth Length of intervals (only in the case when minimum and maximum values are given)
#' @importFrom RColorBrewer brewer.pal brewer.pal.info
#' @importFrom grDevices colorRampPalette
#' @return
#' @export
trimColorSet <- function(minim, maxim, center=NULL, nticks=6, roundPrecision=NULL, reverseColorScale=FALSE, colorSet="RdYlGn") {
# browser()
print(colorSet)
if (!is.element(colorSet,rownames(brewer.pal.info))) {
stop(sprintf("Invalid colorset, please choose from the followings:\n %s", paste(rownames(brewer.pal.info), collapse=", ")))
}
numBaseColors <- brewer.pal.info[colorSet,1]
nsteps <- (maxim-minim)/nticks
if(is.null(center)){
breaks <- seq(minim,maxim,nsteps)
if(reverseColorScale==TRUE) {
colorbar <- rev(colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks))
} else {
colorbar <- colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks)
}
return(list(breaks=breaks,colors=colorbar))
}
breaks_full <- (function(delta){
newRange <- c(center-delta,center+delta)
breaks <- seq(newRange[1],newRange[2],nsteps)
return(breaks)
})(
max((center - minim), (maxim-center))
)
breakConditions <- (breaks_full >= minim) & (breaks_full <= maxim)
if(reverseColorScale==TRUE) {
colorbar <- rev(colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks))
} else {
colorbar <- colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks)
}
return(list(breaks = breaks_full[breakConditions], colors=na.omit(colorbar[breakConditions])))
}
#' agroMapVector
#' The function agroMapVector visualises data on the grid of the Carpatclim reanalysis dataset with customised colorscale by using function trimColorSet.
#' @author Erzsebet Kristof, Roland Hollos
#' @param data Numeric vector that contains data which will be plotted by agroMapVector function
#' @param nticks Number of colors in the colorscale (default setting is 6)
#' @param roundPrecision Number of decimal places to round off values on the colorbar
#' @param reverseColorScale If it is TRUE, the colorscale is reversed (default setting is FALSE)
#' @param colorset Name of the colorscale which is available in the list numBaseColors
#' @param center A number around which diverging colorscales will be centralised
#' @param lonlat Geographical latitudes and longitudes per 1° can be addded to the plot
#' @param plotTitle Main title can added to the plot
#' @param imageTitle File name of the plot, if NULL no graphics will be created.
#' @param minim Minium value of the visualised dataset
#' @param maxim Maximum value of the visualised dataset
#' @importFrom maps map
#' @importFrom fields image.plot
#' @importFrom RColorBrewer brewer.pal
#' @importFrom grDevices colorRampPalette
#' @return
#' @export
agroMapVector <- function(data, errorVector, nticks=NULL, binwidth=NULL, minimum=NULL, maximum=NULL, roundPrecision=NULL, reverseColorScale=FALSE,
colorSet="RdYlGn", center=NULL, plotTitle=NULL, imageTitle=NULL, lonlat=FALSE, countrycont=TRUE,categorical,maskCol) {
if(!categorical){
if((is.na(minimum) && is.na(maximum))){
showNotification("Please provide minimum or maximum value for mapping",type="error")
return(1)
}
if(minimum >= maximum){
showNotification("Minimum must be less than maximum",type="error")
return(1)
}
if(is.na(binwidth)){
showNotification("Please provide binwidth for mapping",type="error")
return(1)
}
if(binwidth<=0){
showNotification("binwidth must be positive number",type="error")
return(1)
}
if(binwidth >= (maximum - minimum)){
showNotification("Binwidth must be less than the difference of the maximum and minimum value",type="error")
return(1)
}
}
errorVector[(errorVector == 0)] <- NA # 10 is arbitary positive number
lon <- seq(16.2,22.8,0.1)
lat <- seq(45.8,48.5,0.1)
lon_ext <- c(16.1,lon,22.9)
lat_ext <- c(45.7,lat,48.6)
dimlon <- length(lon)
dimlat <- length(lat)
# Labels of the x and y axis on the maps:
longitudes <- c("16°E","17°E","18°E","19°E","20°E","21°E","22°E","23°E")
latitudes <- c("46°N","47°N","48°N")
# Indices of grid cells which cover the area of Hungary:
index <- c(18, 19, 20, 21, 22, 23, 24, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 94, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160,
161, 162, 163, 165, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 278,
279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305,
306, 307, 308, 309, 310, 311, 312, 313, 314, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360,
361, 362, 363, 364, 365, 366, 367, 368, 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 409, 410,
411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, 431, 432, 433, 434, 435, 436, 437,
438, 439, 440, 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, 451, 452, 453, 474, 475, 476, 477, 478, 479, 480, 481, 482, 483, 484,
485, 486, 487, 488, 489, 490, 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, 511,
512, 513, 514, 515, 516, 517, 518, 519, 520, 540, 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, 551, 552, 553, 554, 555, 556, 557,
558, 559, 560, 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, 581, 582, 583, 584,
585, 586, 587, 588, 606, 607, 608, 609, 610, 611, 612, 613, 614, 615, 616, 617, 618, 619, 620, 621, 622, 623, 624, 625, 626, 627, 628,
629, 630, 631, 632, 633, 634, 635, 636, 637, 638, 639, 640, 641, 642, 643, 644, 645, 646, 647, 648, 649, 650, 651, 652, 653, 654, 655,
656, 657, 673, 674, 675, 676, 677, 678, 679, 680, 681, 682, 683, 684, 685, 686, 687, 688, 689, 690, 691, 692, 693, 694, 695, 696, 697,
698, 699, 700, 701, 702, 703, 704, 705, 706, 707, 708, 709, 710, 711, 712, 713, 714, 715, 716, 717, 718, 719, 720, 721, 722, 723, 724,
738, 739, 740, 741, 742, 743, 744, 745, 746, 747, 748, 749, 750, 751, 752, 753, 754, 755, 756, 757, 758, 759, 760, 761, 762, 763, 764,
765, 766, 767, 768, 769, 770, 771, 772, 773, 774, 775, 776, 777, 778, 779, 780, 781, 782, 783, 784, 785, 786, 787, 788, 789, 790, 791,
792, 807, 808, 809, 810, 811, 812, 813, 814, 815, 816, 817, 818, 819, 820, 821, 822, 823, 824, 825, 826, 827, 828, 829, 830, 831, 832,
833, 834, 835, 836, 837, 838, 839, 840, 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 858, 859,
875, 876, 877, 878, 879, 880, 881, 882, 883, 884, 885, 886, 887, 888, 889, 890, 891, 892, 893, 894, 895, 896, 897, 898, 899, 900, 901,
902, 903, 904, 905, 906, 907, 908, 909, 910, 911, 912, 913, 914, 915, 916, 917, 918, 919, 920, 921, 922, 923, 924, 925, 926, 927, 942,
943, 944, 945, 946, 947, 948, 949, 950, 951, 952, 953, 954, 955, 956, 957, 958, 959, 960, 961, 962, 963, 964, 965, 966, 967, 968, 969,
970, 971, 972, 973, 974, 975, 976, 977, 978, 979, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 1009,
1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017, 1018, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036,
1037, 1038, 1039, 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, 1048, 1049, 1050, 1051, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1077,
1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1104,
1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118, 1119, 1120, 1121, 1122, 1123, 1124, 1125, 1126, 1127, 1128, 1129, 1130, 1131,
1145, 1146, 1147, 1148, 1149, 1150, 1151, 1152, 1153, 1154, 1155, 1156, 1157, 1158, 1159, 1160, 1161, 1162, 1163, 1164, 1165, 1166, 1167, 1168, 1169, 1170, 1171,
1172, 1173, 1174, 1175, 1176, 1177, 1178, 1179, 1180, 1181, 1182, 1183, 1184, 1185, 1186, 1187, 1188, 1189, 1190, 1191, 1192, 1193, 1194, 1195, 1196, 1197, 1198,
1212, 1213, 1214, 1215, 1216, 1217, 1218, 1219, 1220, 1221, 1222, 1223, 1224, 1225, 1226, 1227, 1228, 1229, 1230, 1231, 1232, 1233, 1234, 1235, 1236, 1237, 1238,
1239, 1240, 1241, 1242, 1243, 1244, 1245, 1246, 1247, 1248, 1249, 1250, 1251, 1252, 1253, 1254, 1255, 1256, 1257, 1258, 1259, 1260, 1261, 1262, 1263, 1264, 1265,
1266, 1277, 1278, 1279, 1283, 1284, 1285, 1286, 1287, 1288, 1289, 1290, 1291, 1292, 1293, 1294, 1295, 1296, 1297, 1298, 1299, 1300, 1301, 1302, 1303, 1304, 1305,
1306, 1307, 1308, 1309, 1310, 1311, 1312, 1313, 1314, 1315, 1316, 1317, 1318, 1319, 1320, 1321, 1322, 1323, 1324, 1325, 1326, 1327, 1328, 1329, 1330, 1331, 1332,
1333, 1334, 1350, 1351, 1352, 1353, 1354, 1355, 1367, 1368, 1369, 1370, 1371, 1372, 1373, 1374, 1375, 1376, 1377, 1378, 1379, 1380, 1381, 1382, 1383, 1384, 1385,
1386, 1387, 1388, 1389, 1390, 1391, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 1403, 1405, 1418, 1419, 1420, 1434, 1435, 1436, 1437, 1438,
1439, 1440, 1441, 1442, 1443, 1444, 1445, 1446, 1447, 1448, 1449, 1450, 1451, 1452, 1453, 1454, 1455, 1456, 1457, 1458, 1459, 1460, 1461, 1462, 1463, 1464, 1465,
1466, 1467, 1468, 1469, 1470, 1471, 1472, 1473, 1474, 1485, 1502, 1503, 1504, 1505, 1506, 1507, 1508, 1509, 1510, 1511, 1512, 1513, 1514, 1515, 1516, 1517, 1518,
1519, 1520, 1521, 1522, 1523, 1524, 1525, 1526, 1527, 1528, 1529, 1530, 1531, 1532, 1533, 1534, 1535, 1536, 1537, 1538, 1539, 1540, 1541, 1575, 1576, 1577, 1578,
1579, 1580, 1581, 1582, 1583, 1584, 1585, 1586, 1587, 1588, 1589, 1590, 1591, 1592, 1593, 1594, 1595, 1596, 1597, 1598, 1599, 1600, 1601, 1602, 1603, 1604, 1605,
1606, 1607, 1608, 1643, 1644, 1648, 1649, 1650, 1651, 1652, 1653, 1654, 1655, 1656, 1657, 1658, 1659, 1660, 1661, 1662, 1663, 1664, 1665, 1666, 1667, 1668, 1669,
1670, 1671, 1672, 1718, 1719, 1720, 1721, 1722, 1723, 1724, 1725, 1726, 1727, 1728, 1729, 1730, 1731, 1732, 1733, 1734, 1735, 1736, 1737, 1786, 1787, 1788, 1789,
1790, 1791, 1792, 1793, 1794, 1795, 1796, 1797, 1803, 1854, 1855, 1856, 1857, 1858, 1860, 1861, 1862, 1863, 1864)
grid_vect <- array(NA, dim=1876)
err_vect <- array(NA, dim=1876)
mask_vect <- array(NA, dim=1876)
grid_vect[index] <- data
mask_vect[index[is.na(data)]] <- 10 # 10 is arbitrary positive number
err_vect[index] <- errorVector
grid_array <- matrix(grid_vect, nrow=length(lon), ncol=length(lat))
err_array <- matrix(err_vect, nrow=length(lon), ncol=length(lat))
mask_array <- matrix(mask_vect, nrow=length(lon), ncol=length(lat))
# extending the plotted map with 0.1° in each direction:
grid_array_ext <- rbind(rep(NA,dimlat+2), cbind(rep(NA,dimlon), grid_array,rep(NA,dimlon)), rep(NA,dimlat+2))
err_array_ext <- rbind(rep(NA,dimlat+2), cbind(rep(NA,dimlon), err_array,rep(NA,dimlon)), rep(NA,dimlat+2))
mask_array_ext <- rbind(rep(NA,dimlat+2), cbind(rep(NA,dimlon), mask_array,rep(NA,dimlon)), rep(NA,dimlat+2))
# Changing the font on maps from Arial to Fira Sans:
# showtext_auto()
# font_add_google("Fira Sans", "fira")
# font_add("fira", file.path(system.file("www", package = "AgroMo"), "font/FiraSans-Light.ttf"))
# browser()
# if (is.null(binwidth)) {
if ((nticks > 1) && categorical) { # With this parameter, plotting of maps is possible by choosing (min,max,bw) and nticks, respectively.
colorbar <- trimColorSet(min(data,na.rm=TRUE),max(data,na.rm=TRUE),center=center, nticks=nticks,
roundPrecision=roundPrecision, reverseColorScale=reverseColorScale, colorSet=colorSet)
if(!is.null(imageTitle)){
png(imageTitle, units="in", width=14, height=9, pointsize=14, res=300)
par(omi=c(0,0,0,0.8))
}
# windows()
if(is.null(roundPrecision)) {
image.plot(lon_ext, lat_ext, grid_array_ext, xaxt="n", yaxt="n", ann=FALSE, col=colorbar$colors, lab.breaks=colorbar$breaks,
axis.args=list(cex.axis=3.5, family="fira"))
image(lon_ext, lat_ext, err_array_ext, col=c("#000000","#000000"), add=TRUE)
} else {
image.plot(lon_ext, lat_ext, grid_array_ext, xaxt="n", yaxt="n", ann=FALSE, col=colorbar$colors, lab.breaks=round(colorbar$breaks,
digits=roundPrecision), axis.args=list(cex.axis=3.5, family="fira"))
image(lon_ext, lat_ext, err_array_ext, col=c("#000000","#000000"), add=TRUE)
}
image(lon_ext, lat_ext, mask_array_ext, col=c(maskCol,"#FFFFFF"), add=TRUE)
if(lonlat==TRUE) {
abline(h=seq(46,48,1), v=seq(16,23,1), lty=2)
}
title(main=plotTitle, cex.main=6, family="fira_title")
axis(1, at=seq(16,23,1), labels=longitudes,
cex.axis=4, family="fira")
axis(1, at=seq(16,23,0.5), labels=FALSE, tck=-0.01)
axis(2, at=seq(46,48,1), labels=latitudes, cex.axis=4, las=2, family="fira")
axis(2, at=seq(46,48,0.5), labels=FALSE, tck=-0.01)
if(countrycont==TRUE){
map("world", xlim=c(lon_ext[1],lon_ext[length(lon_ext)]), ylim=c(lat_ext[1],lat_ext[length(lat_ext)]), add=TRUE)
}
if(!is.null(imageTitle)){
graphics.off()
}
} else {
numBaseColors <- brewer.pal.info[colorSet,1]
brks <- seq(minimum, maximum, binwidth)
if(reverseColorScale == TRUE) {
colorbar <- rev(colorRampPalette(brewer.pal(numBaseColors,colorSet))(length(brks)-1))
} else {
colorbar <- colorRampPalette(brewer.pal(numBaseColors,colorSet))(length(brks)-1)
}
#png(fileTitle, units="in", width=14, height=9, pointsize=14, res=100)
if(!is.null(imageTitle)){
png(imageTitle, units="in", width=14, height=9, pointsize=14, res=300)
par(omi=c(0,0,0,0.8))
}
image.plot(lon_ext, lat_ext, grid_array_ext, xaxt="n", yaxt="n", ann=FALSE, col=colorbar, breaks=brks,
lab.breaks=brks, axis.args=list(cex.axis=3.5, family="fira"))#, asp=1.5555555555)
image(lon_ext, lat_ext, mask_array_ext, col=c(maskCol,"#FFFFFF"), add=TRUE)
if(lonlat==TRUE) {
abline(h=seq(46,48,1), v=seq(16,23,1), lty=2)
}
title(main=plotTitle, cex.main=6, family="fira")
axis(1, at=seq(16,23,1), labels=longitudes,
cex.axis=4, family="fira")
axis(1, at=seq(16,23,0.5), labels=FALSE, tck=-0.01)
axis(2, at=seq(46,48,1), labels=latitudes, cex.axis=4, las=2, family="fira")
axis(2, at=seq(46,48,0.5), labels=FALSE, tck=-0.01)
if(countrycont==TRUE){
map("world", xlim=c(lon_ext[1],lon_ext[length(lon_ext)]), ylim=c(lat_ext[1],lat_ext[length(lat_ext)]), add=TRUE)#, asp=1.55555)
}
if(!is.null(imageTitle)){
graphics.off()
}
# graphics.off()
}
return(0)
}
#agroMapVector(data=readQueryFromDB("DB/agronew.db",query = query),minimum = 0,maximum = 0.12,binwidth = 0.01,colorSet = "Greens", lonlat = TRUE, fileTitle = "kiraly.png")
agroMap <- function(connection=NULL, query=NULL, myData=NULL, attachedDBS = NULL,
queryModifiers=NULL,nticks=NULL, binwidth=NULL,
minimum=NULL, maximum=NULL, roundPrecision=NULL,
reverseColorScale=FALSE,colorSet="RdYlGn", center=NULL,
plotTitle=NULL, imageTitle=NULL, lonlat=FALSE, outFile=NULL, countrycont=TRUE, categorical,maskCol) {
# browser()
if(!is.null(connection)){
agroVector <- readQueryFromDB(connection, query, attachedDBS = attachedDBS,queryModifiers = queryModifiers)
} else {
agroVector <- myData
}
if(!is.null(outFile)){
write.csv(agroVector, outFile)
}
# browser()
errorVector <- myData[,2]
agroVector <- myData[,3]
agroMapVector(agroVector, errorVector, nticks=nticks, binwidth=binwidth, minimum=minimum, maximum=maximum,
roundPrecision=roundPrecision, reverseColorScale=reverseColorScale, colorSet=colorSet,
center=center, plotTitle=plotTitle, imageTitle=imageTitle, lonlat=lonlat, countrycont=countrycont,
categorical=categorical,maskCol=maskCol)
}
#
# query <- "SELECT {groupfun}(maxCumTrans)
# FROM (
# SELECT MAX(cum_trans) AS maxCumTrans, plotid, year
# FROM agromo
# WHERE year >= {startyear} AND year <= {endyear}
# GROUP BY year, plotid)
# GROUP BY plotid"
# # query <- "SELECT {groupfun}(maxCumTrans) FROM (SELECT MAX(cumtrans) AS maxCumTrans, plotid, year FROM agromo WHERE year >= {startyear} AND year <= {endyear} GROUP BY year, plotid) GROUP BY plotid"
#
# queryModifiers <- list(
# groupfun="AVG",
# startyear=2010,
# endyear=2018
# )
#
# dbName <- "/data4/DB/agronew.db"
#
# agroMap(dbName, query, queryModifiers=queryModifiers, nticks=6, colorSet="RdYlGn",reverseColorScale = TRUE)
# #agroMap(dbName, query, queryModifiers=queryModifiers, minimum=0 ,maximum = 420,binwidth = 20,colorSet="RdYlGn")
#
# query2 <-"
# SELECT AVG(plantResp)
# FROM (
# SELECT AVG(dmresp+dgresp) AS plantResp, plotid, year
# FROM agromo
# WHERE year >= {startyear} AND year <= {endyear}
# GROUP BY year, plotid)
# GROUP BY plotid
# "
# queryModifiers2 <- list(
# startyear=2010,
# endyear=2018
# )
#agroMap(dbName, query, queryModifiers=queryModifiers,nticks=6, colorSet="RdYlGn",roundPrecision = 0)
hollorol/AgroMo documentation built on July 21, 2023, 8:51 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions agroMap agroMapVector trimColorSet readQueryFromDB
Documented in agroMapVector readQueryFromDB trimColorSet
#' readQueryFromDB
#'
#' This function reads the database file with a given query, results a vector with 1104 elements
#' @param connection Database connection
#' @param query SQL query on the given database
#' @param attachedDBS Further databases which can be joined
#' @importFrom RSQLite SQLite
#' @importFrom DBI dbConnect dbGetQuery
#' @importFrom showtext showtext_auto
#' @importFrom sysfonts font_add
#' @export
#'
readQueryFromDB <- function(connection, query, attachedDBS=NULL,
queryModifiers=NULL){
if(is.null(attachedDBS)) {
## Copy to grid!
if(!is.null(queryModifiers)){
sapply(names(queryModifiers),function(keys){
query <<- gsub(pattern = sprintf("\\{%s\\}",keys),
sprintf("%s",queryModifiers[[keys]]),
query)
})
}
res <- dbGetQuery(connection,query)[,1]
# dbDisconnect(connection)
# Check the result
if((length(res)!=1104 ) || (!is.numeric(res))){
stop("Something went wrong")
}
return(res)
} else {
stop("Not implemented yet: attachedDBS")
}
}
####
#' trimColorSet
#' The function trimColorSet
#' @author Roland Hollos, Erzsebet Kristof
#' @param nticks Number of colors in the colorscale (default setting is 6)
#' @param roundPrecision Number of decimal places to round off values on the colorbar
#' @param reverseColorScale If it is TRUE, the colorscale is reversed (default setting is FALSE)
#' @param colorset Name of the colorscale which is available in the list numBaseColors
#' @param center A number around which diverging colorscales will be centralised
#' @param minimum Minium value of the visualised dataset
#' @param maximum Maximum value of the visualised dataset
#' @param binwidth Length of intervals (only in the case when minimum and maximum values are given)
#' @importFrom RColorBrewer brewer.pal brewer.pal.info
#' @importFrom grDevices colorRampPalette
#' @return
#' @export
trimColorSet <- function(minim, maxim, center=NULL, nticks=6, roundPrecision=NULL, reverseColorScale=FALSE, colorSet="RdYlGn") {
# browser()
print(colorSet)
if (!is.element(colorSet,rownames(brewer.pal.info))) {
stop(sprintf("Invalid colorset, please choose from the followings:\n %s", paste(rownames(brewer.pal.info), collapse=", ")))
}
numBaseColors <- brewer.pal.info[colorSet,1]
nsteps <- (maxim-minim)/nticks
if(is.null(center)){
breaks <- seq(minim,maxim,nsteps)
if(reverseColorScale==TRUE) {
colorbar <- rev(colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks))
} else {
colorbar <- colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks)
}
return(list(breaks=breaks,colors=colorbar))
}
breaks_full <- (function(delta){
newRange <- c(center-delta,center+delta)
breaks <- seq(newRange[1],newRange[2],nsteps)
return(breaks)
})(
max((center - minim), (maxim-center))
)
breakConditions <- (breaks_full >= minim) & (breaks_full <= maxim)
if(reverseColorScale==TRUE) {
colorbar <- rev(colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks))
} else {
colorbar <- colorRampPalette(brewer.pal(numBaseColors,colorSet))(nticks)
}
return(list(breaks = breaks_full[breakConditions], colors=na.omit(colorbar[breakConditions])))
}
#' agroMapVector
#' The function agroMapVector visualises data on the grid of the Carpatclim reanalysis dataset with customised colorscale by using function trimColorSet.
#' @author Erzsebet Kristof, Roland Hollos
#' @param data Numeric vector that contains data which will be plotted by agroMapVector function
#' @param nticks Number of colors in the colorscale (default setting is 6)
#' @param roundPrecision Number of decimal places to round off values on the colorbar
#' @param reverseColorScale If it is TRUE, the colorscale is reversed (default setting is FALSE)
#' @param colorset Name of the colorscale which is available in the list numBaseColors
#' @param center A number around which diverging colorscales will be centralised
#' @param lonlat Geographical latitudes and longitudes per 1° can be addded to the plot
#' @param plotTitle Main title can added to the plot
#' @param imageTitle File name of the plot, if NULL no graphics will be created.
#' @param minim Minium value of the visualised dataset
#' @param maxim Maximum value of the visualised dataset
#' @importFrom maps map
#' @importFrom fields image.plot
#' @importFrom RColorBrewer brewer.pal
#' @importFrom grDevices colorRampPalette
#' @return
#' @export
agroMapVector <- function(data, errorVector, nticks=NULL, binwidth=NULL, minimum=NULL, maximum=NULL, roundPrecision=NULL, reverseColorScale=FALSE,
colorSet="RdYlGn", center=NULL, plotTitle=NULL, imageTitle=NULL, lonlat=FALSE, countrycont=TRUE,categorical,maskCol) {
if(!categorical){
if((is.na(minimum) && is.na(maximum))){
showNotification("Please provide minimum or maximum value for mapping",type="error")
return(1)
}
if(minimum >= maximum){
showNotification("Minimum must be less than maximum",type="error")
return(1)
}
if(is.na(binwidth)){
showNotification("Please provide binwidth for mapping",type="error")
return(1)
}
if(binwidth<=0){
showNotification("binwidth must be positive number",type="error")
return(1)
}
if(binwidth >= (maximum - minimum)){
showNotification("Binwidth must be less than the difference of the maximum and minimum value",type="error")
return(1)
}
}
errorVector[(errorVector == 0)] <- NA # 10 is arbitary positive number
lon <- seq(16.2,22.8,0.1)
lat <- seq(45.8,48.5,0.1)
lon_ext <- c(16.1,lon,22.9)
lat_ext <- c(45.7,lat,48.6)
dimlon <- length(lon)
dimlat <- length(lat)
# Labels of the x and y axis on the maps:
longitudes <- c("16°E","17°E","18°E","19°E","20°E","21°E","22°E","23°E")
latitudes <- c("46°N","47°N","48°N")
# Indices of grid cells which cover the area of Hungary:
index <- c(18, 19, 20, 21, 22, 23, 24, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 94, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160,
161, 162, 163, 165, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 278,
279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305,
306, 307, 308, 309, 310, 311, 312, 313, 314, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360,
361, 362, 363, 364, 365, 366, 367, 368, 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, 385, 409, 410,
411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, 425, 426, 427, 428, 429, 430, 431, 432, 433, 434, 435, 436, 437,
438, 439, 440, 441, 442, 443, 444, 445, 446, 447, 448, 449, 450, 451, 452, 453, 474, 475, 476, 477, 478, 479, 480, 481, 482, 483, 484,
485, 486, 487, 488, 489, 490, 491, 492, 493, 494, 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, 505, 506, 507, 508, 509, 510, 511,
512, 513, 514, 515, 516, 517, 518, 519, 520, 540, 541, 542, 543, 544, 545, 546, 547, 548, 549, 550, 551, 552, 553, 554, 555, 556, 557,
558, 559, 560, 561, 562, 563, 564, 565, 566, 567, 568, 569, 570, 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, 581, 582, 583, 584,
585, 586, 587, 588, 606, 607, 608, 609, 610, 611, 612, 613, 614, 615, 616, 617, 618, 619, 620, 621, 622, 623, 624, 625, 626, 627, 628,
629, 630, 631, 632, 633, 634, 635, 636, 637, 638, 639, 640, 641, 642, 643, 644, 645, 646, 647, 648, 649, 650, 651, 652, 653, 654, 655,
656, 657, 673, 674, 675, 676, 677, 678, 679, 680, 681, 682, 683, 684, 685, 686, 687, 688, 689, 690, 691, 692, 693, 694, 695, 696, 697,
698, 699, 700, 701, 702, 703, 704, 705, 706, 707, 708, 709, 710, 711, 712, 713, 714, 715, 716, 717, 718, 719, 720, 721, 722, 723, 724,
738, 739, 740, 741, 742, 743, 744, 745, 746, 747, 748, 749, 750, 751, 752, 753, 754, 755, 756, 757, 758, 759, 760, 761, 762, 763, 764,
765, 766, 767, 768, 769, 770, 771, 772, 773, 774, 775, 776, 777, 778, 779, 780, 781, 782, 783, 784, 785, 786, 787, 788, 789, 790, 791,
792, 807, 808, 809, 810, 811, 812, 813, 814, 815, 816, 817, 818, 819, 820, 821, 822, 823, 824, 825, 826, 827, 828, 829, 830, 831, 832,
833, 834, 835, 836, 837, 838, 839, 840, 841, 842, 843, 844, 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, 855, 856, 857, 858, 859,
875, 876, 877, 878, 879, 880, 881, 882, 883, 884, 885, 886, 887, 888, 889, 890, 891, 892, 893, 894, 895, 896, 897, 898, 899, 900, 901,
902, 903, 904, 905, 906, 907, 908, 909, 910, 911, 912, 913, 914, 915, 916, 917, 918, 919, 920, 921, 922, 923, 924, 925, 926, 927, 942,
943, 944, 945, 946, 947, 948, 949, 950, 951, 952, 953, 954, 955, 956, 957, 958, 959, 960, 961, 962, 963, 964, 965, 966, 967, 968, 969,
970, 971, 972, 973, 974, 975, 976, 977, 978, 979, 980, 981, 982, 983, 984, 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, 995, 1009,
1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017, 1018, 1019, 1020, 1021, 1022, 1023, 1024, 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, 1035, 1036,
1037, 1038, 1039, 1040, 1041, 1042, 1043, 1044, 1045, 1046, 1047, 1048, 1049, 1050, 1051, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1077,
1078, 1079, 1080, 1081, 1082, 1083, 1084, 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1093, 1094, 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1104,
1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118, 1119, 1120, 1121, 1122, 1123, 1124, 1125, 1126, 1127, 1128, 1129, 1130, 1131,
1145, 1146, 1147, 1148, 1149, 1150, 1151, 1152, 1153, 1154, 1155, 1156, 1157, 1158, 1159, 1160, 1161, 1162, 1163, 1164, 1165, 1166, 1167, 1168, 1169, 1170, 1171,
1172, 1173, 1174, 1175, 1176, 1177, 1178, 1179, 1180, 1181, 1182, 1183, 1184, 1185, 1186, 1187, 1188, 1189, 1190, 1191, 1192, 1193, 1194, 1195, 1196, 1197, 1198,
1212, 1213, 1214, 1215, 1216, 1217, 1218, 1219, 1220, 1221, 1222, 1223, 1224, 1225, 1226, 1227, 1228, 1229, 1230, 1231, 1232, 1233, 1234, 1235, 1236, 1237, 1238,
1239, 1240, 1241, 1242, 1243, 1244, 1245, 1246, 1247, 1248, 1249, 1250, 1251, 1252, 1253, 1254, 1255, 1256, 1257, 1258, 1259, 1260, 1261, 1262, 1263, 1264, 1265,
1266, 1277, 1278, 1279, 1283, 1284, 1285, 1286, 1287, 1288, 1289, 1290, 1291, 1292, 1293, 1294, 1295, 1296, 1297, 1298, 1299, 1300, 1301, 1302, 1303, 1304, 1305,
1306, 1307, 1308, 1309, 1310, 1311, 1312, 1313, 1314, 1315, 1316, 1317, 1318, 1319, 1320, 1321, 1322, 1323, 1324, 1325, 1326, 1327, 1328, 1329, 1330, 1331, 1332,
1333, 1334, 1350, 1351, 1352, 1353, 1354, 1355, 1367, 1368, 1369, 1370, 1371, 1372, 1373, 1374, 1375, 1376, 1377, 1378, 1379, 1380, 1381, 1382, 1383, 1384, 1385,
1386, 1387, 1388, 1389, 1390, 1391, 1392, 1393, 1394, 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 1403, 1405, 1418, 1419, 1420, 1434, 1435, 1436, 1437, 1438,
1439, 1440, 1441, 1442, 1443, 1444, 1445, 1446, 1447, 1448, 1449, 1450, 1451, 1452, 1453, 1454, 1455, 1456, 1457, 1458, 1459, 1460, 1461, 1462, 1463, 1464, 1465,
1466, 1467, 1468, 1469, 1470, 1471, 1472, 1473, 1474, 1485, 1502, 1503, 1504, 1505, 1506, 1507, 1508, 1509, 1510, 1511, 1512, 1513, 1514, 1515, 1516, 1517, 1518,
1519, 1520, 1521, 1522, 1523, 1524, 1525, 1526, 1527, 1528, 1529, 1530, 1531, 1532, 1533, 1534, 1535, 1536, 1537, 1538, 1539, 1540, 1541, 1575, 1576, 1577, 1578,
1579, 1580, 1581, 1582, 1583, 1584, 1585, 1586, 1587, 1588, 1589, 1590, 1591, 1592, 1593, 1594, 1595, 1596, 1597, 1598, 1599, 1600, 1601, 1602, 1603, 1604, 1605,
1606, 1607, 1608, 1643, 1644, 1648, 1649, 1650, 1651, 1652, 1653, 1654, 1655, 1656, 1657, 1658, 1659, 1660, 1661, 1662, 1663, 1664, 1665, 1666, 1667, 1668, 1669,
1670, 1671, 1672, 1718, 1719, 1720, 1721, 1722, 1723, 1724, 1725, 1726, 1727, 1728, 1729, 1730, 1731, 1732, 1733, 1734, 1735, 1736, 1737, 1786, 1787, 1788, 1789,
1790, 1791, 1792, 1793, 1794, 1795, 1796, 1797, 1803, 1854, 1855, 1856, 1857, 1858, 1860, 1861, 1862, 1863, 1864)
grid_vect <- array(NA, dim=1876)
err_vect <- array(NA, dim=1876)
mask_vect <- array(NA, dim=1876)
grid_vect[index] <- data
mask_vect[index[is.na(data)]] <- 10 # 10 is arbitrary positive number
err_vect[index] <- errorVector
grid_array <- matrix(grid_vect, nrow=length(lon), ncol=length(lat))
err_array <- matrix(err_vect, nrow=length(lon), ncol=length(lat))
mask_array <- matrix(mask_vect, nrow=length(lon), ncol=length(lat))
# extending the plotted map with 0.1° in each direction:
grid_array_ext <- rbind(rep(NA,dimlat+2), cbind(rep(NA,dimlon), grid_array,rep(NA,dimlon)), rep(NA,dimlat+2))
err_array_ext <- rbind(rep(NA,dimlat+2), cbind(rep(NA,dimlon), err_array,rep(NA,dimlon)), rep(NA,dimlat+2))
mask_array_ext <- rbind(rep(NA,dimlat+2), cbind(rep(NA,dimlon), mask_array,rep(NA,dimlon)), rep(NA,dimlat+2))
# Changing the font on maps from Arial to Fira Sans:
# showtext_auto()
# font_add_google("Fira Sans", "fira")
# font_add("fira", file.path(system.file("www", package = "AgroMo"), "font/FiraSans-Light.ttf"))
# browser()
# if (is.null(binwidth)) {
if ((nticks > 1) && categorical) { # With this parameter, plotting of maps is possible by choosing (min,max,bw) and nticks, respectively.
colorbar <- trimColorSet(min(data,na.rm=TRUE),max(data,na.rm=TRUE),center=center, nticks=nticks,
roundPrecision=roundPrecision, reverseColorScale=reverseColorScale, colorSet=colorSet)
if(!is.null(imageTitle)){
png(imageTitle, units="in", width=14, height=9, pointsize=14, res=300)
par(omi=c(0,0,0,0.8))
}
# windows()
if(is.null(roundPrecision)) {
image.plot(lon_ext, lat_ext, grid_array_ext, xaxt="n", yaxt="n", ann=FALSE, col=colorbar$colors, lab.breaks=colorbar$breaks,
axis.args=list(cex.axis=3.5, family="fira"))
image(lon_ext, lat_ext, err_array_ext, col=c("#000000","#000000"), add=TRUE)
} else {
image.plot(lon_ext, lat_ext, grid_array_ext, xaxt="n", yaxt="n", ann=FALSE, col=colorbar$colors, lab.breaks=round(colorbar$breaks,
digits=roundPrecision), axis.args=list(cex.axis=3.5, family="fira"))
image(lon_ext, lat_ext, err_array_ext, col=c("#000000","#000000"), add=TRUE)
}
image(lon_ext, lat_ext, mask_array_ext, col=c(maskCol,"#FFFFFF"), add=TRUE)
if(lonlat==TRUE) {
abline(h=seq(46,48,1), v=seq(16,23,1), lty=2)
}
title(main=plotTitle, cex.main=6, family="fira_title")
axis(1, at=seq(16,23,1), labels=longitudes,
cex.axis=4, family="fira")
axis(1, at=seq(16,23,0.5), labels=FALSE, tck=-0.01)
axis(2, at=seq(46,48,1), labels=latitudes, cex.axis=4, las=2, family="fira")
axis(2, at=seq(46,48,0.5), labels=FALSE, tck=-0.01)
if(countrycont==TRUE){
map("world", xlim=c(lon_ext[1],lon_ext[length(lon_ext)]), ylim=c(lat_ext[1],lat_ext[length(lat_ext)]), add=TRUE)
}
if(!is.null(imageTitle)){
graphics.off()
}
} else {
numBaseColors <- brewer.pal.info[colorSet,1]
brks <- seq(minimum, maximum, binwidth)
if(reverseColorScale == TRUE) {
colorbar <- rev(colorRampPalette(brewer.pal(numBaseColors,colorSet))(length(brks)-1))
} else {
colorbar <- colorRampPalette(brewer.pal(numBaseColors,colorSet))(length(brks)-1)
}
#png(fileTitle, units="in", width=14, height=9, pointsize=14, res=100)
if(!is.null(imageTitle)){
png(imageTitle, units="in", width=14, height=9, pointsize=14, res=300)
par(omi=c(0,0,0,0.8))
}
image.plot(lon_ext, lat_ext, grid_array_ext, xaxt="n", yaxt="n", ann=FALSE, col=colorbar, breaks=brks,
lab.breaks=brks, axis.args=list(cex.axis=3.5, family="fira"))#, asp=1.5555555555)
image(lon_ext, lat_ext, mask_array_ext, col=c(maskCol,"#FFFFFF"), add=TRUE)
if(lonlat==TRUE) {
abline(h=seq(46,48,1), v=seq(16,23,1), lty=2)
}
title(main=plotTitle, cex.main=6, family="fira")
axis(1, at=seq(16,23,1), labels=longitudes,
cex.axis=4, family="fira")
axis(1, at=seq(16,23,0.5), labels=FALSE, tck=-0.01)
axis(2, at=seq(46,48,1), labels=latitudes, cex.axis=4, las=2, family="fira")
axis(2, at=seq(46,48,0.5), labels=FALSE, tck=-0.01)
if(countrycont==TRUE){
map("world", xlim=c(lon_ext[1],lon_ext[length(lon_ext)]), ylim=c(lat_ext[1],lat_ext[length(lat_ext)]), add=TRUE)#, asp=1.55555)
}
if(!is.null(imageTitle)){
graphics.off()
}
# graphics.off()
}
return(0)
}
#agroMapVector(data=readQueryFromDB("DB/agronew.db",query = query),minimum = 0,maximum = 0.12,binwidth = 0.01,colorSet = "Greens", lonlat = TRUE, fileTitle = "kiraly.png")
agroMap <- function(connection=NULL, query=NULL, myData=NULL, attachedDBS = NULL,
queryModifiers=NULL,nticks=NULL, binwidth=NULL,
minimum=NULL, maximum=NULL, roundPrecision=NULL,
reverseColorScale=FALSE,colorSet="RdYlGn", center=NULL,
plotTitle=NULL, imageTitle=NULL, lonlat=FALSE, outFile=NULL, countrycont=TRUE, categorical,maskCol) {
# browser()
if(!is.null(connection)){
agroVector <- readQueryFromDB(connection, query, attachedDBS = attachedDBS,queryModifiers = queryModifiers)
} else {
agroVector <- myData
}
if(!is.null(outFile)){
write.csv(agroVector, outFile)
}
# browser()
errorVector <- myData[,2]
agroVector <- myData[,3]
agroMapVector(agroVector, errorVector, nticks=nticks, binwidth=binwidth, minimum=minimum, maximum=maximum,
roundPrecision=roundPrecision, reverseColorScale=reverseColorScale, colorSet=colorSet,
center=center, plotTitle=plotTitle, imageTitle=imageTitle, lonlat=lonlat, countrycont=countrycont,
categorical=categorical,maskCol=maskCol)
}
#
# query <- "SELECT {groupfun}(maxCumTrans)
# FROM (
# SELECT MAX(cum_trans) AS maxCumTrans, plotid, year
# FROM agromo
# WHERE year >= {startyear} AND year <= {endyear}
# GROUP BY year, plotid)
# GROUP BY plotid"
# # query <- "SELECT {groupfun}(maxCumTrans) FROM (SELECT MAX(cumtrans) AS maxCumTrans, plotid, year FROM agromo WHERE year >= {startyear} AND year <= {endyear} GROUP BY year, plotid) GROUP BY plotid"
#
# queryModifiers <- list(
# groupfun="AVG",
# startyear=2010,
# endyear=2018
# )
#
# dbName <- "/data4/DB/agronew.db"
#
# agroMap(dbName, query, queryModifiers=queryModifiers, nticks=6, colorSet="RdYlGn",reverseColorScale = TRUE)
# #agroMap(dbName, query, queryModifiers=queryModifiers, minimum=0 ,maximum = 420,binwidth = 20,colorSet="RdYlGn")
#
# query2 <-"
# SELECT AVG(plantResp)
# FROM (
# SELECT AVG(dmresp+dgresp) AS plantResp, plotid, year
# FROM agromo
# WHERE year >= {startyear} AND year <= {endyear}
# GROUP BY year, plotid)
# GROUP BY plotid
# "
# queryModifiers2 <- list(
# startyear=2010,
# endyear=2018
# )
#agroMap(dbName, query, queryModifiers=queryModifiers,nticks=6, colorSet="RdYlGn",roundPrecision = 0)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.