Exercise #1

Target: 图像操作

用户可以使用选取pgm图片对角线的位置,为其打上马赛克(为图片的灰度值增加噪声)

Details

运用pixmap读取pgm格式图片,使用plot绘制该图片,通过locator函数返回用户通过鼠标在图片选取的区域(注:图片原点在左上方,locator返回的点原点在左下角,所以要进行转换),然后通过改变read.pnm()返回的图片对象的灰度值,然后通过plot重新绘制该对象

Achieve

# 导入 pixmap library 用于操作图像数据
if ("pixmap" %in% .packages(all.available = TRUE)) {
	library(pixmap)
} else {
	install.packages(pixmap)
	library(pixmap)
}


img <- read.pnm("test.pgm")


plot(img)

loc <- locator()

if (length(loc$x) == 0) {
	quit()
}

area <- list()


area$rows <- seq(from = ifelse(length(loc$y) < 1, 0,
    img@size[1] - loc$y[1]), to = ifelse(length(loc$y) < 2, 
    img@size[1], img@size[1] - loc$y[2]), by = 1)

area$columns <- seq(from = ifelse(length(loc$x) < 1, 0,
    loc$x[1]), to = ifelse(length(loc$x) < 2,
    img@size[2], loc$x[2]), by = 1)

print(area)
#根据 locator得到的像素区域进行增加噪声

blurImgArea <- function(img, area, noise)
{
	nRows <- length(area$rows)
	nCols <- length(area$columns)

	randomNoiseMatrix <- matrix(data = runif(nRows * nCols, min = 0, max = 1),
        nrow = nRows, ncol = nCols)
	
	img@grey[area$rows, area$columns] <- (1 - noise) *
        img@grey[area$rows, area$columns] + noise * randomNoiseMatrix

	return(img)
}

plot(blurImgArea(img, area, 0.75))

Exercise #2

Target：求距离矩阵最小值

输入一个距离矩阵,返回最小距离的行号和列号(假设最小距离只有一个,且矩阵对角线为0并舍弃该值)

Details

根据距离矩阵dis[i, j] == dis[j, i],我们可以避免多次重复比较,通过R的apply函数对矩阵的行扫描,当扫描到某i行就表示该行的前i列已经参与了比较,无需重复比较.

Achieve

# 通过输入一个距离矩阵,找出最小距离及其行列号(舍弃mat[i, i] == 0的结果)
# 通过对距离矩阵进行遍历进行两两比较我们可以很快就能得到答案
# ,但这种方法效率不高,没有利用到距离矩阵mat[i, j] == mat[j, i]的有效信息

# 我们先对每行处理 找出每行的最小元素,然后综合所有行结果找出解集
# 利用mat[i, j] == mat[j, i]的信息我们可以舍弃
# 每行的行号之前的列元素进行求解

# 由于apply函数会丢弃行号的信息,所以我们可以重新构造矩阵为其添加上

addRowTag <- function(mat)
{
	return(cbind(mat, 1:nrow(mat)))
}

rowMin <- function(rVec)
{
	n <- length(rVec)
	currRow <- rVec[n]
	minColIndex <- which.min(rVec[(currRow + 1):(n - 1)])
	return(c(currRow + minColIndex, rVec[currRow + minColIndex]))
}

# 返回值为 [行号, 列号, 最小元素值]
getDistanceInfo <- function(mat)
{
	mat <- addRowTag(mat)

	n <- nrow(mat)
	
	# 返回2xn矩阵 每列包含最小元素的列和该最小元素值
	rowsMinInfo <- apply(mat[-n, ], 1, rowMin)

	# 综合所有元素值找出最小元素值
	i <- which.min(rowsMinInfo[2, ]) #行号
	j <- rowsMinInfo[1, i] # 列号
	return(c(i, j, rowsMinInfo[2, i]))
}

testMat <- matrix(c(0, 12, 13, 8, 20,
	12, 0, 15, 28, 88,
	13, 15, 0, 6, 9,
	8, 28, 6, 0, 33,
	20, 88, 9, 33, 0), nrow = 5)


