R语言实战：机器学习与数据分析源代码1

本文辑录了《R语言实战——机器学习与数据分析》（电子工业出版社2016年出版）一书第1章至第3章之代码。本书引言请见如下链接：
http://blog.csdn.net/baimafujinji/article/details/51596171

内容简介：本书系统地介绍了统计分析和机器学习领域中最为重要和流行的多种技术及它们的基本原理，在详解有关算法的基础上，结合大量R语言实例演示了这些理论在实践中的使用方法。具体内容被分成三个部分，即R语言编程基础、基于统计的数据分析方法以及机器学习理论。统计分析与机器学习部分又具体介绍了包括参数估计、假设检验、极大似然估计、非参数检验方法（包括列联分析、符号检验、符号秩检验等）、方差分析、线性回归（包括岭回归和Lasso方法）、逻辑回归、支持向量机、聚类分析（包括K均值算法和EM算法）和人工神经网络等内容。同时，统计理论的介绍也为深化读者对于后续机器学习部分的理解提供了很大助益。知识结构和阅读进度的安排上既兼顾了循序渐进的学习规律，亦统筹考虑了夯实基础的必要性

网上书店地址：

电子工业出版社官网
中国互动出版网China-pub
京东商城（1）
京东商城（2）

---

Chapter 1

P3

getwd()
setwd("d:/Chapter01")

P5

((5+6)*10-100)/2
sqrt(25)
exp(1)

P6

hi.world <- function() {
+ cat("Hello World!\n")
+ }

hi.world()

n <- 10
n
10 -> n
print(n)

assign("n", 10)
n=10

P7

getwd() # Prints the working directory
setwd("C:/Temp") # Set "C:/Temp" to be the working directory

library(AER)

P8~9

help(exp)
?exp

help("for")
example(exp)

help.search("poisson")
??"poisson"

help(package=AER)
help(files)

---

Chapter 2

P10

value <- 999; string <- "Language R"
indicator <- FALSE; complex_num <- 1+1i
mode(value); mode(string); mode(indicator); mode(complex_num)

n <- 1
typeof(n)
n <- 1L
typeof(n)

P11

light_speed <- 3.0e8
light_speed

5/0
log(0)
0/0
sqrt(-2)
sqrt(-2+0i) # 按照复数进行运算

1:10
10:1
1:10-1
z <- 1:(10-1) #请注意有无括号的区别

P12

z <- seq(1, 5, by=0.5) #等价于seq(from=1, to=5, by=0.5)
z <- seq(10,100,length=10)
z <- rep(1:5,2) # 等价于rep(1:5, times=2)
rep(1:4, each = 2, times = 3)
rep(1:4, each = 2, len = 4) #因为长度是4，所以仅取前4项
z <- c(11, 13, 17, 19)

z <- c(11, 13, 19, 23)
z <- c(z[1:2],17,z[3:4])

P13

z <- c(11, 13, 17, 19)
length(z)

x <- c(1:5)
print_fun <- function(x){
+ for(i in 1:length(x)){
+ print(x[i])
+ }
+ }

1+2
"+"(1,2)

x <- c(1,2,3)
x + c(3,5,7)

P14~16

x <- c(1,2,3)
y <- c(4,6,8,10,12)
x + y

c(1,2,3,1,2) + c(4,6,8,10,12)
x * c(0,5,8)
x <- c(4,25,81)
x/c(2,5,9)

x <- c(0.1,0.2,0.3,0.4,0.5,0.6)
x[c(2,4)]
x[3:5]
y <- 3:6
x[y]
x[c(1,1,5)]

x[-1]
x[-2:-4]

x[-length(x)]
x[1:(length(x)-3)]

x <- c(1,3,5,7,11,13,17,19,23,29)
any(x>10)
any(x>30)
all(x>10)
all(x>=1)

a <- c(-1, 1, -2, 4, -5, 9)
b <- a[a<0]
a<0
a[c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE)]

a[a<0] <- 0

a <- c(-1, -2, 0, NA, 2)
a[a>=0]
subset(a, a>=0)

a <- c(-5, -3, 0, 3, 5)
which(a<0)

P17~19

m <- matrix(c(1,2,3,4,5,6),nrow = 2, ncol = 3)
m <- matrix(c(1,2,3,4,5,6),nrow = 2, ncol = 4)
m <- matrix(c(1,2,3,4,5,6),nrow = 2)

m[1,2] #第1 行第2 列的对应元素
m[2,] #第2 行的全部元素
m[,3] #第3 列的全部元素

m <- matrix(nrow = 3, ncol = 3)
m[1,1]<-4;m[1,2]<-9;m[1,3]<-2
m[2,1]<-3;m[2,2]<-5;m[2,3]<-7
m[3,1]<-8;m[3,2]<-1;m[3,3]<-6

m <- matrix(c(1,2,3,4,5,6),nrow = 2, byrow = TRUE)
m[,2:3]
m[2,2:3]

m[c(1,3),]<-matrix(c(0,9,0,9,0,9),nrow = 2)

a <- matrix(nrow = 3, ncol = 3)
b <- matrix(c(5,8,6,9), nrow = 2)
a[2:3,2:3] <- b

m[-2,]

