TAS Classification

TAS Daigram.

Использовать Проверить

require('ggplot2');

classifydiag.tas <- function (wtp_data, ...){

ds <- selectNames(wtp_data, c("Name", "SiO2_wtp", "K2O_wtp", "Na2O_wtp"));

pts <- data.frame(Name=ds$Name,
                  X=ds$SiO2_wtp,
                  Y=ds$K2O_wtp + ds$Na2O_wtp);

marks  <- data.frame(Label=c("Picro-\nbasalts",
                             "Foidite",
                             "Tephrite-\nBasanite",
                             "Basalts",
                             "Trachy-\nbasalts",
                             "Phono-\ntephrite",
                             "Basaltic\nandesite",
                             "Basaltic\ntrachy-\nandesite",
                             "Tephri-\nphonolite",
                             "Andesite",
                             "Trachy-\nandesite",
                             "Phonolite",
                             "Dacite",
                             "Trachy-\ndacite",
                             "Trachyte",
                             "Rhyolite"),
                     X=c( 43,  39,  44,  48,  49,  49,  55,  53,   53,  60,  58,   58,  67,  66,   65,  73),
                     Y=c(2.0, 8.5, 6.5, 3.0, 6.0, 9.0, 3.0, 7.0, 12.0, 4.0, 8.0, 14.0, 4.5, 9.0, 11.0, 8.0));

limits <- c(35,77,0,16);


rads  <- data.frame(X1 = c( 41,   41,  45,   45, 45, 52),
                    Y1 = c(0.5,    7, 0.5,    5,  5,  5),
                    X2 = c( 41, 52.3,  45,   61, 52, 69),
                    Y2 = c(  7,   14,   5, 13.5,  5,  8));

pls   <- data.frame(X1 = c( 41,  52,   52, 49.2,  57,  57,   53,  63,   63, 57.5, 73.5, 69),
                    Y1 = c(  3, 0.5,    5,  7.3, 1.5,   6,  9.3, 2.0,  7.0, 11.7,    3,  8),
                    X2 = c( 45,  52, 49.2,   45,  57,  53, 48.5,  63, 57.5,   49,   69, 69),
                    Y2 = c(  3,   5,  7.3,  9.5,   6, 9.3, 11.5, 7.0, 11.7, 15.5,    8, 13));

labels <- c("SiO2", "K2O+Na2O");

ret <- c();

ret$type <- "diagram";
ret$points <- pts;
ret$limits <- limits;
ret$marks <- marks;
ret$lines <- rbind(rads,pls);
ret$labels  <- labels;

return(ret);
}