## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  fig.align = "center",
  fig.alt   = "Figure generated by zenplots; see caption and/or surrounding text for details."
)

has_rgraphviz <- requireNamespace("Rgraphviz", quietly = TRUE)
has_pairviz   <- requireNamespace("PairViz",   quietly = TRUE)
has_qqtest <- requireNamespace("qqtest", quietly = TRUE)
rebuild_figs  <- identical(Sys.getenv("ZENPLOTS_REBUILD"), "TRUE") && has_rgraphviz

note_rgraphviz <- function() {
  if (!has_rgraphviz) {
    cat("> **Optional dependency**: All graphs in this vignette can be displayed as Graphviz plots using **Rgraphviz** (Bioconductor).\n",
        "> To install locally:\n\n",
        "```r\n",
        "if (!requireNamespace(\"BiocManager\", quietly=TRUE)) install.packages(\"BiocManager\")\n",
        "BiocManager::install(\"Rgraphviz\")\n",
        "```\n\n", sep = "")
  }
}

install_rgraphviz <- function() {
  cat("> **Optional dependency**: This graph, and any other graph, in this vignette can be displayed as a Graphviz plot using the plot() method from **Rgraphviz**.\n",
      "> To install locally:\n\n",
      "```r\n",
      "if (!requireNamespace(\"BiocManager\", quietly=TRUE)) install.packages(\"BiocManager\")\n",
      "BiocManager::install(\"Rgraphviz\")\n",
      "```\n\n", sep = "")
}

## ----message=FALSE, warning=FALSE---------------------------------------------
library(zenplots)

## ----rgraphviz-note, results='asis', echo=FALSE-------------------------------
note_rgraphviz()

## ----message=FALSE, warning=FALSE---------------------------------------------
if (!has_pairviz) {
  cat("> **Optional dependency**: Examples using the **PairViz** package are skipped if it’s not installed. Install with `install.packages(\"PairViz\")`.\n\n")
} else {
  library(PairViz)
}

## -----------------------------------------------------------------------------
head(attenu)

## ----echo=FALSE---------------------------------------------------------------
names(attenu)

## ----message=FALSE, warning=FALSE, eval=has_pairviz---------------------------
## Since attenu has 5 variates, the complete graph has n=5 nodes
## and an Euler sequence is given as
PairViz::eseq(5)

## ----message=FALSE, warning=FALSE, eval=has_pairviz---------------------------
names(attenu)[PairViz::eseq(5)]

## ----echo=FALSE, message=FALSE, warning=FALSE, fig.align="center", out.width="65%", fig.cap="Precomputed complete graph.", fig.alt="Complete graph whose nodes are the five variate names of the attenu dataset."----
knitr::include_graphics("figures/intro_complete_graph.png")

## ----install_rgraphviz, results='asis', echo=FALSE, eval = TRUE---------------
install_rgraphviz()

## ----plot-a-graph, eval = FALSE-----------------------------------------------
# mygraph <- PairViz::mk_complete_graph(names(attenu))
# Rgraphviz::plot(mygraph)

## ----message=FALSE, warning=FALSE, fig.align="center"-------------------------
zenpath(5)

## ----message=FALSE, warning=FALSE, fig.align="center"-------------------------
## Back loading ensures all pairs appear latest (back) for
## high values of the indices.
zenpath(5, method = "back.loaded")
## Frot loading ensures all pairs appear earliest (front) for
## low values of the indices.
zenpath(5, method = "front.loaded")
## Balanced loading ensures all pairs appear in groups of all
## indices (Hamiltonian paths -> a Hamiltonian decomposition of the Eulerian)
zenpath(5, method = "balanced")

## ----zenpath, echo= FALSE, include=FALSE, fig.align="center", fig.alt="Plot of the three different Euler sequences: back loaded, balanced, and front loaded."----
parOptions <- par(mfrow=c(1,3), mar=c(4, 2,2,0),oma=rep(0,4))
back <- zenpath(15, method = "back.loaded")
balanced <- zenpath(15, method = "balanced")
front <- zenpath(15, method = "front.loaded")
n <- length(zenpath(15))
plot_chars <- letters[1:15]
plot(back, n - 1:n,type="b", ylab="", xlab="", main="Back loaded",
     pch=plot_chars[back], bty="n", xaxt="n", yaxt="n")
