R/Pies2GE.R

In R2G2: Converting R CRAN outputs into Google Earth.

Pies2GE <- function(center, obs, nesting = 0, goo = "Pies2GE.kml", colors = "auto", nedges = 20, orient = 0, maxAlt = 1e4, radius = 5e4){

  ## Checking inputs
  if(!is.null(nrow(center))){
    if(nesting == 0) nesting = rep(1, nrow(center))
    if(length(nedges) == 1) nedges = rep(nedges, nrow(center))
    if(length(orient) == 1) orient = rep(orient, nrow(center))
    if(length(maxAlt) == 1) maxAlt = rep(maxAlt, nrow(center))
    if(length(radius) == 1) radius = rep(radius, nrow(center))
    }
  if(is.na(match("auto", colors)) == FALSE){
    palt = rev(rainbow(ncol(obs)))
    } else {
    palt = colors
    }

  ## prepare input data
  input = data.frame(nesting, center, nedges, radius, orient, maxAlt, obs)
  nsct = ncol(obs) #get number of styles to be used in pies (i.e. nb of columns in obs)

  ## get nesting params
  nesting = as.factor(nesting)
  groups = levels(nesting)

  ## compute edges for all pies
  allcoords = NULL
  for(i in groups){ #loop over all groups found into nesting param

    # get data of focal group
    input.grp = input[ input[, 1] == i,]
    
    # Compute coordinates of each pie, from that group
    for(pie in 1:nrow(input.grp)){
      
      # get data of focal pie and comput coords
      input.pie = input.grp[pie, ]
      coords = FancyPies(center = as.numeric(input.pie[2:3]), 
			obs = as.numeric(input.pie[8:ncol(input.pie)]), 
			nedges = as.numeric(input.pie[4]), 
			radius = as.numeric(input.pie[5]), 
			orient = as.numeric(input.pie[6]), 
			diag = FALSE) #we use the as.numeric to enhence robustness against data idiosyncraties (makes the script more robust here)

	#getting actual data of polygon
	for(j in 1:nsct){
	  tmp = coords[ coords[, 1] == j , 2:3] 
	  end = coords[ coords[, 1] == j + 1 , 2:3]
	  if(is.null(nrow(end))){ 
	    last <- end
	    } else {
	    last <- end[1,]
	    }
	  sgmts = rbind(as.numeric(input.pie[2:3]), tmp, as.numeric(last), as.numeric(input.pie[2:3]))
	  sgmts = cbind(i, pie, j, sgmts, input.pie[7])
	  sgmts = sgmts[nrow(sgmts):1, ] #little trick: you want the ordering of segments to be counterclockwise for proper plotting in GE!!
	  
	  allcoords = rbind(allcoords, sgmts)
	  }
	}
      }

  ## Prepare KML file
  # Initiate file
  cat("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<kml xmlns=\"http://www.opengis.net/kml/2.2\" xmlns:kml=\"http://www.opengis.net/kml/2.2\"\nxmlns:atom=\"http://www.w3.org/2005/Atom\">\n<Document>\n",file=goo, append = FALSE)
  cat("\t<name>R2G2 - Pies2GE</name>\n\t<description>Produced using Pies2GE R script</description>\n",file=goo, append = TRUE)

  # a kml file is organised in two blocs: styles (bloc1) and polygons / items (bloc2)
  bloc1=NULL
  bloc2=NULL

  ## prepare bloc 1 (styles)

  #convert colors into GE format
  colors = gsub('#','', palt)
  red = substr(colors,1,2)
  blu = substr(colors,3,4)
  gre = substr(colors,5,6)
  alp = substr(colors,7,8) #alp is the transparency param, can be adapted if needed
  magic = paste(alp,blu,gre,red,sep='')

  # feed bloc 1
  for(j in 1:nsct){
    #styles numbering
    if(j > 1){
      nr = j - 2
      } else {
      nr = ''
      }
    # color iteration
    col = magic[j]
    # preparing bloc 1 (kml converting)
    bloc1=c(bloc1, paste("\t<Style id=\"sn_ylw-pushpin",nr,"\">\n\t\t<LineStyle id=\"khLineStyle708\">\n\t\t\t<color>ff000000</color>\n\t\t\t<width>0.5</width>\n\t\t</LineStyle>\n\t\t<PolyStyle id=\"khPolyStyle709\">\n\t\t\t<color>",magic[j],"</color>\n\t\t</PolyStyle>\n\t</Style>\n", sep=''))
    }

  # feed block 2 (i.e. parse allcoords and convert them along with correct grouping)
  if(length(table(nesting)) == 1){
    grp = allcoords$j
    } else {
    grp = allcoords$i
    }
  
  # loop over all groups
  for(i in levels(as.factor(grp))){  

    # open group specific folder into GE kml file
    bloc2 = c(bloc2, paste("<Folder>\n<name>Group_",i,"</name>\n", sep=''))

    
    # loop over pie charts
    for(pie in levels(as.factor(allcoords$pie))){
      # retrieve polygon coords
      input.pie = allcoords[grp == i & allcoords$pie == pie, ]

      # loop over polygons in pie charts
      for(j in levels(as.factor(input.pie$j))){
	sgmts = input.pie[input.pie$j == j, 4:6]
	j = as.numeric(as.character(j))

	# get style number
	if(j > 1){
	  nr = j - 2
	  } else {
	  nr = ''
	  }

	# translate them into kml
	bloc2=c(bloc2, paste("\t<Placemark>\n\t\t<name>",paste("group ", nr, sep=""),"</name>\n\t\t<styleUrl>#sn_ylw-pushpin", nr,"</styleUrl>\n\t\t<Polygon>\n\t\t\t<extrude>1</extrude>\n\t\t\t<tessellate>1</tessellate>\n\t\t\t<altitudeMode>absolute</altitudeMode>\n\t\t\t<outerBoundaryIs>\n\t\t\t\t<LinearRing>\n\t\t\t\t\t<coordinates>\n", paste(paste("\t\t\t\t\t", apply(sgmts,1,paste,collapse=','),sep=''),collapse='\n'),"\n\t\t\t\t\t</coordinates>\n\t\t\t\t</LinearRing>\n\t\t\t</outerBoundaryIs>\n\t\t</Polygon>\n\t</Placemark>\n", sep=''))
	} # end of loop over polygons
      } # end of loop over pie charts in groups
    # close group specific folder into GE kml file    
    bloc2 = c(bloc2, "</Folder>\n")
    } #end of loop over groups

  ## Finalise kml writing
  cat(bloc1,bloc2,file=goo,append = TRUE)
  cat("\t</Document>\n</kml>",file=goo, append = TRUE)
  }