First commit

DESCRIPTION

@@ -15,7 +15,7 @@ License: GPL-2
 Encoding: UTF-8
 URL: https://github.com/GSK-Biostatistics/hassediagram
 BugReports: https://github.com/GSK-Biostatistics/hassediagram/issues
-Imports: igraph, methods, MASS, grDevices, graphics, stats, showtext, sysfonts
+Imports: igraph, methods, MASS, grDevices, graphics, stats
 Depends: R (>= 3.5.0)
 Suggests: 
     dae,

R/hasselayout.R

@@ -15,7 +15,7 @@
 #' @param pdf logical. If "Y" then a pdf file containing the Hasse diagram of the layout structure is generated. The default is "N", i.e., a pdf file is not generated.
 #' @param example File name for the pdf output file containing the Hasse diagram. The default is set to "example".
 #' @param outdir Location of the pdf output file if \code{pdf="Y"}. The default is set to \code{NULL} and in this case the pdf output file containing the Hasse diagram will be stored in the working directory of the user's R session.
-#' @param hasse.font The name of the font family used for all text included in the Hasse diagram. Standard and safe font families to choose are "sans", "serif", and "mono". If the design's factor labels contain Unicode characters, or for consistency with Hasse diagrams of restricted layout structures using \link[hassediagram]{hasserls}, the "noto" font family should be selected. The default is "sans".
+#' @param hasse.font The name of the font family used for all text included in the Hasse diagram. Standard and safe font families to choose are "sans", "serif", and "mono". If the design's factor labels contain Unicode characters, or for consistency with Hasse diagrams of restricted layout structures using \link[hassediagram]{hasserls}, a Unicode friendly font family should be selected. For more details on Unicode friendly family options see the Details section in the \link[hassediagram]{hasserls} documentation. The default is "sans".
 #' @param produceBWPlot logical. If "Y" then the Hasse diagram will be generated in black and white format. The default is set to "N", i.e., a coloured version of the plot is produced.
 #' @param structural.colour The colour of the structural lines that connect structural objects on the Hasse diagram. The default colour is "grey".
 #' @param structural.width The width of the structural lines on the Hasse diagram. The default width is 2.