plot(balanced, n - 1:n,type="b", ylab="", xlab="", main="Balanced",
     pch=plot_chars[balanced], bty="n", xaxt="n", yaxt="n")
plot(front, n - 1:n,type="b", ylab="", xlab="", main="Front loaded",
     pch=plot_chars[front], bty="n", xaxt="n", yaxt="n")
par(parOptions)

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=7, fig.height=7, fig.alt="Pairs plot of the attenu data."----
## We remove the space between plots and suppress the axes
## so as to give maximal space to the individual scatterplots.
## We also choose a different plotting character and reduce
## its size to better distinguish points.
pairs(attenu, oma=rep(0,4), gap=0, xaxt="n", yaxt="n")

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=7, fig.height=7, fig.alt = "zenplot showing scatterplots of all pairs of attenu variates"----
## Plotting character and size are chosen to match that
## of the pairs plot.
## zenpath ensures that all pairs of variates appear
## in the zenplot.
## The last argument, n2dcol, is chosen so that the zenplot
## has the same number of plots across the page as does the
## pairs plot.
zenplot(attenu[, zenpath(ncol(attenu))], n2dcol=4)

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=7, fig.height=7, fig.alt = "zenplot showing directions of the layout path along all pairs of attenu variates"----
## Call zenplot exactly as before, except that each scatterplot is replaced
## by an arrow that shows the direction of the layout.
zenplot(attenu[, zenpath(ncol(attenu))], plot2d="arrow", n2dcol=4)

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=10, fig.height=6, fig.alt = "Effect of n2dcol parameter of zenplot layout; odd numbers produce tighter layouts."----
## The default n2dcol is used
zenplot(attenu[, zenpath(ncol(attenu))], n2dcol=5)

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=6, fig.height=10, fig.alt = "Default n2dcol parameter of zenplot layout; not always compact layout."----
## The default n2dcol is used
zenplot(attenu[, zenpath(ncol(attenu))])

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=6, fig.height=10, fig.alt = "Default n2dcol parameter with arrows instead of scatterplots."----
## The directions
zenplot(attenu[, zenpath(ncol(attenu))], plot2d="arrow")

## -----------------------------------------------------------------------------
## Access the German election data from zenplots package
data(de_elect)

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=7, fig.height=7----
## pairs(de_elect[,1:34], oma=rep(0,4), gap=0, pch=".", xaxt="n", yaxt="n")

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=7, fig.height=7----
## Try invoking the plot with the following
## zenplot(de_elect[,zenpath(68)], pch=".", n2dcol="square",col=adjustcolor("black",0.5))

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=7, fig.height=7----
## pairs(de_elect, oma=rep(0,4), gap=0, pch=".", xaxt="n", yaxt="n",col=adjustcolor("black",0.5))

## ----message=FALSE, warning=FALSE---------------------------------------------
Education <- c("School.finishers",
               "School.wo.2nd", "School.2nd",
               "School.Real",  "School.UED")
Employment <- c("Employed", "FFF", "Industry",
                "CTT", "OS" )

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=5, fig.height=6, fig.alt="German Election data using zenplot to compare pairs within different groups."----

EducationData <- de_elect[, Education]
EmploymentData <- de_elect[, Employment]

## Plot all pairs within each group
zenplot(list(Educ= EducationData[, zenpath(ncol(EducationData))],
             Empl= EmploymentData[, zenpath(ncol(EmploymentData))]))

## -----------------------------------------------------------------------------
## Grouping variates in the German election data
Regions <- c("District", "State", "Density")
PopDist <- c("Men", "Citizens", "Pop.18.25", "Pop.25.35",
             "Pop.35.60", "Pop.g.60")
PopChange <- c("Births", "Deaths", "Move.in", "Move.out", "Increase")
Agriculture <- c("Farms", "Agriculture")
Mining <- c("Mining", "Mining.employees")
Apt <- c("Apt.new", "Apt")
Motorized <- c("Motorized")
Education <- c("School.finishers",
               "School.wo.2nd", "School.2nd",
               "School.Real",  "School.UED")