record <- matrix(c(98,75,86,92,78,95),nrow = 2)
colnames(record) <- c("Math","Physics","Chemistry")
rownames(record) <- c("John","Mary")
record
record["John", "Physics"]

P20

a <- matrix(c(1,5,3,7),nrow = 2)
b <- matrix(c(1,0,0,1),nrow = 2)
a + b

c(1,2,3)+b

z
z*c(1,2)

P21

z*c(1,2,3)
z*c(1,2,3,4)

m/rowSums(m)

3+b
3*b

P22

a <- matrix(c(1,5,3,7),nrow = 2)
b <- matrix(c(1,0,0,1),nrow = 2)
a %*% b

new_col <- c(0, 0, 0, 0)
m <- matrix(rep(1:4, times = 3), nrow = 4 )
new_m <- cbind(new_col, m)

cbind(c(0,0), m)

P23~24

m <- rbind(c(1,2,3),c(4,5,6))

new_m <- m[ ,c(1,3)]

apply(m, dimcode, f, fargs)

apply(m, 2, max)

f <- function(x) {x/sum(x)}
y <- apply(z,1,f)

y <- t(apply(z,1,f))

P25

outlier_value <- function(matrix_row, method_opt){
+ if(method_opt==1){return(max(matrix_row))}
+ if(method_opt==0){return(min(matrix_row))}
+ }

apply(m,1,outlier_value,1)
apply(m,1,outlier_value,0)

x = rbind(c(11,13,15),c(12,14,16),c(17,19,21))

x[x[,3]%%3==0,]

result <- x[,3]%%3==0

x[result,]

P26

which(m%%2==0)

m[m[,1]%%2==1 & m[,2]%%2==1 & m[,3]%%2==1,]

m[m[,1]%%2==1 & m[,2]%%2==1 & m[,3]%%2==1,,drop=FALSE]

P27

"["(m, m[,1]%%2==1 & m[,2]%%2==1 & m[,3]%%2==1,,drop=FALSE)

x <- c(10, 20, 30)
y <-as.matrix(x)

---

Chapter 3

P29~30

if(length(x) == 0) {
+   cat("Empty vector!\n")
+ } else {
+   m = mean(x)
+   s = sum(x)
+}

if (x>=0) sqrt(x) else NA
y <- if (x>=0) sqrt(x) else NA

ifelse(x >= 0, sqrt(x), NA)
x <- 1:10
y <- ifelse(x%%2 == 0, 0, 1)

P31~32

while(i <= 5) {
+ cat(i," ")
+ i = i+1
+ }

repeat{
+ cat(i, " ")
+ i <- i+1
+ if(i>5) {
+ cat("\n")
+ break
+ }
+ }

for(i in 1:5){
+ cat(i, " ")
+ }

for(i in 1:10){
+ cat(i, " ")
+ if( i >= 5){
+ cat("\n")
+ break
+ }
+ }

for(i in 100:999){
+ a = floor(i/100)
+ b = floor((i-a*100)/10)
+ c = i-a*100-b*10
+
+ if(a^3+b^3+c^3==i) cat(i,"\n")
+ }

P33

x <- c(TRUE, FALSE, TRUE)
y <- c(TRUE, TRUE, FALSE)
if(x[1] && y[1]) cat("both TRUE\n")
if(x & y) cat("both TRUE\n")

P36

qnorm(0.975)
qnorm(0.975, 0, 1)

qnorm(0.975, 1, 1.5)
qnorm(0.975, sd = 1.5, mean = 1)
qnorm(sd = 1.5, mean = 1, p = 0.975)

P37~38

library(jpeg)
imgshow <- function(file){
+ img = readJPEG(file)
+ plot(c(0, dim(img)[1]), c(0, dim(img)[1]),
+ type = "n", xlab = "", ylab = "")
+ rasterImage(img, 0, 0, dim(img)[1], dim(img)[1])
+ }

imgshow("C:/lena.jpg")

reverse.list <- function(x){
+ for(i in 1:(length(x)/2)){
+ tmp = x[i]
+ x[i] = x[length(x)-i+1]
+ x[length(x)-i+1] = tmp
+ }
+ return (x)
+ }

reverse.list <- function(x){
+ for(i in 1:(length(x)/2)){
+ tmp = x[i]
+ x[i] = x[length(x)-i+1]
+ x[length(x)-i+1] = tmp
+ }
+ x
+ }

P39

Fib <- function(n){
+ if(n<=1) return(n)
+ else return(Fib(n-1)+Fib(n-2))
+ }

Fib.array <- function(n) {
+ for(i in 1:n) {
+ cat(Fib(i)," ")
+ if( i >= n) {
+ cat("\n")
+ break
+ }
+ }
+ }
Fib.array(8)

P40

quicksort <- function(x) {
+ if(length(x) <=1 ) return(x)
+ pivot <- x[1]
+ rest <- x[-1]
+ sv1 <- rest[rest < pivot]
+ sv2 <- rest[rest >=pivot]
+ sv1 <- quicksort(sv1)
+ sv2 <- quicksort(sv2)
+ return(c(sv1, pivot, sv2))
+ }

gcd <- function(a,b) {
if (b == 0) return(a)
else return(gcd(b, a %% b))
}

source("C:/func.R")
gcd(12,20)

gcd <- edit(gcd)
gcd2 <- edit(gcd)