############################################################
#Green and Losada—Applications in Plant Sciences 2023 11(5)—Data Supplement S1
#DOI 10.1002/aps3.11551

#Appendix S1. 

# cleans and thresholds a raw (leaf) image
#
# note that this function is not essential for the analyses described in
#  this paper, but is included for completeness since it was used in
#  producing the binary mask shown in Figure 2B. Unlike all the other
#  functions, it _does_ have user-tuneable parameters relating to how
#  much the raw image should be cleaned up.

clean <- function(x, thresh_win = 30, thresh_sense = 0.01, schmutz = 81,
                  element_diam = 9, edgefill = TRUE, verbose = FALSE){

  require(EBImage)

  if(!is.Image(x)) stop('x is not an image')

  col <- x
  
  # convert to greyscale and normalize values
  gs <- normalize(channel(col, mode = 'gray'))

  # adaptive thresholding;
  #  offset is 'sensitivity'; w and h give window size
  bin <- thresh(gs, w = thresh_win, h = thresh_win, offset = thresh_sense)

# Note:
#  white = 1 (background, areoles)
#  black = 0 (foreground, veins)

  # opening and closing
#  kernel <- makeBrush(element_diam, shap = 'disc')
#  bin <- opening(bin, kern = kernel)
#  bin <- closing(bin, kern = kernel)

  # remove unconnected black in white
  invert <- !bin # invert image so vein network is white/foreground
  invert.lab <- bwlabel(invert) # lable inverted image
  tab <- tabulate(invert.lab)
  biggest.index <- (1:length(tab))[tab == max(tab)]
  biggest <- invert.lab == biggest.index
  clean <- as.Image(!biggest) # invert image so veins are again black/background
  storage.mode(clean) <- 'numeric'

  if(verbose) cat('removing all background pixels (white) unconnected
                  to vein network in foreground (black)\n')

  if(edgefill){
    # remove edge effects SLOW!
    for(i in seq(from = 1, to = nrow(clean), by = sqrt(schmutz))){
      clean <- floodFill(clean, pt = c(i,1), col = 0)
      clean <- floodFill(clean, pt = c(i,ncol(clean)), col = 0)
    }
    for(j in seq(from = 1, to = ncol(clean), by = sqrt(schmutz))){
      clean <- floodFill(clean, pt = c(1,j), col = 0)
      clean <- floodFill(clean, pt = c(nrow(clean),j), col = 0)
    }
  }
  
  #remove small white in black
  clean.lab <- bwlabel(clean)
  tab <- tabulate(clean.lab)
  fts <- computeFeatures.shape(clean.lab)
  small_ids <- (1:max(clean.lab))[fts[,1] < schmutz]
  clean[clean.lab %in% small_ids] <- 0

  return (clean)
} # End of function

############################################################
# calculates a sizing transform

st <- function(x, max_mask = max(dim(x)), draw = FALSE, negate = FALSE){
# x is an image object
# max_mask is an integer giving an upper bound for mask size
# draw is FALSE for no image output; TRUE for screen output;
#  a string to produce an output file
# negate = TRUE reverses foreground and background

require(EBImage)

if(!is.Image(x)){
  stop('x is not an image')
}
if(length(table(x)) > 2){
  warning('input image does not seem to be binary')
}

if(negate){
  x <- !x
}

# initialize variables to hold the sequentially larger masks
masks <- list()
masks.im <- Image(x)

# initialize index
i <- 1

# initialize working mask
thismask <- x

# initialize size transform matrix
sizes <- matrix(0, ncol = ncol(x), nrow = nrow(x))

# loop through sequentially larger odd circular kernels
#  until all foreground is eliminated

while(sum(thismask > 0) > 0){ # while there are foreground pixels left....
  thisdisc <- 2 * i + 1
  if(thisdisc > max_mask) break()
  cat(paste(thisdisc, '. '))
  thismask <- opening(x, kern = makeBrush(thisdisc, shape = 'disc')) # perform an opening
  if(draw == TRUE) image(thismask)
###COMMENTED OUT TO MINIMIZE MEMORY USAGE
#  masks.im <- combine(masks.im, thismask) # save this mask as an image
#  masks[[i]] <- apply(thismask, 2,
#                 function(x){as.numeric(as.logical(x))}) # and as a matrix
#  names(masks)[i] <- paste('d', thisdisc, sep = '')
###
  i <- i + 1
  sizes[apply(thismask > 0, 2, as.logical)] <- thisdisc # where thismask still
                  #has foreground pixels, put in the size of the current disk
  gc() #in case memory is an issue
}

if(draw == TRUE){
  par(mfrow = c(1,2))
  image(sizes)
  plot(as.table(table(sizes)[-1]), type = 'h',
       ylab = 'Frequency', xlab = 'Diameter in Pixels',
       main = 'Table of Image Sizing Transform')
}else if(is.character(draw)){
  nio <- dim(masks.im)[3]
  writeImage(masks.im,
             files = paste(draw, 'mask', 1:nio, '.jpg', sep = ''))
  pdf(paste(draw, 'Rplot.pdf', sep = ''))
  plot(as.table(table(sizes)[-1]), type = 'h',
       ylab = 'Frequency', xlab = 'Diameter in Pixels',
       main = 'Table of Image Sizing Transform')
  dev.off()
}

###COMMENTED OUT TO MINIMIZE MEMORY USAGE
# The original function return list included the necessary
#  data objects to plot all the intermediate masks, here
#  it has been commented out and replaced by a simpler
#  return value to avoid out-of-memory issues
#return(list(kernels = seq(3, i, by = 2),
#            sizes = sizes, masks = masks,
#            masks.im = masks.im))
###
return(list(sizes = sizes))

} # End of function

############################################################
# a function to perform a morphological thinning on an image
#  algorithm from Glasbey and Horgan, Image Analysis for the
#  Biological Sciences; Chapt. 5, p.15f
#
# not used in this paper but included for completeness 

thin <- function(x, verbose = FALSE){
  dims <- dim(x)
  
  #if(is.Image(x))
  #  x <- x@.Data[,,1]
  
  # edge effects are dealt with by cloning the first and last
  #  rows and columns to produce a matrix two pixels wider than
  #  the input matrix and then truncating the output matrix (by
  #  one pixel all around) to return to the initial size.
  x <- rbind(x[1,], x, x[nrow(x),])
  x <- cbind(x[,1], x, x[,ncol(x)])

  for(i in 2:dims[1]){    # loop through each pixel in image
  	for(j in 2:dims[2]){  #  comparing with shape elements 1--8
  	  if(verbose) cat(i, j, ':\t', sep = '\t')
  	  # se1
  	  if(x[i,j]     == 0                         &&
  		(x[i-1,j-1] == 0 && length(x[i-1,j-1]))  &&
  		(x[i,j-1]   == 0 && length(x[i,j-1]))    &&
  		(x[i+1,j-1] == 0 && length(x[i,j]))      &&
  		(x[i-1,j+1] == 1 && length(x[i-1,j+1]))  &&
  		(x[i,j+1]   == 1 && length(x[i,j+1]))    &&
  		(x[i+1,j+1] == 1 && length(x[i+1,j+1]))){
  	    x[i,j] <- 1
  	    if(verbose) cat('1')
  	  }else{
  	    if(verbose) cat('.')
  	  }
      # se2
  	  if(x[i,j]     == 0                         &&
  		(x[i,j-1]   == 0 && length(x[i,j-1]))    &&
  		(x[i+1,j-1] == 0 && length(x[i+1,j-1]))  &&
  		(x[i+1,j]   == 0 && length(x[i+1,j]))    &&
  		(x[i-1,j+1] == 1 && length(x[i-1,j+1]))  &&
  		(x[i,j+1]   == 1 && length(x[i,j+1]))    &&
  		(x[i-1,j]   == 1 && length(x[i-1,j]))){
  		x[i,j] <- 1
  		if(verbose) cat('2')
  	  }else{
  	  	if(verbose) cat('.')
  	  }
      # se3
      if(x[i,j]     == 0                         &&
  		(x[i+1,j-1] == 0 && length(x[i+1,j-1]))  &&
  		(x[i+1,j]   == 0 && length(x[i+1,j]))    &&
  		(x[i+1,j+1] == 0 && length(x[i+1,j+1]))  &&
  		(x[i-1,j-1] == 1 && length(x[i-1,j-1]))  &&
  		(x[i-1,j]   == 1 && length(x[i-1,j]))    &&
  		(x[i-1,j+1] == 1 && length(x[i-1,j+1]))){
  		  x[i,j] <- 1
  		  if(verbose) cat('3')
  		}else{
  		  if(verbose) cat('.')
  		}
  		# se4
  		if(x[i,j]     == 0                         &&
  		  (x[i+1,j]   == 0 && length(x[i+1,j]))    &&
  		  (x[i+1,j+1] == 0 && length(x[i+1,j+1]))  &&
  		  (x[i,j+1]   == 0 && length(x[i,j+1]))    &&
  		  (x[i-1,j]   == 1 && length(x[i-1,j]))    &&
  		  (x[i-1,j-1] == 1 && length(x[i-1,j-1]))  &&
  		  (x[i,j-1]   == 1 && length(x[i,j-1]))){
  		  x[i,j] <- 1
          if(verbose) cat('4')
     	}else{
     	  if(verbose) cat('.')
   		}	
  		# se5
  		if(x[i,j]     == 0                         &&
  		  (x[i-1,j+1] == 0 && length(x[i-1,j+1]))  &&
  		  (x[i,j+1]   == 0 && length(x[i,j+1]))    &&
  		  (x[i+1,j+1] == 0 && length(x[i+1,j+1]))  &&
  		  (x[i-1,j-1] == 1 && length(x[i-1,j-1]))  &&
  		  (x[i,j-1]   == 1 && length(x[i,j-1]))    &&
  		  (x[i+1,j-1] == 1 && length(x[i+1,j-1]))){
  		  x[i,j] <- 1
  		  if(verbose) cat('5')
  		}else{
  		  if(verbose) cat('.')
  		}
  		# se6
   		if(x[i,j]     == 0                         &&
  		  (x[i-1,j]   == 0 && length(x[i-1,j]))    &&
  		  (x[i-1,j+1] == 0 && length(x[i-1,j+1]))  &&
  		  (x[i,j+1]   == 0 && length(x[i,j+1]))    &&
  		  (x[i+1,j]   == 1 && length(x[i+1,j]))    &&
  		  (x[i+1,j-1] == 1 && length(x[i+1,j-1]))  &&
  		  (x[i,j-1]   == 1 && length(x[i,j-1]))){
  		  x[i,j] <- 1
  		  if(verbose) cat('6')
  		}else{
  		  if(verbose) cat('.')
  		}
  		# se7
  		if(x[i,j]     == 0                         &&
  		  (x[i-1,j-1] == 0 && length(x[i-1,j-1]))  &&
  		  (x[i-1,j]   == 0 && length(x[i-1,j]))    &&
  		  (x[i-1,j+1] == 0 && length(x[i-1,j+1]))  &&
  		  (x[i+1,j-1] == 1 && length(x[i+1,j-1]))  &&
  		  (x[i+1,j]   == 1 && length(x[i+1,j]))    &&
  		  (x[i+1,j+1] == 1 && length(x[i+1,j+1]))){
  		  x[i,j] <- 1
  		  if(verbose) cat('7')
  		}else{
    	  if(verbose) cat('.')
  		}
  		# se8
		if(x[i,j]     == 0                         &&
  		  (x[i-1,j]   == 0 && length(x[i-1,j]))    &&
  		  (x[i-1,j-1] == 0 && length(x[i-1,j-1]))  &&
  		  (x[i,j-1]   == 0 && length(x[i,j-1]))    &&
  		  (x[i+1,j]   == 1 && length(x[i+1,j]))    &&
  		  (x[i+1,j+1] == 1 && length(x[i+1,j+1]))  &&
  		  (x[i,j+1]   == 1 && length(x[i,j+1]))){
  		  x[i,j] <- 1
  		  if(verbose) cat('8\n')
  		}else{
  		  if(verbose) cat('.\n')
  		}
  	}
  }
  x <- x[-nrow(x),-ncol(x)]
  x <- x[-1,-1]
  thinned <- Image(x)
  #thinned@compression <- "NONE"
  return(thinned)
} # End of function

############################################################
# an iterative wrapper for the thin() function to produce
#  a skeletonized vein network.

skeleton <- function(x, draw = TRUE, verbose = FALSE){
  prev.iter <- x
  skel <- thin(prev.iter)
  if(draw) image(skel)
  ii <- 1
  while(any(skel != prev.iter)){
  	cat('Iteration', ii, '\n')
  	prev.iter <- skel
    skel <- thin(skel)
    ii <- ii + 1
    if(draw) image(skel)
  }
  return(skel)
} # End of function