Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/65.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/3/sockets/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R 创建一个递归函数,用于计算所有列组合之间的标准化差_R_Function_Recursion - Fatal编程技术网

R 创建一个递归函数,用于计算所有列组合之间的标准化差

R 创建一个递归函数,用于计算所有列组合之间的标准化差,r,function,recursion,R,Function,Recursion,我感兴趣的是创建一个函数,该函数计算data.frame(或matrix)中所有列之间的标准化差,然后使用自己的输出重复该操作,也就是说,计算在上一步获得的所有标准化差之间的标准化差。如果我能设置“迭代次数”(或步骤,无论它们可以被称为什么),那就太棒了 ,带有一个参数(即step=2将返回步骤1中获得的归一化差与输入数据帧中原始列的所有组合的归一化差) 首先,dput(db[1:20,8:13])的输出: 但我不知道如何添加参数,即step,使函数在其输出上迭代指定步骤的次数。另一个大问题是c

我感兴趣的是创建一个函数,该函数计算
data.frame
(或
matrix
)中所有列之间的标准化差,然后使用自己的输出重复该操作,也就是说,计算在上一步获得的所有标准化差之间的标准化差。如果我能设置“迭代次数”(或步骤,无论它们可以被称为什么),那就太棒了 ,带有一个参数(即
step=2
将返回步骤1中获得的归一化差与输入数据帧中原始列的所有组合的归一化差)

首先,
dput(db[1:20,8:13])
的输出:

但我不知道如何添加参数,即
step
,使函数在其输出上迭代指定步骤的次数。另一个大问题是
colnames
的管理。在第一次迭代中,作为新列名称,我分配了规范化差异中涉及的两个
colname
的第一个字母,但从第二次迭代开始,我不能做同样的事情。但是,这是第二个问题,因为我可以在之后更改
colnames
。我强调该函数应该将每个步骤的所有标准化差异作为单个数据帧返回(因此我需要
cbind
每个步骤的结果,但这也可以在以后完成)

    db <- structure(list(blue_2018 = c(319L, 159L, 204L, 123L, 13L, 250L, 
151L, 271L, 288L, 213L, 199L, 222L, 302L, 370L, 170L, 178L, 159L, 
178L, 254L, 204L), green_2018 = c(509L, 343L, 428L, 270L, 39L, 
404L, 352L, 492L, 540L, 420L, 605L, 477L, 584L, 576L, 317L, 401L, 
327L, 328L, 439L, 526L), nir_2018 = c(3584L, 2827L, 3170L, 2702L, 
737L, 1532L, 1898L, 1720L, 2140L, 2326L, 4003L, 2050L, 2336L, 
2780L, 2067L, 2177L, 1983L, 2384L, 2062L, 3354L), red_2018 = c(269L, 
194L, 423L, 175L, 15L, 475L, 295L, 482L, 512L, 221L, 341L, 312L, 
486L, 485L, 187L, 221L, 197L, 223L, 482L, 305L), swir1_2018 = c(1821L, 
1117L, 1771L, 1170L, 222L, 1587L, 1150L, 1784L, 1955L, 1334L, 
1699L, 1196L, 1739L, 1658L, 741L, 1088L, 903L, 1063L, 2033L, 
1711L), swir2_2018 = c(716L, 444L, 801L, 426L, 85L, 1036L, 543L, 
990L, 1039L, 651L, 717L, 557L, 919L, 900L, 328L, 497L, 407L, 
481L, 1098L, 719L)), row.names = c(NA, 20L), class = "data.frame")
mycomb <- function(x){
  var <- c("b","g","n","r","s1","s2")
  comb <- combinations(n = ncol(x), r = 2, v = var, repeats.allowed = F)
  name_diff_norm <- function(comb){
    name<- apply(comb,1,paste0,collapse='')
    return(name)
  }
  norm_diff <- name_diff_norm(comb)
  comb_norm_diff <- combn(x, 2, FUN = function(x) (x[,1]-x[,2])/(x[,1]+x[,2]))
  colnames(comb_norm_diff) <- norm_diff
  return(comb_norm_diff)
}

mycomb(df)