Damiano Oldoni
    • Create new note
    • Create a note from template
      • Sharing URL Link copied
      • /edit
      • View mode
        • Edit mode
        • View mode
        • Book mode
        • Slide mode
        Edit mode View mode Book mode Slide mode
      • Customize slides
      • Note Permission
      • Read
        • Only me
        • Signed-in users
        • Everyone
        Only me Signed-in users Everyone
      • Write
        • Only me
        • Signed-in users
        • Everyone
        Only me Signed-in users Everyone
      • Engagement control Commenting, Suggest edit, Emoji Reply
      • Invitee
      • No invitee
    • Publish Note

      Publish Note

      Everyone on the web can find and read all notes of this public team.
      Once published, notes can be searched and viewed by anyone online.
      See published notes
      Please check the box to agree to the Community Guidelines.
    • Commenting
      Permission
      Disabled Forbidden Owners Signed-in users Everyone
    • Enable
    • Permission
      • Forbidden
      • Owners
      • Signed-in users
      • Everyone
    • Suggest edit
      Permission
      Disabled Forbidden Owners Signed-in users Everyone
    • Enable
    • Permission
      • Forbidden
      • Owners
      • Signed-in users
    • Emoji Reply
    • Enable
    • Versions and GitHub Sync
    • Note settings
    • Engagement control
    • Transfer ownership
    • Delete this note
    • Save as template
    • Insert from template
    • Import from
      • Dropbox
      • Google Drive
      • Gist
      • Clipboard
    • Export to
      • Dropbox
      • Google Drive
      • Gist
    • Download
      • Markdown
      • HTML
      • Raw HTML
Menu Note settings Sharing URL Create Help
Create Create new note Create a note from template
Menu
Options
Versions and GitHub Sync Engagement control Transfer ownership Delete this note
Import from
Dropbox Google Drive Gist Clipboard
Export to
Dropbox Google Drive Gist
Download
Markdown HTML Raw HTML
Back
Sharing URL Link copied
/edit
View mode
  • Edit mode
  • View mode
  • Book mode
  • Slide mode
Edit mode View mode Book mode Slide mode
Customize slides
Note Permission
Read
Only me
  • Only me
  • Signed-in users
  • Everyone
Only me Signed-in users Everyone
Write
Only me
  • Only me
  • Signed-in users
  • Everyone
Only me Signed-in users Everyone
Engagement control Commenting, Suggest edit, Emoji Reply
Invitee
No invitee
Publish Note

Publish Note

Everyone on the web can find and read all notes of this public team.
Once published, notes can be searched and viewed by anyone online.
See published notes
Please check the box to agree to the Community Guidelines.
Engagement control
Commenting
Permission
Disabled Forbidden Owners Signed-in users Everyone
Enable
Permission
  • Forbidden
  • Owners
  • Signed-in users
  • Everyone
Suggest edit
Permission
Disabled Forbidden Owners Signed-in users Everyone
Enable
Permission
  • Forbidden
  • Owners
  • Signed-in users
Emoji Reply
Enable
Import from Dropbox Google Drive Gist Clipboard
   owned this note    owned this note      
Published Linked with GitHub
Subscribed
  • Any changes
    Be notified of any changes
  • Mention me
    Be notified of mention me
  • Unsubscribe
