#########################################################################################################
#Function Purpose/Notes:
#########################################################################################################
#  The function displaces points based on DHS guidelines (random angle of displacement, random distance).
#  Points will be offset within the same administrative boundaries that they are currently located in.
#  All points must currently be located in an administrative boundary or the function will fail.
#########################################################################################################

########################################################################################################################################################
#Function Input:
########################################################################################################################################################
#  pts:          The points to be displaced.  [SpatialPointsDataFrame object, projected, [+proj=utm +zone=36 +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0]].
#  urban_rural:  The vector of urban/rural indicators for each of the points to be offset.  [Urban="U", Rural="R"].  
#  admin:        The administrative boundary of the region of interest.  Points will not be offset outside of these boundaries.  
#                [SpatialPolygonsDataFrame object, projected, [+proj=utm +zone=36 +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0]].
#  samp_num:     The number of times the points should be offset.
#  other_num:    The number of buffer filling points, should be as large as possible (considering time constraints).  We recommend 100,000 or larger. 
########################################################################################################################################################

########################################################################################################################################
#Function Output:
########################################################################################################################################
#  The function returns a list of length "samp_num".  
#  Each entry is a matrix (n x 2) of displaced locations, where n is the number of points to be displaced.
########################################################################################################################################

displace <- function(pts, urban_rural, admin, samp_num, other_num){
      
            #Required Packages
	    require(rgdal)
	    require(maptools)
	    require(rgeos)
	    require(spatstat)
	    require(splancs)
            require(fields)

            #Number of Points to be Displaced
            n<-length(pts)

            #Determining the Maximum Displacement Distance Based on the Urban/Rural Indicator
	    offset.dist<-ifelse(urban_rural=="U", 2000, 5000)
	    rural<-which(urban_rural=="R")

            #1 Out of Every 100 Rural Locations will be Displaced Up to 10km
	    rur.n<-floor(0.01*length(rural))
	    offset.dist[sample(rural, size=rur.n, replace=FALSE)]<-10000
	
	    r.pts0<-list(0)
	    for(i in 1:nrow(pts)){
               r.pts0[[i]]<-matrix(0,nrow=samp_num,ncol=2)

	       #Creating a Buffer Around the Point
	       pdsc<-disc(radius=offset.dist[i], centre =c(coordinates(pts)[i,1], coordinates(pts)[i,2]))
	       pdsc<-as(pdsc, "SpatialPolygons")
	       proj4string(pdsc)<-CRS("+proj=utm +zone=36 +datum=WGS84")
		
	       #Determining which Administrative Boundary the Point is in
	       ov<-over(pts[i,], admin)
               ov_mat<-matrix(unlist(ov),nrow=nrow(admin@data),ncol=ncol(admin@data),byrow=T)
               admin_mat<-matrix(unlist(admin@data),nrow=nrow(admin@data),ncol=ncol(admin@data))
               ov<-c(1:nrow(admin@data))[rowMeans(ov_mat==admin_mat)==1]
               ov<-ov[is.na(ov)==0]
               poly<-admin[ov,]
	       int<-gIntersection(pdsc, poly)

	       #Generating the Displaced Point
               if(length(int@polygons[[1]]@Polygons)==1){          #Only a Single Intersected Region
                 region<-int@polygons[[1]]@Polygons[[1]]@coords 
                 
                 #Non-Missing Intersection Region 
	         if(!is.null(int)){
	           rpt<-csr(region, other_num)
                   probs<-1/rdist(matrix(coordinates(pts[i,]),nrow=1,ncol=2), rpt)
                   rpt<-rpt[sample(c(1:(length(rpt)/2)), size=samp_num, prob=(probs[1,]/sum(probs[1,])), replace=TRUE),]
	           r.pts0[[i]]<-rpt
                   }

                 #Missing Intersection Region
	         if(is.null(int)){
		   rpt<-csr(pdsc@polygons[[1]]@Polygons[[1]]@coords, other_num)
                   probs<-1/rdist(matrix(coordinates(pts[i,]),nrow=1,ncol=2), rpt)
                   rpt<-rpt[sample(c(1:other_num), size=samp_num, prob=(probs[1,]/sum(probs[1,])), replace=TRUE),]
		   r.pts0[[i]] <- rpt
                   }   
                 }
                  
               #Multiple Intersected Regions
               if(length(int@polygons[[1]]@Polygons)>1){
                 region<-int@polygons[[1]]@Polygons[[1]]@coords 
                  
	         if(!is.null(int)){
	           rpt<-csr(region, round(other_num*(int@polygons[[1]]@Polygons[[1]]@area/int@polygons[[1]]@area)))         
                   }
	         if(is.null(int)){
		   rpt<-csr(pdsc@polygons[[1]]@Polygons[[1]]@coords, round(other_num/length(int@polygons[[1]]@Polygons)))
                   }        

                 for(k in 2:length(int@polygons[[1]]@Polygons)){
                    region<-int@polygons[[1]]@Polygons[[k]]@coords 
                  
	            if(!is.null(int)){
	              rpt<-rbind(rpt, csr(region, round(other_num*(int@polygons[[1]]@Polygons[[k]]@area/int@polygons[[1]]@area))))
                      }
	            if(is.null(int)){
		      rpt<-rbind(rpt, csr(pdsc@polygons[[1]]@Polygons[[1]]@coords, round(other_num/length(int@polygons[[1]]@Polygons))))
                      }          
                    }
                 probs<-1/rdist(matrix(coordinates(pts[i,]),nrow=1,ncol=2), rpt)
                 rpt<-rpt[sample(c(1:(length(rpt)/2)), size=samp_num, prob=(probs[1,]/sum(probs[1,])), replace=TRUE),]
		 r.pts0[[i]]<-rpt
                 }

               #Completion Percentage
               print(c("Percent Complete", 100*round(i/n,2)))          
               }
        
             #Arranging the Output
             if(samp_num==1){
               r.pts<-list(0)
               r.pts[[1]]<-matrix(0,nrow=n,ncol=2)
               for(k in 1:n){
                  r.pts[[1]][k,]<-c(r.pts0[[k]])
                  }
               r.pts[[1]]<-SpatialPoints(r.pts[[1]], CRS("+proj=utm +zone=36 +datum=WGS84"))
               }        
      
             if(samp_num>1){
               r.pts<-list(0)
               for(j in 1:samp_num){
                  r.pts[[j]]<-matrix(0,nrow=n,ncol=2)
                  for(k in 1:n){
                     r.pts[[j]][k,]<-r.pts0[[k]][j,]
                     }
                  r.pts[[j]]<-SpatialPoints(r.pts[[j]], CRS("+proj=utm +zone=36 +datum=WGS84"))
                  }
               }
        
        #Outputting the Results
	return(r.pts)
	}