print(getDistanceInfo(testMat))

Exercise #3

Target：获取单词的索引列表

读取文本文件test.txt，首先进行预处理，将文本中非单词字符替换为空格得到所有的单词,然后根据得到的单词集合进行处理，得到单词的索引列表

Details

读取文件使用scan函数,其中what要使用""，表示要读取的是字符串集合,scan会返回一个字符串向量,然后我们使用gsub函数通过合理的正则表达式将所有非单词字符替换为空格,然后使用strsplit将所有单词提取处理,此时strsplit返回的列表还包含了空字符串""和包含大写的单词,我们通过向量的筛选和toupper提取到最终想要的单词表

Achieve

# 读取文件 为文件出现的单词创建索引
indexWords <- function(file)
{
	# 读取文件内容
	contents <- scan(file, what="")

	#将所有非单词字符替换为空格
	contents <- gsub("[^a-zA-Z]", " ", contents)
	# 得到所有单词的列表
	words <- strsplit(contents, split=" ")

	# 快捷函数 
	# 将字符串向量内容转换为小写
	words <- lapply(words, function(strs) {
		# 移除空字符串
		strs <- strs[strs != ""]
		return(sapply(strs, tolower))
	})

	# 将列表转换为向量
	words <- unlist(words)
	
	indexs <- list()
	for (i in 1:length(words))
	{
		indexs[[words[i]]] <- c(indexs[[words[i]]], i)
	}

	return(indexs)
}


sortListByAplpha <- function(wrdList)
{
	keys <- names(wrdList)
	index <- order(keys)
	return(wrdList[index])
}

sortListByRate <- function(wrdList)
{
	rates <- sapply(wrdList, length)
	return(wrdList[order(rates)])
}


print(indexWords("test.txt"))

Exercise #4

Target: 鲍鱼数据-关于性别的Logistic回归模型分析

读取csv格式的包含鲍鱼数据的文件,通过R中提供的glm函数,对鲍鱼数据中除性别外的有关列对性别进行Logistic回归分析,并返回结果集(练习中用到的鲍鱼数据文件在附件中)

Details

练习中用到的鲍鱼数据文件中性别使用字符串表示的,类型是charcter，而使用Logistic回归分析时,随机变量Y的取值范围是 0<=Y <=1,所以使用read.csv时需要通过stringsAsFactors=T来使得Gender列映射为0-1

Achieve

# 读取鲍鱼数据
# 鲍鱼数据每一行表示:
# Gender,Length,Diameter,Height,WholeWt,ShuckedWt,ViscWt,ShellWt,Rings
# 中文解释:	 		
#  性别  	长度	直径	 高度	实际重量 去壳重量 脏器重量 壳重  年龄
# 附加描述:	
# in（'M', 'F', 'I'）
# 对鲍鱼数据每一列(除性别)用Logistic模型进行回归分析,对鲍鱼性别Gender进行预测

logisticPredict <- function(dataFile)
{
	# 读取鲍鱼数据
	data <- read.csv(dataFile, header=T, stringsAsFactors=T)
	
	# 鲍鱼数据包含(M, F, I),分别表示 公 母 幼儿(暂时无性别特征)
	# 去除性别为幼儿的数据
	data <- data[data$Gender != "I", ] 
	
	print(data)	
	# 对鲍鱼数据的某列进行Logistic回归分析
	predictResult <- function(cData)
	{
		return (glm(data$Gender ~ cData, family=binomial)$coefficient)
	}

	# 对鲍鱼数据除性别列外所以列进行Logistic回归分析,并返回结果集
	return(sapply(data[, -1], predictResult))	
}

print(logisticPredict('AbaloneWithHeader.data'))

Appendix

鲍鱼数据(带头部) 鲍鱼数据(无头部)

Exercise #5

Target: 提取子表

Details

对于R中的table类型通过给出各个维度的子向量,提取出和这些子向量有关的表数据,通过此次练习,可以更清楚的意识到R中关于table的数据结构

初识table的构造

