############## # string to upper case function ############### CapLeading <- function (string){ fn <- function(x){ v <- unlist(strsplit(x, split = " ")) u <- sapply(v, function(x){ x <- tolower(x) substring(x, 1, 1) <- toupper(substring(x, 1, 1)) x}) paste(u, collapse = " ") } sapply(string, fn) } ### outputfiles fileName<-"euraocean" fileType<-"Q" #### sets the number of populations to through #lowest K Start_K<-12 #highest K End_K<-12 #### loop does all the work while (Start_K <= End_K) { KNum<-Start_K # get output file data QFile<-read.csv(paste(fileName,KNum,fileType,sep="."),sep=" ",header=FALSE) QFam <-read.csv(paste(fileName,".fam",sep=""),sep=" ",header=FALSE) # remove a bunch of extraneous columns QFam$V6<-NULL QFam$V5<-NULL QFam$V4<-NULL QFam$V3<-NULL QFam$V1<-NULL QFam$Id<-QFam$V2 QFam$V2<-NULL QFileFam<-cbind(QFam,QFile) #get more info from master data frame for the entries you have in the fam file QFileFamMaster<-merge(QFileFam,HGDPMaster) KPlot<-data.frame() # get unique population names allUnique<-unique(QFileFamMaster$PopulationSpecific) for (levels in allUnique) { # uncomment these lines if you want to limit to specific populations #if(levels =="Bengali" | #levels == "hema" | #levels == "Algeria" | #levels == "samoan" | #levels == "krygzstani" | #levels == "yhai"| #levels == "punjabi arain" | #levels == "mepalese" | #levels == "spaniards" | #levels == "yemenese" | #levels == "lebanese" | #levels == "saudis" | #levels == "egyptians" | #levels == "romanians" | #levels == "cypriots" | #levels == "lithuanians" | #levels == "belorussian" | #levels == "syrians" | #levels == "iranians" | #levels == "north Kannadi" | #levels == "turks" | #levels == "armenians" | #levels == "georgians" | #levels == "moroccans" | #levels == "evenkis" | #levels == "nganassans" | #levels == "tn dalit" | #levels == "Brahui" | #levels == "Sindhi" | #levels == "French" | #levels == "Papuan" | #levels == "Palestinian" | #levels == "Cambodian" | #levels == "Japanese" | #levels == "Orcadian" | #levels == "Han" | #levels == "Pima" | #levels == "Dai" | #levels == "FrenBasque" | #levels == "Adygei" | #levels == "Irula" | #levels == "Gujarati_A" | #levels == "Gujarati_B" | #levels == "Iban" | #levels == "tn brahmin" | #levels == "vietnamese" #) ### this brace only matters if the previous line is uncommented { slice <- (QFileFamMaster[QFileFamMaster$PopulationSpecific==levels ,]) a = 1 colSlice = 2 rowVec<-NULL evalString<-NULL while (a <= KNum) { theMean<-mean(slice[,colSlice]) rowVec[a]<-theMean assign(paste("K",a,sep=""),theMean ) theKassign<-paste("K",a,sep="") theKassign<-paste(theKassign,"=rowVec[",sep="") theKassign<-paste(theKassign,a,sep="") theKassign<-paste(theKassign,"]",sep="") if (a == 1) {evalString <- paste(evalString,theKassign,sep="")} else { {evalString <- paste(evalString,theKassign,sep=",")} } a<-a+1 colSlice<-colSlice+1 } ### this renames some outputs if (levels == "French Basque") { levels = "Basque" } levelString<-paste("'",levels,sep="") levelString<-paste(levelString,"'",sep="") evalLevels<-paste("PopulationSpecific=",levelString,sep="") evalString<-paste(evalString,evalLevels,sep=",") evalString<-paste("df<-data.frame(",evalString,sep="") evalString<-paste(evalString,")",sep="") df<-data.frame() eval(parse(text=evalString)) KPlot<-rbind(KPlot,df) } } ### outputs spread sheet for unique populations write.table(KPlot,file="K.csv") KPlot<-t(KPlot) PopNames<-KPlot[KNum+1,] KPlot<-KPlot[-c(KNum+1),] x11() par(mai=c(1.5,0,.1,.25),font=2,font.lab=4) ### the plot. cex is the font size barplot(KPlot,col=rainbow(KNum),names.arg=CapLeading(PopNames),cex.names=.75,las=2) mtext(paste("K =",KNum,sep=" "),4,cex=3) rm(KPlot) ## increment up for the next K Start_K<-Start_K+1 }