
nm.northarrow <- function() {
  scalesize <- 30000
  lines(c(xpos,xpos),c(ypos-scalesize,ypos+scalesize),col="black")
  polygon(c(xpos,xpos-(scalesize/10),xpos,xpos+(scalesize/10),xpos),c((ypos+scalesize/1.5),(ypos+scalesize/1.5),(ypos+scalesize),(ypos+scalesize/1.5),(ypos+scalesize/1.5)), col="black")
  text(xpos,ypos, "N", cex=0.8, col="black", font=1)
  scalebar <- (sbw/3)*5
  lines(c(xpos-scalebar*.5,xpos+scalebar*.5),c(ypos-scalesize*1.5,ypos-scalesize*1.5),col="black")
  text(xpos,ypos-scalesize*2, paste0(scalebar/1000,"km"), cex=0.6, col="black", font=1)
}

nm.colourful <- function(densmap){
  colramp <- nm.rybcolourmap(c(min(densmap),max(densmap)), sealevel=mean(densmap))
  colscale <- colourmap(col=attr(colramp,"stuff")$outputs, breaks=attr(colramp,"stuff")$breaks)
  return(colscale)
}

nm.rybcolourmap <- function(range, ...) {
  col <- nm.rybcolours(range, ...)
  z <- colourmap(col, range=range)
  return(z)
}

nm.rybcolours <- function(range, sealevel=0, ncolours=100,nbeach=0){
  stopifnot(is.numeric(range) && length(range)==2)
  stopifnot(all(is.finite(range)))
  yr <- colorRampPalette(c("yellow","orangered","darkred"), space="rgb")
  cb <- colorRampPalette(c("blue","cyan","yellow"), space="rgb")
  depths <- range[1]
  peaks <- range[2]
  dv <- diff(range)/(ncolours - 1)
  epsilon <- nbeach * dv/2
  lowtide <- max(sealevel - epsilon, depths)
  hightide <-  min(sealevel + epsilon, peaks)
  countbetween <- function(a, b, delta) { max(0, round((b-a)/delta)) }
  nsea <- countbetween(depths, lowtide, dv)
  nbeach <- countbetween(lowtide,  hightide, dv)
  nland <- countbetween(hightide,  peaks, dv)
  colours <- character(0)
  if(nsea > 0)  colours <- cb(nsea)
  if(nbeach > 0)  colours <- c(colours,rep("yellow",nbeach))
  if(nland > 0)  colours <- c(colours, yr(nland))
  return(colours)
}

nm.simFinds <- function(observed, types, toinclude=unique(types), decaymaps=NULL, nsim=1, model="random", dropcols=FALSE, verbose=TRUE){
  if (!is.null(decaymaps)){
    if (!identical(names(decaymaps),toinclude)){
      stop("The list of source decay maps must have names that are identical to unique(types) or to toinclude if the latter is provided.")
    }
  }
  res <- vector(mode="list", length=nsim)
  if (model == "random"){
    probsm <- matrix(ncol=length(toinclude),nrow=nrow(observed))
    probsm[] <- 1/length(toinclude)
  } else if (model == "decay"){
    distm <- matrix(ncol=length(toinclude),nrow=nrow(observed))
    for (d in 1:length(toinclude)){
      distm[,d] <- extract(decaymaps[[toinclude[d]]], observed)
    }
    probsm <- sweep(distm, 1, rowSums(distm), FUN="/")
  } else {
    stop("The model argument is not one of the current options.")
  }
  objdf <- observed
  objdf$simtype <- NA
  if (dropcols){ objdf@data <- objdf@data[,"simtype", drop=FALSE] }
  if (verbose){
    print("Simulating finds...")
    flush.console()
    pb <- txtProgressBar(min=1, max=nsim, style=3)
  }
  for (a in 1:nsim){
    if (verbose){ setTxtProgressBar(pb, a) }
    objdf$simtype <- NA
    for (b in 1:nrow(objdf)){
      if (!types[b] %in% toinclude){
        objdf$simtype[b] <- "other"
      } else {
        objdf$simtype[b] <- sample(toinclude, 1, prob=probsm[b,])
      }
    }
    res[[a]] <- objdf
  }
  class(res) <- append(class(res),"simfinds")
  if (verbose){
    close(pb)
    print("Done.")
  }
  return(res)
}

nm.decay <- function(x, ymax, s){
  ymax*exp(-1/2*(x)^2/s^2)
}

nm.simpson <- function(x){
  pt <- prop.table(na.omit(x))
  return(sum(pt * (1 - pt)))
}

nm.regDiversity <- function(x, regions, toinclude=NULL, divtype="nm.simpson"){
  if ("simfinds" %in% class(x)){
    if (length(regions)==1 & is.character(regions[1]) & regions[1] %in% colnames(x[[1]]@data)){
      regions <- x[[1]]@data[,regions]
    }
    divdf <- as.data.frame(matrix(ncol=length(unique(regions)),nrow=length(x)), stringsAsFactors=FALSE)
    for (d in 1:length(x)){
      tmpdf <- x[[d]]@data
      tmpdf$Type <- tmpdf$simtype
      tmpdf$Region <- regions
      tmpdf <- tmpdf[,c("Type","Region")]
      regdev <- as.data.frame.matrix(xtabs(~Region + Type, data=tmpdf))
      regdev <- regdev[,toinclude]
      divs <- apply(regdev, 1, divtype)
      divdf[d,] <- divs
      if (d==1){
        names(divdf) <- names(divs)
      }
    }
  }
  return(divdf)
}

nm.pfromrank <- function(obs,sims){
  stat <- as.numeric(rank(c(obs,sims))[1])
  n <- length(sims)+1
  if (stat > (n/2)){
    stat <- (stat-n+1) / n
  } else {
    stat <- stat / n
  }
  return(stat)
}

nm.thinDates <- function(ages, errors, bins, size, errorcap=NA, thresh=0.5, method="random", seed=NA){
  df <- data.frame(ages=ages, errors=errors, bins=bins, RN=1:length(ages))
  if (!is.na(errorcap)){ df <- df[df$errors <= errorcap,] }
  allbins <- unique(bins)
  sitelist <- vector(mode="list", length=length(allbins))
  for (a in 1:length(allbins)){
    df1 <- df[df$bins==allbins[a],]
    if (nrow(df1)<=size){
      sitelist[[a]] <- df1$RN
    } else {
      if (method=="random"){
        sitelist[[a]] <- sample(df1$RN,size)
      } else if (method=="splitsample"){
        rnks <- rank(df1$errors)
        check <- min(rnks[rnks>(size*thresh)])
        myinds <- which(rnks<=check)
        if (!is.na(seed) & is.numeric(seed)){ set.seed(seed) }
        res <- sample(df1$RN[myinds],size*thresh)
        if (length(res)<size){
          inds <- df1$RN
          if (!is.na(seed) & is.numeric(seed)){ set.seed(seed) }
          therest <- sample(inds[!inds %in% res],size*(1-thresh))
          sitelist[[a]] <- c(res,therest)
        } else {
          sitelist[[a]] <- res
        }
      } else {
        stop("The method argument must currently be one of random, splitsample or minerrors")
      }
    }
  }
  allres <- sort(unlist(sitelist))
  return(allres)
}

nm.sig <- function(sigtext) {
  if (!is.na(sigtext)) {
    sigtext <- format(round(sigtext, digits = 4), scientific = FALSE)
    return(sigtext)
  }
}
