library(NCA) # Default values copied from p_constants line_colors <- list(ols="green", lh="red3", cols="darkgreen", qr="blue", ce_vrs="orchid4", cr_vrs="violet", ce_fdh="red", cr_fdh="orange", sfa="darkgoldenrod", c_lp="blue") line_types <- list(ols=1, lh=2, cols=3, qr=4, ce_vrs=5, cr_vrs=1, ce_fdh=6, cr_fdh=1, sfa=7, c_lp=2) line_width <- 1.5 point_type <- 21 point_color <- 'red' display_plot <- function (plot) { flip.x <- plot$flip.x flip.y <- plot$flip.y # Determine the bounds of the plot based on the scope xlim <- c(plot$scope.theo[1 + flip.x], plot$scope.theo[2 - flip.x]) ylim <- c(plot$scope.theo[3 + flip.y], plot$scope.theo[4 - flip.y]) # Reset/append colors etc. if needed for (method in names(line_types)) { line.types[[method]] <- line_types[[method]] } if (is.numeric(line_width)) { line.width <- line_width } if (is.numeric(point_type)) { point.type <- point_type } if (point_color %in% colors()) { point.color <- point_color } # Only needed until the next release (3.0.2) if (!exists("point.color")) { point.color <- "blue" } # Plot the data points plot (plot$x, plot$y, pch=point.type, col=point.color, bg=point.color, xlim=xlim, ylim=ylim, xlab=colnames(plot$x), ylab=tail(plot$names, n=1)) # Plot the scope outline abline(v=plot$scope.theo[1], lty=2, col="grey") abline(v=plot$scope.theo[2], lty=2, col="grey") abline(h=plot$scope.theo[3], lty=2, col="grey") abline(h=plot$scope.theo[4], lty=2, col="grey") # Plot the legend before adding the clipping area legendParams = list() for (method in plot$methods) { line.color <- line.colors[[method]] line.type <- line.types[[method]] name <- gsub("_", "-", toupper(method)) legendParams$names = append(legendParams$names, name) legendParams$types = append(legendParams$types, line.type) legendParams$colors = append(legendParams$colors, line.color) } if (length(legendParams) > 0) { legend("topleft", cex=0.7, legendParams$names, lty=legendParams$types, col=legendParams$colors, bg=NA) } # Apply clipping to the lines clip(xlim[1], xlim[2], ylim[1], ylim[2]) # Plot the lines for (method in plot$methods) { line <- plot$lines[[method]] line.color <- line.colors[[method]] line.type <- line.types[[method]] if (method %in% c("lh", "ce_vrs", "ce_fdh")) { lines(line[[1]], line[[2]], type="l", lty=line.type, col=line.color, lwd=line.width) } else { abline(line, lty=line.type, col=line.color, lwd=line.width) } } # Plot the title title(paste0("NCA Plot : ", plot$title), cex.main=1) }