@@ -167,8 +167,8 @@ hasselayout <- function(datadesign,
                         middle.fontlabelmultiplier = 1,   
                         smaller.fontlabelmultiplier = 1) {
 
-  if (!(hasse.font %in% c("sans", "serif", "mono", "noto"))) {
-    warning("hasse.font is safe to be used for 'sans', 'serif', 'mono', and 'noto' fonts. \nYour selected font is not in that list, which may lead to potential errors.")
+  if (!(hasse.font %in% c("sans", "serif", "mono"))) {
+    warning("hasse.font is safe to be used for 'sans', 'serif', and 'mono'. \nYour selected font is not in that list, which may lead to potential errors.")
   }
 
   if (showpartialLS=="Y" || showdfLS=="Y") showLS<-"Y"
@@ -772,7 +772,7 @@ hasselayout <- function(datadesign,
     dscoords <- dscoords.fun("LS", finaleffects, ceffects.table.final.brief, larger.fontlabelmultiplier, smaller.fontlabelmultiplier, middle.fontlabelmultiplier)  
     g$layout <- dscoords$coords
 
-    vertex.label.family <- hasse.font  
+    font_used <- hasse.font  
     vertex.label.font <- rep(2,length(colnames(adjm.reverse)))
     vertex.label.color.objects <- c(rep(objects.colour,length(colnames(adjm.reverse))-3),"transparent",objects.colour,"transparent")
     vertex.label.color.black <- c(rep("black",length(colnames(adjm.reverse))-3),"transparent","black","transparent")
@@ -801,7 +801,14 @@ hasselayout <- function(datadesign,
     edge.color[g2a.edges %in% node.dumg]<-"transparent"
     par(mar=c((2*(max(larger.fontlabelmultiplier,smaller.fontlabelmultiplier)-1)+1)*0.8, (5*(max(larger.fontlabelmultiplier,smaller.fontlabelmultiplier)-1)+1)*0.4, 0.2, (5*(max(larger.fontlabelmultiplier,smaller.fontlabelmultiplier)-1)+1)*0.4)) 
 
-    plot(g2a, asp=FALSE, add=F,vertex.label.color=vertex.label.color.black, vertex.label.cex=dscoords$textlabel.size,vertex.label.font=vertex.label.font, vertex.label.degree=pi/2, vertex.label.dist=0.6, vertex.size=5, vertex.color="transparent", vertex.shape="circle", vertex.frame.color="white", edge.color=edge.color, edge.width = edgewidth, vertex.label.family=vertex.label.family)
+    tryCatch({
+      plot(g2a, asp=FALSE, add=F,vertex.label.color=vertex.label.color.black, vertex.label.cex=dscoords$textlabel.size,vertex.label.font=vertex.label.font, vertex.label.degree=pi/2, vertex.label.dist=0.6, vertex.size=5, vertex.color="transparent", vertex.shape="circle", vertex.frame.color="white", edge.color=edge.color, edge.width = edgewidth, vertex.label.family=font_used)
+    }, error = function(e) {
+      message("The font selected in hasse.font is not available in the system's fonts and rendering failed. See the Details section for more information on fonts. The hasse.font is set to 'sans' instead.")
+      font_used <<- "sans"
+      plot(g2a, asp=FALSE, add=F,vertex.label.color=vertex.label.color.black, vertex.label.cex=dscoords$textlabel.size,vertex.label.font=vertex.label.font, vertex.label.degree=pi/2, vertex.label.dist=0.6, vertex.size=5, vertex.color="transparent", vertex.shape="circle", vertex.frame.color="white", edge.color=edge.color, edge.width = edgewidth, vertex.label.family=font_used)
+    })
+
 
     if (showpartialLS=="Y") {
       adjm3 <- matrix(0,nrow=nrow(adjm),ncol=ncol(adjm),dimnames=dimnames(adjm))
@@ -832,18 +839,18 @@ hasselayout <- function(datadesign,
 
       g3$layout <- dscoords$coords
 
-      plot(g3, asp=FALSE, add=TRUE, vertex.label.color="transparent",vertex.label.cex=dscoords$textlabel.size, vertex.label.font=vertex.label.font, vertex.size=0, vertex.color="transparent", vertex.frame.color="transparent",  edge.label.color=Colourred, edge.label.font=2, edge.color=partial.colour,edge.lty=dottedline, edge.width = partial.width, vertex.label.family=vertex.label.family)
+      plot(g3, asp=FALSE, add=TRUE, vertex.label.color="transparent",vertex.label.cex=dscoords$textlabel.size, vertex.label.font=vertex.label.font, vertex.size=0, vertex.color="transparent", vertex.frame.color="transparent",  edge.label.color=Colourred, edge.label.font=2, edge.color=partial.colour,edge.lty=dottedline, edge.width = partial.width, vertex.label.family=font_used)
     }
 
-    plot(g, asp=FALSE, add=T,vertex.label.color=vertex.label.color.objects, vertex.label.cex=dscoords$textlabel.size,vertex.label.font=vertex.label.font, vertex.size=0, vertex.color="transparent", vertex.frame.color="transparent", vertex.shape="circle", edge.lty=0, edge.width = edgewidth, vertex.label.family=vertex.label.family)
+    plot(g, asp=FALSE, add=T,vertex.label.color=vertex.label.color.objects, vertex.label.cex=dscoords$textlabel.size,vertex.label.font=vertex.label.font, vertex.size=0, vertex.color="transparent", vertex.frame.color="transparent", vertex.shape="circle", edge.lty=0, edge.width = edgewidth, vertex.label.family=font_used)
   }
 
   if (showdfLS=="Y") {
     LS.output <- dfs.fun("LS", noall, finaleffects, ceffects.table.final.brief, adjm, outputlistip1, maxfacs, maxlevels.df, check.confound.df, datadesign)
     g4 <- g
 
     V(g4)$label <- paste(sep="", "[",LS.output$xdfs.reverse[ ,3],LS.output$maxlevelsf.reverse[ ],",",LS.output$xdfs.reverse[ ,4],"]")
-    plot(g4, asp=FALSE, add=T,vertex.label.color=vertex.label.color.df, vertex.label.cex=dscoords$textlabel.size.df, vertex.label.font=vertex.label.font, vertex.label.degree=pi/2, vertex.label.dist=(1*(max(larger.fontlabelmultiplier,smaller.fontlabelmultiplier)-1)+1)*1,vertex.size=0, vertex.color="transparent", vertex.frame.color="transparent", vertex.shape="circle", edge.lty=0, edge.width = edgewidth, vertex.label.family=vertex.label.family)
+    plot(g4, asp=FALSE, add=T,vertex.label.color=vertex.label.color.df, vertex.label.cex=dscoords$textlabel.size.df, vertex.label.font=vertex.label.font, vertex.label.degree=pi/2, vertex.label.dist=(1*(max(larger.fontlabelmultiplier,smaller.fontlabelmultiplier)-1)+1)*1,vertex.size=0, vertex.color="transparent", vertex.frame.color="transparent", vertex.shape="circle", edge.lty=0, edge.width = edgewidth, vertex.label.family=font_used)
     LS.output$xdfs
   }