求助完善R语言中基于因子水平交互矩阵的数据筛选函数

正在开发一个R函数，用于基于因子水平交互矩阵从数据框中提取数据。函数输入包括：

• 目标数据框
• 由0和1组成、主对角线对称的因子水平交互矩阵（行列名为因子水平）
• 因子数据所在的列编号

目前尝试了多种常规方法，但无法在筛选后的数据中保留因子水平的交互结构，需要帮助完善该函数。

因子水平交互矩阵 #

structure(c(1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 
1, 1, 1, 0, 0, 0, 1, 1), dim = c(5L, 5L), dimnames = list(c("15", 
"20", "30", "40", "50"), c("15", "20", "30", "40", "50")))

数据框示例 #

structure(list(NumObr = structure(1:6, levels =     c("1",     "2", "3", 
"4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14",     "15", 
"16", "17", "18", "19", "20", "21", "22", "23", "24", "25",     "26", 
"27", "28", "29", "30", "31", "32", "33", "34", "35", "36",     "37", 
"38", "39", "40", "41", "42", "43", "44", "45", "46", "47",     "48", 
"49", "50", "51", "52", "53", "54", "55", "56", "57", "58",     "59", 
"60", "61", "62", "63", "64", "65", "66", "67", "68", "69",     "70", 
"71", "72", "73", "74", "75", "76", "77", "78", "79", "80",     "81", 
"82", "83", "84", "85", "86", "87", "88", "89", "90", "91",     "92", 
"93", "94", "95", "96", "97", "98", "99", "100", "101",     "102", 
"103", "104", "105", "106", "107", "108", "109", "110",     "111", 
"112", "113", "114", "115", "116", "117", "118", "119",     "120", 
"121", "122", "123", "124", "125", "126", "127", "128",     "129", 
"130", "131", "132", "133", "134", "135", "136", "137",     "138", 
"139", "140", "141", "142", "143", "144", "145", "146",     "147", 
"148", "149", "150", "151", "152", "153", "154", "155",     "156", 
"157", "158", "159", "160", "161", "162", "163", "164",     "165", 
"166", "167", "168", "169", "170", "171", "172", "173",     "174", 
"175", "176", "177", "178", "179", "180", "181", "182",     "183", 
"184", "185", "186", "187", "188", "189", "190", "191",     "192", 
"193", "194", "195", "196", "197", "198", "199", "200",     "201", 
"202", "203", "204", "205", "206", "207", "208", "209",     "210", 
"211", "212", "213", "214", "215"), class = "factor"),     RastvPoly = c(20L, 
20L, 20L, 20L, 20L, 20L), ModUpr = c(207.9995904,     213.9623982, 
202.6860729, 202.1958851, 195.1508638, 204.9938721), ForsMax     = c(1517.935303, 
1529.544189, 1502.401001, 1495.139526, 1521.255737,     1498.248901
), PredProch = c(3415.354431, 3441.474426, 3380.402252,     3364.063934, 
3422.825409, 3371.060028), dLmax = c(1.440741164,     1.459018333, 
1.44097243, 1.435998338, 1.492951597, 1.435195548), LenObr =     c(236L, 
236L, 236L, 236L, 236L, 236L), Weight = c(261L, 263L, 267L,     249L, 
264L, 266L), ConcVol = c(72.33716475, 71.78707224,     70.71161049, 
75.82329317, 71.51515152, 70.97744361), RastvPolyF =     structure(c(2L, 
2L, 2L, 2L, 2L, 2L), levels = c("15", "20", "30", "40",     "50"), class = "factor")), row.names = c(NA, 
6L), class = "data.frame")

现有代码 #

numFactor <- function(dataAnaliz){
  nameCol <- names(dataAnaliz)
  numName <- length(nameCol)
  numF <- c()
  for (i in seq(1,numName,1)) {
    if(class(dataAnaliz[,i])=="factor"){
      numF <- c(numF,i)
    }else{
      next
    }
  }
  return(numF)
}
numPredictor <- function(dataAnaliz){
  nameCol <- names(dataAnaliz)
  numName <- length(nameCol)
  numP <- c()
  for (i in seq(1,numName,1)) {
    if(class(dataAnaliz[,i])=="numeric"){
      numP <- c(numP,i)
    }else{
      next
    }
  }
  return(numP)
}

netFactor <- function(dataAnaliz, numF, numP, alpha){
  levFactor <- levels(dataAnaliz[,numF])
  pMatrix<-matrix(rep(0,length(levFactor)^2),ncol = length(levFactor),nrow = length(levFactor))
  colnames(pMatrix) <- levFactor
  rownames(pMatrix) <- levFactor
  k<-1
  for (i in levFactor) {
    m<-1
    for (j in levFactor) {
      test<- t.test(dataAnaliz[dataAnaliz[,numF]==i, numP],dataAnaliz[dataAnaliz[,numF]==j, numP], correct=FALSE)$p.value
      test <- p.adjust(test, method = "bonferroni",n=length(levFactor))
      if(test>=alpha){
        pMatrix[j,i]<-1
      }else{
        pMatrix[j,i]<-0
      }
      m<-m+1
    }
    k<-k+1
  }
  return(pMatrix)
}

dataSelect <-function(dataAnaliz,netF, numF){
    conFrame <- data.frame(as.table(netF))
    conFrameOne<-conFrame[(conFrame$Freq==1)&(conFrame$Var1!=conFrame$Var2),]
    varCol1 <- conFrameOne$Var1
    varCol2 <- conFrameOne$Var2
    vec<- c()
    for (i in varCol2) {
      vec_1 <-c()
      for (j in varCol1) {
        if((length(conFrameOne[conFrameOne$Var1==j&conFrameOne$Var2==i,]$Freq)!=0)&(i!=j)){
          vec_1 <- c(vec_1,i,j)
        }else{
          vec_1 <- c(vec_1,"|","|")
        }
      }
      vec<-rbind(vec,vec_1)
    }
    
    newVec <- c()
    numRow<- nrow(vec)
    for (i in seq(1,numRow-1,1)) {
      if(!identical(vec[i+1,], vec[i,])){
        newVec<-rbind(newVec,vec[i+1,])
      }
    }
    
    print(newVec)
    conFrameZero <- conFrame[conFrame$Freq==0,]
    levCFZ <- levels(conFrameZero$Var1)
    for ( i in levCFZ) {
      if(length(conFrameZero[conFrameZero$Var2==i,]$Var2)==(length(levCFZ)-1)){
        #print(dataAnaliz[dataAnaliz[,numF]==i,])
      }
    }
    
  }
  print(numP<-numPredictor(newDataMISIS))
  print(nf<-numFactor(newDataMISIS))
  print(netF<-netFactor(newDataMISIS,numF = nf[2], numP[4], 0.05))
  
  dataSelect(newDataMISIS,netF,nf[2])

内容的提问来源于stack exchange，提问作者n_nikitin