# TODO: Add comment # # Author: E.Korsching May 18, 2026 ############################################################################### #### evaluate::parse_all() based ## index.E2 # # index.E2(spath="/home/korschi/on3/eclipseR", opath="/home/korschi/on3/eclipseR/0functions/fn_index/index/index_20260717.txt") # # a <- index.E2(spath="/home/korschi/on3/eclipseR", opath=NULL) index.E2 <- function(spath="/home/user/eclipseR", opath="/home/user/eclipseR/index.txt"){ # 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 # NULL: a R matrix will be returned in the workspace # recursively: T: analyse a project folder recursively, F: analyse only the given folder (avoiding warning) # ini require(evaluate) 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") } # create folder tree proj.dirs <- list.dirs(path=spath, full.names=T, recursive=T) # remove dot folders proj.dirs <- proj.dirs[ !grepl(pattern="/.", x=proj.dirs, fixed=T) ] proj.dirs.len <- length(proj.dirs) #if(proj.dirs.len==0){ proj.dirs <- spath; proj.dirs.len <- 1 } # analyse all folders res <- index.E2.folderLoop(proj.dirs, proj.dirs.len) if(length(res)==0){ stop("no result") } # list -> matrix r.len <- length(res) rn.len <- length(res[[1]]) out <- data.frame(matrix("",r.len,rn.len), stringsAsFactors=F) names(out) <- names(res[[1]]) # fill object for(i in 1:r.len){ out[i,] <- unlist(res[[i]]) } # sort out <- out[order(out$FOLDER, out$FILE, out$FUNCTION), ] if(is.null(opath)){ return(out) }else{ write.table(x=out, file=opath, quote=F, sep="\t", row.names=F) return() } } index.E2.folderLoop <- function(proj.dirs, proj.dirs.len){ # loop through all folders given by proj.dirs and proj.dirs.len true.lines.count <- 0 # filled lines l.count <- 2 # count every list output starting after dummy res <- list("dummy") # create a list of length one for(i in 1:proj.dirs.len){ # in folder 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) #cat("\n path ",proj.dirs[i]) proj <- unlist(strsplit(x=proj.dirs[i], split="/", fixed=T)) proj <- proj[length(proj)] # take last entry # extract functions per file if(all.r.files.len!=0){ for(j in 1:all.r.files.len){ file.p <- unlist(strsplit(x=all.r.files[j], split="/", fixed=T)) file.p <- file.p[length(file.p)] cat("\nfile\t",file.p) # parse af <- file(all.r.files[j], "r") pf <- parse_all(x=af, filename=NULL, allow_error=F) close(af) pf.f <- lengths(pf$expr) # row pointer function (0 and 1's) pf.f.seq <- seq(1, length(pf.f), 1) pf.f.pos <- pf.f.seq[as.logical(pf.f)] # filtered on 1's, but not any 1 is a function pf.f.pos.len <- length(pf.f.pos) true.lines.count <- true.lines.count + pf.f.pos.len #t.m <- as.data.frame( matrix("",pf.f.pos.len,1) ); k1 <- 1 # test matrix for line objects if(pf.f.pos.len>0){ sc <- 0 # success counter errc <- 0 # check why - counter for(k in pf.f.pos){ f.comm <- "" # initialize pf.fu <- pf$src[k] # parsing result lines: functions, empty lines etc. #t.m[k1,1] <- pf.fu; k1 <- k1+1 # test matrix # remove new line & tab pf.fu1 <- gsub(pattern="\\n", replacement="", x=pf.fu) pf.fu1 <- gsub(pattern="\\t", replacement="", x=pf.fu1) #t.m[k1,1] <- pf.fu1; k1 <- k1+1 # test matrix # regex (not perfect ...) n1 <- regexpr("^.+?(?=<-)", pf.fu1, perl=T) # test function name fp1 <- regexpr("(?<=function[ ]{0,3}\\()(.*?)(?=\\))", pf.fu1, perl=T) # test function arguments fc1 <- regexpr("(?<=\\{[ \\n\\t]{0,5}#)(.*?)(?=\\n)", pf.fu, perl=T) # test first commentary line (ek standard inside) fc2 <- regexpr("(?<=#).*?(?=\\n)", pf.fu, perl=T) # test first line function comment (a1,a8) #cat("\n n1 fp1 fc1 fc2 fc3 ",n1,fp1,fc1,fc2,fc3) # test integer if(n1>=0 & fp1>0){ name <- regmatches(pf.fu1, regexpr("^.+?(?=<-)", pf.fu1, perl=T)) # function name f.param <- regmatches(pf.fu1, regexpr("(?<=function[ ]{0,3}\\()(.*?)(?=\\))", pf.fu1, perl=T)) # function arguments if(fc1>0){ f.comm <- regmatches(pf.fu, regexpr("(?<=\\{[ \\n\\t]{0,5}#)(.*?)(?=\\n)", pf.fu, perl=T)) # first commentary line }else if(fc2>0){ f.comm <- regmatches(pf.fu, regexpr("(?<=#).*?(?=\\n)", pf.fu, perl=T)) # first line function comment } # customize regex results name <- gsub(pattern="([[:space:]]*)", replacement="", x=name) # check if(identical(f.comm, character(0))){ f.comm <- "" } # add result to list res[[l.count]] <- list(FOLDER=proj, FILE=file.p, FUNCTION=name, ARGUMENTS=f.param, TEXT=f.comm) sc <- sc +1 l.count <- l.count +1 }else{ errc <- errc +1 } } cat("\tfound\t",sc,"\tfail\t",errc) #assign(paste("aaa.test.",file.p,sep=""), t.m, pos=1) # test matrix } } } } # remove dummy in list res[1] <- NULL cat("\n\n number of filled lines = ",true.lines.count) cat("\n\n number of elements = ",length(res)," -- check all hits\n\n") return(res) } #### index.E2.search <- function(search="", x=NULL, cm=c(1:5)){ # search for a function name and/or a keyword # in the first line description part or in the file name # x: a index.E2() object # cm: set of numbers of columns which should be used (max. 5) if(search==""){ cat("\n provide a search term \n"); return() } if(is.null(x)){ cat("\n provide an index.E2() object \n"); return() } # search in column -> vector of line numbers cml <- length(cm) rn <- NULL for(i in 1:cml){ tmp <- grep(pattern=search, x=x[,cm[i]], ignore.case=F, perl=F, fixed=F, value=F) cat("\ncolumn:",cm[i],length(tmp)) rn <- c(rn, tmp) #-1 if nothing } rn <- unique(rn) cat("\nunique: ",length(rn),"\n") rn <- rn[order(rn)] if(length(rn)>0){ res <- x[rn, ] }else{ res <- 0 } return(res) } #a1 <- index.E2.search( search="perm", x=a, cm=c(1,3) )