February2023

README.md

@@ -1,4 +1,4 @@
-# 2018_smartdotsReport_template
+# 2023_smartdotsReport_template
 
 This template is used to create reports from smartdots events.  The settings for the report are contained in the [config.json](config.json) file.  Currently, the code requires direct access to the smartdots database and so must be run by someone with the appropriate access.  To run the template:
 

data_checker.R

@@ -5,10 +5,13 @@ library(jsonlite)
 library(tidyr)
 
 # # load configuration
-config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+#config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+config <- read_json("bootstrap/initial/data/config.json", simplifyVector = TRUE)
 
 # get data from bootstrap folder  -------------------------------
-ad <- read.taf("bootstrap/data/smartdots_db/ad.csv")
+#ad <- read.taf("bootstrap/smartdots_db/ad.csv")
+ad <- read.taf("bootstrap/ad.csv")
+
 
 # tag some feilds as missing?
 

data_processing.R

@@ -12,20 +12,25 @@ library(lubridate)
 library(plyr)
 library(dplyr)
 library(tidyverse)
-taf.library(ragree)
+#taf.library(ragree)
+#devtools::install_github("raredd/ragree")
+library(ragree)
 
 # create data directory
-mkdir("data")
+#mkdir("data")
 
 # get utility functions
 source("utilities.R")
 source("utilities_data.R")
 
 # load configuration
-config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+#config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+config <- read_json("bootstrap/initial/data/config.json", simplifyVector = TRUE)
+
 
 # get data from bootstrap folder  -------------------------------
-ad <- read.taf("bootstrap/data/smartdots_db/ad.csv")
+#ad <- read.taf("bootstrap/data/smartdots_db/ad.csv")
+ad <- read.taf("bootstrap/ad.csv")
 
 # prepare data -------------------------------
 
@@ -42,6 +47,7 @@ ad <-
     month <- month(parse_date_time(catch_date, "%d/%m/%Y %H:%M:%S"))
   })
 
+
 # if variables are missing add "missing"
 ad$ices_area[is.na(ad$ices_area) | ad$ices_area == ""] <- "missing"
 ad$stock[is.na(ad$stock) | ad$stock == ""] <- "missing"
@@ -76,9 +82,9 @@ for (i in 1:length(fishid))
     yeshist <- yeshist[rep(row.names(yeshist), length(sampleid_nohist)), ]
     yeshist$SampleID <- sampleid_nohist
   }
-
+  
   temp <- rbind(nohist, yeshist)
