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

Базовые алгоритмы программы 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.     mw1 <- rowApply('*',mw,ll/os);
  162.  
  163.     mw$Fe3 <- mm-2*os;
  164.     mw$Fe2 <- mw$Fe - mw$Fe2;
  165.     
  166.     ret <- as.data.frame(setNames(replicate(25, numeric(0), simplify = F), names(mw)))
  167.  
  168. #Non Vector Operation! Tests requried!
  169.     for(i in 1:nrow(mw)) {
  170.         row <- mw[i,];
  171.         if( os<ll && row$Fe > (mm-2*os[i]))
  172.         {
  173.         ret <-rbind(ret,row);
  174.         }
  175.         else
  176.         {
  177.         ret <-rbind(ret,mw1[i,]);
  178.         }
  179.     }
  180.     return(ret);
  181. }
  182.  
  183.  
  184. tpf.recalc_minaral <- function(mn, mw){
  185. rn <- tpf.rename(mw);
  186. clkm <- NULL;
  187. for(i in 1:nrow(rn))
  188. {
  189. clk <- tpf.recalc_minaral_r(mn, rn[i,]);
  190. if (i == 1) { clkm = clk; }
  191. else { clkm = rbind(clkm,clk); }
  192. }
  193. return(tpf.unrename(clkm,mw$Name));
  194. }
  195.  
  196.  
  197.  
  198. tpf.recalc_minaral_r <- function(mn, mw) {
  199.  
  200. if (mn %in% c("SCP")) {  
  201.         mw <- tpf.omesod(mw,33,999);
  202.         sct <- mw$Si+mw$Al;
  203.         kp <- ifelse(sct != 0, 12/sct, 0);
  204.         mw <- rowApply('*',mw,kp);
  205.         mw <- tpf.alal(mw, 12);
  206.         mw$Fe <- mw$Fe3 + mw$Fe2;
  207.         return(mw);
  208. }
  209. if (mn %in% c("SPR")) {  
  210. #        tpf.omesod(mw,10,999);
  211. #        {form(7);-nelzya, t.k. mw[i] uzhe raschitani, t.e. drugie!}
  212. #        s:=0;
  213. #        for i:=Si to C do s:=s+mw[i];
  214. #        if s>0.01e-6 then s:=7/s else s:=0;
  215. #        for i:=Si to Cl do mw[i]:=s*mw[i];
  216. #        mw[fe]:=mw[fe3]+mw[fe2];  mw[fe2]:=mw[fe]; mw[fe3]:=0;
  217. #        fefe(mw, 10,20); alal(mw, 3); mw[sum_o]:=sumo;
  218. }
  219.     
  220. if (mn %in% c("ILM", "HEM")) {  
  221. #        tpf.omesod(mw,3,999);
  222. #        {form(2);}
  223. #        s:=0;
  224. #        for i:=Si to C do s:=s+mw[i];
  225. #        if s>0.01e-6 then s:=2/s else s:=0;
  226. #        for i:=Si to Cl do mw[i]:=s*mw[i];
  227. #        mw[Al4]:=mw[Al]; mw[Al6]:=0;
  228. #        mw[Fe]:=mw[Fe3]+mw[Fe2]; mw[Fe2]:=mw[Fe]; mw[Fe3]:=0;
  229. #        fefe(mw, 3,6); mw[sum_o]:=sumo;
  230. }
  231.  
  232. if (mn %in% c("MAG", "SPL")) {   
  233. #        tpf.omesod(mw,4,999);
  234. #        {form(3);}
  235. #        s:=0;
  236. #        for i:=Si to C do s:=s+mw[i];
  237. #        if s>0.01e-6 then s:=3/s else s:=0;
  238. #        for i:=Si to Cl do mw[i]:=s*mw[i];
  239. #        mw[Al4]:=mw[Al]; mw[Al6]:=0;
  240. #        mw[Fe]:=mw[Fe3]+mw[Fe2]; mw[Fe2]:=mw[Fe]; mw[Fe3]:=0;
  241. #        fefe(mw, 4,8); mw[sum_o]:=sumo;
  242. }
  243.     if (mn %in% c("OPX", "PGT", "CPX")) {  
  244.         return(tpf.omesod(mw,6,2));
  245.     }
  246.     if (mn %in% c("GRT")) {  
  247.         return(tpf.omesod(mw,12,999));
  248.     }
  249.     if (mn %in% c("EP", "ZO")) {        
  250.         return(tpf.omesod(mw,12.5,999));
  251.     }
  252.     if (mn %in% c("CRD")) {  
  253.         return(tpf.omesod(mw,18,6));
  254.     }
  255.     if (mn %in% c("CAM", "HBL", "CUM", "ATH")) {        
  256.         return(tpf.omesod(mw,23,8));
  257.     }
  258.     if (mn %in% c("KFS", "PL")) {  
  259.         return(tpf.omesod(mw,8,999));
  260.     }
  261.     if (mn %in% c("BT", "MS")) {  
  262.         return(tpf.omesod(mw,11,4));
  263.     }
  264.     if (mn %in% c("OL", "MTC")) {  
  265.         return(tpf.omesod(mw,4,1));
  266.     }
  267.     if (mn %in% c("RT", "QTZ")) {        
  268.         return(tpf.omesod(mw,2,999));
  269.     }
  270.     if (mn %in% c("KY","AND","SIL","TTN")) {        
  271.         return(tpf.omesod(mw,5,999));
  272.     }
  273.     if (mn %in% c("L")) {  
  274.        return(tpf.omesod(mw,50,999));
  275.     }
  276.     if (mn %in% c("SID", "DOL", "MGS", "CAL", "FE", "WUS")) {  
  277.        return(tpf.omesod(mw,1,999));
  278.     }
  279.     if (mn %in% c("WO")) {
  280.        return(tpf.omesod(mw,3,999));
  281.     }
  282.     if (mn %in% c("NE")) {  
  283.        return(tpf.omesod(mw,4,2));
  284.     }
  285.     if (mn %in% c("ST")) {  
  286.        return(tpf.omesod(mw,46,999));
  287.     }
  288.     if (mn %in% c("TLC")) {  
  289.        return(tpf.omesod(mw,11,999));
  290.     }
  291.     if (mn %in% c("CHL")) {  
  292.        return(tpf.omesod(mw,14,4));
  293.     }
  294.     if (mn %in% c("CHD")) {  
  295.        return(tpf.omesod(mw,12,999));
  296.     }
  297.     if (mn %in% c("OSU")) {  
  298.        return(tpf.omesod(mw,30,999));
  299.     }
  300.     if (mn %in% c("KRN")) {  
  301.        return(tpf.omesod(mw,43,999));
  302.     }
  303.     if (mn %in% c("STP")) {  
  304.        return(tpf.omesod(mw,23,999));
  305.     }
  306.     if (mn %in% c("HU")) {  
  307.        return(tpf.omesod(mw,13,999));
  308.     }
  309.     if (mn %in% c("CRN")) {
  310.         return(tpf.omesod(mw,3,999));
  311.     }
  312. }
  313.  
  314.  
  • utilities_tpf.1474027656.txt.gz
  • Последние изменения: 2018/11/12 15:08
  • (внешнее изменение)