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.