f1 <- function(a,b=2){ message(a,b) return(a+b) # 没有return返回最后一条语句 } b <- f1(5) # 52 b # 7 f1(2,5) # 25 f1(b=2,a=5) # 52 f1(b=5,2) # 25
r自带函数 c(..., recursive = FALSE, use.names = TRUE)
f2 <- function(...){ cat(..2) # 2 dot_args = list(...) print(dot_args) } f2(1,2,3,4,5)
操作符也是函数类型对象
1+2 # 3 "+"(1,2) # 3 `+`(1,2) # 3 '+'(1+2) # 3 '<-'(new_var,5) new_var # 5 ':'(1,5) # 1 2 3 4 5 '['(1:10,2) # 2
注意:字母作为名称的函数必须使用%%括住名称,才能放在中间被调用
'%ab2c%' <- function(a,b){ sqrt(sum(a^2,b^2)) } ab2c(3,4) # Error in ab2c(3, 4) : could not find function "ab2c" 3 %ab2c% 4
纯粹的字母不能在两个参数之间当做函数使用
'ab2c' <- function(a,b){ sqrt(sum(a^2,b^2)) } ab2c(3,4) # [1] 5 3 %ab2c% 4 # Error in 3 %ab2c% 4 : could not find function "%ab2c%" ab2c <- function(a,b){ sqrt(sum(a^2,b^2)) } ab2c(3,4) # [1] 5 3 %ab2c% 4 # Error in 3 %ab2c% 4 : could not find function "%ab2c%"
函数名称是符号可以不使用%%, 但是使用%%和不使用%%是不同的函数
5+2 # 7 "+" <- function(x,y){ x*y } "%+%" <- function(x,y){ x/y } 5+2 # 10 5 %+% 2 # [1] 2.5 rm(`+`) 5+2 # 7
library(purrr) x <- c(1,1,2,2,8,5,9) x %>% unique() %>% sort() # > 1 2 8 5 9 x <- unique(x) x <- sort(x) # > 1 2 8 5 9
函数接受不同的对象有不同的结果
x <- seq(1,100,by=10) y <- 2*x + 10 xy <- cbind(x,y) class(xy) # matrix plot(xy, xlim = c(1,100), ylim = c(0,230), type = "o",col="red") # figure 1
x <- seq(1,100,by=10) y <- 2*x + 10 xy <- cbind(x,y) my_model <- lm(y~x) class(my_model) # lm op <- par(mfrow = c(2,2)) plot(my_model) # figure 2 par(op)
my_function <- function(x,y){ message("I am interface") UseMethod("my_function",x) # 通过x标签类型确定执行函数 } my_function.addXY <- function(x,y){ return(x+y) } my_function.multiplyXY <- function(x,y){ return(x*y) } my_function.default <- function(x,y){ return(x-y) } x<-9 y<-5 my_function(x,y) # default 4 class(x) <- "addXY" my_function(x,y) # addXY 14 class(x) <- "multiplyXY" my_function(x,y) # multiplyXY 45
"+" 是有两个参数函数的操作
"+.onlyFirst" <- function(a,b){ return(a[1]+b[1]) } a <- 1:5 b <- 6:10 a+b # 7 9 11 13 15 "+"(a,b) # 7 9 11 13 15 class(a) <- "onlyFirst" a+b # 7 "+"(a,b) # 7 class(a) <- NULL class(b) <- "onlyFirst" a+b # 7 "+"(a,b) # 7 class(a) <- "onlyFirst" class(b) <- "onlyFirst" a+b # 7 "+"(a,b) # 7
fun1 <- function(s){ message("before",s) if(s>0){ fun1(s-1) } message("after",s) } fun1(5)
before5 before4 before3 before2 before1 before0 after0 after1 after2 after3 after4 after5
fib <- function(n){ if(n==1){ return(1) }else{ return(c(fib(n-1),sum(fib(n-1),n=2))) } } fib(10) # > 1 3 6 12 24 48 96 192 384 768
split_df <- function(starbase_miRNA_data){ tmp<-strsplit(starbase_miRNA_data$miRNA,split="-",fixed=TRUE) starbase_miRNA_data <- sapply(tmp,function(x) paste(x[1:3],collapse = "-")) data.frame(miRNA=unique(starbase_miRNA_data)) }
gset_1_pd <- pData(gset_1) %>% dplyr::select(sample_id=geo_accession,sample_name=title,tissue_type=source_name_ch1)%>% mutate(group=str_sub(tissue_type,-6,-1)) gset_1_pd <- pData(gset_1) %>% dplyr::select(sample_id=geo_accession,sample_name=title,tissue_type=source_name_ch1)%>% mutate(group= change_col(tissue_type) change_col <- function(x){ return(paste0("a",x)) } gset_1_pd <- pData(gset_1) %>% dplyr::select(sample_id=geo_accession,sample_name=title,tissue_type=source_name_ch1)%>% mutate(group= tissue_type)%>% mutate_at(vars("group"),~ change_col(.)) change_col <- function(x){ return(paste0("a",x)) }
apply(a,1, function(x) mean(x)) rowMeans(a``)
plyr::rename(data, c(old=new)) dplyr::rename(data, new = old)
str_extract(miRNA,"hsa-let-[0-9]+[a-z]?")
as.data.frame(apply(mutation_maf,2,function(x){trimws(x, which = c("both"))}))
df1$Remove_all_space <- gsub('\\s+', '', df1$State)
https://stackoverflow.com/questions/20760547/removing-whitespace-from-a-whole-data-frame-in-r
# library(data.table) # data.table(mutation_maf)->mutation_maf_tab # mutation_maf_tab[,.N, .(Hugo_Symbol, Variant_Classification)] %>% # filter(Hugo_Symbol=="TP53")
idx <- which(!complete.cases(tcga_clinical)) tcga_clinical[idx,] subset(tcga_clinical,!complete.cases(tcga_clinical)) na.omit(tcga_clinical)%>%dim() tcga_clinical%>%dim()
iris %>% set_names("sep_len", "sep_wid", "pet_len", "pet_wid", "spp") %>% names()
circRNA P.Value logFC 1 hsa_circRNA_101175 0.0000825 -1.17 2 hsa_circRNA_002178 0.00011 1.91 3 hsa_circRNA_000554 0.000132 -1.62 4 hsa_circRNA_101004 0.000141 -1.33 5 hsa_circRNA_001678 0.000163 2.68 6 hsa_circRNA_101748 0.000277 1.28
intersect_circRNA <- Reduce(function(x,y) merge(x,y,by="circRNA",all=F),list(gse_1,gse_2,gse_3),accumulate=F)
图片alt
m <- data.frame(matrix(sample(100, 20, replace = TRUE), ncol = 4)) m colMeans(m) rowMeans(m) colSums(m) summarise(m,count=n(),max = max(m), mean = mean(m)) summary(m)
Reduce(function(x,y) intersect(x,y),list(circbank_miRNA,miRanda_miRNA,RNAhybrid_mimRNA),accumulate =FALSE)
将b的顺序调整为a
a<- c("a","b","c") b <-c("b","c","a") b[match(a,b)]
data.matrix <- do.call('cbind',lapply(gsmlist,function(x) {tab <- Table(x) mymatch <- match(probesets,tab$ID_REF) return(tab$VALUE[mymatch]) }))
https://bioconductor.org/packages/release/bioc/vignettes/GEOquery/inst/doc/GEOquery.html
suppressMessages(library(tidyverse)) getName <- function(x,res){ last <- x[length(x)] if(!grepl("Unclassified",last, ignore.case=T)){ res <- c(res,last) } if(length(res)>1 || length(x) ==1){ return(res) } getName(x[1:length(x)-1],res) } lapply(list.files("/data/metagenomics/mtbi_out/micop_virus/",pattern = "merged_abundance_table_(.*)\\D.txt"),function(x){ read_tsv(x,show_col_types = FALSE,comment="#") |> mutate(TAXPATHSN=str_split(TAXPATHSN,"\\|") %>% map_chr(., function(x){ name <- paste0(getName(x,c()),collapse = "_") return(name) })) %>% {.[!duplicated(.$TAXPATHSN),]} |> head() #|> write_tsv(file = "") })
可以动态创建变量
for(i in 1:3) { # Head of for-loop assign(paste0("x_", i), i) # Combining assign & paste0 }
assign("goAnno", goAnno, envir=GO_Env) assign("keytype", keytype, envir=GO_Env) assign("ont", ont, envir = GO_Env) assign("organism", get_organism(OrgDb), envir=GO_Env)
如:如果n是一个变量名称,后又定义x <- "n",而之后的变量n的引用想要使用x来表述,这时候x代表的是字符串"n",而不是变量n。
当定义的字符串向量要传递给tidyverse 时,字符传递给tidyverse 时可能会有问题。因为tidyverse 中列名通常是不带引号的。
解决办法:使用get()或者!! 方法;如果是ggplot2中的映射,可以使用aes_string()。
df %>% select(!!x) %>% head() ## Sepal.Length ## 1 5.1 ## 2 4.9 ## 3 4.7 ## 4 4.6 ## 5 5.0 ## 6 5.4
https://zhuanlan.zhihu.com/p/559652326
Reduce(function(x,y)intersect(x,y),cnames) Map(identical,list( cnames[[1]]),cnames)
https://blog.csdn.net/weixin_29534143/article/details/113581866
淘宝商品