Visualization_of_Hellinger_standardization

# Hellinger distance

library (vegan)
png (width = 6, height = 6, units = 'in', res = 300)
par (mar = c(5,5,2,2))
plot (0:1, 0:1, xlab = list ('Species 1', cex = 1.5), ylab = list ('Species 2', cex = 1.5), axes = F, xlim = c(0, 1.3), ylim = c(0,1.3), type = 'n')
par (xpd = NA)
arrows (x0 = 0, x1 = 1.3, y0 = 0, y1 = 0)
arrows (x0 = 0, x1 = 0, y0 = 0, y1 = 1.3)

xy.start <- expand.grid (x = seq (0,1,by = 0.1), y = seq (0,1,by = 0.1))[-1,]
xy.tot <- as.data.frame (vegan:::decostand (xy.start, 'total'))
xy.hell <- as.data.frame (vegan:::decostand (xy.start, 'hell'))

cols <- rainbow (120)[as.numeric (round (decostand (as.matrix (dist (rbind (c(1,0), xy.hell)))[-1,1], 'range')*100))+1]

points (x = xy.start$x, y = xy.start$y, cex = 2, pch = 21, bg = 'white', lwd = 2, col = cols)

# from start to tot
no.steps <- 100
for (i in seq (1, no.steps))
{
  xy.start.tot <- as.data.frame (t(apply (cbind (xy.start, xy.tot), 1, FUN = function (x) {di.sp1 <- diff (c(x[1], x[3])); di.sp2 <- diff (c(x[2], x[4])); x1 <- x[1]+(di.sp1/no.steps)*i; x2 <- x[2]+(di.sp2/no.steps)*i; c(x1, x2)})))
  par (mar = c(5,5,2,2))
  plot (0:1, 0:1, xlab = list ('Species 1', cex = 1.5), ylab = list ('Species 2', cex = 1.5), axes = F, xlim = c(0, 1.3), ylim = c(0,1.3), type = 'n')
  par (xpd = NA)
  arrows (x0 = 0, x1 = 1.3, y0 = 0, y1 = 0)
  arrows (x0 = 0, x1 = 0, y0 = 0, y1 = 1.3)
  
  points (x = xy.start.tot$x, y = xy.start.tot$y, cex = 2, pch = 21, bg = 'white', lwd = 2, col = cols)
}

# from tot to hell
no.steps <- 100
for (i in seq (1, no.steps))
{
  xy.tot.hell <- as.data.frame (t(apply (cbind (xy.tot, xy.hell), 1, FUN = function (x) {di.sp1 <- diff (c(x[1], x[3])); di.sp2 <- diff (c(x[2], x[4])); x1 <- x[1]+(di.sp1/no.steps)*i; x2 <- x[2]+(di.sp2/no.steps)*i; c(x1, x2)})))
  par (mar = c(5,5,2,2))
  plot (0:1, 0:1, xlab = list ('Species 1', cex = 1.5), ylab = list ('Species 2', cex = 1.5), axes = F, xlim = c(0, 1.3), ylim = c(0,1.3), type = 'n')
  par (xpd = NA)
  arrows (x0 = 0, x1 = 1.3, y0 = 0, y1 = 0)
  arrows (x0 = 0, x1 = 0, y0 = 0, y1 = 1.3)
  axis (1, at = c(1), labels = 1, line = F, lty = 'blank')
  axis (2, at = c(1), labels = 1, line = F, las = 2, lty = 'blank')
  lines (c(0,1), c(1,0), col = 'grey', lty = 'dashed')
  
  points (x = xy.tot.hell$x, y = xy.tot.hell$y, cex = 2, pch = 21, bg = 'white', lwd = 2, col = cols)
} 

xy.tot.hell <- as.data.frame (t(apply (cbind (xy.tot, xy.hell), 1, FUN = function (x) {di.sp1 <- diff (c(x[1], x[3])); di.sp2 <- diff (c(x[2], x[4])); x1 <- x[1]+(di.sp1/no.steps)*i; x2 <- x[2]+(di.sp2/no.steps)*i; c(x1, x2)})))
par (mar = c(5,5,2,2))
plot (0:1, 0:1, xlab = list ('Species 1', cex = 1.5), ylab = list ('Species 2', cex = 1.5), axes = F, xlim = c(0, 1.3), ylim = c(0,1.3), type = 'n')
par (xpd = NA)
arrows (x0 = 0, x1 = 1.3, y0 = 0, y1 = 0)
arrows (x0 = 0, x1 = 0, y0 = 0, y1 = 1.3)
axis (1, at = c(1), labels = 1, line = F, lty = 'blank')
axis (2, at = c(1), labels = 1, line = F, las = 2, lty = 'blank')
lines (c(0,1), c(1,0), col = 'grey', lty = 'dashed')
usr <- par("usr")
clip (0,1,0,1)
symbols (0,0, circle = 1, add = T, inches = F, fg = 'gray')
clip (0,1,0,1)
do.call ('clip', as.list (usr))
points (x = xy.hell$x, y = xy.hell$y, cex = 2, pch = 21, bg = 'white', lwd = 2, col = cols)

dev.off ()