Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Incorporate reasonable changes to some of the R files within R/ #38

Merged
merged 12 commits into from
Jul 7, 2021
Merged

Incorporate reasonable changes to some of the R files within R/ #38

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
ec07a2a
Fix typo in comment
Anirban166 Jun 10, 2021
9160e91
Changed the working directory inside doc.R so as to suitably run dldo…
Anirban166 Jun 10, 2021
0ff30e4
Add an informative message for the error related to wrong set up of w…
Anirban166 Jun 11, 2021
9e727aa
Remove the setwd() call to set working directory to docs
Anirban166 Jun 14, 2021
9c70572
Remove remaining setwd calls (needs fixes)
Anirban166 Jun 29, 2021
7161c14
Fix docdirs file path error (cannot open the connection in file(con, r))
Anirban166 Jul 2, 2021
d0ba98f
Fix errors with setwd(docs) removal (dldoc works like before)
Anirban166 Jul 6, 2021
0715166
Remove the 2nd setwd() call
Anirban166 Jul 6, 2021
60b6e08
Remove unnecessary indentation before ### in R/doc.R
Anirban166 Jul 6, 2021
2285c65
Revert back unwanted whitespace changes
Anirban166 Jul 6, 2021
dbc4c8d
Revert unwanted whitespace changes
Anirban166 Jul 6, 2021
b4782d9
Bring back the setwd() call inside on.exit()
Anirban166 Jul 7, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion R/doc.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,9 @@ dldoc <- function # Make directlabels documentation
version <- read.dcf("DESCRIPTION")[,"Version"]
git.line <- system('git log -1 --pretty=format:"%h %aD"', intern=TRUE)
foot.info <- list(version=version,git=as.character(git.line))
setwd(file.path("..","..","www","docs"))
tryCatch(setwd(file.path("docs")), error = function(e) {
message("Documentation cannot be generated because no 'docs' directory is found. (i.e., 'docs' %in% dir(getwd()) must be FALSE)")
cat('Please ensure that the "docs" folder is present in your current working directory, which is: "', getwd(), '"\n')})
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

error would be better than message

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

also it would be better to remove the setwd calls, because that can be surprising for the user. can you please refactor and remove setwd?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

do you mean the use of stop()? or to just throw an error and not use any message? (error = function(e) NULL )

I went with a message because of the 2nd point you mentioned here

