吴裕雄--天生自然 R语言开发学习：高级编程
作者：互联网
运行的条件是一元逻辑向量（TRUE或FALSE）并且不能有缺失（NA）。else部分是可选的。如果 13
仅有一个语句，花括号也是可以省略的。
下面的代码片段是一个例子：
if(interactive()){ 14
plot(x, y)
} else {
png("myplot.png")
plot(x, y)
dev.off() 15
}
如果代码交互运行，interactive()函数返回TRUE，同时输出一个曲线图。否则，曲线图被存
在磁盘里。你可以使用第21章中的if()函数。 16
3. ifelse()
ifelse()是函数if()的量化版本。矢量化允许一个函数来处理没有明确循环的对象。
ifelse()的格式是： 17
ifelse(test, yes, no)
其中test是已强制为逻辑模式的对象，yes返回test元素为真时的值，no返回test元素为假时
的值。 18
比如你有一个p值向量，是从包含六个统计检验的统计分析中提取出来的，并且你想要标记
p<0.05水平下的显著性检验。可以使用下面的代码：
> pvalues <- c(.0867, .0018, .0054, .1572, .0183, .5386) 19
> results <- ifelse(pvalues <.05, "Significant", "Not Significant")
> results
[1] "Not Significant" "Significant" "Significant"
[4] "Not Significant" "Significant" "Not Significant" 20
ifelse()函数通过pvalues向量循环并返回一个包括"Significant"或"Not Significant"
的字符串。返回的结果依赖于pvalues返回的值是否大于0.05。
同样的结果可以使用显式循环完成： 21
pvalues <- c(.0867, .0018, .0054, .1572, .0183, .5386)
results <- vector(mode="character", length=length(pvalues))
for(i in 1:length(pvalues)){ 22
if (pvalues[i] < .05) results[i] <- "Significant"
else results[i] <- "Not Significant"
}
可以看出，向量化的版本更快且更有效。 23
有一些其他的控制结构，包括while()、repeat()和switch()，但是这里介绍的是最常用
的。有了数据结构和控制结构，我们就可以讨论创建函数了。
20.1.3 创建函数
在R中处处是函数。算数运算符+、-、/和*实际上也是函数。例如，2 + 2等价于 "+"(2, 2)。
本节将主要描述函数语法。语句环境将在20-2节描述。
1. 函数语法
函数的语法格式是：
functionname <- function(parameters){
statements
return(value)
}
如果函数中有多个参数，那么参数之间用逗号隔开。
参数可以通过关键字和/或位置来传递。另外，参数可以有默认值。请看下面的函数：
f <- function(x, y, z=1){
result <- x + (2*y) + (3*z)
return(result)
}
> f(2,3,4)
[1] 20
> f(2,3)
[1] 11
> f(x=2, y=3)
[1] 11
> f(z=4, y=2, 3)
[1] 19
在第一个例子中，参数是通过位置（x=2，y=3，z=4）传递的。在第二个例子中，参数也是通过
位置传递的，并且z默认为1。在第三个例子中，参数是通过关键字传递的，z也默认为1。在最后
一个例子中，y和z是通过关键字传递的，并且x被假定为未明确指定的（这里x=3）第一个参数。
参数是可选的，但即使没有值被传递也必须使用圆括号。return()函数返回函数产生的对
象。它也是可选的；如果缺失，函数中最后一条语句的结果也会被返回。
你可以使用args()函数来观测参数的名字和默认值：
> args(f)
function (x, y, z = 0)
NULL
args()被设计用于交互式观测。如果你需要以编程方式获取参数名称和默认值，可以使用
formals()函数。它返回含有必要信息的列表。
参数是按值传递的，而不是按地址传递。请看下面这个函数语句：
result <- lm(height ~ weight, data=women)
women数据集不是直接得到的。需要形成一个副本然后传递给函数。如果women数据集很大的话，
内存（RAM）可能被迅速用完。这可能成为处理大数据问题时的难题能需要使用特殊的技术（见
#--------------------------------------------------------------------#
# R in Action (2nd ed): Chapter 20 #
# Advanced R programming #
# requires packages ggplot2, reshape2, foreach, doParallel #
# install.packages(c("ggplot2", "reshap2e", "foreach", "doParallel"))#
#--------------------------------------------------------------------#
# Atomic vectors
passed <- c(TRUE, TRUE, FALSE, TRUE)
ages <- c(15, 18, 25, 14, 19)
cmplxNums <- c(1+2i, 0+1i, 39+3i, 12+2i)
names <- c("Bob", "Ted", "Carol", "Alice")
# Matrices
x <- c(1,2,3,4,5,6,7,8)
class(x)
print(x)
attr(x, "dim") <- c(2,4)
print(x)
class(x)
attributes(x)
attr(x, "dimnames") <- list(c("A1", "A2"),
c("B1", "B2", "B3", "B4"))
print(x)
attr(x, "dim") <- NULL
class(x)
print(x)
# Generic vectors (lists)
head(iris)
unclass(iris)
attributes(iris)
set.seed(1234)
fit <- kmeans(iris[1:4], 3)
names(fit)
unclass(fit)
sapply(fit, class)
# Indexing atomic vectors
x <- c(20, 30, 40)
x[3]
x[c(2,3)]
x <- c(A=20, B=30, C=40)
x[c(2,3)]
x[c("B", "C")]
# Indexing lists
fit[c(2,7)]
fit[2]
fit[[2]]
fit$centers
fit[[2]][1,]
fit$centers$Petal.Width # should give an error
# Listing 20.1 - Plotting the centroides from a k-mean cluster analysis
fit <- kmeans(iris[1:4], 3)
means <- fit$centers
library(reshape2)
dfm <- melt(means)
names(dfm) <- c("Cluster", "Measurement", "Centimeters")
dfm$Cluster <- factor(dfm$Cluster)
head(dfm)
library(ggplot2)
ggplot(data=dfm,
aes(x=Measurement, y=Centimeters, group=Cluster)) +
geom_point(size=3, aes(shape=Cluster, color=Cluster)) +
geom_line(size=1, aes(color=Cluster)) +
ggtitle("Profiles for Iris Clusters")
# for loops
for(i in 1:5) print(1:i)
for(i in 5:1)print(1:i)
# ifelse
pvalues <- c(.0867, .0018, .0054, .1572, .0183, .5386)
results <- ifelse(pvalues <.05, "Significant", "Not Significant")
results
pvalues <- c(.0867, .0018, .0054, .1572, .0183, .5386)
results <- vector(mode="character", length=length(pvalues))
for(i in 1:length(pvalues)){
if (pvalues[i] < .05) results[i] <- "Significant"
else results[i] <- "Not Significant"
}
results
# Creating functions
f <- function(x, y, z=1){
result <- x + (2*y) + (3*z)
return(result)
}
f(2,3,4)
f(2,3)
f(x=2, y=3)
f(z=4, y=2, 3)
args(f)
# object scope
x <- 2
y <- 3
z <- 4
f <- function(w){
z <- 2
x <- w*y*z
return(x)
}
f(x)
x
y
z
# Working with environments
x <- 5
myenv <- new.env()
assign("x", "Homer", env=myenv)
ls()
ls(myenv)
x
get("x", env=myenv)
myenv <- new.env()
myenv$x <- "Homer"
myenv$x
parent.env(myenv)
# function closures
trim <- function(p){
trimit <- function(x){
n <- length(x)
lo <- floor(n*p) + 1
hi <- n + 1 - lo
x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
}
trimit
}
x <- 1:10
trim10pct <- trim(.1)
y <- trim10pct(x)
y
trim20pct <- trim(.2)
y <- trim20pct(x)
y
ls(environment(trim10pct))
get("p", env=environment(trim10pct))
makeFunction <- function(k){
f <- function(x){
print(x + k)
}
}
g <- makeFunction(10)
g (4)
k <- 2
g (5)
ls(environment(g))
environment(g)$k
# Generic functions
summary(women)
fit <- lm(weight ~ height, data=women)
summary(fit)
class(women)
class(fit)
methods(summary)
# Listing 20.2 - An example of a generic function
mymethod <- function(x, ...) UseMethod("mymethod")
mymethod.a <- function(x) print("Using A")
mymethod.b <- function(x) print("Using B")
mymethod.default <- function(x) print("Using Default")
x <- 1:5
y <- 6:10
z <- 10:15
class(x) <- "a"
class(y) <- "b"
mymethod(x)
mymethod(y)
mymethod(z)
class(z) <- c("a", "b")
mymethod(z)
class(z) <- c("c", "a", "b")
mymethod(z)
# Vectorization and efficient code
set.seed(1234)
mymatrix <- matrix(rnorm(10000000), ncol=10)
accum <- function(x){
sums <- numeric(ncol(x))
for (i in 1:ncol(x)){
for(j in 1:nrow(x)){
sums[i] <- sums[i] + x[j,i]
}
}
}
system.time(accum(mymatrix)) # using loops
system.time(colSums(mymatrix)) # using vectorization
# Correctly size objects
set.seed(1234)
k <- 100000
x <- rnorm(k)
y <- 0
system.time(for (i in 1:length(x)) y[i] <- x[i]^2)
y <- numeric(k)
system.time(for (i in 1:k) y[i] <- x[i]^2)
y <- numeric(k)
system.time(y <- x^2)
# Listing 20.3 - Parallelization with foreach and doParallel
library(foreach)
library(doParallel)
registerDoParallel(cores=4)
eig <- function(n, p){
x <- matrix(rnorm(100000), ncol=100)
r <- cor(x)
eigen(r)$values
}
n <- 1000000
p <- 100
k <- 500
system.time(
x <- foreach(i=1:k, .combine=rbind) %do% eig(n, p)
)
system.time(
x <- foreach(i=1:k, .combine=rbind) %dopar% eig(n, p)
)
# Finding common errors
mtcars$Transmission <- factor(mtcars$a,
levels=c(1,2),
labels=c("Automatic", "Manual"))
aov(mpg ~ Transmission, data=mtcars) # generates error
head(mtcars[c("mpg", "Transmission")])
table(mtcars$Transmission) # here is the source of the error
# Listing 20.4 - A sample debugging session
args(mad)
debug(mad)
mad(1:10)
# enters debugging mode
# Q to quit - see text
undebug(mad)
# Listing 20.5 - Sample debugging session with recover()
f <- function(x, y){
z <- x + y
g(z)
}
g <- function(x){
z <- round(x)
h(z)
}
h <- function(x){
set.seed(1234)
z <- rnorm(x)
print(z)
}
options(error=recover)
f(2,3)
f(2, -3) # enters debugging mode at this point
标签：返回,函数,天生,编程,传递,ifelse,Significant,参数,吴裕雄 来源： https://www.cnblogs.com/tszr/p/11177848.html