Amp: 13eCNK Method

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)){
rformula <- rbind(rformula, ifelse(ToverS[i]<13,formula[i,],fnorm[i,]));
}

print(rformula);

rformula$Fe_pfu = 0;
rformula$Fe_p3_pfu = ifelse(ToverS<13,0,Fe_p3);
rformula$Fe_p2_pfu = ifelse(ToverS<13,formula$Fe_pfu,Fe_p2);

result <- cbind(data.frame(Name=wtp_data$Name),rformula);
print(result);
return(result);
}

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);
}