Ternary plot in R with color map

Question

I am interested to draw ternary plot in R similar to the one showing here. I would like to see color plot including color bar as legend showing in picture. My following sample code is giving me an error as "Error in values["z", ] : subscript out of bounds". Please help me generating the plot. I am using Ternary package, if there is another better package, please let me know.

nPoints <- 4000L
coords <- cbind(A = abs(rnorm(nPoints, 2, 3)),
                B = abs(rnorm(nPoints, 1, 1.5)),
                C = abs(rnorm(nPoints, 1, 0.5)),
                D = abs(rnorm(nPoints, 100, 5000))
               )

TernaryPlot(alab="A", blab="B", clab="C", grid.lines = 5, grid.minor.lines = 0)
ColourTernary(coords)

Answer 1

Styling points

Option one is to colour each point according to its value; see the "Styling points" section of the user manual

nPoints <- 4000L
coords <- cbind(A = abs(rnorm(nPoints, 2, 3)),
                B = abs(rnorm(nPoints, 1, 1.5)),
                C = abs(rnorm(nPoints, 1, 0.5)),
                D = abs(rnorm(nPoints, 100, 5000))
)

TernaryPlot(alab="A", blab="B", clab="C", grid.lines = 5, grid.minor.lines = 0)

spectrumBins <- 256
mySpectrum <- viridisLite::viridis(spectrumBins)
values <- coords[, "D"]
binnedReflectance <- cut(values, spectrumBins)
dat_col <- mySpectrum[binnedReflectance]


TernaryPoints(coords[, c("A", "B", "C")],
              col = dat_col,
              pch = 16
)

PlotTools::SpectrumLegend(
  "topleft", bty = "n",
  legend = signif(seq(max(values), min(values), length.out = 4), 3),
  palette = mySpectrum
)

Density plotting

The alternative is to colour the background of the plot by interpolating between values at given points, per the interpolation vignette.

nPoints <- 4000L
coords <- cbind(A = abs(rnorm(nPoints, 2, 3)),
                B = abs(rnorm(nPoints, 1, 1.5)),
                C = abs(rnorm(nPoints, 1, 0.5)),
                D = abs(rnorm(nPoints, 100, 5000))
)

TernaryPlot(alab="A", blab="B", clab="C", grid.lines = 5, grid.minor.lines = 0)

# Convert measured points to XY
abc <- coords[, c("A", "B", "C")]
xy <- apply(abc, 1, TernaryToXY)
response <- coords[, "D"]

# Use an inverse distance weighting to interpolate between measured points
Predict <- function(predXY) {
  Distance <- function(a, b) {
    apply(a, 2, function(pt) sqrt(colSums((pt - b) ^ 2)))
  }
  dists <- Distance(xy, predXY)
  id <- 1 / dists
  idw <- id / rowSums(id)
  
  # Return:
  colSums(response * t(idw))
}

# Predict at triangle centres
tri <- TriangleCentres(resolution = 12L)
# Adjust the resolution to suit your own dataset

# Now we interpolate between our known values to generate a colour for each
# of our tiles
predicted <- Predict(tri[1:2, ])
map <- rbind(x = tri["x", ], y = tri["y", ], z = predicted,
             down = tri["triDown", ])

# Place a semitransparent colour fill over grid lines:
ColourTernary(map, bty = "n",
              legend = signif(seq(min(predicted), max(predicted),
                                  length.out = 4), 3))

# Calculate contours
PredictABC <- function(a, b, c) Predict(TernaryToXY(rbind(a, b, c)))
TernaryContour(PredictABC, resolution = 36L)

# Mark the points at which we took measurements
TernaryPoints(abc, pch = ".", col = "#cc3333")

Contour filling

Finally, Ternary 2.2 can produce filled contours with an automatically added scale bar:

nPoints <- 4000L
coords <- cbind(A = abs(rnorm(nPoints, 2, 3)),
                B = abs(rnorm(nPoints, 1, 1.5)),
                C = abs(rnorm(nPoints, 1, 0.5)),
                D = abs(rnorm(nPoints, 100, 5000))
)

# Use an inverse distance weighting to interpolate between measured points
Predict <- function(predXY) {
  Distance <- function(a, b) {
    apply(a, 2, function(pt) sqrt(colSums((pt - b) ^ 2)))
  }
  dists <- Distance(xy, predXY)
  id <- 1 / dists
  idw <- id / rowSums(id)
  
  # Return:
  colSums(coords[, "D"] * t(idw))
}
PredictABC <- function(a, b, c) Predict(TernaryToXY(rbind(a, b, c)))

TernaryPlot(alab = "A", blab = "B", clab = "C",
            grid.lines = 5, grid.minor.lines = 0)

TernaryContour(PredictABC, resolution = 24, filled = TRUE,
               legend = round(seq(max(coords[, "D"]), min(coords[, "D"]),
                                   length.out = 4), 0),
               bty = "n")

Answer 2

You have to call TernaryPointValues with a function that computes the value to display.

TernaryPlot(alab="A", blab="B", clab="C", grid.lines = 5, grid.minor.lines = 0)
FunctionToContour <- function (a, b, c) {
  a - c + (4 * a * b) + (27 * a * b * c)
}

values <- TernaryPointValues(FunctionToContour)
ColourTernary(values, spectrum=rainbow(256))

This package doesn't seem to have support for legends.