@sjcrh/proteinpaint-server 2.87.1 → 2.88.1

package/utils/regression.utils.R

@@ -515,20 +515,22 @@ plot_spline <- function(splineVariable, dat, outcome, res, regtype, formulatype,
   preddat_ci_adj <- preddat_ci + sum(apply(newdat2, 1, prod), na.rm = T)
   
   # plot data
-  plotfile <- paste0(cachedir, "splinePlot_", ifelse(is.null(formulatype), "", paste0(formulatype, "_")), createRandString(), ".png")
-  png(filename = plotfile, width = 950, height = 550, res = 200)
-  par(mar = c(3, 2.5, 1, 5) + 0.1, mgp = c(0.5, 0.5, 0), xpd = T)
+  plotfile <- paste0(cachedir, "splinePlot_", ifelse(is.null(formulatype), "", paste0(formulatype, "_")), createRandString(), ".svg")
+  svg(filename = plotfile, width = 6.7, height = ifelse(is.null(formulatype),5.25,5.35), pointsize = 20)
+  par(mar = c(2, 2, ifelse(is.null(formulatype),0.7,1), 5) + 0.1, mgp = c(1, 1, 0))
   if (regtype == "linear" | regtype == "logistic") {
     if (regtype == "linear") {
       # for linear, plot predicted values
       pointtype <- 16
       pointsize <- 0.3
+      pointalpha <- 0.8
       ylab <- outcome$name
     } else {
       # for logistic, plot predicted probabilities
       preddat_ci_adj <- 1/(1+exp(-preddat_ci_adj))
       pointtype <- 124
       pointsize <- 0.7
+      pointalpha <- 0.5
       ylab <- paste0("Pr(", outcome$name, " ", outcome$categories$nonref, ")")
     }
     # use only finite predicted data
@@ -539,14 +541,16 @@ plot_spline <- function(splineVariable, dat, outcome, res, regtype, formulatype,
     # predicted data will be overlayed later
     plot(dat[,splineVariable$id],
          dat[,outcome$id],
-         cex.axis = 0.5,
          ann = F,
+         xaxt = "n",
+         yaxt = "n",
          type = "n"
     )
     points(dat[,splineVariable$id],
            dat[,outcome$id],
            pch = pointtype,
-           cex = pointsize
+           cex = pointsize,
+           col = adjustcolor("#ce768e", alpha.f = pointalpha)
     )
   } else if (regtype == "cox") {
     # for cox, plot hazard ratios
@@ -555,39 +559,40 @@ plot_spline <- function(splineVariable, dat, outcome, res, regtype, formulatype,
     toKeep <- rowSums(!is.finite(preddat_ci_adj)) == 0
     preddat_ci_adj <- preddat_ci_adj[toKeep,]
     newdat <- newdat[toKeep,,drop = F]
-    pointtype <- 16
-    pointsize <- 0.3
     ylab <- "Hazard Ratio"
     # plot only predicted data
     # do not also plot actual data (like for linear/logistic) because cox outcome data is time-to-event and will not be comparable to the predicted hazard ratios
     plot(newdat[,splineVariable$id],
          preddat_ci_adj[,"fit"],
          ylim = c(min(preddat_ci_adj[,"lwr"]), max(preddat_ci_adj[,"upr"])),
-         cex.axis = 0.5,
          ann = F,
+         xaxt = "n",
+         yaxt = "n",
          type = "n"
     )
   } else {
     stop("unrecognized regression type")
   }
   
+  # axes
+  axis(1, cex.axis = 0.5, mgp = c(0, 0.2, 0))
+  axis(2, cex.axis = 0.5, mgp = c(0, 0.5, 0))
+
   # titles
-  if (is.null(formulatype)) title <- NULL
-  else if (formulatype == "univariate") title <- "Univariate"
-  else if (formulatype == "multivariate") title <- "Multivariable-adjusted"
-  else stop("unexpected formula type")
-  title(main = title, cex.main = 0.6)
-  title(xlab = splineVariable$name,
-        ylab = ylab,
-        line = 1.5,
-        cex.lab = 0.5
-  )
+  title(xlab = splineVariable$name, line = 1, cex.lab = 0.5)
+  title(ylab = ylab, line = 1.5, cex.lab = 0.5)
+  if (!is.null(formulatype)) {
+    if (formulatype == "univariate") plotTitle <- "Univariate"
+    else if (formulatype == "multivariate") plotTitle <- "Multivariable-adjusted"
+    else stop("unexpected formula type")
+    title(main = plotTitle, cex.main = 0.5, line = 0.45)
+  }
   
   # knots
   abline(v = splineVariable$spline$knots[[1]],
          col = "grey60",
          lty = 2,
-         lwd = 0.8,
+         lwd = 1,
          xpd = F
   )
   
@@ -601,29 +606,31 @@ plot_spline <- function(splineVariable, dat, outcome, res, regtype, formulatype,
   # regression line
   lines(newdat[,splineVariable$id],
         preddat_ci_adj[,"fit"],
-        col = "red",
-        lwd = 2
+        col = "blue",
+        lwd = 1.7
   )
   
   # legend for lines
   legend("topright",
+         inset = c(-0.39, 0),
          cex = 0.5,
-         inset = c(-0.3, 0.1),
          legend = c("knots", "cubic spline fit", "95% CI"),
          text.col = "white",
          lty = c(2, 1, NA),
-         col = c("grey60", "red", NA)
+         col = c("grey60", "blue", NA),
+         xpd = TRUE
   )
   
   # legend for ci
   legend("topright",
+         inset = c(-0.39, 0),
          cex = 0.5,
-         inset = c(-0.3, 0.1),
          legend = c("knots", "cubic spline fit", "95% CI"),
          text.col = "black",
          bty = "n",
          fill = c(NA, NA, adjustcolor("grey", alpha.f = 0.8)),
-         border = c(NA, NA, NA)
+         border = c(NA, NA, NA),
+         xpd = TRUE
   )
   dev.off()
   return(plotfile)