Различия
Здесь показаны различия между двумя версиями данной страницы.
Следующая версия | Предыдущая версия | ||
interpmin:px_macgreg [2016/04/28 12:59] admin создано |
interpmin:px_macgreg [2018/11/12 15:07] (текущий) |
||
---|---|---|---|
Строка 22: | Строка 22: | ||
* <del>тест</del> | * <del>тест</del> | ||
</WRAP> | </WRAP> | ||
+ | |||
+ | === Source === | ||
<Code linenums lang-r> | <Code linenums lang-r> | ||
+ | source('recalc_px_macgreg.r'); | ||
+ | |||
interpmin.px_macgreg <- function (wtp_data, ...) | interpmin.px_macgreg <- function (wtp_data, ...) | ||
{ | { | ||
+ | d <- recalc.px_macgreg(wtp_data); | ||
+ | d$Si_pfu <- ifelse(d$Si_pfu<2,d$Si_pfu,2); | ||
+ | d$Al_c4_pfu <- ifelse(2-d$Si_pfu<d$Al_pfu,2-d$Si_pfu,d$Al_pfu); | ||
+ | d$Al_c6_pfu <- ifelse(d$Al_c4_pfu<d$Al_pfu,d$Al_pfu-d$Al_c4_pfu,0); | ||
+ | |||
+ | z <- d$Na_pfu+d$K_pfu; | ||
+ | dd <- d$Al_c6_pfu-d$Al_c4_pfu; | ||
+ | s1 <- d$Si_pfu-2; | ||
+ | s2 <- ifelse(s1<0,0,s1); | ||
+ | M3 <- d$Cr_pfu+2*(s2+d$Ti_pfu)+d$Fe_p3_pfu+dd; | ||
+ | ee <- M3-(d$Na_pfu+d$K_pfu); | ||
+ | e2 <- ifelse(ee<0,0,ee); | ||
+ | A1i <- d$Al_c4_pfu-d$Ti_pfu; | ||
+ | Na2i <- d$Na_pfu-d$Ti_pfu; | ||
+ | Na2 <- ifelse(Na2i<0,0,Na2i); | ||
+ | zp1 <- d$Na_pfu+d$K_pfu-d$Ti_pfu; | ||
+ | zp <- ifelse(zp1<0,0,zp1); | ||
+ | Ti_Napx <- d$Ti_pfu; | ||
+ | A1n <- ifelse(A1i<0,0,A1i); | ||
+ | A2n <- d$Al_c6_pfu - A1n; | ||
+ | A3n <- ifelse(A2n<0,0,A2n); | ||
+ | F2n <- ifelse(A2n<0,d$Fe_p3_pfu+A2n,d$Fe_p3_pfu); | ||
+ | g <- d$Ca_pfu - e2/2 - A1n; | ||
+ | g2 <- ifelse(g<0,0,g); | ||
+ | Di <- ifelse(g2>d$Mg_pfu,d$Mg_pfu,g2); | ||
+ | Hd <- 0.0; | ||
+ | h <- (d$Fe_p2_pfu + d$Mn_pfu + d$Mg_pfu - g2)/2; | ||
+ | Jd <- ifelse(A3n>zp,zp,A3n); | ||
+ | zn <- zp-A3n; | ||
+ | zm <- ifelse(zn<0,0,zn); | ||
+ | Ko <- ifelse(d$Cr_pfu > zm, zm, d$Cr_pfu); | ||
+ | zl <- zm - d$Cr_pfu; | ||
+ | zk <- ifelse(zl<0,0,zl); | ||
+ | Ac <- ifelse(d$Fe_p3_pfu>zk,zk,d$Fe_p3_pfu); | ||
+ | Kcpx <- d$K_pfu; | ||
+ | |||
+ | res <- data.frame(Name=wtp_data$Name); | ||
+ | |||
+ | res$X_Jd <- ifelse(Ko-Kcpx<0,Jd-Kcpx,Jd); | ||
+ | res$X_Ac <- Ac; | ||
+ | res$X_DiHd <- g2; | ||
+ | res$X_CaTs <- A1n; | ||
+ | res$X_Ko <- ifelse(Jd-Kcpx<0,Ko-Kcpx,Ko); | ||
+ | res$X_K_Ko <- ifelse(Jd-Kcpx<0,Kcpx,0); | ||
+ | res$X_K_Jd <- ifelse(Ko-Kcpx<0,Kcpx,0); | ||
+ | res$X_Ti_Napx <- Ti_Napx; | ||
+ | res$X_CaEs <- e2; | ||
+ | res$X_Opx <- ifelse(h>0,h,0); | ||
+ | |||
+ | return(res); | ||
+ | } | ||
+ | |||
+ | interpmin.px_macgreg.test <- function () | ||
+ | { | ||
+ | src <- data.frame(Name='test', SiO2_wtp=49.210, TiO2_wtp=0.19, Al2O3_wtp=11.180, Cr2O3_wtp=0.23, | ||
+ | FeO_wtp=6.28, MnO_wtp=0.00, MgO_wtp=19.160, CaO_wtp=16.16, Na2O_wtp=0.00, K2O_wtp=0.00); | ||
+ | |||
+ | result <- interpmin.px_macgreg(src); | ||
+ | | ||
+ | expect_equal(object = result$X_Jd, 0.0, tolerance = 0.05); | ||
+ | expect_equal(object = result$X_DiHd, 0.342, tolerance = 0.05); | ||
+ | expect_equal(object = result$X_Opx, 0.392, tolerance = 0.05); | ||
} | } | ||
</Code> | </Code> |