# TODO: Add comment # # Author: Korsching Apr 3, 2014,2023,2025 ############################################################################### ## environmets # assign(res,"aaa",pos=1) # pos.to.env(-1) # integer between 1 and length(search()) or -1 enclosing environment, 1: .GlobalEnv ## index.E # # index.E(spath="/home/korschi/on3/eclipseR", opath="/home/korschi/on3/eclipseR/0functions/index20260513.txt", recursively=T) # a <- index.E(spath="/home/korschi/on3/eclipseR", opath="", recursively=T) # index.E(spath="/home/korschi/on3/eclipseR", opath="/home/korschi/on3/eclipseR/0functions/index20240822eclipse.txt", recursively=F) index.E <- function(spath="/home/user/eclipseR", opath="/home/user/eclipseR/index.txt", recursively=T){ # create a R function index for a folder or folder tree # spath: "/absolute/path": files of a *.r *.R type will be analysed # opath: "/absolute/path": will save a text file including a tab separated matrix if there is at least one function # "": a R matrix will be returned in the workspace # recursively: T: analyse a project folder recursively, F: analyse only the given folder # ini if(spath==""){ stop("\n Supply an absolute path to the R folder of interest\n") } if(is.na(file.info(spath)$isdir)){ stop("\n R folder not existing \n") } if(recursively){ # read complete project folder structure proj.dirs <- list.dirs(path=spath, full.names=T, recursive=recursively) proj.dirs.len <- length(proj.dirs) if(proj.dirs.len==0){ cat("\nno project subfolders in path \n") } # analyse project folders res <- index.E.folderLoop(proj.dirs, proj.dirs.len) }else{ # read given folder cat("\n main.path = ",spath," -- crosscheck path \n") proj.dirs <- spath proj.dirs.len <- 1 # analyse main folder res <- index.E.folderLoop(proj.dirs, proj.dirs.len) } if(length(res)==0){ return() } # list # list -> matrix res <- index.E.2matrix(res) # sort res <- res[order(res$proj, res$FILEn, res$FUNCn),] if(opath==""){ return(res) }else{ write.table(x=res, file=opath, quote=F, sep="\t", row.names=F) return() } } index.E.folderLoop <- function(proj.dirs, proj.dirs.len){ # loop through all folders given by proj.dirs and proj.dirs.len counter <- 0 # count 'function found' to check if some hits get lost in the parsing process real.count <- 1 # count every list output (including dummy) res <- list("dummy") # create a list of length one for(i in 1:proj.dirs.len){ # filter on files with *.R or *.r all.r.files <- list.files(path=proj.dirs[i], pattern="(\\.R$|\\.r$)", all.files=F, full.names=T, recursive=F, ignore.case=F, include.dirs=F) #, no..=F) all.r.files.len <- length(all.r.files) # extract functions per folder and file if(all.r.files.len!=0){ for(j in 1:all.r.files.len){ # read text as vector of lines #cat("\n",all.r.files[j]) text.file <- scan(file=all.r.files[j], what="character", sep="\n", quiet=F, comment.char="#", blank.lines.skip=T) # comment char on: removed R comments text.file.len <- length(text.file) # all occurences of pattern at line number pos.fn <- grep(pattern="<-[[:blank:]]*function", x=text.file, ignore.case=F, perl=F, value=F, fixed=F) # not found: anonymous function: function(){} mostly a one liner in other functions like apply() pos.fn.len <- length(pos.fn) # number of hits counter <- counter+pos.fn.len if(pos.fn.len!=0){ # extract each hit: function name, parameters, first comment line for(k in 1:pos.fn.len){ k1 <- pos.fn[k] # local line k2 <- k1 # fn name & rest firstline <- unlist(strsplit(x=text.file[k1], split="[[:blank:]]*<-[[:blank:]]*function", fixed=F)) #cat("\n\n\n--- line ",firstline[1]," ; ",firstline[2]," file: ",all.r.files[j],"\n") #### name <- firstline[1] text.file[k1] <- firstline[2] # extract parameters, and if possible comment erg <- index.E.onelinefn(k1,text.file) # full one liner if(erg$flag==0){ # more than one line erg <- index.E.MfnSMlineParam(k1,text.file) # param in one or multiple line(s) } f.param <- erg$f.param f.comm <- erg$f.comm # remove tabs etc. name <- gsub(pattern="(\\t|[[:space:]]*)", replacement="", x=name) f.param <- gsub(pattern="\\t", replacement="", x=f.param) f.param <- gsub(pattern="^[ ]*|[ ]*$", replacement="", x=f.param) f.param <- gsub(pattern="\\)[ \\t]*\\)$", replacement="\\)", x=f.param) f.comm <- gsub(pattern="^[ \\t]*", replacement="", x=f.comm, perl=T) # strip path from project dir and file proj <- unlist(strsplit(x=proj.dirs[i], split="/", fixed=T)) proj <- proj[length(proj)] # take last entry file.p <- unlist(strsplit(x=all.r.files[j], split="/", fixed=T)) file.p <- file.p[length(file.p)] # add result to list real.count <- real.count +1 res[[real.count]] <- list(proj=proj, FILEn=file.p, FUNCn=name, parameter=f.param, text=f.comm) } } } } } # remove dummy res[1] <- NULL cat("\n number of functions found = ",counter," -- crosscheck if all hits are in the index file \n") return(res) } index.E.onelinefn <- function(k1,text.file){ # index.E.folderLoop #cat("\n : ",text.file[k1]) frA1 <- regexpr("\\((.*?)", text.file[k1], perl=T) # ( start frA2 <- regexpr("(\\))(?=[ \\{\\t]*)", text.file[k1], perl=T) # ) end if(frA1==-1|frA2==-1){ return(list(f.param="",f.comm="",flag=0)) } # no first ( or no last ) or no } leave frA1 <- frA1+1 attr(frA1,"match.length") <- frA2-2 pP <- regmatches(text.file[k1], frA1) # parameter part frB <- regexpr("(?<=\\)).+?.*", text.file[k1], perl=T) if(frB!=-1){ pF <- regmatches(text.file[k1], frB) # function body part + ev. comment }else{ # regmatches with -1 gives length(pF)==0 pF <- "" } #cat("\n frB",frB," pF ",pF," pP ",pP) frC <- regexpr("#", pF, perl=T) # separate comment frC2 <- regexpr(".*#", pF, perl=T) # separate comment frC3 <- regexpr("#.*", pF, perl=T) # separate comment if(frC!=-1){ attr(frC2,"match.length") <- attr(frC2,"match.length") -1 pFs <- regmatches(pF, frC2) # function body part pC <- regmatches(pF, frC3) # comment part }else{ pFs <- pF pC <- "" } # check if multiline is better frD1 <- regexpr("\\{", pFs, perl=T) frD2 <- regexpr("\\}", pFs, perl=T) #cat("\n pF ",pF," pP ",pP," pFs ",pFs," pC ",pC) #cat("\n frA1 ",frA1," frA2 ",frA2," frB ",frB," frC ",frC," frC2 ",frC2," frC3 ",frC3," frD1 ",frD1," frD2 ",frD2) if(frD1!=-1 & frD2==-1){ return(list(f.param="",f.comm="",flag=0)) } # multiline if(frA1!=-1 & frA2!=-1){ return(list(f.param=pP,f.comm=pC,flag=1)) }else{ return(list(f.param="",f.comm="",flag=0)) } } index.E.awaycomments <- function(text){ # index.E.folderLoop pA <- regexpr(".*#", text) # cut away primary/intermediate comments if(pA>=0){ attr(pA,"match.length") <- attr(pA,"match.length") -1 tA <- regmatches(text, pA) }else{ tA <- text } return(tA) } index.E.striproundopen <- function(text){ # index.E.folderLoop pA <- regexpr("(?<=\\().*", text, perl=T) # cut away ( and all before if(pA>=1){ tA <- regmatches(text, pA) # can be match length 0 or more }else{ tA <- "?" # not found at all } return(tA) } index.E.curlyspecial <- function(text){ # index.E.folderLoop pA <- regexpr(".*[\\)]?(?=[\\)]{1}[ \t]*\\{.*#)", text, perl=T) # ) + { + cut away intermediate comment if(pA>=0){ tA <- regmatches(text, pA) return(tA) } pA <- regexpr(".*[\\)]?(?=[\\)]{1}[ \t]*\\{.*$)", text, perl=T) # only ) + { if(pA>=0){ tA <- regmatches(text, pA) return(tA) } pA <- regexpr(".*(?=[ \t]*\\{.*)", text, perl=T) # only { if(pA>=0){ tA <- regmatches(text, pA) # presumably nothing return(tA) } } index.E.fullcommentline <- function(text){ # index.E.folderLoop pCo <- regexpr("[ \t]*#.*", text, perl=T) if(pCo==-1){ f.comm <- "" # no comment in line } if(pCo>=1){ f.comm <- regmatches(text, pCo) # comment line } return(f.comm) } index.E.MfnSMlineParam <- function(k1,text.file){ # index.E.folderLoop kk <- k1 frB <- regexpr("\\((.*)\\)(?=[^,]*[ \t]*\\{)", text.file[kk], perl=T) # normal syntax if(frB>=1){ # in same line ( ) { frB <- frB+1 attr(frB,"match.length") <- attr(frB,"match.length") -2 f.param <- regmatches(text.file[kk], frB) # all parameters f.comm <- index.E.fullcommentline(text.file[kk+1]) return(list(f.param=f.param,f.comm=f.comm)) } if(frB==-1){ # { in following lines f.param <- "" a <- T while(a){ # find { kk <- kk+1 frB <- regexpr("\\{", text.file[kk], perl=T) if(frB>=1){ a <- F } } # range k1 -> kk for(i in k1:(kk-1)){ # remove & join together if(i==k1){ # remove first main ( text.file[i] <- index.E.striproundopen(text.file[i]) } f.param <- paste(f.param, index.E.awaycomments(text.file[i]), collapse=" ") # remove comments keep parameters } # last line with { could be special f.param <- paste(f.param, index.E.curlyspecial(text.file[kk]), collapse=" ") f.comm <- index.E.fullcommentline(text.file[kk+1]) } return(list(f.param=f.param,f.comm=f.comm)) } index.E.2matrix <- function(x){ # take a index.E nested list object and create a data.frame x.len <- length(x) xn.len <- length(x[[1]]) res <- data.frame(matrix("",x.len,xn.len), stringsAsFactors=F) names(res) <- names(x[[1]]) # fill object for(i in 1:x.len){ res[i,] <- x[[i]] } # order alpabetically according to function name res <- res[order(res[ ,2]), ] # return(res) }