目前,区试要求对照不得位于区组的首尾小区,且不同区组的相邻小区位置不得出现同一品种。基于这一要求,编写了R语言的随机区组试验设计。此函数可用于多个试验点试验设计生成情况。
rcbd函数有6个参数:
local_name为试验点名称的向量,默认为NULL。当不为空时,local_num的数值将自动等于local_name向量的长度。
local_num表示试验点数量,默认只有一个试验点,与local_name是二选一的。
block表示区组数,默认单个试验点的区组数为3,也可以对不同试验点设置不同的区组数,此时用向量表示即可
varieties是品种列表,需要是字符向量
ck表示是否设置有对照,如果有,则将ck=对照名称
same默认为FALSE,表示要求单个试验点不同区组的同一小区位置不出现同一品种
# 自定义单点的随机区组设计
rcbd_loc1<-function(block=3, # 默认区组数为3varieties, # 品种列表,是字符向量ck=NULL, # 设置对照,是字符串same=FALSE # 默认同一个小区位置不出现同一品种){n<-length(varieties) # 计算品种数量# 判断条件:如果n=0则函数报错,并跳出函数if(n==0) return("varieties参数中没有品种信息")# 定义一个列表,用于存放每次生成的随机品种组lst<-list()# 生成数据框中的数组编号blk<-rep(seq_len(block),each=n)# 生成数据框中每个区组中的小区编号plt<-rep(seq_len(n),times=block)if(is.null(ck)){ # 当不设置对照名称时if(same){ # 完全随机区组试验设计for(i in seq_len(block)){lst[[i]]<-sample(varieties,n,replace=FALSE)}}else{ # same为FALSE,表示同一小区位置不出现同一品种for(i in seq_len(block)){lst[[i]]<-sample(varieties,n,replace=FALSE)# 第一次生成的随机组不做任何要求# 后面所有生成的随机组都要与前面的随机组进行比较# 如果有相同的品种出现在同一小区位置,则重新生成随机组if (i!=1){for(j in seq_len(i-1)){while(any(lst[[j]]==lst[[i]])){lst[[i]]<-sample(varieties,n,replace=FALSE)}}}}}}else{ # 当设置有对照名称时,对照不出现在区组的首尾处# 判断ck是否在varieties中,如果不在则终止函数if(!ck%in%varieties) return("对照不在品种数据中")if(same){ # 允许在同一小区位置出现同一品种for(i in seq_len(block)){lst[[i]]<-sample(varieties,n,replace=FALSE)while(lst[[i]][1]==ck | lst[[i]][n]==ck){lst[[i]]<-sample(varieties,n,replace=FALSE)}}}else{ # 在同一小区位置不允许出现同一品种for(i in seq_len(block)){lst[[i]]<-sample(varieties,n,replace=FALSE)while(lst[[i]][1]==ck | lst[[i]][n]==ck){lst[[i]]<-sample(varieties,n,replace=FALSE)}# 第一次生成的随机组不做任何要求# 后面所有生成的随机组都要与前面的随机组进行比较# 如果有相同的品种出现在同一小区位置,则重新生成随机组if (i!=1){for(j in seq_len(i-1)){while(any(lst[[j]]==lst[[i]]) | lst[[i]][1]==ck | lst[[i]][n]==ck ){lst[[i]]<-sample(varieties,n,replace=FALSE)}}}}}}lst<-unlist(lst)df<-data.frame(blk,plt,lst)df
}# 多次调用的中间函数,用于在单个试验点的随机区组数据框上添加试验点信息
temp_func<-function(block, # 区组数num0, # 数字表示的试验点name0=NULL, # 试验点名称varieties, # 品种向量ck, # same){lc_num<-rep(num0,block*length(varieties))if (!is.null(name0)) lc_name<-rep(name0,block*length(varieties))temp_df<-rcbd_loc1(block,varieties,ck,same)if (class(temp_df)=="character"){return(paste("单点试验设计参数有误:",temp_df))}else{temp_df["loc_num"]<-lc_numif (!is.null(name0)) temp_df["loc_name"]<-lc_name}temp_df
}# 多点次的随机区组设计,需要调用单点次随机区组设计
rcbd<-function(local_name=NULL,local_num=1, # 与local_name是二选一block=3, # 默认单个试验点的区组数为3,也可以对不同试验点设置不同的区组数,此时用向量表示即可varieties, # 品种列表,是字符向量ck=NULL, # 设置对照,是字符串same=FALSE # 默认同一个小区位置不出现同一品种){# 定义一个列表,用于存放每个试验点的随机区组数据lst_lc<-list()# 加载dplyr包,用于后面的数据框的合并library(dplyr)if(is.null(local_name)){ # 在local_name为空的情况下,直接调用local_numif(length(block)==1){ # 所有试验点区组数为固定值for (x in seq_len(local_num)){lst_lc[[x]]<-temp_func(block=block,num0=x,varieties=varieties, ck=ck, same=same)if (class(lst_lc[[x]])=="character") return(lst_lc[[x]])}}else{ # 不同试验点设置不同的区组数# 如果区组向量的长度与试验点数不一致,则报错if(length(block)!=local_num) return("区组向量的长度与试验点数不一致")for (x in seq_len(local_num)){lst_lc[[x]]<-temp_func(block=block[x],num0=x,varieties=varieties, ck=ck, same=same)if (class(lst_lc[[x]])=="character") return(lst_lc[[x]])}}}else{ # 如果local_name不为空,则local_num等于local_name的长度local_num=length(local_name)if(length(block)==1){ # 所有试验点区组数为固定值for (x in seq_len(local_num)){lst_lc[[x]]<-temp_func(block=block,num0=x,name0=local_name[x], varieties=varieties, ck=ck, same=same)if (class(lst_lc[[x]])=="character") return(lst_lc[[x]])}}else{ # 不同试验点设置不同的区组数# 如果区组向量的长度与试验点数不一致,则报错if(length(block)!=local_num) return("区组向量的长度与试验点数不一致")for (x in seq_len(local_num)){lst_lc[[x]]<-temp_func(block=block[x],num0=x,name0=local_name[x], varieties=varieties, ck=ck, same=same)if (class(lst_lc[[x]])=="character") return(lst_lc[[x]])}}}# 将列表中的各试验点的数据框合并为一个数据框# 调用dplyr包的bind_rows()函数combined_df <- bind_rows(lst_lc)combined_df
}# 录入参数
varieties<-c("A","B","C","D","E")
local_name<-c("地点1","地点2","地点3")# 调用函数,常用设置
rcbd(local_name=local_name, block=3, varieties=varieties, ck="C", same=FALSE)
如果要生成(地点、小区)×区组的二维表,使用下述代码:
# 生成(地点、小区)×区组的二维表
df<-rcbd(local_name=local_name, block=3, varieties=varieties, ck="C", same=FALSE)
library(reshape2)
dcast(df,loc_name+plt~blk,value.var="lst")
dcast(df,loc_name+blk~plt,value.var="lst")