Subscribe
# INBO CODING CLUB 26 September 2024 Welcome! ## Share your code snippet If you want to share your code snippet, copy paste your snippet within a section of three backticks (```): As an **example**: ``` library(tidyverse) ``` (*you can copy paste this example and add your code further down*) ## Yellow sticky notes No yellow sticky notes online. Put your name + " | " and add a "*" each time you solve a challenge (see below). ## Participants Name | Challenges --- | --- Damiano Oldoni | *** Nele Mullens | ** Jorre Vannieuwenhuyze | Sanne Govaert | Pieter Huybrechts | *** Falk Mielke | Adriaan Seynaeve | ## Challenge 0 ### Cecilia: ```{r} make_bread <- function(grains, yeast, water, salt) { # Code to generate `bread` bread <- grains + yeast + water + salt return(bread) } make_focaccia <- function(grains, yeast, water, salt) { # Code to generate `focaccia` focaccia <- grains + 1.5 * yeast + 0.7 * water + 2 * salt return(focaccia) } make_doughs <- function(grains, yeast, water, salt) { # Function to generate `bread` bread <- make_bread(grains, yeast, water, salt) # Function to generate `bread` focaccia <- make_focaccia(grains, yeast, water, salt) doughs <- list(bread = bread, focaccia = focaccia) return(doughs) } ``` ### Thierry ``` make_doughs <- function(grains, yeast, water, salt) { doughs <- list( bread = make_bread( grains = grains, yeast = yeast, water = water, salt = salt ), focaccia = make_focaccia( grains = grains, yeast = yeast, water = water, salt = salt ) ) return(doughs) } make_bread <- function(grains, yeast, water, salt) { grains + yeast + water + salt } make_focaccia <- function(grains, yeast, water, salt) { grains + 1.5 * yeast + 0.7 * water + 2 * salt } ``` ### Falk ```{r} make_dough_making_function <- function(m1, m2, m3, m4) { function(grains, yeast, water, salt) { m1*grains + m2*yeast + m3*water + m4*salt } } make_bread <- make_dough_making_function(1, 1, 1, 1) make_focaccia <- make_dough_making_function(1, 1.5, 0.7, 2) make_doughs <- function(grains, yeast, water, salt) { # Combine bread and focaccia as a list of doughs doughs <- list(bread = make_bread(grains, yeast, water, salt), focaccia = make_focaccia(grains, yeast, water, salt)) return(doughs) } ``` ### Kaat ```r make_bread <- function(grains, yeast, water, salt) { # Code to generate `bread` bread <- grains + yeast + water + salt return(bread)} make_foccacia <- function(grains, yeast, water, salt) { # Code to generate `bread` focaccia <- grains + 1.5 * yeast + 0.7 * water + 2 * salt return(focaccia)} make_doughs <- function(grains, yeast, water, salt) { # Code to generate `bread` and `focaccia` bread <- make_bread(grains, yeast, water, salt) focaccia <- make_foccacia(grains, yeast, water, salt) # Combine bread and focaccia as a list of doughs doughs <- list(bread = bread, focaccia = focaccia) return(doughs) } ``` ## Robrecht ```r make_doughs <- function(grains, yeast, water, salt, output = "both"){ if(output %in% c("both", "bread", "foccacia")){ bread <- grains + yeast + water + salt foccacia <- grains + 1.5 * yeast + 0.7 * water + 2 * salt doughs <- list(bread = bread, foccacia = foccacia) ifelse(output == "bread", return(doughs$bread), ifelse(output == "foccacio",return(doughs$foccacia), return(doughs))) } else{ return("please provide output in the form as 'both', 'bread' or 'foccacia'") } } ``` ## Challenge 1 ### Damiano's solution (example) Copy paste this section to show your solutions. ```r # dummy code print("This is how to insert code.") ``` ### Jorre ```r get_obs_2010 <- function(species){ # Set scientific name to lowercase species <- tolower(species) # Replace spaces with underscores species <- str_replace_all( species, pattern = " ", replacement = "_" ) # Compose filename file_name <- paste0("20240926_", species, "_2010", ".txt") # Read file ha_2010 <- read_tsv(paste0("./data/20240926/",file_name)) return(ha_2010) } get_obs <- function(speciesm,year){ # Set scientific name to lowercase species <- tolower(species) # Replace spaces with underscores species <- str_replace_all( species, pattern = " ", replacement = "_" ) # Compose filename file_name <- paste0("20240926_", species, "_",year, ".txt") # Read file ha <- read_tsv(paste0("./data/20240926/",file_name)) return(ha) } ``` ### Kaat ``` get_obs_2010 <- function (species){ # Set scientific name to lowercase species <- tolower(species) # Replace spaces with underscores species <- str_replace_all( species, pattern = " ", replacement = "_" ) # Compose filename file_name <- paste0("20240926_", species, "_2010", ".txt") # Read file ha_2010 <- read_tsv(paste0("./data/20240926/", file_name)) return(ha_2010) } get_obs <- function (species, year){ # Set scientific name to lowercase species <- tolower(species) # Replace spaces with underscores species <- str_replace_all( species, pattern = " ", replacement = "_" ) # Compose filename file_name <- paste0("20240926_", species,"_", year, ".txt") # Read file ha <- read_tsv(paste0("./data/20240926/", file_name)) return(ha) } ``` ### Nele ```r get_obs_2010 <- function(species) { species <- tolower(species) species <- str_replace_all( species, pattern = " ", replacement = "_" ) file_name <- paste0("20240926_", species, "_2010", ".txt") ha_2010 <- read_tsv(paste0("./data/20240926/", file_name)) return(as.data.frame(ha_2010)) } df_H_axyridis <- get_obs_2010("Harmonia axyridis") get_obs <- function(species, year) { species <- tolower(species) species <- str_replace_all( species, pattern = " ", replacement = "_" ) file_name <- paste0("20240926_", species, "_", year, ".txt") dataset_obs <- read_tsv(paste0("./data/20240926/", file_name)) return(as.data.frame(dataset_obs)) } df_H_axyridis <- get_obs("Harmonia axyridis", "2011") ``` ### Thierry ``` read_data <- function(species = "Harmonia axyridis", year = 2010, root = ".") { stopifnot(require(assertthat), require(readr)) assert_that( is.string(species), noNA(species), is.string(root), noNA(root), file_test("-d", root), is.count(year) ) tolower(species) |> gsub(pattern = " ", replacement = "_") |> sprintf(fmt = "20240926_%s_%i.txt", year) -> filename file.path(root, filename) |> read_tsv() } ``` ### Sanne's solution ```r # Challenge 1.1 get_obs_2010 <- function(species) { # Set scientific name to lowercase and replace spaces with underscores species <- tolower(species) %>% stringr::str_replace_all(pattern = " ", replacement = "_") # Compose filename file_name <- paste0("20240926_", species, "_2010", ".txt") # Read file observations_2010 <- readr::read_tsv(paste0("./data/20240926/", file_name)) return(observations_2010) } # Challenge 1.2 get_obs <- function(species, year) { # Set scientific name to lowercase and replace spaces with underscores species <- tolower(species) %>% stringr::str_replace_all(pattern = " ", replacement = "_") # Compose filename file_name <- paste0("20240926_", species, "_", year, ".txt") # Read file observations <- readr::read_tsv(paste0("./data/20240926/", file_name)) return(observations) } ``` ### Cecilia ```{r} # Define functions get_obs_2010 <- function(species) { # Set scientific name to lowercase species <- tolower(species) # Replace spaces with underscores species <- str_replace_all( species, pattern = " ", replacement = "_" ) # Compose filename file_name <- paste0("20240926_", species, "_2010", ".txt") # Read file ha_2010 <- read_tsv(paste0("./data/20240926/", file_name)) return(ha_2010) } get_obs <- function(species, year) { # Set scientific name to lowercase species <- tolower(species) # Replace spaces with underscores species <- str_replace_all( species, pattern = " ", replacement = "_" ) # Compose filename file_name <- paste0("20240926_", species, "_", year, ".txt") # Read file ha <- read_tsv(paste0("./data/20240926/", file_name)) return(ha) } # Define variable species <- "Harmonia axyridis" year <- "2011" # Call function related ha_2010 <- get_obs_2010(species) ha <- get_obs(species, year) ``` ### Robrecht ``` get_obs_2010 <- function(...){ files <- list.files(pattern = ".*.txt") all_data <- c() for(file in files){ data <- read.delim(file, header = TRUE) all_data <- merge(all_data, data, all = TRUE) } return(all_data) } data <- get_obs_2010() ``` ### Falk ```r get_obs <- function(year, species) { # Set scientific name to lowercase fn_species <- tolower(species) # Replace spaces with underscores fn_species <- stringr::str_replace_all(fn_species, pattern = " ", replacement = "_") # check year input if (!is.character(year)) { fn_year <- paste0(year) } else { fn_year <- year } # get current folder fn_date <- "20240926" # format(lubridate::today(), format = "%Y%m%d") file_name <- paste0("./data/", fn_date, "/", fn_date, "_", fn_species, "_", fn_year, ".txt" ) # Read file data <- readr::read_tsv(file_name) return(data) } get_obs(2024, "Harmonia axyridis") ``` ## Challenge 2 ### Thierry ``` clean_data <- function( data, max_coord_uncertain = 1000, issues_to_discard = c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" ), occurrenceStatus_to_discard = c("absent", "excluded") ) { stopifnot(require(assertthat), require(tidyverse)) assert_that( inherits(data, "data.frame"), has_name(data, "issue"), has_name(data, "occurrenceStatus"), has_name(data, "coordinateUncertaintyInMeters"), is.number(max_coord_uncertain), noNA(max_coord_uncertain) ) issues_to_discard <- match.arg(issues_to_discard, several.ok = TRUE) occurrenceStatus_to_discard <- match.arg( occurrenceStatus_to_discard, several.ok = TRUE ) data |> filter( .data$coordinateUncertaintyInMeters < max_coord_uncertain | is.na(.data$coordinateUncertaintyInMeters), !.data$issue %in% issues_to_discard, !.data$occurrenceStatus %in% occurrenceStatus_to_discard ) } calc_grid_cell <- function(df, lon_step = 0.1, lat_step = 0.05) { stopifnot(require(assertthat), require(tidyverse)) assert_that( inherits(df, "data.frame"), has_name(df, "decimalLongitude"), has_name(df, "decimalLongitude"), is.number(lon_step), noNA(lon_step), is.number(lat_step), noNA(lat_step) ) df |> mutate( cell_code = sprintf( fmt = "01x005E%iN%i", floor(.data$decimalLongitude / lon_step), floor(.data$decimalLatitude / lat_step)) ) } calc_grid_cell_base <- function( df, lon = "decimalLongitude", lat = "decimalLatitude", lon_step = 0.1, lat_step = 0.05 ) { stopifnot(require(assertthat)) assert_that( inherits(df, "data.frame"), has_name(df, lat), has_name(df, lon), is.number(lon_step), noNA(lon_step), is.number(lat_step), noNA(lat_step) ) df$cell_code <- sprintf( fmt = "01x005E%iN%i", floor(df[, lon] / lon_step), floor(df[, lat] / lat_step) ) } calc_n_obs_ind <- function(df) { stopifnot(require(assertthat), require(tidyverse)) assert_that( inherits(df, "data.frame"), has_name(df, "cell_code"), has_name(df, "individualCount") ) df |> group_by(.data$cell_code) %>% summarise( n_observations = n(), n_individuals = sum(.data$individualCount) ) } plot_distr_cells <- function(df, binwidth = 5) { stopifnot(require(assertthat), require(tidyverse)) assert_that( inherits(df, "data.frame"), has_name(df, "n_observations"), has_name(df, "n_individuals"), is.number(binwidth), noNA(binwidth), binwidth > 0 ) df |> pivot_longer( cols = c("n_observations", "n_individuals"), values_to = "n", names_to = "indicator", names_pattern = "n_?(.*)" ) |> ggplot() + geom_histogram( aes(x = n, fill = indicator), position = "dodge", binwidth = binwidth ) + xlab("n (binwidth: 5)") + ggtitle(label = "Grid cells distribution") } ``` ### Cecilia ```{r} clean_data <- function(df, max_coord_uncertain = 1000, issues_to_discard = c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH"), occurrenceStatus_to_discard = c( "absent", "excluded") ) { ## STEP 2: data cleaning # Remove observations with coordinate uncertainty higher than 1000 meters df <- df %>% filter(coordinateUncertaintyInMeters < max_coord_uncertain | is.na(coordinateUncertaintyInMeters)) # Remove data with some geographic issues df <- df %>% filter(!issue %in% issues_to_discard) # Remove absences df <- df %>% filter(!occurrenceStatus %in% occurrenceStatus_to_discard) return(df) } calc_grid_cell <- function(df, lon = 0.1, lan = 0.05) { ## STEP 3: get the grid cell code each observation belongs to and add it to ## the data.frame. We use grid cells of 0.1 lon degrees x 0.05 lat degrees df <- df %>% mutate(cell_code = paste0( "01x005", "E", floor(decimalLongitude/lan), # cell size "N", floor(decimalLatitude/lon))) return(df) } ha_clean <- clean_data(ha) ha_clean_extra_col <- calc_grid_cell(ha_clean) ``` ### Nele ```{r} #2.1: clean_data(): clean_data <- function(obs_data) { obs_dat <- obs_data %>% filter(coordinateUncertaintyInMeters < 1000 | is.na(coordinateUncertaintyInMeters)) obs_dat %>% filter(!issue %in% c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" )) obs_dat <- obs_dat %>% filter(!occurrenceStatus %in% c( "absent", "excluded" )) } clean_H_axyridis <- clean_data(df_H_axyridis) #2.2: calc_grid_cell(): calc_grid_cell <- function(clean_data, name_long = "decimalLongitude", name_lat = "decimalLatitude",lon = 0.1, lat = 0.05) { clean_data <- clean_data %>% mutate(cell_code = paste0( "01x005", "E", floor(.data[[name_long]]/lon), #not just use name_long, because R will expect a colname names name_long "N", floor(.data[[name_lat]]/lat))) } grid_H_axyridis <- calc_grid_cell(clean_H_axyridis) #2.3: calc_n_obs_ind(): calc_n_obs_ind <- function(dataframe_obs) { n_obs <- dataframe_obs %>% group_by(cell_code) %>% summarise(n_observations = n(), # number of observations (rows) n_individuals = sum(individualCount)) # number of individuals } obs_H_axyridis <- calc_n_obs_ind(grid_H_axyridis) #2.4: plot_distr_cells(): plot_distr_cells <- function (obs_count, binsize = 5) { n_obs <- obs_count %>% tidyr::pivot_longer(cols = c(n_observations, n_individuals), values_to = "n", names_to = "indicator", names_pattern = "n_?(.*)" ) p <- ggplot(n_obs) + geom_histogram(aes(x = n, fill = indicator), position = "dodge", binwidth = binsize) + xlab("n (binwidth: 5)") + ggtitle(label = "Grid cells distribution") p return(p) } plot_distr_cells(obs_H_axyridis, 10) ``` ### Jorre ``` clean_data <- function( df, max_coord_uncertain=1000, issues_to_discard=c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" ), occurrenceStatus_to_discard=c( "absent", "excluded" ) ){ stopifnot(require(assertthat), require(tidyverse)) assert_that( is.data.frame(df), is.numeric(max_coord_uncertain), max_coord_uncertain>=0, is.character(issues_to_discard), is.character(occurrenceStatus_to_discard) ) df |> filter( coordinateUncertaintyInMeters < max_coord_uncertain | is.na(coordinateUncertaintyInMeters) ) |> filter(!issue %in% issues_to_discard) |> filter(!occurrenceStatus %in% occurrenceStatus_to_discard) } calc_grid_cell <- function(df, lon=.1,lat=.05, lonvar='decimalLongitude',latvar='decimalLatitude' ){ stopifnot(require(assertthat), require(tidyverse)) assert_that( is.data.frame(df), is.numeric(lon), is.numeric(lat), is.character(lonvar),is.character(latvar) ) df |> mutate( cell_code = paste0( "01x005", "E", floor(!!sym(lonvar)/lon), "N", floor(!!sym(latvar)/lat) ) ) } ``` ### Falk ```r clean_data <- function(df, max_coord_uncertain = 1000, issues_to_discard = c("ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" ), occurrenceStatus_to_discard = c("absent", "excluded") ) { # Remove observations with coordinate uncertainty higher than max_coord_uncertain df <- df %>% filter(coordinateUncertaintyInMeters < max_coord_uncertain , !is.na(coordinateUncertaintyInMeters) ) # Remove data with some geographic issues df <- df %>% filter(!issue %in% issues_to_discard) # Remove absences df <- df %>% filter(!occurrenceStatus %in% occurrenceStatus_to_discard) return(df) } ``` *(I got distracted afterwards...)* ### Emma's solution ```r clean_data <- function(df, max_coord_uncertain = 1000, issues_to_discard = c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" ), occurrenceStatus_to_discard = c( "absent", "excluded" )){ # Remove observations with coordinate uncertainty higher than 1000 meters data_clean <- df %>% filter(coordinateUncertaintyInMeters < max_coord_uncertain | is.na(coordinateUncertaintyInMeters)) # Remove data with some geographic issues data_clean <- data_clean %>% filter(!issue %in% issues_to_discard) # Remove absences data_clean <- data_clean %>% filter(!occurrenceStatus %in% occurrenceStatus_to_discard) return(data_clean) } calc_grid_cell <- function(df, name_long = "decimalLongitude", name_lat = "decimalLatitude", lat = 0.05, lon = 0.1){ df_grid <- df %>% mutate(cell_code = paste0( "01x005", "E", floor(get(name_long)/lon), "N", floor(get(name_lat)/lat))) return(df_grid) } calc_n_obs_ind <- function(df){ n_obs_ind <- df %>% group_by(cell_code) %>% summarise(n_observations = n(), # number of observations (rows) n_individuals = sum(individualCount)) # number of individuals return(n_obs_ind) } plot_distr_cells <- function(df, binwidth = 5){ n_obs_ind_ha <- df %>% tidyr::pivot_longer(cols = c(n_observations, n_individuals), values_to = "n", names_to = "indicator", names_pattern = "n_?(.*)" ) p <- ggplot(n_obs_ind_ha) + geom_histogram(aes(x = n, fill = indicator), position = "dodge", binwidth = binwidth) + xlab(paste0("n (binwidth: ", binwidth, ")")) + ggtitle(label = "Grid cells distribution") return(p) } ha_2010 <- get_obs("Harmonia axyridis", 2010) cleaned_ha_2010 <- clean_data(ha_2010) grid_ha_2010 <- calc_grid_cell(cleaned_ha_2010) n_obs_ha_2010 <- calc_n_obs_ind(grid_ha_2010) plot_distr_cells(n_obs_ha_2010) ``` ### Pieter ```r #' Data Cleaning #' #' @param df data.frame with observations #' @param max_coord_uncertain maximum of coordinateUncertaintyInMeters allowed (numeric). #' @param issues_to_discard issues whose obs have to be removed (character). #' @param occurrenceStatus_to_discard the occurrenceStatus values whose obs have to be removed (character). #' #' @return data.frame with the cleaned observations #' #' @examples clean_data(df = get_obs(species = "Harmonia axyridis", year = 2011)) clean_data <- function(df, max_coord_uncertain = 1000, issues_to_discard = c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" ), occurrenceStatus_to_discard = c( "absent", "excluded" )) { # Check if all the required columns are present in the input data.frame assertthat::assert_that(assertthat::has_name(df, "coordinateUncertaintyInMeters")) assertthat::assert_that(assertthat::has_name(df, "issue")) assertthat::assert_that(assertthat::has_name(df, "occurrenceStatus")) # Remove observations with coordinate uncertainty higher than the maximum # allowed value if (!missing(max_coord_uncertain)) { df <- dplyr::filter(df, coordinateUncertaintyInMeters < max_coord_uncertain) %>% dplyr::filter(!is.na(coordinateUncertaintyInMeters)) } # Remove data with some geographic issues if (!missing(issues_to_discard)) { df <- dplyr::filter(df, !issue %in% issues_to_discard) } # Remove absences if (!missing(occurrenceStatus_to_discard)) { df <- dplyr::filter(df, !occurrenceStatus %in% occurrenceStatus_to_discard) } # Return cleaned data.frame return(df) } #' Calculate grid cell code based on decimal longitude and latitude #' #' This function calculates the grid cell code for each row in a data frame based on the decimal longitude and latitude values. #' The grid cell code is generated by dividing the longitude and latitude values by the specified cell sizes and concatenating them with the grid cell code prefix. #' #' @param df The input data frame. #' @param decimalLongitude The name of the column containing the decimal longitude values. #' @param decimalLatitude The name of the column containing the decimal latitude values. #' @param cell_size_E The size of the grid cells in the east-west direction. #' @param cell_size_N The size of the grid cells in the north-south direction. #' #' @return The input data frame with an additional column "cell_code" containing the grid cell codes. calculate_grid_cell_code <- function(df, decimalLongitude, decimalLatitude, cell_size_E, cell_size_N) { # Function implementation goes here # ... # ... } # Usage example: # df <- data.frame(decimalLongitude = c(1.234, 2.345, 3.456), # decimalLatitude = c(4.567, 5.678, 6.789)) # df <- calculate_grid_cell_code(df, "decimalLongitude", "decimalLatitude", 0.1, 0.1) #' #' @examples #' df <- data.frame(decimalLongitude = c(10.5, 11.2, 12.7), #' decimalLatitude = c(50.2, 51.8, 52.3)) #' calc_grid_cell(df) #' # Output: #' # decimalLongitude decimalLatitude cell_code #' # 1 10.5 50.2 01x005E210N100 #' # 2 11.2 51.8 01x005E224N103 #' # 3 12.7 52.3 01x005E254N104 calc_grid_cell <- function(df, decimalLongitude = "decimalLongitude", decimalLatitude = "decimalLatitude", cell_size_E = 0.1, cell_size_N = 0.05){ dplyr::mutate(df, cell_code = paste0( "01x005", "E", floor(.data[[decimalLongitude]]/cell_size_E), "N", floor(.data[[decimalLatitude]]/cell_size_N))) } #' Calculate the number of observations and individuals per cell code #' #' This function takes a data frame as input and calculates the number of observations #' (rows) and the number of individuals per cell code. It groups the data frame by the #' cell code and then calculates the counts using the `n()` and `sum()` functions. #' #' @param df The input data frame #' @return A data frame with the number of observations and individuals per cell code #' #' @examples #' df <- data.frame(cell_code = c("A", "A", "B", "B"), #' individualCount = c(1, 2, 3, 4)) #' calc_n_obs_ind(df) #' calc_n_obs_ind <- function(df){ df %>% group_by(cell_code) %>% summarise(n_observations = n(), # number of observations (rows) n_individuals = sum(individualCount)) # number of individuals } #' Plot Distribution of Cells #' #' This function takes a data frame and a width parameter as input and plots the distribution of grid cells. #' #' @param df The data frame containing the data for the plot. #' @param width The width parameter for the histogram binwidth. #' #' @return Plot of the distribution of grid cells. #' #' @examples #' df <- data.frame(n_observations = c(10, 20, 30), #' n_individuals = c(5, 10, 15)) #' plot_distr_cells(df, 5) #' plot_distr_cells <- function(df, width){ # Prepare the data for the plot n_obs_ind <- df %>% tidyr::pivot_longer(cols = c(n_observations, n_individuals), values_to = "n", names_to = "indicator", names_pattern = "n_?(.*)" ) # Create the plot p <- ggplot(n_obs_ind) + geom_histogram(aes(x = n, fill = indicator), position = "dodge", binwidth = width) + xlab(sprintf("n (binwidth: %s)", width)) + ggtitle(label = "Grid cells distribution") # Return the plot return(p) } ``` ## Challenge 3 ### Emma's solution ```r analyse_obs <- function(species, year, ...){ ha_2010 <- get_obs(species, year) cleaned_ha_2010 <- clean_data(ha_2010, ...) grid_ha_2010 <- calc_grid_cell(cleaned_ha_2010) n_obs_ha_2010 <- calc_n_obs_ind(grid_ha_2010) p <- plot_distr_cells(n_obs_ha_2010) return(list(data = n_obs_ha_2010, plot = p)) } ``` ### Pieter ```r analyse_obs <- function(species, year, max_coord_uncertain = 1000, issues_to_discard = c( "ZERO_COORDINATE", "COORDINATE_OUT_OF_RANGE", "COORDINATE_INVALID", "COUNTRY_COORDINATE_MISMATCH" ), occurrenceStatus_to_discard = c( "absent", "excluded" ), decimalLongitude = "decimalLongitude", decimalLatitude = "decimalLatitude", cell_size_E = 0.1, cell_size_N = 0.05, width = 10) { n_obs_ind <- get_obs(species, year) %>% clean_data(max_coord_uncertain, issues_to_discard, occurrenceStatus_to_discard) %>% calc_grid_cell(decimalLongitude, decimalLatitude, cell_size_E, cell_size_N) %>% calc_n_obs_ind() plot <- plot_distr_cells(n_obs_ind, width) return(list(n_obs_ind = n_obs_ind, plot = plot)) } ``` ```r ana_result <- analyse_obs( species = "Chorthippus biguttulus", year = 2010, max_coord_uncertain = 5000, decimalLatitude = "latitude", decimalLongitude = "longitude", width = 5 ) ana_result$n_obs_ind ana_result$plot analyse_obs( species = "Harmonia axyridis", year = 2011 )$plot ``` ## Notes ### Example of data masking using tidyselect ```r my_select <- function(df, cols_to_select){ dplyr::select(df, dplyr::all_of(cols_to_select)) } my_select(population, c("country", "year")) ` ```