R中的table由一个表示因子水平频数的向量或矩阵,表示因子组合的向量或列表构成,通过传参任何能够提取因子组合的数据结构给table函数就能构造一个table

> ct <- table(c("M", "F", "F", "I"))
> print(ct)

F I M 
2 1 1
> ct <- table(c("M", "F", "F", "I"), c(20, 22, 19, 22))
> print(ct)
   
    19 20 22
  F  1  0  1
  I  0  0  1
  M  0  1  0

> ct <- table(list(sex=c("M", "F", "F", "I"), age=c(20, 22, 19, 22)))
> print(ct)
   age
sex 19 20 22
  F  1  0  1
  I  0  0  1
  M  0  1  0

> ct <- table(data.frame(sex=c("M", "F", "F", "I"), age=c(20, 22, 19, 22)))
> print(ct)
   age
sex 19 20 22
  F  1  0  1
  I  0  0  1
  M  0  1  0

> ct <- table(c("M", "F", "F", "I"), c(20, 22, 19))
Error in table(c("M", "F", "F", "I"), c(20, 22, 19)) : 
  所有参数的长度都应一致

> ct <- table(data.frame(sex=c("M", "F", "F", "I"), age=c(20, 22, 19)))
Error in data.frame(sex = c("M", "F", "F", "I"), age = c(20, 22, 19)) : 
  参数值意味着不同的行数: 4, 3

通过以上输出,我们不难发现,其实table内部只是维护了可转化为data.frame的数据结构,然后可以通过该data.frame的列(去重)计算所有列正交后的频数,所有列的水平所以我们能推出R中得到一个table数据结构的一般步骤:

将维度相同所有因子作为输入(可转化为data.frame的数据结构)

内部计算因子水平频数矩阵或数组

内部计算得到因子水平的向量或列表

组合二者得到table

提取子表

通过以上知识我们知道,table由不同空间的水平(包含该水平的标识)和由该数据结构计算的组合水平频数构成，我们通过提供水平元组(level1, level2, level3, ...)来提取它的频数,比如:

> ct <- table(name=c("Marry", "Lisa", "Jack"), sex=c("F", "F", "M"), age=c(18, 21, 19))
> ct["Lisa", "F", "21"]
[1] 1

假如我们编写了subtable函数,那么输出应该符合下面的代码:

> ct <- table(name=c("Marry", "Lisa", "Jack"), sex=c("F", "F", "M"), age=c(18, 21, 19))
> subtable(ct, list(name=c("Marry", "Lisa"), sex=c("F", "M"), age=c("18", "21")))
$name
[1] 2

$sex
[1] 2

$age
[1] 2

 'table' int [1:2, 1:2, 1:2] 1 0 0 0 0 1 0 0
 - attr(*, "dimnames")=List of 3
  ..$ name: chr [1:2] "Marry" "Lisa"
  ..$ sex : chr [1:2] "F" "M"
  ..$ age : chr [1:2] "18" "21"
NULL
, , age = 18

       sex
name    F M
  Marry 1 0
  Lisa  0 0

, , age = 21

       sex
name    F M
  Marry 0 0
  Lisa  1 0

通过以上样例可知,我们的subtable应该能够接受多个水平向量(可变参数),subtable需要一个函数能够对table内部的频数矩阵进行不定水平向量个数的"["进行提取调用,此时R中提供的do.call将派上用场,能够对提供的表进行诸如 ct[level1, level2, level3, ...]之类的调用

Achieve

ct <- read.table("ct.txt", header=T)

cttab <- table(ct)
# 提取 table的子集
subtable <- function(tab, subDims)
{
	tabArray <- unclass(tab)
	
	# 获取每个维度的因子
	dcargs <- list(tabArray)
	nDims <- length(subDims)
	for (i in 1:nDims)
	{
		dcargs[[i+1]] <- subDims[[i]]
	}

	subArray <- do.call("[", dcargs)
	
	dim <- lapply(subDims, length)
	subArray <- array(subArray, dim=dim, subDims)

	class(subArray) <- "table"
	return(subArray)
}

