R/demCat.R

In shetleranna/demTable:

demCat <- function(x,y,z,k){
  if(length(ls(pattern="demCatdf",pos=".GlobalEnv"))==1){rm(list=ls(pattern="demCatdf",pos=".GlobalEnv"),pos=".GlobalEnv")}
  #change all NAs in dataset to Missing
  y[is.na(y)]<-" Missing"
  #make initial df 
  for(i in x){
    temp <- as.data.frame(rbind(as.data.frame(cbind(Demographics=i,Sublevel="",n="","%"=""),stringsAsFactors = FALSE),
                                as.data.frame(cbind(Demographics="",Sublevel=names(table(y[,i])),n=table(y[,i]),"%"=formatC(100*table(y[,i])/nrow(y),digits=z,format="f")),
                                              row.names=sort(unique(y[,y$var==i])),stringsAsFactors = FALSE)),stringsAsFactors = FALSE)
   #if there are groups, add those columns
    if(!missing(k)){
      if(length(unique(y[,k]))>1){
        grptemp<-as.data.frame(matrix(nrow=nrow(temp),ncol=2*length(unique(y[,k]))))
        rownames(grptemp)<-temp$Sublevel
        colnames(grptemp)<-rep(c("n","%"),length(unique(y[,k])))
        for(g in 1:length(unique(y[,k]))){
          for(s in rownames(grptemp)[-1]){
            grptemp[s,(g*2-1)]<-length(y[which(y[,k]==unique(y[,k])[g] & y[,i]==s),i])
            grptemp[s,(g*2)]<-formatC(grptemp[s,(g*2-1)]/length(which(y[,k]==unique(y[,k])[g]))*100,digits=z,format="f")
          }
        }
        temp<-as.data.frame(cbind(temp,grptemp,stringsAsFactors=FALSE))
        temp[is.na(temp)]<-""
      }}
    rownames(temp)<-c(1:nrow(temp))
    assign(paste0("demCat",i),temp,envir = .GlobalEnv)
  }
  #add n totals (sums)
  sums<-c("","",nrow(y),"")
  if(!missing(k)){
    for(g in 1:length(unique(y[,k]))){
      sums<-c(sums,c(length(which(y[,k]==unique(y[,k])[g])),""))
    }}
  temp<-as.data.frame(rbind(sums,do.call(rbind,lapply(sort(names(which(unlist(eapply(.GlobalEnv,is.data.frame)))))[grep("demCat",
          sort(names(which(unlist(eapply(.GlobalEnv,is.data.frame))))))],get))),stringsAsFactors = FALSE)
  #make colnames prettier and consistent
  temp<-rbind(temp,colnames(temp))
  temp<-temp[c(nrow(temp),1:(nrow(temp)-1)),]
  coln<-c("","","Total","")
  colnames(temp)[1:4]<-coln
  if(ncol(temp)>4){
    for(g in 1:length(unique(y[,k]))){
      coln<-c(coln,c(unique(y[,k])[g],""))
    }
    colnames(temp)<-coln
  }
  rownames(temp)<-c(1:nrow(temp))
  assign(paste0("demCatdf"),temp,envir = .GlobalEnv)
  rm(list=ls(pattern="demCat",pos=".GlobalEnv")[which(!ls(pattern="demCat",pos=".GlobalEnv") 
                                                      %in% c("demCat","demCatdf"))],pos=".GlobalEnv")
  write.csv(demCatdf,paste0("demCatdf",gsub("[[:punct:]]| ","",Sys.time()),".csv"),row.names = FALSE)
}