Amp: 13eCNK

Droop equation No 6 assuming 13 cations excluding Ca,Na & K and with ZrO2.

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

recalc.amp_13ecnk <- function (wtp_data, ...) {
wnames <- c('SiO2_wtp', 'TiO2_wtp', 'Al2O3_wtp', 'Cr2O3_wtp',
           'FeO_wtp', 'MnO_wtp', 'MgO_wtp', 'CaO_wtp', 'Na2O_wtp',
           'K2O_wtp', 'ZrO2_wtp');
 
anames <- c('Si_pfu', 'Ti_pfu', 'Al_pfu', 'Cr_pfu',
           'Fe_pfu', 'Mn_pfu', 'Mg_pfu', 'Ca_pfu', 'Na_pfu',
           'K_pfu', 'Zr_pfu');
 
xmweights <- c(60.08, 79.88, 101.96, 151.99, 71.85, 70.94, 40.3, 56.08, 61.98, 94.2, 123.22);
ocount <-    c(2,     2,     3,      3,      1,     1,     1,    1,     1,     1,    1);
xcount <-    c(1/2,   1/2,   2/3,    2/3,    1,     1,     1,    1,     2,     2,    1/2);
 
wtp <- selectNames(wtp_data, wnames)
 
mprop <- rowApply(`/`,wtp,xmweights);
atpropo <- rowApply(`*`,mprop,ocount);
 
atproposumm <- rowSums(atpropo);
t2 <- 23/atproposumm;
noanions <- atpropo*t2;
formula <- rowApply(`*`,noanions,xcount);
names(formula) <- anames;
 
cationCNK <- formula$Si_pfu + formula$Ti_pfu + formula$Al_pfu + formula$Cr_pfu + formula$Fe_pfu + formula$Mn_pfu + formula$Mg_pfu + formula$Zr_pfu;
ToverS <- 13 / cationCNK;
 
fnorm <- formula*ToverS;
 
Fe_p3 <- (2*23)*(1-ToverS);
 
Fe_p2 <- ifelse(Fe_p3>fnorm$Fe_pfu,0,fnorm$Fe_pfu-Fe_p3);
Fe_p3 <- ifelse(Fe_p3>fnorm$Fe_pfu,fnorm$Fe_pfu,Fe_p3);
 
rformula <- formula[0, ];
 
for(i in 1:nrow(formula)){
    if (cationCNK[i]<13) {
        rformula <- rbind(rformula, formula[i,]);
    } else {
        rformula <- rbind(rformula, fnorm[i,]);
    }
}
 
rformula$Fe_p3_pfu <- ifelse(cationCNK<13,0,Fe_p3);
rformula$Fe_p2_pfu <- ifelse(cationCNK<13,formula$Fe_pfu,Fe_p2);
rformula$Fe_pfu <- rformula$Fe_p3_pfu+rformula$Fe_p2_pfu;
Ca_2m <- 2 - rformula$Ca_pfu;
Si_8m <- 8 - rformula$Si_pfu;
Al_mSi_8m <- rformula$Al_pfu - Si_8m;
 
rformula$Si_T_pfu <- rformula$Si_pfu;
rformula$Al_T_pfu <- ifelse(rformula$Al_pfu<Si_8m,rformula$Al_pfu,Si_8m);
rformula$Al_c4_pfu <- rformula$Al_T_pfu;
rformula$Sum_T <- rformula$Si_T_pfu + rformula$Al_T_pfu;
 
rformula$Al_C_pfu <- ifelse(rformula$Al_pfu<Si_8m,0,Al_mSi_8m);
rformula$Al_c6_pfu <- rformula$Al_C_pfu;
rformula$Ti_C_pfu <- rformula$Ti_pfu;
rformula$Cr_C_pfu <- rformula$Cr_pfu;
rformula$Fe_p2_C_pfu <- rformula$Fe_p2_pfu;
rformula$Fe_p3_C_pfu <- rformula$Fe_p3_pfu;
rformula$Fe_C_pfu <- rformula$Fe_pfu;
rformula$Mn_C_pfu <- rformula$Mn_pfu;
rformula$Mg_C_pfu <- rformula$Mg_pfu;
rformula$Sum_C <- rformula$Al_C_pfu+rformula$Ti_C_pfu+rformula$Cr_C_pfu+rformula$Fe_pfu+rformula$Mn_C_pfu+rformula$Mg_C_pfu;
 
rformula$Ca_B_pfu <- rformula$Ca_pfu;
rformula$Na_B_pfu <- ifelse(Ca_2m>rformula$Na_pfu, rformula$Na_pfu, Ca_2m);
rformula$Sum_B <- rformula$Ca_B_pfu + rformula$Na_B_pfu;
 
rformula$Na_A_pfu <- rformula$Na_pfu - rformula$Na_B_pfu;
rformula$K_A_pfu <- rformula$K_pfu;
rformula$Sum_A <- rformula$Na_A_pfu + rformula$K_A_pfu;
 
result <- cbind(data.frame(Name=wtp_data$Name),rformula);
return(result);
}
# избыточная выдача; невозможно прочитать всю строку
# или удвоить строку или вывести необходимые величины вперед
# достаточно SiT/ AlT/ Al6/ Fe3/ Ti/ Cr/ Fe2/ Mn/ Mg/ Ca/ Na/ K/ TOTAL
 
recalc.amp_13ecnk.test <- function (){
    tdata = data.frame(Name=c('test1', 'test2'), SiO2_wtp=c(42.890, 30), TiO2_wtp=c(1.800, 1.800), Al2O3_wtp=c(11.550, 11.550), FeO_wtp=c(14.960,14.960),
                    MgO_wtp=c(11.120,11.120),  CaO_wtp=c(11.490,11.490), Na2O_wtp=c(1.870,1.870), K2O_wtp=c(1.060,1.060));
 
    result <- recalc.amp_13ecnk(tdata);
    
    expect_equal(object = result[1,]$Fe_p3_pfu,0.308, tolerance = 0.05);
    expect_equal(object = result[2,]$Si_pfu,5.267, tolerance = 0.05);
}