# Miscellaneous subroutines or functions used by interpolate_seats.R.

# Function which takes a state abbreviation and returns the full name.
long_state <- function(short_state) {
  switch(short_state,
         QLD = "Queensland",
         NSW = "New South Wales",
         VIC = "Victoria",
         TAS = "Tasmania",
         SA = "South Australia",
         WA = "Western Australia",
         NT = "Northern Territory",
         ACT = "Australian Capital Territory"
  )
}


# Function which takes a takes a party name (ending in "_prim" as in the data frame) and returns
# the lower and upper bounds of the colour scale.
party_colours <- function(party) {
  switch(party,
         ALP_prim = c("#FFFFFF", "#FF0000"),
         LP_prim = c("#FFFFFF", "#0000FF"),
         NP_prim = c("#FFFFFF", "#33AA00"),
         GRN_prim = c("#FFFFFF", "#00FF00"),
         HAN_prim = c("#000000", "#FFFF00"),
         IND_prim = c("#FFFFFF", "#444444"),
         DEM_prim = c("#FFFFFF", "#444444"),
         KAP_prim = c("#FFFFFF", "#FF0000"),
         PUP_prim = c("#000000", "#FFFF00")
  )
}

# Function to return a colour to plot booth locations; default is black but choose something different
# if the raster colour scale goes through either black or dark grey.
booth_colour <- function(clr_vec) {
  # The first and last entries of the colour scale are for water and nonseat cells.  We are only
  # interested in the second and second-last colours in the scale (in TCP/TPP, there is a middle colour,
  # always middle-grey or white, and the default black booth colour will never clash with it).
  main_clrs <- clr_vec[c(2, length(clr_vec)-1)]
  clrs_dark_grey <- is_dark_grey(main_clrs)
  
  if (length(which(clrs_dark_grey)) > 0) {
    rgb_clr <- col2rgb(main_clrs[which(!clrs_dark_grey)])
    grey <- (sum(rgb_clr == rgb_clr[1]) == 3)
    if (grey) {
      booth_clr <- "#FF0000"
    } else {
      rgb_clr <- 1 - rgb_clr/255
      booth_clr <- rgb(rgb_clr[1], rgb_clr[2], rgb_clr[3])
    }
    
    if (length(booth_clr) > 1) {
      print("booth_clr vector has length > 1.")
      asdkfjh <- asldkjfh(asdgfd)
    }
  } else {
    booth_clr <- "#000000"
  }
  
  return(booth_clr)
}

# Function to take a vectors of colours of form "#FF9900" and returns whether each is dark grey.
is_dark_grey <- function(clr_vec) {
  rgb_clrs <- col2rgb(clr_vec)
  grey <- apply(rgb_clrs, 2, function(x) sum(x == x[1])) == 3
  dark <- rgb_clrs[1, ] < 128
  darkgrey <- as.vector(dark & grey)
  return(darkgrey)
}


# Returns the top-right corner of a raster-plot area, as a complex number.
# Assumes that the grey background has RGB-values around 0.898(...).
raster_corner <- function(raster_img) {
  grey_px_bycol <- apply(as.matrix(raster_img[ , , 3]), 1, function(x) sum((x>0.898) & (x<0.899)))
  grey_px_byrow <- apply(as.matrix(raster_img[ , , 3]), 2, function(x) sum((x>0.898) & (x<0.899)))
  real_end_x <- max(which(grey_px_bycol > 0.5*max(grey_px_bycol)))
  real_end_y <- min(which(grey_px_byrow > 0.5*max(grey_px_byrow)))
  
  return(complex(real=real_end_x, imaginary=real_end_y))
}


# Returns the y-pixel of the lower edge of a raster plot area.
raster_lower <- function(raster_img) {
  grey_px_byrow <- apply(as.matrix(raster_img[ , , 3]), 2, function(x) sum((x>0.898) & (x<0.899)))
  real_end_y <- max(which(grey_px_byrow > 0.5*max(grey_px_byrow)))
  
  return(real_end_y)
}


