[R language] age sex frequency matching select samples for case-control study, and perform frequency matching on age and sex

Case control study , Frequency matching of age and sex

Example data

Sample data download

ID	group	sex	age
A1	Control	Woman	90
A10	Control	male	89
A100	Control	male	85
A1000	Control	male	74
A1001	Case	Woman	74
A1002	Case	male	74
A1003	Case	Woman	74
A1004	Case	male	74
A1005	Control	male	74

data <- read.csv(" Age sex frequency matching .csv")

##  Age can be stratified first 
data$agegroup <- cut(data$age,c(0,10,20,30,40,50,60,70,80,90,Inf),
                     right =FALSE #  Select section opening [ ] situation 
                     )
#  Generate list data , By each list[?] For the same reason sex and age
dataSplit <- split(data, list(data$sex, data$age))

#  Single list extract 
A <- as.data.frame(data_case[[1]])
data1 <- A[A$group == "Case", ]
data2 <- A[A$group == "Control", ]
num <- as.numeric(table(A$group == "Case")[2])
set.seed(123) #  Set random number , Repeat many times to keep consistent 
data3 <- data2[sample(1:NROW(data2), num, replace = FALSE), ]
assign(paste0("dataFinal", 1), rbind(data1, data3))

#  Cyclic extraction 
for (i in 1:length(dataSplit)) {
    
  A <- as.data.frame(data_case[[i]])
    data1 <- A[A$group == "Case", ]
    data2 <- A[A$group == "Control", ]
    numCase <- nrow(data1)
    numControl <- nrow(data2)
    if (numCase > 0 & numControl>0 & numControl-numCase>=0) {
    
      na.omit <- TRUE
      set.seed(123) #  Set random number , Repeat many times to keep consistent  【 Can be silent 】
      data3 <- data2[sample(1:numControl, numCase, replace = FALSE), ]
      assign(paste0("dataFinal", i), rbind(data1, data3))
    }
    if (numCase > 0 & numControl>0 & numControl-numCase<0) {
    
      na.omit <- TRUE
      set.seed(123) #  Set random number , Repeat many times to keep consistent  【 Can be silent 】
      data3 <- data1[sample(1:numCase, numControl, replace = FALSE), ]
      assign(paste0("dataFinal", i), rbind(data2, data3))
    } 
}

#  Merge multiple data frames 
multimerge<-function(dat=list(),...){
    
  if(length(dat)<2)return(as.data.frame(dat))
  mergedat<-dat[[1]]
  dat[[1]]<-NULL
  for(i in dat){
    
    mergedat<-merge(all=TRUE,mergedat,i,...)
  }
  return(mergedat)
}

files=ls(pattern = "dataFinal")
listALL=list()
#  Data frame composition list
for (i in 1:length(ls(pattern = "dataFinal"))) {
    
  eval(parse(text = paste0("listALL","[[",i,"]]", " <- ",files[i])))
}

dataALL <- multimerge(listALL)
#  Sort 
dataALL=dplyr::arrange(dataALL,age,sex,group)
#  export 
write.csv(dataALL,"dataALL.csv",row.names = F)