Различия
Здесь показаны различия между двумя версиями данной страницы.
| Предыдущая версия справа и слева Предыдущая версия Следующая версия | Предыдущая версия | ||
|
utilities_tpf [2016/09/16 12:29] admin |
utilities_tpf [2020/02/19 13:27] (текущий) f0ma |
||
|---|---|---|---|
| Строка 2: | Строка 2: | ||
| <Code linenums lang-r> | <Code linenums lang-r> | ||
| + | |||
| + | source('utilities.r') | ||
| + | |||
| tpf.elements <- read.csv("constants_elements_tpf.csv",stringsAsFactors=F) | tpf.elements <- read.csv("constants_elements_tpf.csv",stringsAsFactors=F) | ||
| Строка 152: | Строка 155: | ||
| clist <- c(c(cat_ox/cat_cat),c(1,1)); | clist <- c(c(cat_ox/cat_cat),c(1,1)); | ||
| - | s <- rowApply('*',mw,clist); | + | s <- rowSums(rowApply('*',mw,clist)); |
| sfc <- 0.5*(mw$F+mw$Cl); | sfc <- 0.5*(mw$F+mw$Cl); | ||
| Строка 160: | Строка 163: | ||
| tpf.fefe <- function(mw,ll,mm,theta = 0.000001){ | tpf.fefe <- function(mw,ll,mm,theta = 0.000001){ | ||
| + | #Non Vector Operation! Tests requried! | ||
| + | | ||
| os = tpf.sumo(mw) + (mw$F + mw$Cl)/2; | os = tpf.sumo(mw) + (mw$F + mw$Cl)/2; | ||
| - | mw1 <- rowApply('*',mw,ll/os); | + | if (os>theta) { |
| - | + | if( os<ll && mw$Fe > (mm-2*os)) { | |
| - | mw$Fe3 <- mm-2*os; | + | mw$Fe3 <- mm-2*os; |
| - | mw$Fe2 <- mw$Fe - mw$Fe2; | + | mw$Fe2 <- mw$Fe - mw$Fe2; |
| - | + | }else{ | |
| - | ret <- as.data.frame(setNames(replicate(29, numeric(0), simplify = F), names(mw))) | + | mw <- rowApply('*',mw,ll/os); |
| - | + | ||
| - | #Non Vector Operation! Tests requried! | + | |
| - | for(i in 1:nrow(mw)) { | + | |
| - | row <- mw[i,]; | + | |
| - | if( os<ll && row$Fe > (mm-2*os[i])) | + | |
| - | { | + | |
| - | ret <-rbind(ret,row); | + | |
| - | } | + | |
| - | else | + | |
| - | { | + | |
| - | ret <-rbind(ret,mw1[i,]); | + | |
| } | } | ||
| } | } | ||
| - | return(ret); | + | return(mw); |
| } | } | ||
| Строка 194: | Строка 188: | ||
| else { clkm = rbind(clkm,clk); } | else { clkm = rbind(clkm,clk); } | ||
| } | } | ||
| - | return(tpf.unrename(clkm,mw$Name)); | + | |
| + | ds <- tpf.unrename(clkm,mw$Name) | ||
| + | return(cbind(data.frame(Name=mw$Name),selectNames(ds, tpf.elements_rename))); | ||
| } | } | ||