Import from clipboard

Advanced permission required

Your current role can only read. Ask the system administrator to acquire write and comment permission.

This team is disabled

Sorry, this team is disabled. You can't edit this note.

This note is locked

Sorry, only owner can edit this note.

Reach the limit

Sorry, you've reached the max length this note can be.
Please reduce the content or divide it to more notes, thank you!

Import from Gist

Import from Snippet

or

Export to Snippet

Are you sure?

Do you really want to delete this note?
All users will lose their connection.

Create a note from template

Create a note from template

Oops...
This template is not available.
Upgrade
All
  • All
  • Team
No template found.

Create custom template

Upgrade

Delete template

Do you really want to delete this template?
Turn this template into a regular note and keep its content, versions, and comments.

This page need refresh

You have an incompatible client version.
Refresh to update.
New version available!
See releases notes here
Refresh to enjoy new features.
Your user state has changed.
Refresh to load new user state.

Sign in

Forgot password

or

By clicking below, you agree to our terms of service.

Sign in via Facebook Sign in via Twitter Sign in via GitHub Sign in via Dropbox Sign in with Wallet
Wallet ( )
Connect another wallet

New to HackMD? Sign up

Help

  • English
  • 中文
  • Français
  • Deutsch
  • 日本語
  • Español
  • Català
  • Ελληνικά
  • Português
  • italiano
  • Türkçe
  • Русский
  • Nederlands
  • hrvatski jezik
  • język polski
  • Українська
  • हिन्दी
  • svenska
  • Esperanto
  • dansk

