I'm trying to transform coordinates to lat-long using shapefile in R but I get the error message below
Error in rename.sf(.tbl, !!!syms) : internal error: can't find `agr` columns
this is my shapefile sample data named"dvc_read"
structure(list(lat = c(40.61955, 40.61955, 40.6659, 40.6659,
40.6659, 40.6659), long = c(-74.02346, -74.02346, -73.99604,
-73.99604, -73.99604, -73.99604), End_Lat = c("0", "40.61955",
"40.66912", "40.67653", "40.66912", "40.66912"), End_Lng = c("0",
"-74.02346", "-73.99678", "-74.00127", "-73.99678", "-73.99678"
), Year = c("2019", "2020", "2019", "2018", "2020", "2020"),
Month = c("9", "8", "2", "5", "1", "1"), Day = c("15", "3",
"5", "18", "20", "29"), Date = c("2019-09-15", "2020-08-03",
"2019-02-05", "2018-05-18", "2020-01-20", "2020-01-29"),
accident.description = c("One lane blocked", "Right and center lane blocked",
"Right lane blocked", "Road closed", "Two lanes blocked",
"Right lane blocked"), Severity = c("3", "3", "2", "4", "3",
"2"), City = c("Brooklyn", "Brooklyn", "Brooklyn", "Brooklyn",
"Brooklyn", "Brooklyn"), geometry = structure(list(structure(c(-74.02346,
40.61955), class = c("XY", "POINT", "sfg")), structure(c(-74.02346,
40.61955), class = c("XY", "POINT", "sfg")), structure(c(-73.99604,
40.6659), class = c("XY", "POINT", "sfg")), structure(c(-73.99604,
40.6659), class = c("XY", "POINT", "sfg")), structure(c(-73.99604,
40.6659), class = c("XY", "POINT", "sfg")), structure(c(-73.99604,
40.6659), class = c("XY", "POINT", "sfg"))), class = c("sfc_POINT",
"sfc"), precision = 0, bbox = structure(c(xmin = -74.02346,
ymin = 40.61955, xmax = -73.99604, ymax = 40.6659), class = "bbox"), crs = structure(list(
input = "NAD83", wkt = "GEOGCRS[\"NAD83\",\n DATUM[\"North American Datum 1983\",\n ELLIPSOID[\"GRS 1980\",6378137,298.257222101,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"latitude\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"longitude\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n ID[\"EPSG\",4269]]"), class = "crs"), n_empty = 0L)), row.names = 6:11, class = c("sf",
"data.frame"), sf_column = "geometry", agr = structure(c(NA_integer_,
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_,
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_
), .Names = c("lat", "long", "End_Lat", "End_Lng", "Year", "Month",
"Day", "Date", NA, "Severity", "City"), .Label = c("constant",
"aggregate", "identity"), class = "factor"))
And this is my code here :
dvc_wrangle <- dvc_read %>%
st_transform(crs = 4326) %>% # transform coords to latlong
# decapitalise everything for easy handling
rename_all(tolower) %>%
mutate_if(is.character, tolower) %>% # simplify strings
# deal with dates
mutate(
Date = ymd(date),
Month = case_when(
month == 1 ~ "Jan", month == 2 ~ "Feb",
month == 3 ~ "Mar", month == 4 ~ "Apr",
month == 5 ~ "May", month == 6 ~ "Jun",
month == 7 ~ "Jul", month == 8 ~ "Aug",
month == 9 ~ "Sep", month == 10 ~ "Oct",
month == 11 ~ "Nov", month == 12 ~ "Dec",
TRUE ~ "Unknown"
),
# clean up strings (not perfect)
Severity = if_else(severity %in% c("1", "2", "3"), "unknown", severity),
Accident.Description = if_else(accident.description == "Road closed", "Road_closed", accident.description),
City = if_else(str_detect(city, "x") == TRUE, "unknown", city),
City = if_else(
city %in% c(
"Brooklyn", "Jamaica", "Merrick", "Roosevelt", "unclassified",
), "unknown", city
),
# final name tidy-up
Accident.Description = str_replace_all(accident.description, "_", " ")
) %>%
# title case for these columns
mutate_at(vars(Severity, Accident.Description, City), tools::toTitleCase) # To Title Case
If I use the CSV format, I get the error message:
Error in UseMethod("st_transform") :
no applicable method for 'st_transform' applied to an object of class "data.frame"
I reinstalled and updated all these packages but I still have the issue :
library(dplyr) # tidy data manipulation
library(stringr) # string manipulation
library(janitor) # misc tidy data manipulation
library(lubridate) # dealing with dates and times
library(forcats) # deal with factors
library(sf) # geography
library(lubridate) # ymd
library(tidyverse)
Any suggestions or recommendations regarding what the error message is about. Thank you for your time and help in advance
Update II:
I changed the code based on your suggestions and it ran without any issues. However, this is part of a program that I'm trying to run on Shiny, and I can run the server and the UI successfully when I use the CSV version of the data, but when I use the shapefile object I created, I run into other errors, and I googled the error, and it looks like it's related to some different setting in Rstuido where I saw inconsistent behavior from R studio when I ran different samples of my shapefile data. This is the error message I get when I run the Shiny app
runApp('ShinyApp.R')
Error in sample.int(length(x), size, replace, prob) :
invalid first argument
Here's the updated code and the UI and server for Shiny. I'd really appreciate it if you could run them on your machine and share with me your output and thoughts regarding the error message I have.
dvc_wrangle <- dvc_read %>%
st_transform(crs = 4326) %>%
rename_with(tolower, everything()) %>%
mutate(across(where(is.character), tolower)) %>%
mutate(
Date = ymd(date),
Month = case_when(
month == 1 ~ "Jan", month == 2 ~ "Feb",
month == 3 ~ "Mar", month == 4 ~ "Apr",
month == 5 ~ "May", month == 6 ~ "Jun",
month == 7 ~ "Jul", month == 8 ~ "Aug",
month == 9 ~ "Sep", month == 10 ~ "Oct",
month == 11 ~ "Nov", month == 12 ~ "Dec",
TRUE ~ "Unknown"
),
# clean up strings (not perfect)
Severity = if_else(severity %in% c("5"), "unknown", severity),
Accident.Description = if_else(accident.description == "Road closed", "Road_closed", accident.description),
City = if_else(str_detect(city, "x"), "unknown", city), City = if_else(
city %in% c(
"Brooklyn", "Jamaica", "Merrick", "Roosevelt", "unclassified"
), "unknown", city
), Accident.Description = str_replace_all(accident.description, "_", " ")
) %>% mutate(across(c(Severity, Accident.Description, City), tools::toTitleCase))
###
# extract latlong cols from sf geometry and bind back to df
dvc_xy <- as.data.frame(st_coordinates(dvc_wrangle))
dvc <- bind_cols(dvc_wrangle, dvc_xy) %>% rename(longitude = X, latitude = Y)
# Save objects ------------------------------------------------------------
saveRDS(dvc, "/Users/data/dvc.RDS")
write.csv(dvc, "/Users/data/dvc.csv")
#
**# # Read pre-prepared data
dvc <- readRDS("/Users/data/dvc.RDS")** # the dvc.RDS object I want to call in my Shiny App
#
# # Month order for dropdown input
mo_order <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
And here is the UI and server implantation using the dvc.RDS object I created
# Load packages -----------------------------------------------------------
# Load packages
library(shiny) # interactive app framework
library(shinydashboard) # layout
#library(icon) # for icons
#install.packages("flexdashboard")
#install.packages("janitor")
# Data manipulation and cleaning
library(dplyr) # tidy data manipulation
library(stringr) # string manipulation
library(janitor) # misc tidy data manipulation
library(lubridate) # dealing with dates and times
library(forcats) # deal with factors
library(sf) # geography
library(flexdashboard) # layout of the tool (pages, frames, etc)
library(crosstalk) # for allowing htmlwidgets to interact with shared data
library(leaflet) # interactive maps
library(DT) # interactive tables
# UI ----------------------------------------------------------------------
ui <- dashboardPage(
skin = "black",
dashboardHeader(
title = "Event-based Traffic Speed Prediction System",
titleWidth = 450
), # end dashboardHeader()
dashboardSidebar(
HTML("<br>"),
box(
title = "About",
icon("info-circle", lib = "font-awesome"), HTML("<a href='https://www.rostrum.blog/2019/01/18/deer-collisions/'> System info</a>"), HTML("<br>"),
width = 12,
background = "blue",
collapsible = TRUE, collapsed = TRUE
),
box(
title = "How to",
width = 12,
background = "blue",
collapsible = TRUE, collapsed = TRUE,
HTML("<ul>
<li>Upload dataset Model menu to update the map and table</li>
<li>The map and table are in separate tabs</li>
<li>You can zoom and drag the map around</li>
<li>Click a marker on the map for details</li>
<li>You can download your selection with the 'Download' button</li></ul>")
),
box(
title = "Filters",
width = 12,
background = "blue",
collapsible = TRUE, collapsed = FALSE,
selectInput(
inputId = "input_year",
label = "Year",
choices = sort(unique(dvc$Year)),
multiple = TRUE,
selected = sample(unique(dvc$Year), 1)
),
selectInput(
inputId = "input_month",
label = "Month",
choices = unique(dvc$Month[order(match(dvc$Month, mo_order))]),
multiple = TRUE,
selected = sample(unique(dvc$Month), 3)
),
selectInput(
inputId = "input_la",
label = "Accident.Description",
choices = sort(unique(dvc$Accident.Description)),
multiple = TRUE,
selected = sample(unique(dvc$Accident.Description), 3)
)
) # end box()
), # end dashboardSidebar()
dashboardBody(
fluidRow(
valueBoxOutput("output_valueselection"),
valueBoxOutput("output_valueyearla"),
valueBoxOutput("output_valueyear"),
tabBox(
id = "tabset1",
width = 12,
tabPanel("Map", leafletOutput("output_map", height = "600px")),
tabPanel("Table", dataTableOutput("output_table"))
)
) # end fluidRow()
) # end dashboardBody()
) # end of ui dashboardPage()
# Server ------------------------------------------------------------------
# Server ------------------------------------------------------------------
server <- function(input, output) {
# Value box - year
output$output_valueyear <- renderValueBox({
shinydashboard::valueBox(
value = dvc %>% st_drop_geometry() %>% filter(Year %in% input$input_year) %>% count() %>% pull(),
subtitle = "Collisions in selected year(s)",
icon = icon("calendar", lib = "font-awesome"),
color = "blue",
width = 4
)
}) # end of renderValueBox
# Value box - year by la
output$output_valueyearla <- renderValueBox({
shinydashboard::valueBox(
value = dvc %>% st_drop_geometry() %>% filter(Year %in% input$input_year, Accident.Description %in% input$input_la) %>% count() %>% pull(),
subtitle = "Collisions in selected LA(s) and year(s)",
icon = icon("map-o", lib = "font-awesome"),
color = "blue",
width = 4
)
}) # end of renderValueBox
# Value box - total in your selection
output$output_valueselection <- renderValueBox({
shinydashboard::valueBox(
value = dvc %>% st_drop_geometry() %>% filter(Year %in% input$input_year, Month %in% input$input_month, Accident.Description %in% input$input_la) %>% count() %>% pull(),
subtitle = "Collisions in selection",
icon = icon("car", lib = "font-awesome"),
color = "blue",
width = 4
)
}) # end of renderValueBox
# Interactive map with Leaflet
output$output_map <- renderLeaflet({
dvc %>%
filter(
Year %in% input$input_year,
Month %in% input$input_month,
Accident.Description %in% input$input_la
) %>%
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
addAwesomeMarkers(
icon = awesomeIcons(
icon = "exclamation-circle",
iconColor = "#FFFFFF",
library = "fa",
markerColor = "darkblue"
),
popup = ~paste0(
"<style>
td, th {
text-align: left;
padding: 3px;
}
</style>",
"<table>",
"<tr>","<td>", "Date", "</td>", "<td>", Date, "</td>", "<tr>",
"<tr>","<td>", "LA", "</td>", "<td>", Accident.Description, "</td>", "<tr>",
"<tr>","<td>", "City", "</td>", "<td>", City, "</td>", "<tr>",
"<tr>","<td>", "Species", "</td>", "<td>", Severity, "</td>", "<tr>",
"</table>"
)
)
}) # end of renderLeaflet
# Interactive table with DT
output$output_table <- renderDataTable({
dvc %>%
st_drop_geometry() %>%
filter(
Year %in% input$input_year,
Month %in% input$input_month,
Accident.Description %in% input$input_la
) %>%
select(
Date = Date,
Year = Year,
Month = Month,
`Accident.Description` = Accident.Description,
City = City,
`Severity` = Severity
) %>%
datatable(
filter = "top",
extensions = c("Scroller", "Buttons"), # scroll instead of paginate
rownames = FALSE, # remove row names
style = "bootstrap", # style
width = "100%", # full width
height = "800px",
options = list(
deferRender = TRUE,
# scroll
scrollY = 300,
scroller = TRUE,
# button
autoWidth = TRUE, # column width consistent when making selections
dom = "Blrtip",
buttons =
list(
list(
extend = "collection",
buttons = c("csv", "excel"), # download extension options
text = "Download" # text to display
)
)
) # end of options = list()
) # end of datatable()
}) # end of renderDataTable()
} # end of server function
# Run ---------------------------------------------------------------------
shinyApp(ui, server)
I found some recommendations by removing the Tidyverse package, but it didn't solve my issue.
Any recommendations or thoughts will be much appreciated.
CodePudding user response：
We may use rename_with and also instead of _all/_at, which is deprecated in favor of across
library(dplyr)
library(lubridate)
library(sf)
library(stringr)
dvc_read %>%
st_transform(crs = 4326) %>% rename_with(tolower, everything()) %>% mutate(across(where(is.character), tolower)) %>% mutate(
Date = ymd(date),
Month = case_when(
month == 1 ~ "Jan", month == 2 ~ "Feb",
month == 3 ~ "Mar", month == 4 ~ "Apr",
month == 5 ~ "May", month == 6 ~ "Jun",
month == 7 ~ "Jul", month == 8 ~ "Aug",
month == 9 ~ "Sep", month == 10 ~ "Oct",
month == 11 ~ "Nov", month == 12 ~ "Dec",
TRUE ~ "Unknown"
),
# clean up strings (not perfect)
Severity = if_else(severity %in% c("1", "2", "3"), "unknown", severity),
Accident.Description = if_else(accident.description == "Road closed", "Road_closed", accident.description),
City = if_else(str_detect(city, "x"), "unknown", city), City = if_else(
city %in% c(
"Brooklyn", "Jamaica", "Merrick", "Roosevelt", "unclassified"
), "unknown", city
), Accident.Description = str_replace_all(accident.description, "_", " ")
) %>% mutate(across(c(Severity, Accident.Description, City), tools::toTitleCase))
-output
Simple feature collection with 6 features and 16 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: -74.02346 ymin: 40.61955 xmax: -73.99604 ymax: 40.6659
Geodetic CRS: WGS 84
lat long end_lat end_lng year month day date accident.description severity city
6 40.61955 -74.02346 0 0 2019 9 15 2019-09-15 one lane blocked 3 brooklyn
7 40.61955 -74.02346 40.61955 -74.02346 2020 8 3 2020-08-03 right and center lane blocked 3 brooklyn
8 40.66590 -73.99604 40.66912 -73.99678 2019 2 5 2019-02-05 right lane blocked 2 brooklyn
9 40.66590 -73.99604 40.67653 -74.00127 2018 5 18 2018-05-18 road closed 4 brooklyn
10 40.66590 -73.99604 40.66912 -73.99678 2020 1 20 2020-01-20 two lanes blocked 3 brooklyn
11 40.66590 -73.99604 40.66912 -73.99678 2020 1 29 2020-01-29 right lane blocked 2 brooklyn
geometry Date Month Severity Accident.Description City
6 POINT (-74.02346 40.61955) 2019-09-15 Sep Unknown One Lane Blocked Brooklyn
7 POINT (-74.02346 40.61955) 2020-08-03 Aug Unknown Right and Center Lane Blocked Brooklyn
8 POINT (-73.99604 40.6659) 2019-02-05 Feb Unknown Right Lane Blocked Brooklyn
9 POINT (-73.99604 40.6659) 2018-05-18 May 4 Road Closed Brooklyn
10 POINT (-73.99604 40.6659) 2020-01-20 Jan Unknown Two Lanes Blocked Brooklyn
11 POINT (-73.99604 40.6659) 2020-01-29 Jan Unknown Right Lane Blocked Brooklyn
CodePudding user response：
I guess the problem comes from the missing as_tibble() function. Please note that I convert back the object to sf using st_as_sf() at the end of the code (don't know if it is needed or not... in fact, it depends on your future use of the object)
Reprex
- Code
library(sf)
library(dplyr)
library(lubridate)
library(stringr)
dvc_wrangle <- dvc_read %>%
st_transform(crs = 4326) %>% # transform coords to latlong
# decapitalise everything for easy handling
as_tibble() %>%
rename_all(list(tolower)) %>%
mutate_if(is.character, tolower) %>% # simplify strings
# deal with dates
mutate(
Date = ymd(date),
Month = case_when(
month == 1 ~ "Jan", month == 2 ~ "Feb",
month == 3 ~ "Mar", month == 4 ~ "Apr",
month == 5 ~ "May", month == 6 ~ "Jun",
month == 7 ~ "Jul", month == 8 ~ "Aug",
month == 9 ~ "Sep", month == 10 ~ "Oct",
month == 11 ~ "Nov", month == 12 ~ "Dec",
TRUE ~ "Unknown"
),
# clean up strings (not perfect)
Severity = if_else(severity %in% c("1", "2", "3"), "unknown", severity),
Accident.Description = if_else(accident.description == "Road closed", "Road_closed", accident.description),
City = if_else(str_detect(city, "x") == TRUE, "unknown", city),
City = if_else(
city %in% c(
"Brooklyn", "Jamaica", "Merrick", "Roosevelt", "unclassified"),
"unknown", city
),
# final name tidy-up
Accident.Description = str_replace_all(accident.description, "_", " ")
) %>%
# title case for these columns
mutate_at(vars(Severity, Accident.Description, City), tools::toTitleCase) %>%
st_as_sf()
- Output
dvc_wrangle
#> Simple feature collection with 6 features and 16 fields
#> Geometry type: POINT
#> Dimension: XY
#> Bounding box: xmin: -74.02346 ymin: 40.61955 xmax: -73.99604 ymax: 40.6659
#> Geodetic CRS: WGS 84
#> # A tibble: 6 x 17
#> lat long end_lat end_lng year month day date accident.descri~ severity
#> <dbl> <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
#> 1 40.6 -74.0 0 0 2019 9 15 2019~ one lane blocked 3
#> 2 40.6 -74.0 40.61955 -74.02~ 2020 8 3 2020~ right and cente~ 3
#> 3 40.7 -74.0 40.66912 -73.99~ 2019 2 5 2019~ right lane bloc~ 2
#> 4 40.7 -74.0 40.67653 -74.00~ 2018 5 18 2018~ road closed 4
#> 5 40.7 -74.0 40.66912 -73.99~ 2020 1 20 2020~ two lanes block~ 3
#> 6 40.7 -74.0 40.66912 -73.99~ 2020 1 29 2020~ right lane bloc~ 2
#> # ... with 7 more variables: city <chr>, geometry <POINT [°]>, Date <date>,
#> # Month <chr>, Severity <chr>, Accident.Description <chr>, City <chr>
Created on 2022-01-25 by the reprex package (v2.0.1)