print(subtable(cttab, list(Vote.for.X=c("No", "Yes"), Vote.for.Last.Time=c("No", "Yes"))))

Exercise #6

Target: 在表中找寻频数最大的单元格

R中table是有关一个元组(多个空间的水平组成的)的频数对照表,比如存在table tab,我们通过tab[level1, level2, ...]可以很快的访问元组(level1, level2, ...)的频数,寻找在表中频数最大的单元格,我们可以扩展以下,将问题转化为将表table转化为一个可以快速访问表中升序/降序排序频数的数据结构,此时,不难想到用一个行为水平元组外加上一个元组的频数构成的data.frame能够表示这种数据结构

方案一

如果我们对R中as.data.frame(tab)的行为一无所知的话,我们可以通过table的数据结构,自行编写代码构造上述data.frame,首先我们需要获取table中所有空间的水平,构造所有可能的水平元组(通过"向量"的积构造),将该水平元组集合构造为data.frame，然后通过所有元组访问table获取频数,构造频数向量,最后将该频数向量增加到data.frame中,最后通过order函数排序

Achieve

ct <- read.table("ct.txt", header=T)
ct <- table(ct)
# 获取"向量"积的集合
combineVec <- function(m, v)
{
	if (!is.vector(v))
	{
		return(NA)
	}

	if (is.null(m))
	{
		return(v)
	}
	nCol <- ifelse(is.vector(m), length(m), ncol(m))
	print(nCol)
	nFrame <- NULL
	for (i in 1:nCol)
	{
		for (j in 1:length(v))
		{
			nFrame <- cbind(nFrame, c(ifelse(is.vector(m), m[i], m[, i]), v[j]))
		}
	}
	return(nFrame)
}

tabdom <- function(tab)
{
	if ("Freq" %in% dimnames(tab))
	{
		# 简单处理 如果有"Freq"列冲突直接返回
		return(NA)
	}
		
	# 将tab转为data.frame	
	levels <- dimnames(tab)
	frame <- levels[[1]]
	for (i in 2:length(levels))
	{
		frame <- combineVec(frame, levels[[i]])
	}
	# 转置:使得行向量为水平元组
	frame <- t(frame)
	colnames(frame) <- names(levels)
	frame <- data.frame(frame)
	freqs <- NULL
	
	# 构造频数向量
	for (i in 1:nrow(frame))
	{
		
		doArgs <- list(tab)
		for (j in 1:ncol(frame))
		{
			doArgs[[j+1]] <- as.character(frame[i, j])
		}
		freqs <- c(freqs, do.call("[", doArgs))
	}
	frame$Freq <- freqs
	frame <- frame[order(freqs, decreasing=T), ]	
	return(frame)
}

print(tabdom(ct))

方案二

如果我们R中as.data.frame(table)足够了解,该功能实现将会特别简单,R中的as.data.frame(table)做了我们方案一的大部分工作,它会构造一个每一行为水平元组和该水平元组在table的频数(该频数列名为Freq)的data.frame数据框,为了完成我们的功能,我们知道,只需要将table通过as.data.frame转化,然后按照Freq列排序即可

Achieve

ct <- read.table("ct.txt", header=T)

ct <- table(ct)


tabdom <- function(tab)
{
	frame <- as.data.frame(tab)

	frame <- frame[order(frame$Freq, decreasing=T), ]

	return(frame)
}


print(tabdom(ct))

Appendix

ct.txt(数据文件) tabdom.r(方案一实现文件) tabdom.r(方案二实现文件)

<<The Art of R Programing>> – exercise

Exercise #1

Target: 图像操作

Details

Achieve

Exercise #2

Target：求距离矩阵最小值

Details

Achieve

Exercise #3

Target：获取单词的索引列表

Details

Achieve

Exercise #4

Target: 鲍鱼数据-关于性别的Logistic回归模型分析

Details

Achieve

Appendix

Exercise #5

Target: 提取子表

Details

Achieve

Exercise #6

Target: 在表中找寻频数最大的单元格

More

Achieve

Achieve

Appendix