# Function to fill up a map with land and water at given values
basic_map <- function(old_grid, land, land_value, water, water_value) {
  new.df <- as.data.frame(old_grid)
  new.df$celltype <- NA
  new.df$celltype[land] <- land_value
  new.df$celltype[water] <- water_value
  new.df$fakewater <- water_value
  new.df$fakeland <- land_value
  
  return(new.df)
}



# Function to plot a map with suburbs, returns the lower-right corner of the raster area.
# Assumes that the values to go into the raster plot are in precisely the right format.
plot_map <- function(xrange, yrange, data.df, clrs, clrvals, suburb_xy, suburb_names, plot_title, out_file, img_height) {
  map_raster <- ggplot(environment = environment()) + scale_x_continuous(limits=xrange, label=function(x) format(x/1000))
  map_raster <- map_raster + scale_y_continuous(limits=yrange, label=function(x) format(x/1000)) + coord_equal()
  map_raster <- map_raster + theme(axis.title.y = element_text(vjust=0.4))
  map_raster <- map_raster + geom_raster(data=data.df, aes(x=x, y=y, fill=fakewater))
  map_raster <- map_raster + geom_raster(data=data.df, aes(x=x, y=y, fill=fakeland))
  map_raster <- map_raster + geom_raster(data=data.df, aes(x=x, y=y, fill=celltype))
  map_raster <- map_raster + scale_fill_gradientn(colours=clrs, space="rgb", values=clrvals)
  map_raster <- map_raster + guides(fill = guide_colorbar(title=""))
  
  # Following line is problematic, I think because of a scoping issues bug with aes in ggplot2.
  # As a result, the suburb_xy and suburb_names are actually referring to variables that live in
  # the main environment, not the environment local to this function.
  map_raster <- map_raster + geom_text(aes(x=suburb_xy[, 1], y=suburb_xy[, 2], label=suburb_names), colour="#FFFF00")
  map_raster <- map_raster + ggtitle(plot_title)
  
  png_print(out_file, 500, img_height, map_raster)
  
  # Remove the colourbar:
  main_img <- readImage(out_file)
  corner_px <- raster_corner(main_img)
  real_end_r <- Re(corner_px)
  
  # Don't want to cut off the right-most axis label, so only replace rows 1:raster_lower(main_img) with white pixels:
  main_img[(real_end_r+1):500, 1:raster_lower(main_img) , ] <- 1
  writeImage(main_img, out_file)
  
  return(corner_px)
}


# Writes a picture to PNG:
png_print <- function(out_file, img_width, img_height, ggplot_img) {
  png(filename=out_file, width=img_width, height=img_height, units="px")
  print(ggplot_img)
  dev.off()
  return(T)
}


# Function that takes a point pattern and a threshold distance, and returns a vector containing the 
# reciprocal of the number of neighbours of each point in the ppp less than the threshold (plus 1 for 
# the point itself).
decl_wts <- function(points_ppp, dist) {
  n <- 1
  indices_togo <- 1:length(points_ppp$x)
  wts <- rep(1, length(points_ppp$x))
  while (length(indices_togo) > 0) {
    nearest_dist <- nndist(points_ppp, k=n)
    indices_gt_dist <- which(nearest_dist > dist)
    indices_gt_dist <- intersect(indices_gt_dist, indices_togo)
    wts[indices_gt_dist] <- 1/n
    if (length(indices_gt_dist) > 0) {
      # For some reason v <- v[-numeric()] returns numeric() rather than v, so we have to
      # put the following line inside an if statement to check that we have some indices
      # to get rid of.
      indices_togo <- indices_togo[-which(indices_togo %in% indices_gt_dist)]
    }
    n <- n + 1
    if (n == length(points_ppp$x)) {
      # Exhausted all points; fill up the rest of the weights vector.
      wts[indices_togo] <- 1/n
      indices_togo <- numeric()
    }
  }
  return(wts)
}