-
+  
   if (i == 1) {
     result <- temp
   } else {
@@ -88,13 +94,21 @@ for (i in 1:length(fishid))
 
 ad <- result
 
+ad$TypeAnnotation[ad$TypeAnnotation=="Delegate"]<-"eventOrganizer"
+ad$TypeAnnotation[ad$TypeAnnotation=="Organizer"]<-"eventOrganizer"
+ad$reader[ad$reader==""]<-"eventOrganizer" ## to add a name to the Reader column from the Event Organizer
+ad$Sex[is.na(ad$Sex) | ad$Sex==""]<-"NI"
+ad<-ad[ad$Sex!="NI",]
+ad$Maturity[is.na(ad$Maturity) | ad$Maturity==""]<-"NI"
+ad<-ad[ad$Maturity!="NI",]
+
 # Calculate modal maturity stage and coefficient of unalikability of maturity stage
 ad_long <- ad %>%
   add_modal_trad(varmod = "Maturity", config$ma_method) %>%
   add_modal_linearweight(varmod = "Maturity", config$ma_method) %>%
   add_modal_negexpweight(varmod = "Maturity", config$ma_method)
 
-ad_long_ex <- ad[ad$expertise == "Advanced", ] %>%
+ad_long_adv <- ad[ad$expertise == "Advanced", ] %>% 
   add_modal_trad(varmod = "Maturity", config$ma_method) %>%
   add_modal_linearweight(varmod = "Maturity", config$ma_method) %>%
   add_modal_negexpweight(varmod = "Maturity", config$ma_method)
@@ -106,14 +120,14 @@ ad_long <- ad_long %>%
   add_modal_linearweight(varmod = "Sex", config$ma_method) %>%
   add_modal_negexpweight(varmod = "Sex", config$ma_method)
 
-ad_long_ex <- ad_long_ex %>%
+ad_long_adv <- ad_long_adv %>%
   add_modal_trad(varmod = "Sex", config$ma_method) %>%
   add_modal_linearweight(varmod = "Sex", config$ma_method) %>%
   add_modal_negexpweight(varmod = "Sex", config$ma_method)
 
 # Choose the final mode (traditional, readers linear weight or negative exponential linear weight) based in the existence of histological samples or not, and, in case there are no histological samples, depending if there is multimodality or not.
 ad_long <- select_mode(ad_long, config$ma_method, config$mode_definition)
-ad_long_ex <- select_mode(ad_long_ex, config$ma_method, config$mode_definition)
+ad_long_adv <- select_mode(ad_long_adv, config$ma_method, config$mode_definition)
 
 # prepare data in wbgr output format
 # IMAGE,1,2,3,4,5,6,7,8,9,10,11,12,13
@@ -150,6 +164,6 @@ head(webgr_sex)
 # write out input data tables for use later
 write.taf(ad4webgr, "data/data.csv", quote = TRUE)
 write.taf(ad_long, "data/ad_long.csv", quote = TRUE)
-write.taf(ad_long_ex, "data/ad_long_ex.csv", quote = TRUE)
+write.taf(ad_long_adv, "data/ad_long_adv.csv", quote = TRUE)
 write.taf(webgr_maturity, "data/WebGR_maturity_ages_all.csv", quote = TRUE)
 write.taf(webgr_sex, "data/WebGR_sex_ages_all.csv", quote = TRUE)

model.R

@@ -1,7 +1,7 @@
 ## Run analysis, write model results
 
-## Before: data/ad_long.csv, data/ad_long_ex.csv,
-##         data/ad_wide.csv, data/ad_wide_ex.csv
+## Before: data/ad_long.csv, data/ad_long_adv.csv,
+##         data/ad_wide.csv, data/ad_wide_adv.csv
 ## After:
 
 library(icesTAF)
@@ -16,31 +16,32 @@ library(ggplot2)
 library(scales) # rescale_none
 
 # library ragree contains the function unalike, that is used to estimate the coefficient of unalikeability
-taf.library(ragree)
+library(ragree)
 #
 
 # make model directory
 mkdir("model")
 
 # # load configuration
-config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+#config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+config <- read_json("bootstrap/initial/data/config.json", simplifyVector = TRUE)
 
 # load utilities
 source("utilities.R")
 source("utilities_model.R")
 
 # read input data
 ad_long_all <- read.taf("data/ad_long.csv")
-ad_long_ex <- read.taf("data/ad_long_ex.csv")
+ad_long_adv <- read.taf("data/ad_long_adv.csv")
 
 
 # model maturity range
 modal_matur_unique_all <-  sort(unique(ad_long_all$modal_maturity))
-modal_matur_unique_ex <-  sort(unique(ad_long_ex$modal_maturity))
+modal_matur_unique_adv <-  sort(unique(ad_long_adv$modal_maturity))
 
 # model sex range
 modal_sex_unique_all <-  sort(unique(ad_long_all$modal_sex))
-modal_sex_unique_ex <-  sort(unique(ad_long_ex$modal_sex))
+modal_sex_unique_adv <-  sort(unique(ad_long_adv$modal_sex))
 
 # set strata to NULL if all are NA
 # if(length(setdiff("strata", names(config)))==0) {if(all(is.na(ad_long_all[["strata"]]))) config$strata <- NULL}
@@ -53,15 +54,16 @@ write.taf(sample_data_overview, dir = "model")
 
 # Participants table
 stager_data <- reader_data_table(ad_long_all, strata=config$strata)
+stager_data <- slice(stager_data, 1:(n() - 1))
 write.taf(stager_data, dir = "model")
 
 # Results ##############################################
 
 # repeat for all and for experts only
 
-for (group in c("all", "ex")) {
+for (group in c("all", "adv")) {
  #group <- "all"
- #group <- "ex"
+ #group <- "adv"
 
   # get the appropriate dataset
   ad_long <- get(vname("ad_long"))
@@ -148,6 +150,23 @@ for (group in c("all", "ex")) {
   )
   write.taf(vname("cu_tab_maturity"), dir = "model")
 
+  # CU table (coefficient of unalikeability) - Females
+  assign(
+    vname("cu_tab_maturity_females"),
+    cu_table(ad_long[ad_long$Sex=="F",], "Maturity", by = "reader")
+  )
+  write.taf(vname("cu_tab_maturity_females"), dir = "model")
+
+
+  # CU table (coefficient of unalikeability) - Males
+  assign(
+    vname("cu_tab_maturity_males"),
+    cu_table(ad_long[ad_long$Sex=="M",], "Maturity", by = "reader")
+  )
+  write.taf(vname("cu_tab_maturity_males"), dir = "model")
+
+
+  # CU table (coefficient of unalikeability) - by Sex
   assign(
     vname("cu_tab_sex"),
     cu_table(ad_long, "Sex", by = "reader")
@@ -168,6 +187,22 @@ for (group in c("all", "ex")) {
     pa_table(ad_long, "Sex", by = "reader")
   )
   write.taf(vname("pa_tab_sex"), dir = "model")
+
+  ##females
+  assign(
+    vname("pa_tab_maturity_females"),
+    pa_table(ad_long[ad_long$Sex=="F",], "Maturity", by = "reader")
+  )
+  write.taf(vname("pa_tab_maturity"), dir = "model")
+
+
+  ##males
+  assign(
+    vname("pa_tab_maturity_males"),
+    pa_table(ad_long[ad_long$Sex=="M",], "Maturity", by = "reader")
+  )
+  write.taf(vname("pa_tab_maturity_males"), dir = "model")
+
 
   ##################################################################################################################################################
   #  Frequency table (Number for each maturity stage per modal_maturity for each ). This is the equivalent to the relative bias table in the ageing.
@@ -225,6 +260,9 @@ for (group in c("all", "ex")) {
     maturity_composition_table(ad_long, by = "reader")
   )
   write.taf(vname("maturity_composition_tab"), dir = "model")
+
+
+
 
   ####################
   # sex composition
@@ -243,6 +281,7 @@ for (group in c("all", "ex")) {
 
   saveRDS(get(vname("msem")),  file = file.path("model", paste0(vname("msem"), ".rds")))
 
+
   #########################################################
   # sex category error matrix (SSEM) only for advanced s
   assign(
@@ -298,6 +337,21 @@ for (group in c("all", "ex")) {
     )
     write.taf(vsname("cu_tab_sex_by"), dir = "model")
 
+
+    # CU table (coefficient of unalikeability) - Males
+    assign(
+      vname("cu_tab_maturity_males"),
+      cu_table(ad_long[ad_long$Sex=="M",], "Maturity", by = "reader")
+    )
+    write.taf(vname("cu_tab_maturity_males"), dir = "model")
+
+
+    # CU table (coefficient of unalikeability) - by Sex
+    assign(
+      vname("cu_tab_sex"),
+      cu_table(ad_long, "Sex", by = "reader")
+    )
+    write.taf(vname("cu_tab_sex"), dir = "model")
 
     ##############################################################################################################################
     # Percent agreement between maturity stagings and modal maturity stage.
@@ -312,6 +366,21 @@ for (group in c("all", "ex")) {
       pa_table(ad_long, "Sex", by = stratum)
     )
     write.taf(vsname("pa_tab_sex_by"), dir = "model")
+
+    ##females
+    assign(
+      vname("pa_tab_maturity_females"),
+      pa_table(ad_long[ad_long$Sex=="F",], "Maturity", by = "reader")
+    )
+    write.taf(vname("pa_tab_maturity"), dir = "model")
+
+
+    ##males
+    assign(
+      vname("pa_tab_maturity_males"),
+      pa_table(ad_long[ad_long$Sex=="M",], "Maturity", by = "reader")
+    )
+    write.taf(vname("pa_tab_maturity_males"), dir = "model")
 
     ##################################
     ## Annex tables  #################
@@ -333,7 +402,8 @@ for (group in c("all", "ex")) {
       mat_stage_error_matrix(ad_long, by = stratum)
     )
     saveRDS(get(vname("msem")), file = file.path("model", paste0(vname("msem"), ".rds")))
-
+
+
     #########################################################
     # sex category error matrix (MSEM) only for advanced s
     assign(
@@ -347,5 +417,4 @@ for (group in c("all", "ex")) {
 }
 
 
-
 #config$strata=select_strata

report.R

@@ -8,7 +8,7 @@ library(icesTAF)
 library(rmarkdown)
 library(jsonlite)
 library(knitr)
-# 
+#
 library(pander)
 library(ggplot2)
 library(scales)
@@ -24,11 +24,12 @@ source("utilities.R")
 source("utilities_report.R")
 
 # load configuration data
-config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+#config <- read_json("bootstrap/data/config.json", simplifyVector = TRUE)
+config <- read_json("bootstrap/initial/data/config.json", simplifyVector = TRUE)
 
 # load data for report
 ad_long_all <- read.taf("data/ad_long.csv")
-ad_long_ex <- read.taf("data/ad_long_ex.csv")
+ad_long_adv <- read.taf("data/ad_long_adv.csv")
 
 # # set strata to NULL is all are NA
 # if (all(is.na(ad_long_all[[config$strata]]))) config$strata <- NULL