Added remaining files

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2022 Katie Hampson
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

R/Every_nth.R

@@ -0,0 +1,18 @@
+every_nth <- function(x, nth, empty = TRUE, inverse = FALSE) 
+{
+  if (!inverse) {
+    if(empty) {
+      x[1:nth == 1] <- ""
+      x
+    } else {
+      x[1:nth != 1]
+    }
+  } else {
+    if(empty) {
+      x[1:nth != 1] <- ""
+      x
+    } else {
+      x[1:nth == 1]
+    }
+  }
+}

R/elapsed_months.R

@@ -0,0 +1,7 @@
+elapsed_months <- function(end_date, start_date) {
+  ed <- as.Date(end_date)
+  sd <- as.Date(start_date)
+
+  (12 * (as.numeric(substr(ed, 1,4)) - as.numeric(substr(sd, 1,4)))) +
+      (as.numeric(substr(ed, 6,7)) - as.numeric(substr(sd, 6,7)))
+}

R/g_legend.R

@@ -0,0 +1,6 @@
+g_legend <- function(a.gplot){
+  tmp <- ggplot_gtable(ggplot_build(a.gplot))
+  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
+  legend <- tmp$grobs[[leg]]
+  return(legend)
+}

R/popMap.R

@@ -0,0 +1,72 @@
+#
+## Function to distribute individuals to cells based on a probability map
+#________________________________________
+
+
+PopMap<- function(PembaUTM,PembaWard,init=0,probMap,wardPops,missedVill=NA,missedVillCells=NA,villageIDs){
+
+  ## Set up column to hold initial population map
+  PembaUTM$popMap <- init
+
+  if(!is.null(missedVill)){
+    if(is.na(missedVill)|is.na(missedVillCells)){
+
+      ##Find villages that don't have an assigned cell
+      missedVill <- which(!is.element(1:length(wardPops),unique(PembaUTM$WardID)))
+
+      ##Find which grid cell each of these has the greatest degree of overlap with
+      centroids <- SpatialPoints(coordinates(PembaWard[missedVill,]),proj4string=PembaUTM@proj4string)
+      missedVillCells <- over(centroids,PembaUTM)$cellID
+
+      ## If some missed villages haven't got a cell as they're on the coast, assign these to the closest cell
+      if(length(which(is.na(missedVillCells)))>0){
+        for (i in which(is.na(missedVillCells))){
+          missedVillCells[i] <- which.min(gDistance(centroids[i,], PembaUTM, byid=TRUE))
+        } 
+      }
+
+    } 
+  }
+
+
+  ## for each village
+  for(i in 1:nrow(PembaWard@data)){
+
+    if(is.element(i,missedVill)){
+      PembaUTM$popMap[missedVillCells[which(missedVill==i)]] <- PembaUTM$popMap[missedVillCells[which(missedVill==i)]] + wardPops[i]
+
+    }else {
+
+      ## cells and individuals in village
+      n_inds<-wardPops[i]
+      if(sign(n_inds)==-1){
+        cells<-which(villageIDs==i & PembaUTM$popMap>0)
+        probs<-rep(1,length(cells))
+      }else{
+        cells<-which(villageIDs==i)
+        probs <- probMap[which(!is.na(probMap[]))[cells]]
+        if(sum(probs)==0){probs<-probs+1}
+      }
+
+      popChanges <- rep(0,length(cells))
+      if(sign(n_inds)==-1){
+        popChangesTable <- table(sample(rep(1:length(cells),times=PembaUTM$popMap[cells]),abs(n_inds)))
+        popChanges[as.numeric(names(popChangesTable))] <- as.numeric(popChangesTable)
+
+      }else if(sign(n_inds)==1){
+        popChanges <- rmultinom(1,abs(n_inds),probs)
+      }    
+
+
+      ##distribute among available cells
+      PembaUTM$popMap[cells] <- PembaUTM$popMap[cells] + sign(n_inds)*popChanges
+
+    }
+
+  }
+
+  return(PembaUTM$popMap)
+
+}
+
+