Can R and Shiny make me a better fisherman? Part 3
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
In this previous post, I presented the shiny application I developed to record data about my fishing session. In today’s post, I will present briefly the changes and updates I made to improve the application. Here are the main changes:
Weather API: the API I was using (Dark Sky) stopped furnishing free data. I changed for Openweathermap and I needed to update the functions to gather the same information as before.
River flow: the first version of the application did not collect any data about the flow of the river in which I am fishing. However I am convinced that the river flow before the fishing session might have an impact on the presence of seabass. I therefore created a web scrapping function that collect the flow of the Nive and the Adour (main fishing rivers).
Collecting lure data: in the first version, data about fishing lures I used were only collected when a fish was caught. However I did not have data about how long I used the lure before catching a fish. The new version of the application now collects data about lure and how often I change lure.
Weather API
Small changes were made to adapt the former weather function to the new weather API. As this new API do not furnish moon phase data, I decided to compute the moon phase with the oce package:
library(httr) library(jsonlite) library(tidyverse) library(rvest) library(oce) weather <- function(lat, lon, API_key){ url <- paste0("api.openweathermap.org/data/2.5/weather?lat=", lat, "&lon=", lon, "&appid=", API_key, "&units=metric") rep <- GET(url) table <- fromJSON(content(rep, "text")) # The weather API don't provide moon phase so I compute it with Oce package moon_phase <- round(moonAngle(t = Sys.Date(), longitude = as.numeric(lon), latitude = as.numeric(lat))$illuminatedFraction, 3) current.weather.info <- data.frame(Air_temp = table$main$temp, Weather = table$weather$main, Atm_pres = table$main$pressure, Wind_str = table$wind$speed, Wind_dir = table$wind$deg, Cloud_cover = table$clouds$all, PrecipInt = ifelse(is.null(table$rains$`1h`), 0, table$rains$`1h`), Moon = moon_phase) return(current.weather.info) }
River flow
I wrote functions to scrap information about the flows of the rivers in which I fish the most on a french website:
# Get and prepare the flow data get_Qdata <- function(link){ table <- fromJSON(content(GET(link), "text")) table <- table$Serie$ObssHydro table <- as.data.frame(table) table$DtObsHydro <- sub("T", " ", table$DtObsHydro) table$DtObsHydro <- substr(table$DtObsHydro, start = 1, stop = 19) ts <- data.frame(Date = seq.POSIXt(as.POSIXct(range(table$DtObsHydro)[1],'%m/%d/%y %H:%M:%S'), as.POSIXct(range(table$DtObsHydro)[2],'%m/%d/%y %H:%M:%S'), by="hour")) table$DtObsHydro <- as.POSIXct(table$DtObsHydro, format = "%Y-%m-%d %H:%M:%S") table <- full_join(table, ts, by = c("DtObsHydro" = "Date")) %>% arrange(DtObsHydro) return(table) } # Main function to collect river flow river_flow <- function(){ # Url of website to scrap: url_index <- "https://www.vigicrues.gouv.fr/services/station.json/index.php" rep <- GET(url_index) table_index <- fromJSON(content(rep, "text"))$Stations%>% na.omit() # I need to add the flow of several rivers to get the flow of the rivers I am interested in: stations <- table_index %>% filter(LbStationHydro %in% c("Pontonx-sur-l'Adour", "St-Pandelon", "Artiguelouve", "Escos", "Aïcirits [St-Palais]", "Cambo-les-Bains")) base_url <- "http://www.vigicrues.gouv.fr/services/observations.json?CdStationHydro=" height_url <- "&FormatDate=iso" Q_url <- "&GrdSerie=Q" stations <- stations %>% mutate(WL_link = paste0(base_url, CdStationHydro, height_url), Q_link = paste0(WL_link, Q_url)) data_Q <- lapply(stations$Q_link, function(x){get_Qdata(x)}) data_Q <- suppressWarnings(Reduce(function(...) merge(..., all = TRUE, by = "DtObsHydro"), data_Q)) names(data_Q) <- c("Date", stations$LbStationHydro) data_Q <- data_Q %>% mutate(hour_of_day = format(Date, "%Y-%m-%d %H")) data_Q <- aggregate(.~hour_of_day, data = data_Q, mean, na.rm = TRUE, na.action = na.pass) data_Q <- imputeTS::na_interpolation(data_Q, option = "linear") final_data <- data_Q %>% mutate(Adour = `Pontonx-sur-l'Adour` + `Aïcirits [St-Palais]` + Artiguelouve + Escos + `St-Pandelon`, Date = as.POSIXct(hour_of_day, tryFormats = "%Y-%m-%d %H")) %>% select(Date, `Cambo-les-Bains`, Adour) %>% rename(Nive = `Cambo-les-Bains`) Cur_flow <- data.frame("Nive_c" = final_data[nrow(final_data), 2], "Adour_c" = final_data[nrow(final_data), 3]) final_data <- cbind(Cur_flow, final_data) %>% nest(Ts_flow = c(Date, Nive, Adour)) %>% mutate(Ts_flow = paste(Ts_flow)) return(final_data) }
Shiny application
A simplified graph of the new application is showed below:
Simplified workflow of the new version of application
UI side
The UI side did not change that much, I only removed the tab that displayed fishing data on a map because I wasn’t using this feature too much:
# Load libraries library(shiny) library(shinyWidgets) library(googlesheets) library(miniUI) library(leaflet) library(rdrop2) Sys.setenv(TZ="Europe/Paris") #Import the functions for weather API and webscrapping suppressMessages(source("api_functions.R")) # Load the dropbox token : token <<- readRDS("token.rds") # Minipage for small screens ui <- miniPage(tags$script('$(document).ready(function () { navigator.geolocation.getCurrentPosition(onSuccess, onError); function onError (err) { Shiny.onInputChange("geolocation", false); } function onSuccess (position) { setTimeout(function () { var coords = position.coords; console.log(coords.latitude + ", " + coords.longitude); Shiny.onInputChange("geolocation", true); Shiny.onInputChange("lat", coords.latitude); Shiny.onInputChange("long", coords.longitude); }, 1100) } });'), gadgetTitleBar("Catch them all", left = NULL, right = NULL), miniTabstripPanel( miniTabPanel("Session", icon = icon("sliders"), miniContentPanel(uiOutput("UI_sess", align = "center"), uiOutput("UI", align = "center")) ) ) )
Server side
Several changes were made in the server side to collect data about the lures I used. Now, each time I change my fishing lure, I fill a small form to collect the lure characteristics and it adds a line in a third csv file:
server <- function(input, output, session){ observeEvent(input$go ,{ # Read the csv file containing information about fishing session. If a session is running, # display the UI that allows the user to input data about the fish caught. If a session is not started, # display a button to start the session and small survey on lure characteristics. dat <<- drop_read_csv("/app_peche/session1.csv", header = T, stringsAsFactors = F, dtoken = token) # Reactive UI output$UI <- renderUI({ if(!is.na(rev(dat$End)[1])){ # We now indicate what type of lure we use at the beginning of the session: tagList( selectInput("lure1", label = "Type de leurre", choices = list("Shad" = "shad", "Slug" = "slug", "Jerkbait" = "jerkbait", "Casting jig" = "jig", "Topwater" = "topwater"), selected = "shad", selectize = FALSE), selectInput("color_lure1", label = "Couleur du leurre", choices = list("Naturel" = "naturel", "Sombre" = "sombre", "Clair" = "clair", "Flashy" = "flashy" ), selected = "naturel", selectize = FALSE), selectInput("length_lure1", label = "Taille du leurre", choices = list("Petit" = "petit", "Moyen" = "moyen", "Grand" = "grand"), selected = "petit", selectize = FALSE), actionButton("go","Commencer session !")) }else{ tagList(actionButton("go","End session")) } }) output$UI_sess <- renderUI({ if(!is.na(rev(dat$End)[1])){ tagList(textInput("comments", label = "Commentaire avant le début?", value = "NA")) }else{ input$catch input$lure tagList( selectInput("lure_type", label = "Type de leurre", choices = list("Shad" = "shad", "Slug" = "slug", "Jerkbait" = "jerkbait", "Casting jig" = "jig", "Topwater" = "topwater"), selected = "shad", selectize = FALSE), selectInput("color_lure", label = "Couleur du leurre", choices = list("Naturel" = "naturel", "Sombre" = "sombre", "Clair" = "clair", "Flashy" = "flashy" ), selected = "naturel", selectize = FALSE), selectInput("length_lure", label = "Taille du leurre", choices = list("Petit" = "petit", "Moyen" = "moyen", "Grand" = "grand"), selected = "petit", selectize = FALSE), actionButton("lure", label = "Changer de leurre!"), br(), br(), h4("Ajouter une capture"), selectInput("species", label = "Espèces", choices = list("Bar" = "bar", "Bar moucheté" = "bar_m", "Alose" = "alose", "Maquereau" = "maquereau", "Chinchard" = "chinchard"), selected = "bar"), sliderInput("length", label = "Taille du poisson", value = 25, min = 0, max = 80, step = 1), actionButton("catch","Rajoutez cette capture aux stats!"), br(), br(), textInput("comments1", label = h4("Commentaire avant la fin ?"), value = "NA") ) } }) }, ignoreNULL = F) #If the button is pushed, create the line to be added in the csv file. observeEvent(input$go,{ # Two outcomes depending if the session starts or ends. This gives the possibility # to the user to add a comment before starting the session or after ending the session if(!is.na(rev(dat$End)[1])){ #Tide + geoloc + Weather c_tide <- tide() geoloc <- c(input$lat,input$long) current.weather.info <- weather(lat = geoloc[1], lon = geoloc[2]) river.flow <- river_flow() n_ses <- c(rev(dat$Session)[1] + 1) time_beg <- as.character(as.POSIXct(Sys.time())) comment <- input$comments dat.f <<- cbind(data.frame(n_ses, time_beg, NA, geoloc[2], geoloc[1]), current.weather.info, c_tide, river.flow, comment) names(dat.f) <- names(dat) print(dat.f) final_dat <- rbind(dat, dat.f) lure <- drop_read_csv("/app_peche/lure.csv", header = T, stringsAsFactors = F, dtoken = token) new_lure <- data.frame(n_ses = n_ses, time = as.character(as.POSIXct(Sys.time())), type_lure = input$lure1, color_lure = input$color_lure1, length_lure = input$length_lure1) new_df <- rbind(lure, new_lure) write_csv(as.data.frame(new_df), "lure.csv") drop_upload("lure.csv", path = "App_peche", mode = "overwrite", dtoken = token) }else{ dat$End[nrow(dat)] <- as.character(as.POSIXct(Sys.time())) dat$Comments[nrow(dat)] <- paste(dat$Comments[nrow(dat)], "/", input$comments1) final_dat <- dat } # Write csv in temporary files of shiny server write_csv(as.data.frame(final_dat), "session1.csv") # Upload it to dropbox account drop_upload("session1.csv", path = "App_peche", mode = "overwrite", dtoken = token) }) # Add a line to the catch csv file whenever a fish is caught observeEvent(input$catch,{ caugth <- drop_read_csv("/app_peche/catch1.csv", header = T, stringsAsFactors = F, dtoken = token) catch <- data.frame(n_ses = dat$Session[nrow(dat)], time = as.character(as.POSIXct(Sys.time())), species = input$species, length = input$length) b <- rbind(caugth,catch) write_csv(as.data.frame(b), "catch1.csv") drop_upload("catch1.csv", path = "App_peche", mode = "overwrite", dtoken = token) }) observeEvent(input$lure,{ lure <- drop_read_csv("/app_peche/lure.csv", header = T, stringsAsFactors = F, dtoken = token) new_lure <- data.frame(n_ses = dat$Session[nrow(dat)], time = as.character(as.POSIXct(Sys.time())), type_lure = input$lure_type, color_lure = input$color_lure, length_lure = input$length_lure) new_df <- rbind(lure, new_lure) write_csv(as.data.frame(new_df), "lure.csv") drop_upload("lure.csv", path = "App_peche", mode = "overwrite", dtoken = token) }) }
Conclusion
I have tested this new application during two fishing sessions and it has been working like a charm. I can’t wait to present you my findings at the end of this fishing season !
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.