inst/doc/stppSim-vignette.R

In stppSim: Spatiotemporal Point Patterns Simulation

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----functions, include=FALSE-------------------------------------------------
# A function for captioning and referencing images
fig <- local({
    i <- 0
    ref <- list()
    list(
        cap=function(refName, text) {
            i <<- i + 1
            ref[[refName]] <<- i
            paste("Figure ", i, ": ", text, sep="")
        },
        ref=function(refName) {
            ref[[refName]]
        })
})

## ----figs1, warnings=FALSE, echo=FALSE, out.width="90%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs1","Type of origin concentration")----
knitr::include_graphics("origins.png")

## ----eval=FALSE, echo=TRUE----------------------------------------------------
#  #load shapefile data
#  load(file = system.file("extdata", "camden.rda", package="stppSim"))
#  #extract boundary shapefile
#  boundary = camden$boundary # get boundary
#  #compute the restriction map
#  restrct_map <- space_restriction(shp = boundary,res = 20, binary = TRUE)
#  #plot the restriction map
#  plot(restrct_map)

## ----eval=FALSE, echo=TRUE----------------------------------------------------
#  # get landuse data
#  landuse = camden$landuse
#  
#  #compute the restriction map
#  full_restrct_map <- space_restriction(shp = landuse,
#       baseMap = restrct_map, res = 20, field = "restrVal", background = 1)
#  
#  #plot the restriction map
#  plot(full_restrct_map)

## ----figs2, echo=FALSE, out.width="100%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs2","Restriction map")----
knitr::include_graphics("restrictionMap.png")

## ----figs3, echo=FALSE, out.width="70%", out.height="50%", fig.align = "center", fig.cap=fig$cap("figs3", "Global trends and patterns")----
knitr::include_graphics("trend.png")

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  #To install from  `CRAN`
#  install.packages("stppSim")
#  
#  #To install the `developmental version`, type:
#  remotes::install_github("MAnalytics/stppSim")
#  #Note: `remotes` is an extra package that needed to be installed prior to the running of this code.

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  library(stppSim)

## ----eval=FALSE, echo = TRUE, message=FALSE, warning=FALSE--------------------
#  
#  #load the data
#  load(file = system.file("extdata", "camden.rda",
#                          package="stppSim"))
#  
#  boundary <- camden$boundary # get boundary data
#  
#  #specifying data sizes
#  pt_sizes = c(200, 1000, 2000)
#  
#  #simulate data
#  artif_stpp <- psim_artif(n_events=pt_sizes, start_date = "2021-01-01",
#    poly=boundary, n_origin=50, restriction_feat = NULL,
#    field = NA,
#    n_foci=5, foci_separation = 10, mfocal = NULL,
#    conc_type = "dispersed",
#    p_ratio = 20, s_threshold = 50, step_length = 20,
#    trend = "stable", fpeak=NULL,
#    slope = NULL,show.plot=FALSE, show.data=FALSE)
#  

## ----eval=FALSE---------------------------------------------------------------
#  stpp_1000 <- artif_stpp[[2]]

## ----figs4, echo=FALSE, out.width="100%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs4", "Simulated spatial point patterns of Camden")----
knitr::include_graphics("fromscratch.png")

## ----figs5, echo=FALSE, out.width="100%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs5","Simulated global trends and patterns (gtp)")----
knitr::include_graphics("temporalscratch.png")

## ----figs6, echo=FALSE, out.width="50%", out.height="50%", fig.align = "center", fig.cap=fig$cap("figs6", "Gtp with an earlier first seasonal peak")----
knitr::include_graphics("onemonth.png")

## ----eval=FALSE, echo = TRUE, message=FALSE, warning=FALSE--------------------
#  
#  #load the data
#  load(file = system.file("extdata", "camden.rda",
#                          package="stppSim"))
#  
#  boundary <- camden$boundary # get boundary data
#  
#  #specifying data sizes
#  pt_sizes = c(1500)
#  
#  #simulate data
#  artif_stpp <- psim_artif(n_events=pt_sizes, start_date = NULL,
#    poly=boundary, n_origin=50, restriction_feat = NULL,
#    field = NA,
#    n_foci=5, foci_separation = 10, mfocal = NULL,
#    conc_type = "dispersed",
#    p_ratio = 20, s_threshold = 50, step_length = 20,
#    trend = "stable", fpeak=NULL,
#    shortTerm = "acyclical"
#    s_band = c(0, 200),
#    t_band = c(1,2),
#    slope = NULL,show.plot=FALSE, show.data=FALSE)
#  

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  
#  #load Camden crimes
#  data(camden_crimes)
#  
#  #extract 'theft' crime
#  theft <- camden_crimes %>%
#    filter(type == "Theft")
#  
#  #print the total no. of records
#  nrow(theft)

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  
#  #specify the proportion of total records to extract
#  sample_size <- 0.3 #i.e., 30%
#  
#  set.seed(1000)
#  dat_sample <- theft[sample(1:nrow(theft),
#    round((sample_size * nrow(theft)), digits=0),
#    replace=FALSE),1:3]
#  
#  #print the number of records in the sample data
#  nrow(dat_sample)

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  
#  plot(dat_sample$x, dat_sample$y,
#      pch = 16,
#       cex = 1,
#       main = "Sample data at unique locations",
#       xlab = "x",
#       ylab = "y")

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  agg_sample <- dat_sample %>%
#    mutate(y = round(y, digits = 0))%>%
#    mutate(x = round(x, digits = 0))%>%
#    group_by(x, y) %>%
#    summarise(n=n()) %>%
#    mutate(size = as.numeric(if_else((n >= 1 & n <= 2), paste("1"),
#                          if_else((n>=3 & n <=5), paste("2"), paste("2.5")))))
#  
#  dev.new()
#  itvl <- c(1, 2, 2.5)
#  plot(agg_sample$x, agg_sample$y,
#       pch = 16,
#       cex=findInterval(agg_sample$size, itvl),
#       main = "Sample data aggregated at unique location",
#       xlab = "x",
#       ylab = "y")
#  legend("topright", legend=c("1-2","3-5", ">5"), pt.cex=itvl, pch=16)
#  
#  #hist(agg_sample$size)

## ----figs7, echo=FALSE, out.width="100%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs7", "Sample real data (a) unaggregated and (b) aggregated by locations")----
knitr::include_graphics("samplerealvssampleaggregated.png")

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  
#  #As the actual size of any real (full) dataset
#  #would not be known, therefore we will assume
#  #`n_events` to be `2000`. In practice, a user can
#  #infer `n_events` from several other sources, such
#  #as other available full data sets, or population data,
#  #etc.
#  
#  #Simulate
#  sim_fullData <- psim_real(n_events=2000, ppt=dat_sample,
#    start_date = NULL, poly = NULL, s_threshold = NULL,
#    step_length = 20, n_origin=50, restriction_feat=landuse,
#    field="restrVal", p_ratio=20, crsys = "EPSG:27700")
#  

## ----eval=FALSE, echo=FALSE, warning=FALSE------------------------------------
#  #read
#  load(file="C:/Users/monsu/Documents/GitHub/stppSim backup/simulation_for_vignette/sim_fullData.rda")
#  sim_d <- sim_fullData[[1]]
#  

## ----eval=FALSE, echo=TRUE, warning=FALSE-------------------------------------
#  summary(sim_fullData[[1]])

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  
#  #get the restriction data
#  landuse <- as_Spatial(landuse)
#  
#  simulated_stpp_ <- psim_real(
#    n_events=2000,
#    ppt=dat_sample,
#    start_date = NULL,
#    poly = NULL,
#    netw = NULL,
#    s_threshold = NULL,
#    step_length = 20,
#    n_origin=100,
#    restriction_feat = landuse,
#    field="restrVal",
#    p_ratio=20,
#    interactive = FALSE,
#    s_range = 600,
#    s_interaction = "medium",
#    crsys = "EPSG:27700"
#  )
#  

## ----eval=FALSE, message=FALSE, warning=FALSE---------------------------------
#  
#  #extract the output of a simulation
#  stpp <- simulated_stpp_[[1]]
#  
#  stpp <- stpp %>%
#    dplyr::mutate(date = substr(datetime, 1, 10))%>%
#    dplyr::mutate(date = as.Date(date))
#  
#  #define spatial and temporal thresholds
#  s_range <- 600
#  s_thres <- seq(0, s_range, len=4)
#  
#  t_thres <- 1:31
#  
#  #detect space-time interactions
#  myoutput2 <- NRepeat(x = stpp$x, y = stpp$y, time = stpp$date,
#                          sds = s_thres,
#                          tds = t_thres,
#                          s_include.lowest = FALSE, s_right = FALSE,
#                          t_include.lowest = FALSE, t_right = FALSE)
#  
#  #extract the knox ratio
#  knox_ratio <- round(myoutput2$knox_ratio, digits = 2)
#  
#  #extract the corresponding significance values
#  pvalues <- myoutput2$pvalues
#  
#  #append asterisks to significant results
#  for(i in 1:nrow(pvalues)){ #i<-1
#      id <- which(pvalues[i,] <= 0.05)
#      knox_ratio[i,id] <- paste0(knox_ratio[i,id], "*")
#  
#  }
#  
#  #output the results
#  knox_ratio
#  

## ----figs8, echo=FALSE, out.width="100%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs8", "Setting an earlier first seasonal peak")----
knitr::include_graphics("simvsreal_spatial.png")

## ----figs9, echo=FALSE, out.width="100%", out.height="100%", fig.align = "center", fig.cap=fig$cap("figs9", "Global temporal pattern of (a) simulated and (b) full real data set ")----
knitr::include_graphics("simvsreal_temporal.png")

## ----table1, results='asis', echo=FALSE, tidy.opts=list(width.cutoff=50)------
table <- data.frame(cbind(Dimension = c("Spatial", "","","Temporal","",""),
      Scale_sq.mts = c(150, 250, 400, "Daily", "Weekly", "Monthly"),
      Corr.Coeff = c(.50, .62, .78, .34, .78, .93)))

knitr::kable(table, caption = "Table 1. `Correlation between simulated and real data sets`", row.names=FALSE, align=c("l", "r", "r"))

## ----eval=FALSE, echo=TRUE, warning=FALSE-------------------------------------
#  
#  #load 'area1' object - boundary of Camden, UK
#  load(file = system.file("extdata", "camden.rda",
#                          package="stppSim"))
#  
#  camden_boundary = camden$boundary
#  
#  #load 'area2' - boundary of Birmingham, UK
#  load(file = system.file("extdata", "birmingham_boundary.rda",
#                          package="stppSim"))
#  
#  #run the comparison
#  output <- compare_areas(area1 = camden_boundary,
#                area2 = birmingham_boundary, display_output = FALSE)
#  

## ----eval=FALSE, echo=FALSE, warning=FALSE------------------------------------
#  output$comparison