Documents

Help & Tutorial

How to use Book mode

How to use Slide mode

API Docs

Edit in VSCode

Install browser extension

Get in Touch

Feedback

Discord

Send us email

Resources

Releases

Pricing

Blog

Policy

Terms

Privacy

Cheatsheet

Syntax Example Reference
# Header Header 基本排版
- Unordered List
  • Unordered List
1. Ordered List
  1. Ordered List
- [ ] Todo List
  • Todo List
> Blockquote
Blockquote
**Bold font** Bold font
*Italics font* Italics font
~~Strikethrough~~ Strikethrough
19^th^ 19th
H~2~O H2O
++Inserted text++ Inserted text
==Marked text== Marked text
[link text](https:// "title") Link
![image alt](https:// "title") Image
`Code` Code 在筆記中貼入程式碼
```javascript
var i = 0;
```
var i = 0;
:smile: :smile: Emoji list
{%youtube youtube_id %} Externals
$L^aT_eX$ LaTeX
:::info
This is a alert area.
:::

This is a alert area.

Versions and GitHub Sync
Upgrade to Prime Plan

  • Edit version name
  • Delete

revision author avatar     named on  

More Less

No updates to save
Compare
    Choose a version
    No search result
    Version not found
Sign in to link this note to GitHub
Learn more
This note is not linked with GitHub
 

Feedback

Submission failed, please try again

Thanks for your support.

On a scale of 0-10, how likely is it that you would recommend HackMD to your friends, family or business associates?

Please give us some advice and help us improve HackMD.

 

Thanks for your feedback

Remove version name

Do you want to remove this version name and description?

Transfer ownership

Transfer to
    Warning: is a public team. If you transfer note to this team, everyone on the web can find and read this note.

      Link with GitHub

      Please authorize HackMD on GitHub
      • Please sign in to GitHub and install the HackMD app on your GitHub repo.
      • HackMD links with GitHub through a GitHub App. You can choose which repo to install our App.
      Learn more  Sign in to GitHub

      Push the note to GitHub Push to GitHub Pull a file from GitHub

        Authorize again
       

      Choose which file to push to

      Select repo
      Refresh Authorize more repos
      Select branch
      Select file
      Select branch
      Choose version(s) to push
      • Save a new version and push
      • Choose from existing versions
      Include title and tags
      Available push count

      Upgrade

      Pull from GitHub

       
      File from GitHub
      File from HackMD

      GitHub Link Settings

      File linked

      Linked by
      File path
      Last synced branch
      Available push count

      Upgrade

      Danger Zone

      Unlink
      You will no longer receive notification when GitHub file changes after unlink.

      Syncing

      Push failed

      Push successfully