Homework 5 Lab 4
Joshua Reyna
2023-03-29
library(mapview)
library(censusxy)
library(tmap)
library(tmaptools)
library(classInt)
library(xplorerr)
library(grid)
library(tidycensus)
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ dplyr 1.0.9
## ✔ tidyr 1.2.0 ✔ stringr 1.4.1
## ✔ readr 2.1.2 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(sf)## Linking to GEOS 3.9.1, GDAL 3.4.3, PROJ 7.2.1; sf_use_s2() is TRUElibrary(tmap)
library(tmaptools)
library(classInt)
library(dplyr)
library(patchwork)
library(ggsn)
library(viridis)## Loading required package: viridisLiteinstall.packages## function (pkgs, lib, repos = getOption("repos"), contriburl = contrib.url(repos,
## type), method, available = NULL, destdir = NULL, dependencies = NA,
## type = getOption("pkgType"), configure.args = getOption("configure.args"),
## configure.vars = getOption("configure.vars"), clean = FALSE,
## Ncpus = getOption("Ncpus", 1L), verbose = getOption("verbose"),
## libs_only = FALSE, INSTALL_opts, quiet = FALSE, keep_outputs = FALSE,
## ...)
## {
## if (!is.character(type))
## stop("invalid 'type'; must be a character string")
## type2 <- .Platform$pkgType
## if (type == "binary") {
## if (type2 == "source")
## stop("type 'binary' is not supported on this platform")
## else type <- type2
## if (type == "both" && (!missing(contriburl) || !is.null(available)))
## stop("specifying 'contriburl' or 'available' requires a single type, not type = \"both\"")
## }
## if (is.logical(clean) && clean)
## clean <- "--clean"
## if (is.logical(dependencies) && is.na(dependencies))
## dependencies <- if (!missing(lib) && length(lib) > 1L)
## FALSE
## else c("Depends", "Imports", "LinkingTo")
## get_package_name <- function(pkg) {
## gsub("_[.](zip|tar[.]gz|tar[.]bzip2|tar[.]xz)", "", gsub(.standard_regexps()$valid_package_version,
## "", basename(pkg)))
## }
## getConfigureArgs <- function(pkg) {
## if (.Platform$OS.type == "windows")
## return(character())
## if (length(pkgs) == 1L && length(configure.args) && length(names(configure.args)) ==
## 0L)
## return(paste0("--configure-args=", shQuote(paste(configure.args,
## collapse = " "))))
## pkg <- get_package_name(pkg)
## if (length(configure.args) && length(names(configure.args)) &&
## pkg %in% names(configure.args))
## config <- paste0("--configure-args=", shQuote(paste(configure.args[[pkg]],
## collapse = " ")))
## else config <- character()
## config
## }
## getConfigureVars <- function(pkg) {
## if (.Platform$OS.type == "windows")
## return(character())
## if (length(pkgs) == 1L && length(configure.vars) && length(names(configure.vars)) ==
## 0L)
## return(paste0("--configure-vars=", shQuote(paste(configure.vars,
## collapse = " "))))
## pkg <- get_package_name(pkg)
## if (length(configure.vars) && length(names(configure.vars)) &&
## pkg %in% names(configure.vars))
## config <- paste0("--configure-vars=", shQuote(paste(configure.vars[[pkg]],
## collapse = " ")))
## else config <- character()
## config
## }
## get_install_opts <- function(pkg) {
## if (!length(INSTALL_opts))
## character()
## else paste(INSTALL_opts[[get_package_name(pkg)]], collapse = " ")
## }
## if (missing(pkgs)) {
## if (!interactive())
## stop("no packages were specified")
## if (.Platform$OS.type == "windows" || .Platform$GUI ==
## "AQUA" || (capabilities("tcltk") && capabilities("X11") &&
## suppressWarnings(tcltk::.TkUp))) {
## }
## else stop("no packages were specified")
## if (is.null(available)) {
## av <- available.packages(contriburl = contriburl,
## method = method, ...)
## if (missing(repos))
## repos <- getOption("repos")
## if (type != "both")
## available <- av
## }
## else av <- available
## if (NROW(av)) {
## pkgs <- select.list(sort(unique(rownames(av))), multiple = TRUE,
## title = "Packages", graphics = TRUE)
## }
## }
## if (.Platform$OS.type == "windows" && length(pkgs)) {
## pkgnames <- get_package_name(pkgs)
## inuse <- search()
## inuse <- sub("^package:", "", inuse[grep("^package:",
## inuse)])
## inuse <- pkgnames %in% inuse
## if (any(inuse)) {
## warning(sprintf(ngettext(sum(inuse), "package %s is in use and will not be installed",
## "packages %s are in use and will not be installed"),
## paste(sQuote(pkgnames[inuse]), collapse = ", ")),
## call. = FALSE, domain = NA, immediate. = TRUE)
## pkgs <- pkgs[!inuse]
## }
## }
## if (!length(pkgs))
## return(invisible())
## if (missing(lib) || is.null(lib)) {
## lib <- .libPaths()[1L]
## if (!quiet && length(.libPaths()) > 1L)
## message(sprintf(ngettext(length(pkgs), "Installing package into %s\n(as %s is unspecified)",
## "Installing packages into %s\n(as %s is unspecified)"),
## sQuote(lib), sQuote("lib")), domain = NA)
## }
## ok <- dir.exists(lib) & (file.access(lib, 2) == 0L)
## if (length(lib) > 1 && any(!ok))
## stop(sprintf(ngettext(sum(!ok), "'lib' element %s is not a writable directory",
## "'lib' elements %s are not writable directories"),
## paste(sQuote(lib[!ok]), collapse = ", ")), domain = NA)
## if (length(lib) == 1L && .Platform$OS.type == "windows") {
## ok <- dir.exists(lib)
## if (ok) {
## fn <- file.path(lib, paste0("_test_dir_", Sys.getpid()))
## unlink(fn, recursive = TRUE)
## res <- try(dir.create(fn, showWarnings = FALSE))
## if (inherits(res, "try-error") || !res)
## ok <- FALSE
## else unlink(fn, recursive = TRUE)
## }
## }
## if (length(lib) == 1L && !ok) {
## warning(gettextf("'lib = \"%s\"' is not writable", lib),
## domain = NA, immediate. = TRUE)
## userdir <- unlist(strsplit(Sys.getenv("R_LIBS_USER"),
## .Platform$path.sep))[1L]
## if (interactive()) {
## ans <- askYesNo(gettext("Would you like to use a personal library instead?"),
## default = FALSE)
## if (!isTRUE(ans))
## stop("unable to install packages")
## lib <- userdir
## if (!file.exists(userdir)) {
## ans <- askYesNo(gettextf("Would you like to create a personal library\n%s\nto install packages into?",
## sQuote(userdir)), default = FALSE)
## if (!isTRUE(ans))
## stop("unable to install packages")
## if (!dir.create(userdir, recursive = TRUE))
## stop(gettextf("unable to create %s", sQuote(userdir)),
## domain = NA)
## .libPaths(c(userdir, .libPaths()))
## }
## }
## else stop("unable to install packages")
## }
## lib <- normalizePath(lib)
## if (length(pkgs) == 1L && missing(repos) && missing(contriburl)) {
## if ((type == "source" && any(grepl("[.]tar[.](gz|bz2|xz)$",
## pkgs))) || (type %in% "win.binary" && endsWith(pkgs,
## ".zip")) || (startsWith(type, "mac.binary") && endsWith(pkgs,
## ".tgz"))) {
## repos <- NULL
## message("inferring 'repos = NULL' from 'pkgs'")
## }
## if (type == "both") {
## if (type2 %in% "win.binary" && endsWith(pkgs, ".zip")) {
## repos <- NULL
## type <- type2
## message("inferring 'repos = NULL' from 'pkgs'")
## }
## else if (startsWith(type2, "mac.binary") && endsWith(pkgs,
## ".tgz")) {
## repos <- NULL
## type <- type2
## message("inferring 'repos = NULL' from 'pkgs'")
## }
## else if (grepl("[.]tar[.](gz|bz2|xz)$", pkgs)) {
## repos <- NULL
## type <- "source"
## message("inferring 'repos = NULL' from 'pkgs'")
## }
## }
## }
## if (length(pkgs) == 1L && is.null(repos) && type == "both") {
## if ((type2 %in% "win.binary" && endsWith(pkgs, ".zip")) ||
## (startsWith(type2, "mac.binary") && endsWith(pkgs,
## ".tgz"))) {
## type <- type2
## }
## else if (grepl("[.]tar[.](gz|bz2|xz)$", pkgs)) {
## type <- "source"
## }
## }
## if (is.null(repos) && missing(contriburl)) {
## tmpd <- destdir
## nonlocalrepos <- any(web <- grepl("^(http|https|ftp)://",
## pkgs))
## if (is.null(destdir) && nonlocalrepos) {
## tmpd <- file.path(tempdir(), "downloaded_packages")
## if (!file.exists(tmpd) && !dir.create(tmpd))
## stop(gettextf("unable to create temporary directory %s",
## sQuote(tmpd)), domain = NA)
## }
## if (nonlocalrepos) {
## df <- function(p, destfile, method, ...) download.file(p,
## destfile, method, mode = "wb", ...)
## urls <- pkgs[web]
## for (p in unique(urls)) {
## this <- pkgs == p
## destfile <- file.path(tmpd, basename(p))
## res <- try(df(p, destfile, method, ...))
## if (!inherits(res, "try-error") && res == 0L)
## pkgs[this] <- destfile
## else {
## pkgs[this] <- NA
## }
## }
## }
## }
## if (type == "both") {
## if (type2 == "source")
## stop("type == \"both\" can only be used on Windows or a CRAN build for macOS")
## if (!missing(contriburl) || !is.null(available))
## type <- type2
## }
## getDeps <- TRUE
## if (type == "both") {
## if (is.null(repos))
## stop("type == \"both\" cannot be used with 'repos = NULL'")
## type <- "source"
## contriburl <- contrib.url(repos, "source")
## if (missing(repos))
## repos <- getOption("repos")
## available <- available.packages(contriburl = contriburl,
## method = method, fields = "NeedsCompilation", ...)
## pkgs <- getDependencies(pkgs, dependencies, available,
## lib, ...)
## getDeps <- FALSE
## av2 <- available.packages(contriburl = contrib.url(repos,
## type2), method = method, ...)
## bins <- row.names(av2)
## bins <- pkgs[pkgs %in% bins]
## srcOnly <- pkgs[!pkgs %in% bins]
## binvers <- av2[bins, "Version"]
## hasArchs <- !is.na(av2[bins, "Archs"])
## needsCmp <- !(available[bins, "NeedsCompilation"] %in%
## "no")
## hasSrc <- hasArchs | needsCmp
## srcvers <- available[bins, "Version"]
## later <- as.numeric_version(binvers) < srcvers
## action <- getOption("install.packages.compile.from.source",
## "interactive")
## if (!nzchar(Sys.which(Sys.getenv("MAKE", "make"))))
## action <- "never"
## if (any(later)) {
## msg <- ngettext(sum(later), "There is a binary version available but the source version is later",
## "There are binary versions available but the source versions are later")
## cat("\n", paste(strwrap(msg, indent = 2, exdent = 2),
## collapse = "\n"), ":\n", sep = "")
## out <- data.frame(binary = binvers, source = srcvers,
## needs_compilation = hasSrc, row.names = bins,
## check.names = FALSE)[later, ]
## print(out)
## cat("\n")
## if (any(later & hasSrc)) {
## if (action == "interactive" && interactive()) {
## msg <- ngettext(sum(later & hasSrc), "Do you want to install from sources the package which needs compilation?",
## "Do you want to install from sources the packages which need compilation?")
## res <- askYesNo(msg)
## if (is.na(res))
## stop("Cancelled by user")
## if (!isTRUE(res))
## later <- later & !hasSrc
## }
## else if (action == "never") {
## cat(" Binaries will be installed\n")
## later <- later & !hasSrc
## }
## }
## }
## bins <- bins[!later]
## if (length(srcOnly)) {
## s2 <- srcOnly[!(available[srcOnly, "NeedsCompilation"] %in%
## "no")]
## if (length(s2)) {
## msg <- ngettext(length(s2), "Package which is only available in source form, and may need compilation of C/C++/Fortran",
## "Packages which are only available in source form, and may need compilation of C/C++/Fortran")
## msg <- c(paste0(msg, ": "), sQuote(s2))
## msg <- strwrap(paste(msg, collapse = " "), exdent = 2)
## message(paste(msg, collapse = "\n"), domain = NA)
## if (action == "interactive" && interactive()) {
## res <- askYesNo("Do you want to attempt to install these from sources?")
## if (is.na(res))
## stop("Cancelled by user")
## if (!isTRUE(res))
## pkgs <- setdiff(pkgs, s2)
## }
## else if (action == "never") {
## cat(" These will not be installed\n")
## pkgs <- setdiff(pkgs, s2)
## }
## }
## }
## if (length(bins)) {
## if (type2 == "win.binary")
## .install.winbinary(pkgs = bins, lib = lib, contriburl = contrib.url(repos,
## type2), method = method, available = av2, destdir = destdir,
## dependencies = NULL, libs_only = libs_only,
## quiet = quiet, ...)
## else .install.macbinary(pkgs = bins, lib = lib, contriburl = contrib.url(repos,
## type2), method = method, available = av2, destdir = destdir,
## dependencies = NULL, quiet = quiet, ...)
## }
## pkgs <- setdiff(pkgs, bins)
## if (!length(pkgs))
## return(invisible())
## message(sprintf(ngettext(length(pkgs), "installing the source package %s",
## "installing the source packages %s"), paste(sQuote(pkgs),
## collapse = ", ")), "\n", domain = NA)
## flush.console()
## }
## else if (getOption("install.packages.check.source", "yes") %in%
## "yes" && (type %in% "win.binary" || startsWith(type,
## "mac.binary"))) {
## if (missing(contriburl) && is.null(available) && !is.null(repos)) {
## contriburl2 <- contrib.url(repos, "source")
## if (missing(repos))
## repos <- getOption("repos")
## av1 <- tryCatch(suppressWarnings(available.packages(contriburl = contriburl2,
## method = method, ...)), error = function(e) e)
## if (inherits(av1, "error")) {
## message("source repository is unavailable to check versions")
## available <- available.packages(contriburl = contrib.url(repos,
## type), method = method, ...)
## }
## else {
## srcpkgs <- pkgs[pkgs %in% row.names(av1)]
## available <- available.packages(contriburl = contrib.url(repos,
## type), method = method, ...)
## bins <- pkgs[pkgs %in% row.names(available)]
## na <- srcpkgs[!srcpkgs %in% bins]
## if (length(na)) {
## msg <- sprintf(ngettext(length(na), "package %s is available as a source package but not as a binary",
## "packages %s are available as source packages but not as binaries"),
## paste(sQuote(na), collapse = ", "))
## cat("\n ", msg, "\n\n", sep = "")
## }
## binvers <- available[bins, "Version"]
## srcvers <- binvers
## OK <- bins %in% srcpkgs
## srcvers[OK] <- av1[bins[OK], "Version"]
## later <- as.numeric_version(binvers) < srcvers
## if (any(later)) {
## msg <- ngettext(sum(later), "There is a binary version available (and will be installed) but the source version is later",
## "There are binary versions available (and will be installed) but the source versions are later")
## cat("\n", paste(strwrap(msg, indent = 2, exdent = 2),
## collapse = "\n"), ":\n", sep = "")
## print(data.frame(binary = binvers, source = srcvers,
## row.names = bins, check.names = FALSE)[later,
## ])
## cat("\n")
## }
## }
## }
## }
## if (.Platform$OS.type == "windows") {
## if (startsWith(type, "mac.binary"))
## stop("cannot install macOS binary packages on Windows")
## if (type %in% "win.binary") {
## .install.winbinary(pkgs = pkgs, lib = lib, contriburl = contriburl,
## method = method, available = available, destdir = destdir,
## dependencies = dependencies, libs_only = libs_only,
## quiet = quiet, ...)
## return(invisible())
## }
## have_spaces <- grep(" ", pkgs)
## if (length(have_spaces)) {
## p <- pkgs[have_spaces]
## dirs <- shortPathName(dirname(p))
## pkgs[have_spaces] <- file.path(dirs, basename(p))
## }
## pkgs <- gsub("\\", "/", pkgs, fixed = TRUE)
## }
## else {
## if (startsWith(type, "mac.binary")) {
## if (!grepl("darwin", R.version$platform))
## stop("cannot install macOS binary packages on this platform")
## .install.macbinary(pkgs = pkgs, lib = lib, contriburl = contriburl,
## method = method, available = available, destdir = destdir,
## dependencies = dependencies, quiet = quiet, ...)
## return(invisible())
## }
## if (type %in% "win.binary")
## stop("cannot install Windows binary packages on this platform")
## if (!file.exists(file.path(R.home("bin"), "INSTALL")))
## stop("This version of R is not set up to install source packages\nIf it was installed from an RPM, you may need the R-devel RPM")
## }
## cmd0 <- file.path(R.home("bin"), "R")
## args0 <- c("CMD", "INSTALL")
## output <- if (quiet)
## FALSE
## else ""
## env <- character()
## tlim <- Sys.getenv("_R_INSTALL_PACKAGES_ELAPSED_TIMEOUT_")
## tlim <- if (is.na(tlim))
## 0
## else tools:::get_timeout(tlim)
## outdir <- getwd()
## if (is.logical(keep_outputs)) {
## if (is.na(keep_outputs))
## keep_outputs <- FALSE
## }
## else if (is.character(keep_outputs) && (length(keep_outputs) ==
## 1L)) {
## if (!dir.exists(keep_outputs) && !dir.create(keep_outputs,
## recursive = TRUE))
## stop(gettextf("unable to create %s", sQuote(keep_outputs)),
## domain = NA)
## outdir <- normalizePath(keep_outputs)
## keep_outputs <- TRUE
## }
## else stop(gettextf("invalid %s argument", sQuote("keep_outputs")),
## domain = NA)
## if (length(libpath <- .R_LIBS())) {
## if (.Platform$OS.type == "windows") {
## oldrlibs <- Sys.getenv("R_LIBS")
## Sys.setenv(R_LIBS = libpath)
## on.exit(Sys.setenv(R_LIBS = oldrlibs))
## }
## else env <- paste0("R_LIBS=", shQuote(libpath))
## }
## if (is.character(clean))
## args0 <- c(args0, clean)
## if (libs_only)
## args0 <- c(args0, "--libs-only")
## if (!missing(INSTALL_opts)) {
## if (!is.list(INSTALL_opts)) {
## args0 <- c(args0, paste(INSTALL_opts, collapse = " "))
## INSTALL_opts <- list()
## }
## }
## else {
## INSTALL_opts <- list()
## }
## if (verbose)
## message(gettextf("system (cmd0): %s", paste(c(cmd0, args0),
## collapse = " ")), domain = NA)
## if (is.null(repos) && missing(contriburl)) {
## update <- cbind(path.expand(pkgs), lib)
## for (i in seq_len(nrow(update))) {
## if (is.na(update[i, 1L]))
## next
## args <- c(args0, get_install_opts(update[i, 1L]),
## "-l", shQuote(update[i, 2L]), getConfigureArgs(update[i,
## 1L]), getConfigureVars(update[i, 1L]), shQuote(update[i,
## 1L]))
## status <- system2(cmd0, args, env = env, stdout = output,
## stderr = output, timeout = tlim)
## if (status > 0L)
## warning(gettextf("installation of package %s had non-zero exit status",
## sQuote(update[i, 1L])), domain = NA)
## else if (verbose) {
## cmd <- paste(c(cmd0, args), collapse = " ")
## message(sprintf("%d): succeeded '%s'", i, cmd),
## domain = NA)
## }
## }
## return(invisible())
## }
## tmpd <- destdir
## nonlocalrepos <- !all(startsWith(contriburl, "file:"))
## if (is.null(destdir) && nonlocalrepos) {
## tmpd <- file.path(tempdir(), "downloaded_packages")
## if (!file.exists(tmpd) && !dir.create(tmpd))
## stop(gettextf("unable to create temporary directory %s",
## sQuote(tmpd)), domain = NA)
## }
## av2 <- NULL
## if (is.null(available)) {
## filters <- getOption("available_packages_filters")
## if (!is.null(filters)) {
## available <- available.packages(contriburl = contriburl,
## method = method, ...)
## }
## else {
## f <- setdiff(available_packages_filters_default,
## c("R_version", "duplicates"))
## av2 <- available.packages(contriburl = contriburl,
## filters = f, method = method, ...)
## f <- available_packages_filters_db[["R_version"]]
## f2 <- available_packages_filters_db[["duplicates"]]
## available <- f2(f(av2))
## }
## }
## if (getDeps)
## pkgs <- getDependencies(pkgs, dependencies, available,
## lib, ..., av2 = av2)
## foundpkgs <- download.packages(pkgs, destdir = tmpd, available = available,
## contriburl = contriburl, method = method, type = "source",
## quiet = quiet, ...)
## if (length(foundpkgs)) {
## if (verbose)
## message(gettextf("foundpkgs: %s", paste(foundpkgs,
## collapse = ", ")), domain = NA)
## update <- unique(cbind(pkgs, lib))
## colnames(update) <- c("Package", "LibPath")
## found <- pkgs %in% foundpkgs[, 1L]
## files <- foundpkgs[match(pkgs[found], foundpkgs[, 1L]),
## 2L]
## if (verbose)
## message(gettextf("files: %s", paste(files, collapse = ", \n\t")),
## domain = NA)
## update <- cbind(update[found, , drop = FALSE], file = files)
## if (nrow(update) > 1L) {
## upkgs <- unique(pkgs <- update[, 1L])
## DL <- .make_dependency_list(upkgs, available)
## p0 <- .find_install_order(upkgs, DL)
## update <- update[sort.list(match(pkgs, p0)), ]
## }
## if (Ncpus > 1L && nrow(update) > 1L) {
## tlim_cmd <- character()
## if (tlim > 0) {
## if (nzchar(timeout <- Sys.which("timeout"))) {
## tlim_cmd <- c(shQuote(timeout), "-s INT", tlim)
## }
## else warning("timeouts for parallel installs require the 'timeout' command")
## }
## args0 <- c(args0, "--pkglock")
## tmpd2 <- file.path(tempdir(), "make_packages")
## if (!file.exists(tmpd2) && !dir.create(tmpd2))
## stop(gettextf("unable to create temporary directory %s",
## sQuote(tmpd2)), domain = NA)
## mfile <- file.path(tmpd2, "Makefile")
## conn <- file(mfile, "wt")
## deps <- paste(paste0(update[, 1L], ".ts"), collapse = " ")
## deps <- strwrap(deps, width = 75, exdent = 2)
## deps <- paste(deps, collapse = " \\\n")
## cat("all: ", deps, "\n", sep = "", file = conn)
## aDL <- .make_dependency_list(upkgs, available, recursive = TRUE)
## for (i in seq_len(nrow(update))) {
## pkg <- update[i, 1L]
## fil <- update[i, 3L]
## args <- c(args0, get_install_opts(fil), "-l",
## shQuote(update[i, 2L]), getConfigureArgs(fil),
## getConfigureVars(fil), shQuote(fil), ">", paste0(pkg,
## ".out"), "2>&1")
## cmd <- paste(c("MAKEFLAGS=", tlim_cmd, shQuote(cmd0),
## args), collapse = " ")
## deps <- aDL[[pkg]]
## deps <- deps[deps %in% upkgs]
## deps <- if (length(deps))
## paste(paste0(deps, ".ts"), collapse = " ")
## else ""
## cat(paste0(pkg, ".ts: ", deps), paste("\t@echo begin installing package",
## sQuote(pkg)), paste0("\t@", cmd, " && touch ",
## pkg, ".ts"), paste0("\t@cat ", pkg, ".out"),
## "", sep = "\n", file = conn)
## }
## close(conn)
## cwd <- setwd(tmpd2)
## on.exit(setwd(cwd))
## status <- system2(Sys.getenv("MAKE", "make"), c("-k -j",
## Ncpus), stdout = output, stderr = output, env = env)
## if (status > 0L) {
## pkgs <- update[, 1L]
## tss <- sub("[.]ts$", "", dir(".", pattern = "[.]ts$"))
## failed <- pkgs[!pkgs %in% tss]
## for (pkg in failed) system(paste0("cat ", pkg,
## ".out"))
## warning(gettextf("installation of one or more packages failed,\n probably %s",
## paste(sQuote(failed), collapse = ", ")), domain = NA)
## }
## if (keep_outputs)
## file.copy(paste0(update[, 1L], ".out"), outdir)
## file.copy(Sys.glob(paste0(update[, 1L], "*.zip")),
## cwd)
## file.copy(Sys.glob(paste0(update[, 1L], "*.tgz")),
## cwd)
## file.copy(Sys.glob(paste0(update[, 1L], "*.tar.gz")),
## cwd)
## setwd(cwd)
## on.exit()
## unlink(tmpd2, recursive = TRUE)
## }
## else {
## tmpd2 <- tempfile()
## if (!dir.create(tmpd2))
## stop(gettextf("unable to create temporary directory %s",
## sQuote(tmpd2)), domain = NA)
## outfiles <- file.path(tmpd2, paste0(update[, 1L],
## ".out"))
## for (i in seq_len(nrow(update))) {
## outfile <- if (keep_outputs)
## outfiles[i]
## else output
## fil <- update[i, 3L]
## args <- c(args0, get_install_opts(fil), "-l",
## shQuote(update[i, 2L]), getConfigureArgs(fil),
## getConfigureVars(fil), shQuote(fil))
## status <- system2(cmd0, args, env = env, stdout = outfile,
## stderr = outfile, timeout = tlim)
## if (!quiet && keep_outputs)
## writeLines(readLines(outfile))
## if (status > 0L)
## warning(gettextf("installation of package %s had non-zero exit status",
## sQuote(update[i, 1L])), domain = NA)
## else if (verbose) {
## cmd <- paste(c(cmd0, args), collapse = " ")
## message(sprintf("%d): succeeded '%s'", i, cmd),
## domain = NA)
## }
## }
## if (keep_outputs)
## file.copy(outfiles, outdir)
## unlink(tmpd2, recursive = TRUE)
## }
## if (!quiet && nonlocalrepos && !is.null(tmpd) && is.null(destdir))
## cat("\n", gettextf("The downloaded source packages are in\n\t%s",
## sQuote(normalizePath(tmpd, mustWork = FALSE))),
## "\n", sep = "", file = stderr())
## libs_used <- unique(update[, 2L])
## if (.Platform$OS.type == "unix" && .Library %in% libs_used) {
## message("Updating HTML index of packages in '.Library'")
## make.packages.html(.Library)
## }
## }
## else if (!is.null(tmpd) && is.null(destdir))
## unlink(tmpd, TRUE)
## invisible()
## }
## <bytecode: 0x00000224b7f3d740>
## <environment: namespace:utils>remotes::install_github("paleolimbot/qgisprocess") #Select 1 for ALL; next there will be a pop-up box, select Yes force=TRUE.## Skipping install of 'qgisprocess' from a github remote, the SHA1 (464d75b3) has not changed since last install.
## Use `force = TRUE` to force installationlibrary(qgisprocess)## Attempting to load the cache ... Success!
## QGIS version: 3.28.2-Firenze
## Having access to 865 algorithms from 6 QGIS processing providers.
## Run `qgis_configure(use_cached_data = TRUE)` to reload cache and get more details.
## >>> Run `qgis_enable_plugins()` to enable 2 disabled plugin(s) and
## access their algorithms: grassprovider, otbproviderqgis_configure() #set up QGIS - find the executable## getOption('qgisprocess.path') was not found.
## Sys.getenv('R_QGISPROCESS_PATH') was not found.
## Trying 'qgis_process' on PATH...
## 'qgis_process' is not available on PATH.
## Found 1 QGIS installation containing 'qgis_process':
## C:/Program Files/QGIS 3.28.2/bin/qgis_process-qgis.bat
## Trying command 'C:/Program Files/QGIS 3.28.2/bin/qgis_process-qgis.bat'
## Success!
## Now using 'qgis_process' at 'C:/Program Files/QGIS 3.28.2/bin/qgis_process-qgis.bat'.
## >>> If you need another installed QGIS instance, run `qgis_configure()`;
## see `?qgis_configure` if you need to preset the path of 'qgis_process'.
##
## QGIS version is now set to: 3.28.2-Firenze
## Using JSON for output serialization.
## Using JSON for input serialization.
## 3 out of 5 available processing provider plugins are enabled.
## You now have access to 865 algorithms from 6 QGIS processing providers.
##
## >>> Run `qgis_enable_plugins()` to enable 2 disabled plugin(s) and
## access their algorithms: grassprovider, otbprovider
##
## Saving configuration to 'C:\Users\josha\AppData\Local/R-qgisprocess/R-qgisprocess/Cache/cache-0.0.0.9000.rds'
## Use qgis_algorithms(), qgis_providers(), qgis_plugins(), qgis_use_json_output(),
## qgis_path() and qgis_version() to inspect the cache environment.head(qgis_algorithms())## # A tibble: 6 × 24
## provider provider_title algorithm algorithm_id algorithm_title
## <chr> <chr> <chr> <chr> <chr>
## 1 3d QGIS (3D) 3d:tessellate tessellate Tessellate
## 2 gdal GDAL gdal:aspect aspect Aspect
## 3 gdal GDAL gdal:assignprojection assignproject… Assign project…
## 4 gdal GDAL gdal:buffervectors buffervectors Buffer vectors
## 5 gdal GDAL gdal:buildvirtualraster buildvirtualr… Build virtual …
## 6 gdal GDAL gdal:buildvirtualvector buildvirtualv… Build virtual …
## # ℹ 19 more variables: provider_can_be_activated <lgl>,
## # provider_is_active <lgl>, provider_long_name <chr>, provider_version <chr>,
## # provider_warning <chr>, can_cancel <lgl>, deprecated <lgl>, group <chr>,
## # has_known_issues <lgl>, help_url <chr>, requires_matching_crs <lgl>,
## # short_description <chr>, tags <list>, default_raster_file_extension <chr>,
## # default_vector_file_extension <chr>,
## # supported_output_raster_extensions <list>, …tidycensus::census_api_key(key = "07d238ca1e63146dd99a8fc68cf2137c743c383d", overwrite = T)## To install your API key for use in future sessions, run this function with `install = TRUE`.addr<-read.csv("WorkingDirectoryFall2020StatsDem1/bars.csv")
addr<-addr[c(6, 12:14)]
names(addr)<-c("street", "city", "st", "zip")
head(addr)## street city st zip
## 1 108 King William San Antonio TX 78204
## 2 905 Nogalitos St San Antonio TX 78204
## 3 507 Ruiz St San Antonio TX 78207
## 4 514 W Commerce St San Antonio TX 78207
## 5 5721 W Commerce St San Antonio TX 78237
## 6 254 Hobart St San Antonio TX 78237results<-cxy_geocode(addr,
street = "street",
city = "city",
state ="st",
zip = "zip",
class="sf",
output = "simple")## 2 rows removed to create an sf object. These were addresses that the geocoder could not match.results.proj<-st_transform(results,
crs = 2278)
mapview(results.proj)mean_feature<-apply(st_coordinates(results.proj), MARGIN = 2, FUN = mean)
mean_feature<-data.frame(place="meanfeature", x=mean_feature[1], y= mean_feature[2])
mean_feature<-st_as_sf(mean_feature, coords = c("x", "y"), crs= 2278)
mapview(mean_feature, col.regions="red")+mapview( results)chull <- st_convex_hull(st_union(results))
mapview(chull)+
mapview(results, col.regions = "green")sa_acs<-get_acs(geography = "tract",
state="TX",
county = "Bexar",
year = 2019,
variables=c(
"DP03_0119PE") ,
geometry = T, output = "wide")## Getting data from the 2015-2019 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Using the ACS Data Profile##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%sa_acs2<-sa_acs%>%
mutate(ppov=DP03_0119PE)%>%
dplyr::select(GEOID, ppov)
sa_acs2<-st_transform(sa_acs2, crs = 2278)
sa_trol<-st_cast(sa_acs2, "MULTILINESTRING")
spjoin<-st_join(results.proj, sa_acs2)
head(spjoin)## Simple feature collection with 6 features and 6 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: 2100089 ymin: 13694870 xmax: 2130647 ymax: 13705940
## Projected CRS: NAD83 / Texas South Central (ftUS)
## street city st zip GEOID ppov
## 2 108 King William San Antonio TX 78204 48029192100 1.2
## 23 905 Nogalitos St San Antonio TX 78204 48029150100 14.5
## 12 507 Ruiz St San Antonio TX 78207 48029110600 37.8
## 14 514 W Commerce St San Antonio TX 78207 48029110100 24.7
## 15 5721 W Commerce St San Antonio TX 78237 48029171200 22.3
## 9 254 Hobart St San Antonio TX 78237 48029171501 23.6
## geometry
## 2 POINT (2130647 13699644)
## 23 POINT (2124919 13694869)
## 12 POINT (2125077 13705944)
## 14 POINT (2128147 13702613)
## 15 POINT (2104639 13705051)
## 9 POINT (2100089 13698413)map5 <- tm_shape(sa_acs2)+
tm_polygons()+
tm_shape(spjoin)+
tm_dots("ppov", title="% in Poverty",
palette="Reds",
style="pretty",
n=5,
size=0.3)+
tm_format("World",
main.title="San Antonio Poverty Around Bars Estimates (2019) - Pretty Breaks",
main.title.position=c('center','top'),
main.title.size=1.5,
title="Author: Joshua A. Reyna, M.S \nSource: ACS 2019",
legend.title.size=1.7,
legend.outside=T,
legend.text.size=1.2)+
tm_scale_bar(position = c("left","bottom"))+
tm_compass()
map5
library(spatstat)## Loading required package: spatstat.data## Loading required package: spatstat.geom## spatstat.geom 3.1-0##
## Attaching package: 'spatstat.geom'## The following object is masked from 'package:patchwork':
##
## area## The following object is masked from 'package:grid':
##
## as.mask## Loading required package: spatstat.random## spatstat.random 3.1-4## Loading required package: spatstat.explore## Loading required package: nlme##
## Attaching package: 'nlme'## The following object is masked from 'package:dplyr':
##
## collapse## spatstat.explore 3.1-0## Loading required package: spatstat.model## Loading required package: rpart## spatstat.model 3.2-1## Loading required package: spatstat.linnet## spatstat.linnet 3.0-6##
## spatstat 3.0-3
## For an introduction to spatstat, type 'beginner'library(qgisprocess)
bars_nn<-qgis_run_algorithm(alg="native:nearestneighbouranalysis",
INPUT=results.proj,
OUTPUT_HTML_FILE=file.path(tempdir(), "barsnn.html"),
load_output = TRUE)## Ignoring unknown input 'load_output'bars_nn## <Result of `qgis_run_algorithm("native:nearestneighbouranalysis", ...)`>
## List of 6
## $ EXPECTED_MD : num 2045
## $ NN_INDEX : num 1.03
## $ OBSERVED_MD : num 2113
## $ OUTPUT_HTML_FILE: 'qgis_outputHtml' chr "C:\\Users\\josha\\AppData\\Local\\Temp\\RtmpiEjqw4/barsnn.html"
## $ POINT_COUNT : num 21
## $ Z_SCORE : num 0.29## A nearest neighbour analysis was conducted on bars within the San Antonio area. The index value of 1.03 would suggest these bar locations are dispersed, however the z-score is .29 meaning these results are not significant.```