Created
October 11, 2013 11:06
-
-
Save benizar/6933022 to your computer and use it in GitHub Desktop.
This code creates a pl/R function for creating texture triangles directly from a PostgreSQL database.This example is composed by three pl/R files (_plr_clasif_textural_usage.sql, _plr_clasif_textural.sql and _plr_clasif_textural.R). This code is quite old and it would look better using the "The Soil Texture Wizard" package. Want more info? Visit…
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Cargamos las librerias necesarias | |
library(Cairo) | |
library(plotrix) | |
# Definimos la funcion | |
clasif.textural = function (soiltexture = NULL, at = seq(0.1, 0.9, by = 0.1), | |
axis.labels = c("% arena (entre 0,05 y 2 mm)", "% limo (entre 0,05 y 0,002 mm)", "% arcilla (menor de 0,002 mm)"), | |
tick.labels = list(l = seq(10, 90, by = 10), r = seq(10, | |
90, by = 10), b = seq(10, 90, by = 10)), show.names = TRUE, | |
show.lines = TRUE, col.names = "black", bg.names = par("bg"), | |
show.grid = TRUE, col.axis = "black", col.lines = "black", | |
col.grid = "gray", lty.grid = 3, show.legend = FALSE, label.points = FALSE, | |
point.labels = '', col.symbols = "blue", pch = par("pch"), | |
...) | |
{ | |
par(xpd = TRUE) | |
plot(0.5, type = "n", axes = FALSE, xlim = c(0, 1), ylim = c(0, | |
1), main = NA, xlab = NA, ylab = NA) | |
triax.frame(at = at, axis.labels = axis.labels, | |
tick.labels = tick.labels, col.axis = col.axis, show.grid = show.grid, | |
col.grid = col.grid, lty.grid = lty.grid) | |
arrows(0.12, 0.41, 0.22, 0.57, length = 0.15) | |
arrows(0.78, 0.57, 0.88, 0.41, length = 0.15) | |
arrows(0.6, -0.1, 0.38, -0.1, length = 0.15) | |
if (show.lines) { | |
triax.segments <- function(h1, h3, t1, t3, col) { | |
segments(1 - h1 - h3/2, h3 * sin(pi/3), 1 - t1 - | |
t3/2, t3 * sin(pi/3), col = col) | |
} | |
h1 <- c(85, 70, 80, 52, 52, 50, 20, 8, 52, 45, 45, 65, | |
45, 20, 20)/100 | |
h3 <- c(0, 0, 20, 20, 7, 0, 0, 12, 20, 27, 27, 35, 40, | |
27, 40)/100 | |
t1 <- c(90, 85, 52, 52, 43, 23, 8, 0, 45, 0, 45, 45, | |
0, 20, 0)/100 | |
t3 <- c(10, 15, 20, 7, 7, 27, 12, 12, 27, 27, 55, 35, | |
40, 40, 60)/100 | |
triax.segments(h1, h3, t1, t3, col.lines) | |
} | |
if (show.names) { | |
xpos <- c(0.5, 0.7, 0.7, 0.73, 0.73, 0.5, 0.275, 0.275, | |
0.27, 0.27, 0.25, 0.135, 0.18, 0.07, 0.49, 0.72, | |
0.9) | |
ypos <- c(0.66, 0.49, 0.44, 0.36, 0.32, 0.35, 0.43, 0.39, | |
0.3, 0.26, 0.13, 0.072, 0.032, 0.024, 0.18, 0.15, | |
0.06) * sin(pi/3) | |
snames <- c("arcillosa", "arcillosa", "limosa", "franco arcillosa", "limosa", | |
"franco arcillosa", "arcillosa", "arenosa", "franco arcillosa", "arenosa", | |
"franco arenosa", "arenosa", "franca", "arenosa", "franca", "franco limosa", | |
"limosa") | |
boxed.labels(xpos, ypos, snames, border = FALSE, col = col.names, | |
cex=0.8, xpad = 0.5) | |
} | |
par(xpd = FALSE) | |
if (is.null(soiltexture)) | |
return(NULL) | |
soilpoints <- triax.points(soiltexture, show.legend = show.legend, | |
label.points = label.points, point.labels = point.labels, | |
col.symbols = col.symbols, pch = pch, ...) | |
invisible(soilpoints) | |
} | |
# Definimos la imagen | |
CairoPNG("…/images/clasificacion_textural.png", width=500, height=560) | |
# Construimos las consultas | |
select = 'select ' | |
arena = paste(arg1, ',', sep=' '); | |
limo = paste(arg2, ',', sep=' '); | |
arcilla = paste(arg3, ' '); | |
from = ' from ' | |
tabla = arg4 | |
selection = paste(select, arena, limo, arcilla, from, tabla, sep=''); | |
selectgids = paste('select gid', from, tabla, sep=''); | |
# Ejecutamos las consultas | |
texturas <- pg.spi.exec(selection) | |
gids<- pg.spi.exec(selectgids) | |
# Ejecutamos la funcion creada mas arriba | |
soiltex.return<-clasif.textural(texturas, | |
pch=arg5, point.labels = gids[,], label.points=arg6) | |
dev.off() | |
# Damos permisos de lectura | |
system('chmod go+r …/images/clasificacion_textural.png'); | |
# Una comprobacion para asegurarnos de que se ha creado la grafica, pero no afecta para nada. | |
if (file.exists('…/images/clasificacion_textural.png')) { | |
print ('Grafico realizado. Se llama …/images/clasificacion_textural.png')}; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment