首页 > 代码库 > R 代码积累

R 代码积累

R 代码积累不定期更新

1.阶乘、递归、reduce、sprintf

#NO.1
# 阶乘函数
fact <- function(n){
  if(n==0) return(1) #基例在这
  else return(n*fact(n-1))
}

#1+2!+3!+...+20!的和
#测试 Reduce(‘+‘, lapply(1:3,fact)) 结果是9
Reduce(‘+‘, lapply(1:20,fact))

#NO.2
#判断101-200之间有多少个素数,并输出所有素数
is.prime <- function(num) {
  if (num == 2) {
    TRUE
  } else if (any(num %% 2:(num-1) == 0)) {
    FALSE
  } else { 
    TRUE
  }
}
#101共有多少个素数
Reduce(‘+‘, lapply(101:200,is.prime))
#打印出每一个素数
for(i in 101:200){
  if(!is.prime(i)) next
  print(sprintf(‘%d 是素数 %s‘,i,is.prime(i)))
}

2.MD5加密卡号

library(magrittr)
library(digest)
library(data.table)
library(readxl)
library(lubridate)

dat=read_excel(‘data_union.xlsx‘,sheet=4)
dim(dat)
get_len <- function(a){
  return(paste0(nchar(a),a))
}
dat$card_len=lapply(dat$bank_card, get_len)%>%unlist()
dat$card_md5 <- lapply(dat$card_len, digest, algo="md5",serialize=F)%>%unlist()
dat$card_md5_upper <- toupper(dat$card_md5)
write.table(
  dat[,c(‘card_md5_upper‘)]
  ,‘yqb_card_md5.txt‘,row.names = F
  ,col.names=F
  ,quote = F)

#ym_apply
dat$ym_apply=dat$time %m-% months(1)%>%
  format("%Y%m")%>%as.numeric()

#write out card_md5 and ym_apply
write.table(
  dat[c(‘card_md5_upper‘,‘ym_apply‘)]
  ,sep=‘,‘
  ,‘yqb_card_ym_md5.txt‘,row.names = F
  ,col.names=F
  ,quote = F)

unique(dat$ym_apply)

3.时间函数

https://cran.r-project.org/web/packages/lubridate/vignettes/lubridate.html

 4.随机森林可视化

 

library(randomForest)
library(kernlab) # spam数据集 来源于这个 包
library(magrittr)
library(caret)
#setwd(‘...‘)
#data <- read.csv(‘...‘)

data(spam) #加载数据集
# spam 是一个数据集,一条记录代表一封邮件包含哪些特殊词
# ,这封邮件是否是垃圾邮件(y变量)等等一些变量
View(spam)
table(spam$type) #看一下Y变量的分布,是否存在不均衡(imbalanced data)
#type 是y变量 也可以是0,1,但注意,如果你的数据集是 df,  要预先 将y变量转换为factor ,df$y <- as.factor(df$y)
set.seed(2016) #为使模型可再现,这里预先设定随机种子,因为随机森林的 每棵树对行是进行随机有放回的抽样的

rf <- randomForest(type~.
                   ,data=http://www.mamicode.com/spam"auc") #Calculate the AUC value
AUC=perf_AUC@y.values[[1]]

perf_ROC=performance(pred,"tpr","fpr") #plot the actual ROC curve
plot(perf_ROC, main="ROC plot")
text(0.5,0.5,paste("AUC = ",format(AUC, digits=5, scientific=FALSE)))

#cutoff accuracy
perf <- performance(pred, measure="acc", x.measure="cutoff")
# Get the cutoff for the best accuracy
bestAccInd <- which.max(perf@"y.values"[[1]])
bestMsg <- paste("best accuracy=", perf@"y.values"[[1]][bestAccInd], 
                 " at cutoff=", round(perf@"x.values"[[1]][bestAccInd], 4))
plot(perf, sub=bestMsg)
abline(v=round(perf@"x.values"[[1]][bestAccInd], 4))

# calculate the confusion matrix and plot
cm <- confusionMatrix(rf$predicted, reference = spam$type)
draw_confusion_matrix(cm)

#confusion matrix visualization
draw_confusion_matrix <- function(cm) {
  
  layout(matrix(c(1,1,2)))
  par(mar=c(2,2,2,2))
  plot(c(100, 345), c(300, 450), type = "n", xlab="", ylab="", xaxt=‘n‘, yaxt=‘n‘)
  title(‘CONFUSION MATRIX‘, cex.main=2)
  
  # create the matrix 
  rect(150, 430, 240, 370, col=‘#3F97D0‘)
  text(195, 435,  rf$classes[1], cex=1.2)
  rect(250, 430, 340, 370, col=‘#F7AD50‘)
  text(295, 435, rf$classes[2], cex=1.2)
  text(125, 370, ‘Predicted‘, cex=1.3, srt=90, font=2)
  text(245, 450, ‘Actual‘, cex=1.3, font=2)
  rect(150, 305, 240, 365, col=‘#F7AD50‘)
  rect(250, 305, 340, 365, col=‘#3F97D0‘)
  text(140, 400,  rf$classes[1], cex=1.2, srt=90)
  text(140, 335, rf$classes[2], cex=1.2, srt=90)
  
  # add in the cm results 
  res <- as.numeric(cm$table)
  text(195, 400, res[1], cex=1.6, font=2, col=‘white‘)
  text(195, 335, res[2], cex=1.6, font=2, col=‘white‘)
  text(295, 400, res[3], cex=1.6, font=2, col=‘white‘)
  text(295, 335, res[4], cex=1.6, font=2, col=‘white‘)
  
  # add in the specifics 
  plot(c(100, 0), c(100, 0), type = "n", xlab="", ylab="", main = "DETAILS", xaxt=‘n‘, yaxt=‘n‘)
  text(10, 85, names(cm$byClass[1]), cex=1.2, font=2)
  text(10, 70, round(as.numeric(cm$byClass[1]), 3), cex=1.2)
  text(30, 85, names(cm$byClass[2]), cex=1.2, font=2)
  text(30, 70, round(as.numeric(cm$byClass[2]), 3), cex=1.2)
  text(50, 85, names(cm$byClass[5]), cex=1.2, font=2)
  text(50, 70, round(as.numeric(cm$byClass[5]), 3), cex=1.2)
  text(70, 85, names(cm$byClass[6]), cex=1.2, font=2)
  text(70, 70, round(as.numeric(cm$byClass[6]), 3), cex=1.2)
  text(90, 85, names(cm$byClass[7]), cex=1.2, font=2)
  text(90, 70, round(as.numeric(cm$byClass[7]), 3), cex=1.2)
  
  # add in the accuracy information 
  text(30, 35, names(cm$overall[1]), cex=1.5, font=2)
  text(30, 20, round(as.numeric(cm$overall[1]), 3), cex=1.4)
  text(70, 35, names(cm$overall[2]), cex=1.5, font=2)
  text(70, 20, round(as.numeric(cm$overall[2]), 3), cex=1.4)
}  

  

R 代码积累