raster color table to sld

rToSld.R

library(raster)
library(XML)

# get raster file 
# e.g. read from file:  
 r <- raster("dat.tif")

# create sample values
r <- raster(ncol=10, nrow=10)
r[] <- as.integer(runif(length(r))*255)
colortable(r) <- terrain.colors(10)



rToSld <- function(r,nodataval=NULL){
  require(raster)
  require(XML)
  colTab <- colortable(r)
  if(length(colTab)==0) stop("no colortable")
  top <- newXMLNode("colorMap")
  names(colTab) <- 0:(length(colTab) - 1)
  valTab <- sort(unique(r))
  sapply(valTab, function(x){
    col <- colTab[x]
    if(length(col)>0 && !is.na(col)){
      opa <- 1
      if(!is.null(nodataval) && x == nodataval) opa <- 0
      newXMLNode("colorMapEntry",attrs = list(
        color = col,
        quantity = x,
        opacity = opa 
      ),
      parent=top
      )
    }
  }
  )
  return(top)
} 

rToSld(r,8)
# <colorMap>
#   <colorMapEntry color="#2DB600FF" quantity="2" opacity="1"/>
#   <colorMapEntry color="#63C600FF" quantity="3" opacity="1"/>
#   <colorMapEntry color="#E6E600FF" quantity="5" opacity="1"/>
#   <colorMapEntry color="#EDB48EFF" quantity="8" opacity="0"/>
#   </colorMap> 

It's a good starting point to develop something useful. Thanks!

Where is the colortable() function from? -- Need to update my raster package!
It doesn't work straightforward for me. Here the way I'd comment the function to make it easier for me to read and understand.

# hardcoded stuff commented-out, trying to get the function only
library(raster)
library(XML)

# get raster file 
# e.g. read from file:  
 # r <- raster("dat.tif")

# create sample values
# r <- raster(ncol=10, nrow=10)
# r[] <- as.integer(runif(length(r))*255)
# colortable(r) <- terrain.colors(10)  # still running older version raster_2.3-40, need to change this a bit



rToSld <- function(r,nodataval=NULL){

  # load required librairies
  require(raster)
  require(XML)

  # color table for input raster -- see comment(s) above
  colTab <- colortable(r)

  # break if no colortable given
  if(length(colTab)==0) stop("no colortable")

  # define new (default) namespace? see:
  # http://svitsrv25.epfl.ch/R-doc/library/XML/html/newXMLDoc.html

  # Also, from the manual: "While the functions are available, their direct use
  # is not encouraged. Instead, use xmlTree as the functions need to be used
  # within a strict regime to avoid corrupting C level structures."
  top <- newXMLNode("colorMap")

  # feed colTab's columns with names
  names(colTab) <- 0:(length(colTab) - 1)

  # sort all values of input raster "r"
  valTab <- sort(unique(r))

  # apply custom function to 'valTab'
  sapply(valTab, function(x){

    # 
    col <- colTab[x]

    # check if "col" exists?
    if(length(col)>0 && !is.na(col)){

      # set "opacity" -- note: better spell the full word than only three letters
      opa <- 1

      # set opacity to zero, which means Trasparent if 'nodataval' is not NULL
    # and 'x' is identical to the 'nodataval'
      if(!is.null(nodataval) && x == nodataval) opa <- 0

      # create new 'colorMapEntry' for given 'col'(or), value 'x' & opacity
      newXMLNode("colorMapEntry",attrs = list(
        color = col,
        quantity = x,
        opacity = opa 
      ),
      parent=top
      )
    }
  }
  )

  # return a/the "top" level document object
  return(top)
} 

# rToSld(r,8)
# <colorMap>
#   <colorMapEntry color="#2DB600FF" quantity="2" opacity="1"/>
#   <colorMapEntry color="#63C600FF" quantity="3" opacity="1"/>
#   <colorMapEntry color="#E6E600FF" quantity="5" opacity="1"/>
#   <colorMapEntry color="#EDB48EFF" quantity="8" opacity="0"/>
#   </colorMap>