Unemployment <- c("Unemployment.03", "Unemployment.04")
Employment <- c("Employed", "FFF", "Industry", "CTT", "OS" )
Voting.05 <- c("Voters.05", "Votes.05", "Invalid.05", "Valid.05")
Voting.02 <- c("Voters.02", "Votes.02", "Invalid.02", "Valid.02")
Voting <- c(Voting.02, Voting.05)
VotesByParty.02 <- c("Votes.SPD.02", "Votes.CDU.CSU.02", "Votes.Gruene.02",
                     "Votes.FDP.02", "Votes.Linke.02")
VotesByParty.05 <- c("Votes.SPD.05", "Votes.CDU.CSU.05", "Votes.Gruene.05",
                     "Votes.FDP.05", "Votes.Linke.05")
VotesByParty <- c(VotesByParty.02, VotesByParty.05)
PercentByParty.02 <- c("SPD.02", "CDU.CSU.02", "Gruene.02",
                       "FDP.02", "Linke.02", "Others.02")
PercentByParty.05 <- c("SPD.05", "CDU.CSU.05", "Gruene.05",
                       "FDP.05", "Linke.05", "Others.05")
PercentByParty <- c(PercentByParty.02, PercentByParty.05)

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=11, fig.height=14, fig.alt = "Zenplot of all pairs within each of several groups of variates from the German Election data."----
groups <- list(Regions=Regions, Pop=PopDist,
               Change = PopChange, Agric=Agriculture,
               Mining=Mining, Apt=Apt,  Cars=Motorized,
               Educ=Education, Unemployed=Unemployment, Employed=Employment#,
               # Vote02=Voting.02, Vote05=Voting.05,
               # Party02=VotesByParty.02, Party05=VotesByParty.05,
               # Perc02=PercentByParty.02, Perc05=PercentByParty.05
               )

group_paths <- lapply(groups, FUN= function(g) g[zenpath(length(g), method = "front.loaded")] )
x <- groupData(de_elect, indices=group_paths)

zenplot(x, pch = ".", cex=0.7, col = "grey10")

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=10, fig.height=10, fig.alt = "As the previous plot but with redefined short names."----
#
## Grouping variates in the German election data
RegionsShort <- c("ED", "State", "density")
PopDistShort <- c("men", "citizen", "18-25", "25-35", "35-60", "> 60")
PopChangeShort <- c("births", "deaths", "in", "out", "up")
AgricultureShort <- c("farms", "hectares")
MiningShort <- c("firms", "employees")
AptShort <- c("new", "all")
TransportationShort <- c("cars")
EducationShort <- c("finishers", "no.2nd", "2nd", "Real", "UED")
UnemploymentShort<- c("03", "04")
EmploymentShort <- c("employed", "FFF", "Industry", "CTT", "OS" )
Voting.05Short <- c("eligible", "votes", "invalid", "valid")
Voting.02Short <- c("eligible", "votes", "invalid", "valid")
VotesByParty.02Short <- c("SPD", "CDU.CSU", "Gruene", "FDP", "Linke")
VotesByParty.05Short <- c("SPD", "CDU.CSU", "Gruene", "FDP", "Linke")
PercentByParty.02Short <- c("SPD", "CDU.CSU", "Gruene", "FDP", "Linke", "rest")
PercentByParty.05Short <-  c("SPD", "CDU.CSU", "Gruene", "FDP", "Linke", "rest")

shortNames <- list(RegionsShort, PopDistShort, PopChangeShort, AgricultureShort,
                   MiningShort, AptShort, TransportationShort, EducationShort,
                   UnemploymentShort, EmploymentShort, Voting.05Short, Voting.02Short,
                   VotesByParty.02Short, VotesByParty.05Short, PercentByParty.02Short,
                   PercentByParty.05Short)
# Now replace the names in x by these.

nGroups <- length(x)

for (i in 1:nGroups) {
  longNames <- colnames(x[[i]])
  newNames <- shortNames[[i]]
  oldNames <- groups[[i]]
  #print(longNames)
  #print(newNames)
  for (j in 1:length(longNames)) {
    for (k in 1:length(newNames)) {
      if (grepl(oldNames[k], longNames[j])) {
        longNames[longNames == longNames[j]] <- newNames[k]
      }
    }
  }
  colnames(x[[i]]) <- longNames
}

