Это старая версия документа!

Базовые алгоритмы программы TPF

  1. tpf.elements <- read.csv("constants_elements_tpf.csv",stringsAsFactors=F)
  2.  
  3. tpf.oxides_ord <- c('SiO2_wtp', 'Al2O3_wtp', 'TiO2_wtp', 'Cr2O3_wtp', 'Fe2O3_wtp',
  4.                     'FeO_wtp', 'MnO_wtp', 'MgO_wtp', 'CaO_wtp', 'Na2O_wtp', 'K2O_wtp',
  5.                     'BaO_wtp', 'NiO_wtp', 'ZnO_wtp', 'BeO_wtp', 'P2O5_wtp', 'V2O5_wtp',
  6.                     'CoO_wtp', 'GeO2_wtp', 'ZrO2_wtp', 'Cs2O_wtp', 'PbO_wtp', 'SO3_wtp',
  7.                     'CO2_wtp', 'F_wtp', 'Cl_wtp');
  8.  
  9. tpf.oxides_elements_ord <- c('Si', 'Al', 'Ti', 'Cr', 'Fe3', 'Fe2', 'Mn', 'Mg',
  10.                              'Ca', 'Na', 'K', 'Ba', 'Ni', 'Zn', 'Be', 'P', 'V',
  11.                              'Co', 'Ge', 'Zr', 'Cs', 'Pb', 'S', 'C', 'F', 'Cl');
  12.  
  13. tpf.elements_ord <- c('Si', 'Al', 'Ti', 'Cr', 'Fe3', 'Fe2', 'Mn', 'Mg', 'Ca',
  14.                       'Na', 'K', 'Ba', 'Ni', 'Zn', 'Be', 'P', 'V', 'Co', 'Ge',
  15.                       'Zr', 'Cs', 'Pb', 'S', 'C', 'F', 'Cl', 'Al4', 'Al6', 'Fe');
  16.  
  17. tpf.elements_rename <- c('Si_pfu', 'Al_pfu', 'Ti_pfu', 'Cr_pfu', 'Fe_p3_pfu', 'Fe_p2_pfu',
  18.                          'Mn_pfu', 'Mg_pfu', 'Ca_pfu', 'Na_pfu', 'K_pfu', 'Ba_pfu', 'Ni_pfu',
  19.                          'Zn_pfu', 'Be_pfu', 'P_pfu', 'V_pfu', 'Co_pfu', 'Ge_pfu', 'Zr_pfu',
  20.                          'Cs_pfu', 'Pb_pfu', 'S_pfu', 'C_pfu', 'F_pfu', 'Cl_pfu',
  21.                          'Al_c4_pfu', 'Al_c6_pfu', 'Fe_pfu');
  22.  
  23.  
  24. tpf.rename <- function(wtp_data){
  25. renamed <- selectNames(wtp_data,tpf.oxides_ord);
  26. names(renamed) <- tpf.oxides_elements_ord;
  27. return(renamed);
  28. }
  29.  
  30. tpf.unrename <- function(mw, labels){
  31. renamed <- selectNames(mw,tpf.elements_ord);
  32. names(renamed) <- tpf.elements_rename;
  33. return(cbind(Name = labels, renamed[,colSums(renamed^2) !=0]));
  34. }
  35.  
  36. tpf.select_cations <- function(start,end){
  37. subs <- tpf.oxides_elements_ord[match(start,tpf.elements_ord):match(end,tpf.elements_ord)]
  38. return(subs);
  39. }
  40.  
  41. tpf.norm <- function(mw,sk){
  42.     ccat <- tpf.select_cations('Si','C');
  43.     an <- tpf.select_cations('F','Cl');
  44.     cat_ws <- subset(tpf.elements,element %in% ccat)$weight;
  45.     cat_cnt <- subset(tpf.elements,element %in% ccat)$cat_count;
  46.     an_ws <- c(1,1);
  47.     ws <- c(cat_ws/sk/cat_cnt,an_ws);
  48.     ret <- rowApply('/',mw,ws);
  49.     return(ret);
  50. }
  51.  
  52. tpf.normfcl <- function(mw,skfcl){
  53.     ccat <- tpf.select_cations('Si','C');
  54.     an <- tpf.select_cations('F','Cl');
  55.     cat_ws <- c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1); 
  56.     an_ws <- subset(tpf.elements,element %in% an)$weight;
  57.     ws <- c(cat_ws,an_ws/skfcl);
  58.     ret <- rowApply('/',mw,ws);
  59.     return(ret);
  60. }
  61.  
  62. tpf.normbt <- function(mw,sk){
  63.     ccat1 <- c(tpf.select_cations('Si','Ca'));
  64.     ccat2 <- c(tpf.select_cations('Ba','C'));
  65.     an <- tpf.select_cations('F','Cl');
  66.     cat1_ws <- subset(tpf.elements,element %in% ccat1)$weight;
  67.     cat1_cnt <- subset(tpf.elements,element %in% ccat1)$cat_count;
  68.     catt_ws <- c(1,1); 
  69.     cat2_ws <- subset(tpf.elements,element %in% ccat2)$weight;
  70.     cat2_cnt <- subset(tpf.elements,element %in% ccat2)$cat_count;
  71.     an_ws <- c(1,1);
  72.     ws <- c(cat1_ws/sk/cat1_cnt,catt_ws,cat2_ws/sk/cat2_cnt,an_ws);
  73.     ret <- rowApply('/',mw,ws);
  74.     ret$Na <- 0.0;
  75.     ret$K <- 0.0;
  76.     return(ret);
  77. }
  78.  
  79. tpf.sumfcl <- function(mw,so,theta = 0.000001){
  80. cat <- c(tpf.select_cations('Si','Cl'));
  81. cat_ws <- subset(tpf.elements,element %in% cat)$weight;
  82. cat_ox <- subset(tpf.elements,element %in% cat)$an_count;
  83. cat_ox[25] <- 1;
  84. cat_ox[26] <- 1;
  85.  
  86. ds <- rowApply('*',mw,cat_ox/cat_ws);
  87.  
  88. s <-rowSums(ds);
  89. sfc <- (ds$F + ds$Cl);
  90. s <- s - sfc/2;
  91.  
  92. #return (ifelse (s > theta, so/s, 0.0));
  93. return (so/s);
  94. }
  95.  
  96.  
  97. tpf.sum <- function(mw,so,theta = 0.000001){
  98. cat <- c(tpf.select_cations('Si','C'));
  99. cat_ws <- subset(tpf.elements,element %in% cat)$weight;
  100. cat_ox <- subset(tpf.elements,element %in% cat)$an_count;
  101.  
  102. ds <- rowApply('*',mw,cat_ox/cat_ws);
  103.  
  104. s <-rowSums(ds);
  105.  
  106. #return (ifelse (s > theta, so/s, 0.0));
  107. return (so/s);
  108. }
  109.  
  110.  
  111. tpf.alal <- function(mw,siv){
  112. mw$Al4 <- ifelse(mw$Si+mw$Al>siv, ifelse(mw$Si<siv,siv-mw$Si,0),mw$Al);
  113. mw$Al6 <- mw$Al - mw$Al4;
  114. return(mw);
  115. }
  116.  
  117.  
  118. tpf.omesod_v <- function(mw,so,siv){
  119. rn <- tpf.rename(mw);
  120. clkm <- NULL;
  121. for(i in 1:nrow(rn))
  122. {
  123. clk <- tpf.omesod(rn[i,],so,siv);
  124. if (i == 1) { clkm = clk; }
  125. else { clkm = rbind(clkm,clk); }
  126. }
  127. return(tpf.unrename(clkm,mw$Name));
  128. }
  129.  
  130. tpf.omesod <- function(mw,so,siv){
  131. sk <- tpf.sum(mw,so);
  132. skfcl <- tpf.sumfcl(mw,so);
  133. mw1 <- tpf.norm(mw,sk);
  134. mw2 <- tpf.normfcl(mw1,skfcl);
  135. mw3 <- tpf.alal(mw2,siv);
  136. mw3$Fe = mw3$Fe3 + mw3$Fe2;
  137. return (mw3);
  138. }
  139.  
  140.  
  141. tpf.sumo <- function (mw){
  142.     s <- 0;
  143.     sfc <- 0;
  144.     
  145.     cat <- c(tpf.select_cations('Si','C'));
  146.     cat_ox <- subset(tpf.elements,element %in% cat)$an_count;
  147.     cat_cat <- subset(tpf.elements,element %in% cat)$cat_count;
  148.  
  149.     clist <-  c(c(cat_ox/cat_cat),c(1,1));
  150.  
  151.     s <- rowApply('*',mw,clist);
  152.     sfc <- 0.5*(mw$F+mw$Cl);
  153.  
  154.     return (s-sfc);
  155. }
  156.  
  157.  
  158. tpf.fefe <- function(mw,ll,mm,theta = 0.000001){
  159.     os = tpf.sumo(mw) + (mw$F + mw$Cl)/2;
  160.  
  161.     os2 <- ll/os;
  162.     mw1 <- rowApply('*',mw,os2);
  163.     mw1[is.nan(mw1)] <- 0;
  164.  
  165.     mw$Fe3 <- mm-2*os;
  166.     mw$Fe2 <- mw$Fe - mw$Fe2;
  167.  
  168.     print(mw1);
  169.     return(mw);    
  170.  
  171. #Non Vector Operation! Tests requried!
  172.     for(i in 1:nrow(mw)) {
  173.         row <- mw[i,];
  174.         if( os<ll && row$Fe > (mm-2*os[i]))
  175.         {
  176. #        pass
  177.         }
  178.         else
  179.         {
  180.         mw[i,] <- mw1[i,];
  181.         }
  182.     }
  183.     return(mw);
  184. }
  185.  
  186.  
  187. tpf.recalc_minaral <- function(mn, mw){
  188. rn <- tpf.rename(mw);
  189. clkm <- NULL;
  190. for(i in 1:nrow(rn))
  191. {
  192. clk <- tpf.recalc_minaral_r(mn, rn[i,]);
  193. if (i == 1) { clkm = clk; }
  194. else { clkm = rbind(clkm,clk); }
  195. }
  196. return(tpf.unrename(clkm,mw$Name));
  197. }
  198.  
  199.  
  200.  
  201. tpf.recalc_minaral_r <- function(mn, mw) {
  202.  
  203. if (mn %in% c("SCP")) {  
  204.         mw <- tpf.omesod(mw,33,999);
  205.         sct <- mw$Si+mw$Al;
  206.         kp <- ifelse(sct != 0, 12/sct, 0);
  207.         mw <- rowApply('*',mw,kp);
  208.         mw <- tpf.alal(mw, 12);
  209.         mw$Fe <- mw$Fe3 + mw$Fe2;
  210.         return(mw);
  211. }
  212. if (mn %in% c("SPR")) {  
  213.          mw <- tpf.omesod(mw,10,999);
  214.          s <- rowSums(mw) - mw$F - mw$Cl;
  215.          s <- ifelse(s != 0, 7/s, 0);
  216.          mw <- rowApply('*',mw,s);
  217.          mw$Fe <- mw$Fe3 + mw$Fe2;
  218.          mw$Fe2 <- mw$Fe;
  219.          mw$Fe3 <- 0;
  220.          mw <- tpf.fefe(mw, 10,20);
  221.          mw <- tpf.alal(mw, 3);
  222.          return(mw);
  223. }
  224.     
  225. if (mn %in% c("ILM", "HEM")) {  
  226.          mw <- tpf.omesod(mw,3,999);
  227.          s <- rowSums(mw) - mw$F - mw$Cl;
  228.          s <- ifelse(s != 0, 2/s, 0);
  229.          mw <- rowApply('*',mw,s);
  230.          mw$Al4 <- mw$Al;
  231.          mw$Al6 <- 0;
  232.          mw$Fe <- mw$Fe3+mw$Fe2;
  233.          mw$Fe2 <- mw$Fe;
  234.          mw$Fe3 <- 0;
  235.          mw <- tpf.fefe(mw, 3,6);
  236.          return(mw);
  237. }
  238.  
  239. if (mn %in% c("MAG", "SPL")) {   
  240.          mw <- tpf.omesod(mw,4,999);
  241.          s <- rowSums(mw) - mw$F - mw$Cl;
  242.          s <- ifelse(s != 0, 3/s, 0);
  243.          mw <- rowApply('*',mw,s);
  244.          mw$Al4 <- mw$Al;
  245.          mw$Al6 <- 0;
  246.          mw$Fe <- mw$Fe3+mw$Fe2;
  247.          mw$Fe2 <- mw$Fe;
  248.          mw$Fe3 <- 0;
  249.          mw <- tpf.fefe(mw, 4,8);
  250.          return(mw);
  251. }
  252.     if (mn %in% c("OPX", "PGT", "CPX")) {  
  253.         return(tpf.omesod(mw,6,2));
  254.     }
  255.     if (mn %in% c("GRT")) {  
  256.         return(tpf.omesod(mw,12,999));
  257.     }
  258.     if (mn %in% c("EP", "ZO")) {        
  259.         return(tpf.omesod(mw,12.5,999));
  260.     }
  261.     if (mn %in% c("CRD")) {  
  262.         return(tpf.omesod(mw,18,6));
  263.     }
  264.     if (mn %in% c("CAM", "HBL", "CUM", "ATH")) {        
  265.         return(tpf.omesod(mw,23,8));
  266.     }
  267.     if (mn %in% c("KFS", "PL")) {  
  268.         return(tpf.omesod(mw,8,999));
  269.     }
  270.     if (mn %in% c("BT", "MS")) {  
  271.         return(tpf.omesod(mw,11,4));
  272.     }
  273.     if (mn %in% c("OL", "MTC")) {  
  274.         return(tpf.omesod(mw,4,1));
  275.     }
  276.     if (mn %in% c("RT", "QTZ")) {        
  277.         return(tpf.omesod(mw,2,999));
  278.     }
  279.     if (mn %in% c("KY","AND","SIL","TTN")) {        
  280.         return(tpf.omesod(mw,5,999));
  281.     }
  282.     if (mn %in% c("L")) {  
  283.        return(tpf.omesod(mw,50,999));
  284.     }
  285.     if (mn %in% c("SID", "DOL", "MGS", "CAL", "FE", "WUS")) {  
  286.        return(tpf.omesod(mw,1,999));
  287.     }
  288.     if (mn %in% c("WO")) {
  289.        return(tpf.omesod(mw,3,999));
  290.     }
  291.     if (mn %in% c("NE")) {  
  292.        return(tpf.omesod(mw,4,2));
  293.     }
  294.     if (mn %in% c("ST")) {  
  295.        return(tpf.omesod(mw,46,999));
  296.     }
  297.     if (mn %in% c("TLC")) {  
  298.        return(tpf.omesod(mw,11,999));
  299.     }
  300.     if (mn %in% c("CHL")) {  
  301.        return(tpf.omesod(mw,14,4));
  302.     }
  303.     if (mn %in% c("CHD")) {  
  304.        return(tpf.omesod(mw,12,999));
  305.     }
  306.     if (mn %in% c("OSU")) {  
  307.        return(tpf.omesod(mw,30,999));
  308.     }
  309.     if (mn %in% c("KRN")) {  
  310.        return(tpf.omesod(mw,43,999));
  311.     }
  312.     if (mn %in% c("STP")) {  
  313.        return(tpf.omesod(mw,23,999));
  314.     }
  315.     if (mn %in% c("HU")) {  
  316.        return(tpf.omesod(mw,13,999));
  317.     }
  318.     if (mn %in% c("CRN")) {
  319.         return(tpf.omesod(mw,3,999));
  320.     }
  321. }
  322.  
  323.  
  • utilities_tpf.1474030581.txt.gz
  • Последние изменения: 2018/11/12 15:08
  • (внешнее изменение)