#### tests of parse_all() E.Korsching 2026 # install.packages("evaluate") # among others the included parse_all() function is extending the parse() function library(evaluate) a1 <- c( "function() {}", "function() {", " # Hello!", "}", "function() {", " # Hello!", " # Goodbye!", "}" ) a2 <- parse_all(a1) lengths(a2$expr) # [1] 1 1 1 a2$src # [1] "function() {}\n" # [2] "function() {\n # Hello!\n}\n" # [3] "function() {\n # Hello!\n # Goodbye!\n}\n" a3 <- "function() {} function() { # Hello! } function() { # Hello! # Goodbye! }" a4 <- parse_all(a3) lengths(a4$expr) # [1] 1 1 1 a4$src # [1] "function() {}\n" # [2] "function() {\n\t# Hello!\n}\n" # "function() {\n\t# Hello!\n\t # Goodbye!\n}\n" attributes(a4) #$names #[1] "src" "expr" #$row.names #[1] 1 2 3 #$class #[1] "data.frame" # no difference between concatinated single strings and one whole string # tabs handled as \t and spaces as is - there might be mixtures of both ## real world experiment #1 af <- file("/home/korschi/on3/eclipseR/0functions/fn_index/test/de_f_test.R", "r") a <- parse_all(x=af, filename=NULL, allow_error=F) lengths(a$expr) # [1] 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 a$src #[1] "# TODO: Add comment\n" #[2] "# \n" #[3] "# Author: Korsching\n" #[4] "###############################################################################\n" #[5] "\n" #[6] "\n" #[7] "\n" #[8] "de.wrap <- function(x, groups, coll, out, wpath, test=\"nbW\", cond1=c(\"condition\",\"A\",\"N\"), stati=\"de_overview\"){\n\t# DE wrapper function (2025-01)\n\t# is only working with selcted experiments ... return()\n}\n" #[9] "\n" #[10] "de.pre <- function(x, wpath, sfile){\n\t# customize and remove empty rows\n\t# x: data frame / matrix\n\tx <- as.matrix(x)\n\tdnl <- length(dimnames(x)[[2]])\n\tnrx <- nrow(x)\n\tfConn <- ... " #[11] "\n" #[12] "\n" #[13] "# DE\n" #[14] "de.fn <- function(countdata, a1, wpath, wfile, sfile, anno=NULL, cond1=NULL, sign=F, test=\"DESeq\", ret=F){\n\t# DESeq function\n\t# countdata: data matrix, samples in columns\n\t# a1: column data ... " #[15] "\n" #[16] "\n" #[17] "\n" #[18] "# Extract the lines with number of significant factors from the statistic file\n" #[19] "de.overview <- function(p, f, ret=F){\n\t# extract from wrap.de() report file the lines with number of significants\n\t# p: path name, f: file name with extension, ret: additionally return table ... " #[20] "# de.overview(p=\"res20250113/DESeq\", f=\"de_overview_DESeq.tsv\", ret=T)\n" #[21] "\n" #[22] "\n" #[23] "\n" #[24] "\n" # text line length with spaces in this text block is as long as the longest string line - see below - there the spaces are not deleted (?? copy problem ?? or some meaning ??) #2 af <- file("/home/korschi/on3/eclipseR/0functions/fn_index/test/test_func.R", "r") a <- parse_all(x=af, filename=NULL, allow_error=F) lengths(a$expr) # [1] 0 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 a$src #[1] "#\n" #[2] "# test file with different function structures\n" #[3] "#\n" #[4] "\n" #[5] "\n" #[6] "# end with comment\n" #[7] "a1 <- function(x){ sin(x) }\t\t# comment a1\n" #[8] "# end with space + tab\n" #[9] "a2 <- function(x){ sin(x) } \t\n" #[10] "# end with }\n" #[11] "a3 <- function(x){ sin(x) }\n" #[12] "# space between ) {\n" #[13] "a4 <- function(x) { sin(x) }\n" #[14] "# tab between ) {\n" #[15] "a5 <- function(x)\t{ sin(x) }\n" #[16] "# no param\n" #[17] "a6 <- function(){ 1+2 }\n" #[18] "# space between round bracket\n" #[19] "a7 <- function( ){ 1+2 }\n" #[20] "# space between round bracket and comment\n" #[21] "a8 <- function( ){ 1+2 }\t# comment a8\n" #[22] "# no curly brackets if a one line function\n" #[23] "a9 <- function(x) max(x)*2 - min(x) + ab/ac\t\t# comment a9\n" #[24] "\n" #[25] "\n" #[26] "# parameter in one line and {\n" #[27] "ab1 <- function(x, y, z=c(1,2,3)){\n\t# ab1\n\taa <- x*y*z\n\taa\n}\n" #[28] "# parameter in one line and spaces ) ) { and tab comment\n" #[29] "ab2 <- function(x, y, z=c(1,2,3) ) {\t# comment0\n\t# ab2\n\taa <- x*y*z\n\taa\n}\n" #[30] "# only parameter in one line and { new line\n" #[31] "ab3 <- function(x, y, z)\t# ab3\n{\n\taa <- x*y*z\n\taa\n}\n" #[32] "\n" #[33] "\n" #[34] "# parameter on many lines\n" #[35] "b1 <- function(x,\n\ty,\n\tz=c(1,2,3)){\n\t# b1\n\taa <- x*y*z\n\taa\n}\n" #[36] "# parameter on many lines + comment + space )) {\n" #[37] "b2 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)) {\n\t# b2\n\taa <- x*y*z\n\taa\n}\n" #[38] "# parameter on many lines + comment also after curly bracket\n" #[39] "b3 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)){\t# comment2\n\t# b3\n\taa <- x*y*z\n\taa\n}\n" #[40] "# parameter on many lines + comment + curly bracket next line\n" #[41] "b4 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3))\n{\n\t# b4\n\taa <- x*y*z\n\taa\n}\n" #[42] "# parameter on many lines + comment + )space) + curly bracket next line\n" #[43] "b5 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3) )\n{\n\t# b5\n\taa <- x*y*z\n\taa\n}\n" #[44] "# parameter on many lines + comment + round and curly bracket next lines\n" #[45] "b6 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)\t# comment2\n\t)\n{\n\t# b6\n\taa <- x*y*z\n\taa\n}\n" #[46] "# parameter on many lines + x next line + comment + round and curly bracket next lines\n" #[47] "b7 <- function(\n\tx,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)\t# comment2\n\t)\n{\n\t# b7\n\taa <- x*y*z\n\taa\n}\n" #[48] "# parameter on many lines + x next line + comment + round and curly bracket next lines + no comment after {\n" #[49] "b8 <- function(\n\t\tx,\t# comment0\n\t\ty,\t\t# comment1\n\t\tz=c(1,2,3)\t# comment2\n)\n{\n\taa <- x*y*z\n\taa\n}\n" #[50] "# parameter on many lines + x next line + comment + round and curly bracket next lines + no comment after { + for loop /w {} inside body\n" #[51] "b9 <- function(\n\t\tx,\t# comment0\n\t\ty,\t\t# comment1\n\t\tz=c(1,2,3)\t# comment2\n)\n{\n\taa <- x*y*z\n\tfor(i in 1:10){\n\t\tbb <- 1+i\n\t}\n\taa\n}\n" #[52] "\n" #[53] "\n" #[54] "\n" #[55] "\n" #[56] "\n" #[57] "\n" #[58] "\n" # work & test a <- index.E2(spath="/home/korschi/on3/eclipseR/xinwei", opath=NULL, recursively=T) index.E2(spath="/home/korschi/on3/eclipseR/xinwei", opath="/home/korschi/on3/eclipseR/index.txt", recursively=T) # af <- file("/home/korschi/on3/eclipseR/xinwei/0snippets.R", "r") a2 <- parse_all(af) close(af) lengths(a2$expr) # special function for list elements length (no: 0, some:1) regexpr("function[ ]{0,3}\\(", "a \t <- function (a=n, b=u) { hj\n kk\n } #gg", perl=T) regexpr("function[ ]{0,3}\\(", "a \t <- sdf (a=n, b=u) { hj\n kk\n } #gg", perl=T) unlist(a[[1]]) names(a[[1]]) a <- index.E2(spath="/home/korschi/on3/eclipseR/0functions/0", opath="/home/korschi/on3/eclipseR/index.txt", recursively=T) ## further details # w/o \t\n removal # #a1 <- function(x){ sin(x) }\t\t#comment a1\n #a2 <- function(x){ sin(x) } \t\n #a3 <- function(x){ sin(x) }\n #a4 <- function(x) { sin(x) }\n #a5 <- function(x)\t{ sin(x) }\n #a6 <- function(){ 1+2 }\n #a7 <- function( ){ 1+2 }\n #a8 <- function( ){ 1+2 }\t# comment a8\n #a9 <- function(x) max(x)*2 - min(x) + ab/ac\t\t# comment a9\n #ab1 <- function(x, y, z=c(1,2,3)){\n\t# comment ab1\n\taa <- x*y*z\n\taa\n}\n #ab2 <- function(x, y, z=c(1,2,3) ) {\t# comment 1 ab2\n\t# comment 2 ab2\n\taa <- x*y*z\n\taa\n}\n #ab3 <- function(x, y, z)\t# alternate comment\n{\n\taa <- x*y*z\n\taa\n}\n #b1 <- function(x,\n\ty,\n\tz=c(1,2,3)){\n\t# comment b1\n\taa <- x*y*z\n\taa\n}\n #b2 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)) {\n\t# comment b2\n\taa <- x*y*z\n\taa\n}\n #b3 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)){\t# comment 1 b2\n\t# comment 2 b3\n\taa <- x*y*z\n\taa\n}\n #b4 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3))\n{\n\t# comment b4\n\taa <- x*y*z\n\taa\n}\n #b5 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3) )\n{\n\t# comment b5\n\taa <- x*y*z\n\taa\n}\n #b6 <- function(x,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)\t# comment2\n\t)\n{\n\t# comment b6\n\taa <- x*y*z\n\taa\n}\n #b7 <- function(\n\tx,\t# comment0\n\ty,\t\t# comment1\n\tz=c(1,2,3)\t# comment2\n\t)\n{\n\t# comment b7\n\taa <- x*y*z\n\taa\n}\n #b8 <- function(\n\t\tx,\t# comment0\n\t\ty,\t\t# comment1\n\t\tz=c(1,2,3)\t# comment2\n)\n{\n\taa <- x*y*z\n\taa\n}\n #b9 <- function(\n\t\tx,\t# comment0\n\t\ty,\t\t# comment1\n\t\tz=c(1,2,3)\t# comment2\n)\n{\n\taa <- x*y*z\n\tfor(i in 1:10){\n\t\tbb <- 1+i\n\t}\n\taa\n}\n #c1 <- function(\n\t\tx,\t# comment0\n\t\ty,\t\t# comment1\n\t\tz=c(1,2,3)\t# comment2\n)\n{\n\tf1 <- function(x) { x/2 }\t# embedded function one line\n\tf2 <- function(x,y){\t# embedded function multiple lines\n\t\tz <- x+y\n\t}\n\tz1 <- apply(x, 2, function(x){ x-x })\t# embedded anonymous function\n\taa <- x*y*z\n\tfor(i in 1:10){\n\t\tbb <- 1+i\n\t}\n\taa\n}\n # w/ \t\n removal # #a1 <- function(x){ sin(x) }#comment a1 #a2 <- function(x){ sin(x) } #a3 <- function(x){ sin(x) } #a4 <- function(x) { sin(x) } #a5 <- function(x){ sin(x) } #a6 <- function(){ 1+2 } #a7 <- function( ){ 1+2 } #a8 <- function( ){ 1+2 }# comment a8 #a9 <- function(x) max(x)*2 - min(x) + ab/ac# comment a9 #ab1 <- function(x, y, z=c(1,2,3)){# comment ab1aa <- x*y*zaa} #ab2 <- function(x, y, z=c(1,2,3) ) {# comment 1 ab2# comment 2 ab2aa <- x*y*zaa} #ab3 <- function(x, y, z)# alternate comment{aa <- x*y*zaa} #b1 <- function(x,y,z=c(1,2,3)){# comment b1aa <- x*y*zaa} #b2 <- function(x,# comment0y,# comment1z=c(1,2,3)) {# comment b2aa <- x*y*zaa} #b3 <- function(x,# comment0y,# comment1z=c(1,2,3)){# comment 1 b2# comment 2 b3aa <- x*y*zaa} #b4 <- function(x,# comment0y,# comment1z=c(1,2,3)){# comment b4aa <- x*y*zaa} #b5 <- function(x,# comment0y,# comment1z=c(1,2,3) ){# comment b5aa <- x*y*zaa} #b6 <- function(x,# comment0y,# comment1z=c(1,2,3)# comment2){# comment b6aa <- x*y*zaa} #b7 <- function(x,# comment0y,# comment1z=c(1,2,3)# comment2){# comment b7aa <- x*y*zaa} #b8 <- function(x,# comment0y,# comment1z=c(1,2,3)# comment2){aa <- x*y*zaa} #b9 <- function(x,# comment0y,# comment1z=c(1,2,3)# comment2){aa <- x*y*zfor(i in 1:10){bb <- 1+i}aa} #c1 <- function(x,# comment0y,# comment1z=c(1,2,3)# comment2){f1 <- function(x) { x/2 }# embedded function one linef2 <- function(x,y){# embedded function multiple linesz <- x+y}z1 <- apply(x, 2, function(x){ x-x })# embedded anonymous functionaa <- x*y*zfor(i in 1:10){bb <- 1+i}aa} a <- index.E2(spath="/home/korschi/on3/eclipseR/0functions/fn_index/test", opath=NULL, recursively=T) a1 <- "a1 <- function(x, y){# comm sin(x); a <- 0 } # comment a1" # ? non greedy regexpr("^.+(?=<-)", a1, perl=T)[1] regexpr("(?<=function[ ]{0,3}\\()(.*?)(?=\\))", a1, perl=T)[1] regexpr("(?<=\\{[ \\n\\t]{0,5}#)(.*)(?=\\n)", a1, perl=T)[1] regexpr("(?<=[ ]{0,2}<-[ ]{0,3}function[ ]{0,3}\\()(.*?)", a1, perl=T)[1] regmatches(a1, regexpr("^.+?(?=<-)", a1, perl=T)) # function name regmatches(a1, regexpr("(?<=function[ ]{0,3}\\()(.*?)(?=\\))", a1, perl=T)) # function arguments regmatches(a1, regexpr("(?<=\\{[ \\n\\t]{0,5}#)(.*)(?=\\n)", a1, perl=T)) # first commentary line regmatches(a1, regexpr("(?<=[ ]{0,2}<-[ ]{0,3}function[ ]{0,3}\\()(.*)", a1, perl=T)) # function arguments gsub(pattern="\\n", replacement="", x=a1) gsub(pattern="\\t", replacement="", x=a1) regmatches(a1, regexpr("(?<=\\{[ ]{0,3}#)(.+)", a1, perl=T)) # first commentary line regmatches(a1, regexpr("(?<=\\{[ ]{0,3}#).*", a1, perl=T)) # first commentary line regmatches(a1, regexpr("(?<=\\{[ ]{0,2}#[ ]{0,1})([^ ]+)", a1, perl=T)) # first commentary line(?=[ ]*) # (?:^.*?#[ ]{0,2})(.*?)\\n # final tests index.E2(spath="/home/korschi/on3/eclipseR", opath="/home/korschi/on3/eclipseR/0functions/fn_index/index/index_20260521.txt", recursively=T) a <- index.E2(spath="/home/korschi/on3/eclipseR", opath=NULL, recursively=T) # number of filled lines = 24124 # number of elements = 1166 -- check all hits a1 <- index.E2.search(search="perm", x=a) save.image()