zenplot(x, pch = ".", cex=0.75)


## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=10, fig.height=16, fig.alt="Zenplot where the method eulerian.cross has one group of variates crossed with another."----
crossedGroups <- c(Employment, Education)
crossedPaths <- zenpath(c(length(Employment), length(Education)), method="eulerian.cross")
zenplot(de_elect[,crossedGroups][crossedPaths])

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=5, fig.height=2, fig.alt="Zenplot lays out boxplots in a row across the plot, using the turns argument."----
earthquakes <- attenu[, c(1,2,4,5)]  # ignore the station id
zenplot(earthquakes,
        plot1d="boxplot", plot2d=NULL,
        width1d=5, width2d=1,
        turns=c("r","r","r","r","r","r","r"))

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=4, fig.height=4, fig.alt="zenplot showing four boxplots laid out in a cross, using the turns argument."----
zenplot(earthquakes,
        plot1d="boxplot", plot2d=NULL,
        width1d=1, width2d=1,  # now widths must be the same
        turns=c("r","d","d","l","l","u","u"))

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=4, fig.height=4, fig.alt="Arrows laid out using turns argument."----
zenplot(earthquakes,
        plot1d= "arrow", plot2d="arrow",
        width1d=1, width2d=2,
        turns=c("r","d","d","l","l","u","u"))

## ----message=FALSE, warning=FALSE, fig.align="center", fig.width=4, fig.height=4, fig.alt="Zenplot with user defined 1d and 2d plots, laid out using turns."----
zenplot(earthquakes,
        plot1d = function(zargs, ...) {
          rect_1d_graphics(zargs,  ...)
          arrow_1d_graphics(zargs, col="firebrick", lwd=3, add=TRUE, ...)
        },
        plot2d = function(zargs, ...) {
          rect_2d_graphics(zargs,  ...)
          arrow_2d_graphics(zargs, col="steelblue", lwd=3, lty=2, add=TRUE, ...)
        },
        width1d = 1, width2d = 2,
        turns=c("r","d","d","l","l","u","u"))

## ----message=FALSE, warning=FALSE, results="hide", fig.align="center", fig.width=6, fig.height=3, fig.alt="Novel plot of alternating histograms and qqtest plots via user defined and built in one and two dimensional functions."----
#
# qqtest is preferred to the base qqplot so will be used if available.
# 
has_qqtest <- requireNamespace("qqtest", quietly = TRUE)

zenplot(earthquakes[, zenpath(ncol(earthquakes))],
        width1d = 1, width2d = 2, n2dcols = 5,
        plot1d = function(zargs, ...) {
            r <- extract_1d(zargs) # extract args for 1d
            col <- grDevices::adjustcolor(
                if (r$horizontal) "firebrick" else "steelblue", alpha.f = 0.7)
            hist_1d_graphics(zargs, col = col, ...)
        },
        plot2d = function(zargs, ...) {
            r <- extract_2d(zargs) # extract args for 2d
            x <- as.matrix(r$x)    # r$x is a data frame with one named variate
                                   # one-column data frame -> matrix
            xlim <- r$xlim
            y <- as.matrix(r$y)    # r$y is a data frame with one named variate
            ylim <- r$ylim
            
            # use the better quantile-quantile plot (qqtest) if available
            # qqtest has bands testing whether y comes from the same 
            # distribution as x or not;  all points in the band
            # indicate no evidence against the hypothesis of the
            # same distribution,
            if (has_qqtest) { 
                # qqtest draws directly into the current region
                qqtest::qqtest(y, dataTest = x,
                               xlim = xlim, ylim = ylim,
                               cex = 0.3, col = "black", pch = 19,
                               legend = FALSE, main = "", axes = FALSE, ...)
            } else {
                # base fallback: 
                #   construct the qqplot by hand 
                #   adding the points into our region
                xx <<- stats::na.omit(as.numeric(x))
                yy <<- stats::na.omit(as.numeric(y))
                qq <- stats::qqplot(xx, yy, plot.it = FALSE)
                plot_region(xlim, ylim)
                box()
                points(qq$x, qq$y, pch = 19, cex = 0.3)
            }
        })