This would look like:
image

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, I can remove setwd() (guess we won't need this tryCatch then) but then just appending the file path (just docs/, as required in our gh-pages branch) to wherever its required would do the job right?
(for e.g. the very next line will then be foot <- filltemplate(foot.info,"docs/templates/foot.html")?)

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

yes stop() with an error.
yes append file path instead of setwd.

Copy link
Collaborator Author

@Anirban166 Anirban166 Jun 29, 2021 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For context, I have two versions of directlabels locally: One is with the current gh-pages branch on D: (where I test dldoc)
and the other is my master branch with this PR's changes on E: (from where I install dldoc by source)

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't know. Can you please debug? what file is it? insert print() and browser() statements?

Copy link
Collaborator Author

@Anirban166 Anirban166 Jun 29, 2021 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure, and sorry for not doing so earlier - debugging otw!
image
For the previous error, the docdirs variable (which would be the list of strings of the names of different plot type directories under tests/doc) was empty as because I forgot to append the file path to it

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hi @tdhock is it okay if I just keep the first setwd() call? (removed the other two, and dldoc works like usual up till this point)
It is really convenient, and I mean otherwise I'm just editing the file paths but due to that single removal, a lot of places are affected and it gets a bit hard to debug, for e.g. the one that I showed above was possibly occuring because the tests/doc/lineplot/lars.R file couldn't access the Rdata file (called via extract.plot). This was what the last version (modified a week back) looked like:

dldoc <- function # Make directlabels documentation
### Positioning Methods for direct labels are supposed to work with
### only certain plot types. Each Positioning Method is defined in
### R/file.R and plot examples are found in tests/doc/file/*.R so that
### we can automatically assemble a database of example plots from the
### code.
(pkgdir=".."
 ### Package directory root.
){
  #odir <- setwd(pkgdir)
  #on.exit(setwd(odir))
  docdir <- file.path(pkgdir,"tests","doc")
  docdirs <- dir(docdir)
  plotfiles <- sapply(docdirs,function(d)Sys.glob(file.path(docdir,d,"*.R")))
  Rfiles <- paste(file.path(pkgdir,"R",docdirs),".R",sep="")
  posfuns <- lapply(Rfiles,extract.posfun)
  names(posfuns) <- docdirs
  plots <- lapply(plotfiles,lapply,extract.plot)
  browser()
  ## add crosslinks between positioning method
  repfuns <- apply(cbind(lapply(posfuns,names),names(posfuns)),1,function(L){
    REP <- paste('<a href="../../',L[[2]],
                 '/posfuns/\\1.html">\\1</a>',sep='')
    function(def,ignore){
      items <- L[[1]][L[[1]]!=ignore]
      if(length(items)){
        ## at the end: [.<] means do not find tags twice, when some
        ## function names are subsets of others
        grp <- paste(sub("[.]","[.]",items),collapse="|")
        FIND <- paste("\\b(",grp,")\\b(?![.<])",sep="")
        gsub(FIND,REP,def,perl=TRUE)
      }else def
    }
  })
  repall <- function(def,ignore){
    for(f in repfuns)def <- f(def,ignore)
    def
  }
  posfuns <- lapply(posfuns,function(L)lapply(L,function(LL){
    LL$definition <- repall(LL$definition,LL$name)
    LL
  }))

  ## matrix of all extracted data to process
  m <- cbind(plots,posfuns,type=names(plots))

  makerd <- function # Make Rd positioning method description
  (L
   ## List of posfuns and plots to match up
  ){

    plotcodes <- paste("{\n",sapply(L$plots,"[[","code"),"\n}",sep="",collapse=",\n")
    forloop <- paste("\nfor(p in list(",plotcodes,"))",sep="")
    dlines <- paste(paste('print(direct.label(p,"',
                  names(L$posfuns),'"))',sep=""),collapse="\n  ")
    sprintf("### %s Positioning Methods%s{\n  %s\n}\n",L$type,forloop,dlines)
  }
  rd <- apply(m[rownames(m)!="utility.function",],1,makerd)
  rd <- c("\n\\dontrun{",rd,"}")
  pf.file <- file.path(pkgdir,"man","positioning.functions.Rd")
  pflines <- readLines(pf.file)
  exline <- grep("\\\\examples[{]",pflines)[1]
  newrd <- paste(paste(pflines[1:exline],collapse="\n"),
                 paste(rd,collapse="\n"),"\n}",sep="")
  write(newrd,pf.file)

  ## escape plot definitions for html
  for(i in 1:nrow(m))if(length(m[i,]$plots))for(j in seq_along(m[i,]$plots)){
    m[i,]$plots[[j]]$code <- rhtmlescape(m[i,]$plots[[j]]$code)
  }
  ggplot2::theme_set(ggplot2::theme_grey())

  version <- read.dcf("DESCRIPTION")[,"Version"]
  git.line <- system('git log -1 --pretty=format:"%h %aD"', intern=TRUE)
  foot.info <- list(version=version,git=as.character(git.line))
  foot <- filltemplate(foot.info,file.path(pkgdir,"docs/templates/foot.html"))
  makehtml <- function # Make HTML documentation
  ## Make plots and HTML for documentation website.
  (L
   ## List of positioning method and plots to match up.
  ){
    ## all paths are relative to the docs directory
    subdir <- file.path(pkgdir,"docs",L$type)
    pngurls <- matrix("",nrow=length(L$posfuns),ncol=length(L$plots),
                      dimnames=list(names(L$posfuns),
                                    sapply(L$plots,function(x)x$name)))
    ## first make plots
    datanames <- names(L)[sapply(L,class)=="list"]
    tomake <- file.path(subdir,c("",datanames))
    for(d in tomake)
      if(!file.exists(d))dir.create(d,recursive=TRUE)
    for(p in L$plots){
      cat(p$name,":",sep="")
      for(f in L$posfuns){
        pngfile <- file.path(subdir,paste(p$name,f$name,"png",sep="."))
        pngurls[f$name,p$name] <- pngfile
        if(!file.exists(pngfile)){
          cat(" ",f$name,sep="")
          png(pngfile)
          set.seed(1)
          tryCatch({
            print(direct.label(p$plot,f$fun))
          },error=function(e){
            l <- capture.output(print(e$call))
            grid.text(sprintf("ERROR\n%s\n%s",l,e$message))
          })
          dev.off()
        }
        thumbfile <- file.path(subdir,paste(p$name,f$name,"thumb.png",sep="."))
        if(!file.exists(thumbfile)){
          cmd <- paste("convert -geometry 64x64",pngfile,thumbfile)
          cat("*")
          system(cmd)
        }
      }
      cat("\n")
    }
    ## now make html for plot examples
    makepage <- function(item,items,row,main){
      if(length(items)){
        tmp <- lapply(items,function(f){
          pngurl <- if("fun"%in%names(f))pngurls[f$name,item$name]
          else pngurls[item$name,f$name]
          c(f,pngurl=file.path("..","..",pngurl),
            parname=item$name,
            url=file.path("..",row,paste(f$name,".html",sep="")))
        })
        rowfile <- paste(pkgdir,"docs/templates/",row,"-row.html",sep="")
        rowhtml <- sapply(tmp,filltemplate,rowfile)
        item$table <- paste(c("<table>",rowhtml,"</table>"),collapse="\n")
      }
      item$type <- L$type
      item$pagetitle <- item$name
      item$head <- filltemplate(item,file.path(pkgdir,"docs/templates/head.html"))
      item$foot <- foot
      html <- filltemplate(item,paste(pkgdir,"docs/templates/",main,".html",sep=""))
      write(html,file.path(subdir,main,paste(item$name,".html",sep="")))
      item
    }
    res <- list()
    for(i in seq_along(datanames)){
      this <- datanames[i]
      that <- datanames[-i]
      res[[this]] <- lapply(L[[this]],makepage,L[[that]],that,this)
    }
    res
  }
  res <- apply(m,1,makehtml)
  extract.links <- function(L){
    sapply(names(L),function(N)if(N=="type")L[[N]] else {
      coll <- if(N=="posfuns")"<br />" else ""
      x <- sapply(L[[N]],function(x)x$name)
      content <- if(N=="plots"){
        ann <- paste(x,L$posfuns[[1]]$name,sep=".")
        paste('<img alt="',ann,'" src="',L$type,
              "/",ann,".thumb.png",'" />',sep="")
      } else x
      if(length(x))
        paste(paste("<a href=\"",L$type,"/",N,"/",x,".html\">",content,"</a>",
                    sep=""),collapse=paste("\n",coll,"\n",sep=""))
      else x
    },simplify=FALSE)
  }
  links <- apply(m,1,extract.links)
  tmp <- list(head=filltemplate(list(pagetitle="home"),file.path(pkgdir,"docs/templates/head.html")),
              foot=foot)
  rows <- lapply(links,filltemplate,file.path(pkgdir,"docs/templates/index-row.html"))
  tmp$table <- paste(rows,collapse="\n")
  html <- filltemplate(tmp,file.path(pkgdir,"docs/templates/index.html"))
  write(html,file.path(pkgdir,"docs/index.html"))

  m
  ### Matrix of lists describing example plots and matching builtin
  ### Positioning Methods.
}

extract.posfun <- function # Extract Positioning Method for documentation
### Use inlinedocs to extract comments and definitions from code, then
### for each item found add the value and its name to the list.
(f
 ### R code file, which should contain only Positioning Methods that
 ### can be used with examples defined in the doc/ subdirectory with
 ### the same name.
){
  L <- inlinedocs::extract.docs.file(f)
  e <- new.env()
  sys.source(f,e)
  for(N in names(L)){
    L[[N]]$fun <- e[[N]]
    L[[N]]$name <- N
    L[[N]]$definition <- rhtmlescape(L[[N]]$definition)
  }
  ## sort by big names first, since doc system find/replace gives bugs
  ## otherwise if one function's name is a substring of another's!
  ##L <- L[order(nchar(names(L)),decreasing=TRUE)]
  L
  ### List of lists, each of which describes one Positioning Method
  ### defined in f.
}

extract.plot <- function # Extract plot and definition for documentation
### Given an R code file, execute it, store the definition, and save
### the resulting plot in a variable.
(f
 ### R code file with plot example.
){
  require(directlabels)
  code <- readLines(f)
  i <- max(grep("^\\w",code))
  code[i] <- paste("p <-",code[i])
  writeLines(code,tf <- tempfile())
  e <- new.env()
  sys.source(tf,e)
  ##code <- rhtmlescape(code)
  list(code=paste(code,collapse="\n"),
       plot=e$p,
       name=sub(".R$","",basename(f)))
}

rhtmlescape <- function
### for standards compliance we should escape <>&
(code
 ### R code to be displayed on a HTML page between pre tags.
){
  code <- gsub("[&]","&amp;",code)
  code <- gsub("[<]","&lt;",code)
  code <- gsub("[>]","&gt;",code)
  ### Standards compliant HTML to display.
}

filltemplate <- function
### Fill in occurances of OBJ$item in the file template with the value
### in R of L$item.
(L,template){
  txt <- paste(readLines(template),collapse="\n")
  L <- L[sapply(L,class)=="character"&sapply(L,length)>0]
  locs <- gregexpr("OBJ[$]([a-z]+)\\b",txt)[[1]]
  keywords <- sapply(seq_along(locs),function(i)
    substr(txt,locs[i]+4,locs[i]+
             attr(locs,"match.length")[i]-1))
  FIND <- sapply(keywords,function(x)paste("OBJ[$]",x,sep=""))
  REP <- unlist(ifelse(keywords%in%names(L),L[keywords],""))
  for(i in seq_along(FIND)){
    txt <- gsub(FIND[i],REP[i],txt)
  }
  txt
}

Sorry this took long, I was out of commission for a few days following the aftermath from my vaccination shot (right arm was completely sore and my body felt weak) and I couldn't do any GSoC work :(

If it is okay, could you please merge this for now? (Also #41 )
I want to start work on the third point now, and I'll give this a re-visit later (also the 2nd workflow is done with the changes, but need to modify dldoc before I push that onto master)

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ok that is fine to keep a setwd for now but it would be good to remove them eventually.

foot <- filltemplate(foot.info,"templates/foot.html")
makehtml <- function # Make HTML documentation
## Make plots and HTML for documentation website.
Expand Down
4 changes: 2 additions & 2 deletions R/positioning.functions.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,7 @@ dlgrob <- function
axes2native=identity,
...
){
## increment dlgrob.id to get a unique name because as explaine on
## increment dlgrob.id to get a unique name because as explained on
## ?grid::gTree "Grob names need not be unique in general, but all
## children of a gTree must have different names."
dl.env$dlgrob.id <- dl.env$dlgrob.id+1L
Expand Down Expand Up @@ -147,7 +147,7 @@ direct.label <- structure(function # Direct labels for color decoding
print(direct.label(ratplot))
## To put them on the same side, just manually specify the
## Positioning Method.
print(direct.label(ratplot,"last.qp"))
Anirban166 marked this conversation as resolved.
Show resolved Hide resolved
print(direct.label(ratplot,"last.qp"))

lattice.options(oldopt)
})
Expand Down