Updating Measuring Performance tutorial and tweaks to others

PacificCommunity · Feb 25, 2019 · b8ff91f · b8ff91f
1 parent 96d39ce
commit b8ff91f
Show file tree

Hide file tree

Showing 21 changed files with 323 additions and 164 deletions.
diff --git a/MeasuringPerformance/app.R b/MeasuringPerformance/app.R
@@ -117,15 +117,18 @@ ui <- navbarPage(
                    value="PIradar",
                    column(12, fluidRow(
                     tags$span(title="Radar plot of the median values of the performance indicators over the three time periods. Note that the PIs for effort and variability have been transformed so that the larger the value, the better the HCR is thought to be performing.",
-                 plotOutput("plotpiradar", height="600px")),
-                 "Note that stability PIs and relative effort are not shown on the radar plot."
+                 plotOutput("plotpiradar", height="600px"))#,
+                 #"Note that stability PIs and relative effort are not shown on the radar plot."
            ))
           ),
           tabPanel(title="Performance indicators - table",
                    value="PItable",
                    column(12, fluidRow(
-                   "Performance indicators in the long-term",
-                   div(tags$span(title="Peformance indicators in the long-term. The value is the median, the values in the parentheses are the 20-80 percentiles.", tableOutput("bigpitable"), style = "font-size:85%"))
+                   #"Performance indicators in the long-term",
+                   "Performance indicators in the short-, medium- and long-term",
+                   div(tags$span(title="Peformance indicators in the short-term. The value is the median, the values in the parentheses are the 20-80 percentiles.", tableOutput("bigpitable_short"), style = "font-size:85%")),
+                   div(tags$span(title="Peformance indicators in the medium-term. The value is the median, the values in the parentheses are the 20-80 percentiles.", tableOutput("bigpitable_medium"), style = "font-size:85%")),
+                   div(tags$span(title="Peformance indicators in the long-term. The value is the median, the values in the parentheses are the 20-80 percentiles.", tableOutput("bigpitable_long"), style = "font-size:85%"))
            ))
           ),
           tabPanel(title="Majuro plots",
@@ -159,7 +162,7 @@ ui <- navbarPage(
       ),
       mainPanel(width=9,
         fluidRow(column=12,
-          stoch_params_setterUI("stoch", init_prod_sigma=0.2, init_est_sigma=0.04, init_est_bias=0.0),
+          stoch_params_setterUI("stoch", init_prod_sigma=0.2, init_est_sigma=0.2, init_est_bias=0.0),
           stock_params_setterUI("stock"),
           # Total number of years (including historical years)
           numericInput("nyears", "Number of years", value = 30, min=20, max=100, step=1),
@@ -185,8 +188,8 @@ ui <- navbarPage(
         p("Project the stock forward under the chosen HCR by clicking on the ", strong("Project HCR"), " button. If you like the look of the output, add the HCR to the basket by clicking on the ", strong("Add to basket"), " button"),
         p("Keep adding HCRs to your basket until you are ready to compare them."),
         h1("Performance indicators"),
-        p("There are 8 PIs in the table. ", em("SB/SBF=0"), " and ", em("Catch"), " are fairly self explanatory. ", em("Effort (rel. 1999)"), " and ", em("CPUE (rel. 1999)"), " are the fishing effort and CPUE relative to their values in 1999 respectively. ", em("Prob. SB > LRP"), " is the probability of of SB/SBF=0 being above the LRP. ", em("Catch variability"), ",", em("Effort variability"), " and ", em("CPUE variability"), " measure the variability in the catch, relative effort and relative CPUE respectively. The variability PIs measure the bumpiness over time. The higher the value, the more the value changes over time."),
-        p("It should be noted that these PIs don't all point the same way.  It is generally thought that the higher the value of ", em("SB/SBF=0"), ",", em("Prob. SB > LRP"), ",", em("Catch"), " and ", em("CPUE (rel. 1999)"), " the better the HCR is performing. However, for ", em("Effort (rel. 1999)"), "and the ", em("variability"), " PIs, lower values are preferred. The higher the effort, the greater the costs. Stable catches and effort are preferred to catches and effort that varying strongly between years. Care must therefore be taken when using PIs to compare performance of HCRs."),
+        p("There are 8 PIs in the table. ", em("SB/SBF=0"), " and ", em("Catch"), " are fairly self explanatory. ", em("Effort (rel. 2018)"), " and ", em("CPUE (rel. 2018)"), " are the fishing effort and CPUE relative to their values in 2018 respectively. ", em("Prob. SB > LRP"), " is the probability of of SB/SBF=0 being above the LRP. ", em("Catch variability"), ",", em("Effort variability"), " and ", em("CPUE variability"), " measure the variability in the catch, relative effort and relative CPUE respectively. The variability PIs measure the bumpiness over time. The higher the value, the more the value changes over time."),
+        p("It should be noted that these PIs don't all point the same way.  It is generally thought that the higher the value of ", em("SB/SBF=0"), ",", em("Prob. SB > LRP"), ",", em("Catch"), " and ", em("CPUE (rel. 2018)"), " the better the HCR is performing. However, for ", em("Effort (rel. 2018)"), "and the ", em("variability"), " PIs, lower values are preferred. The higher the effort, the greater the costs. Stable catches and effort are preferred to catches and effort that varying strongly between years. Care must therefore be taken when using PIs to compare performance of HCRs."),
         h1("Comparing performance"),
         p("Choose the ", strong("Compare performance"), " tab for a range of plots and tables that allow the comparison of the performance of the HCRs through performance indicators and other metrics."),
         p("The performance indicators and HCRs can be selected and delselected to help with the comparison.")
@@ -197,7 +200,7 @@ ui <- navbarPage(
 
 server <- function(input, output,session) {
   # Global parameters
-  app_params <- list(initial_year = 1990, # Cosmetic only
+  app_params <- list(initial_year = 2009, # Cosmetic only
                      last_historical_timestep = 10)
   # Storage for stocks - not actually needed - we only use the tsstore and pistore - make both reactive
   # Comment out but leave in case we decide to use it
@@ -373,18 +376,47 @@ server <- function(input, output,session) {
     auto=TRUE
   )
 
+  # I don't like the repetition!
   # The mega table for the PIs - tricky
-  output$bigpitable <- renderTable({
+  output$bigpitable_long <- renderTable({
     hcr_choices <- input$hcrchoice
     pi_choices <- input$pichoice
     # If no HCR or PI is selected then don't do anything
     if(is.null(hcr_choices) | is.null(pi_choices)){
       return()
     }
-    big_pi_table(pis=pistore(), hcr_choices=hcr_choices, pi_choices=pi_choices) 
+    big_pi_table(pis=pistore(), hcr_choices=hcr_choices, pi_choices=pi_choices, term_choice="long") 
     },
     rownames = TRUE,
-    caption= "Performance indicators",
+    caption= "Performance indicators in the long-term",
+    auto=TRUE
+  )
+
+  output$bigpitable_medium <- renderTable({
+    hcr_choices <- input$hcrchoice
+    pi_choices <- input$pichoice
+    # If no HCR or PI is selected then don't do anything
+    if(is.null(hcr_choices) | is.null(pi_choices)){
+      return()
+    }
+    big_pi_table(pis=pistore(), hcr_choices=hcr_choices, pi_choices=pi_choices, term_choice="medium") 
+    },
+    rownames = TRUE,
+    caption= "Performance indicators in the medium-term",
+    auto=TRUE
+  )
+
+  output$bigpitable_short <- renderTable({
+    hcr_choices <- input$hcrchoice
+    pi_choices <- input$pichoice
+    # If no HCR or PI is selected then don't do anything
+    if(is.null(hcr_choices) | is.null(pi_choices)){
+      return()
+    }
+    big_pi_table(pis=pistore(), hcr_choices=hcr_choices, pi_choices=pi_choices, term_choice="short") 
+    },
+    rownames = TRUE,
+    caption= "Performance indicators in the short-term",
     auto=TRUE
   )
 

diff --git a/R/funcs.R b/R/funcs.R
@@ -506,8 +506,7 @@ current_pi_table <- function(pis){
   return(out)
 }
 
-
-big_pi_table <- function(pis, hcr_choices, pi_choices){
+big_pi_table <- function(pis, hcr_choices, pi_choices, term_choice="long"){
   if (length(pis) == 0){
     return()
   }
@@ -521,12 +520,11 @@ big_pi_table <- function(pis, hcr_choices, pi_choices){
   }
   signif <- 2
   # Big fuck-off table: PIs along top, HRCs in the rows
-  # Just the long term
   # Just the median and two quantiles
   # which quantiles do we want? drop the "q" from the front and order
   qs <- sort(as.numeric(substring(unique(piqs$quantiles),2)))
   qs <- paste("q", qs[2:4],sep="")
-  piqs <- subset(piqs, (hcr %in% hcr_choices) & (name %in% pi_choices) & (term == "long") & (quantiles %in% qs))
+  piqs <- subset(piqs, (hcr %in% hcr_choices) & (name %in% pi_choices) & (term == term_choice) & (quantiles %in% qs))
   piqs$value <- signif(piqs$value, signif)
   dat <- spread(piqs, key="quantiles", value="value")
   # Make the text values

diff --git a/R/plots.R b/R/plots.R
@@ -621,7 +621,8 @@ plot_pi_choice <- function(pis, hcr_choices, pi_choices, plot_choice){
     # The plots - facet on name
     # Plot type one - bar chart on q50
     #dat <- subset(piqs, (quantiles=="q50") & (hcr %in% hcr_choices) & (name %in% pi_choices))
-    dat <- subset(piqs_transform, (quantiles=="q50"))
+    #dat <- subset(piqs_transform, (quantiles=="q50"))
+    dat <- subset(piqs, (quantiles=="q50"))
     p <- ggplot(dat, aes(x=term, y=value, fill=hcrlegend))
     p <- p + geom_bar(stat="identity", position="dodge", colour="black", width=0.7)
     p <- p + scale_fill_manual(values=hcrcols)

diff --git a/tutorials/figures/measuringPerformanceHCR1.png b/tutorials/figures/measuringPerformanceHCR1.png
diff --git a/tutorials/figures/measuringPerformance_boxPlot.png b/tutorials/figures/measuringPerformance_boxPlot.png
diff --git a/tutorials/figures/measuringPerformance_medianBar.png b/tutorials/figures/measuringPerformance_medianBar.png
diff --git a/tutorials/figures/measuringPerformance_medianBar2.png b/tutorials/figures/measuringPerformance_medianBar2.png
diff --git a/tutorials/figures/measuringPerformance_medianBar3.png b/tutorials/figures/measuringPerformance_medianBar3.png
diff --git a/tutorials/figures/measuringPerformance_medianBar4.png b/tutorials/figures/measuringPerformance_medianBar4.png
diff --git a/tutorials/figures/measuringPerformance_radar.png b/tutorials/figures/measuringPerformance_radar.png
diff --git a/tutorials/figures/measuringPerformance_start.png b/tutorials/figures/measuringPerformance_start.png
diff --git a/tutorials/figures/measuringPerformance_timeSeries.png b/tutorials/figures/measuringPerformance_timeSeries.png
diff --git a/tutorials/introHCR.Rmd b/tutorials/introHCR.Rmd
@@ -1,5 +1,5 @@
 ---
-title: "Introduction to Harvest Control Rules using *AMPED*"
+title: "Introduction to Harvest Control Rules with *AMPED*"
 author: "Finlay Scott - OFP, SPC"
 date: "2019-21-02"
 output:
@@ -8,14 +8,16 @@ output:
   pdf_document:
     includes:
       in_header: mystyle.sty
+    latex_engine: xelatex
+mainfont: Calibri Light
 fontsize: 12pt
 ---
 
 <!--use render()-->
 <!-- render("tutorials/measuringPerformance.Rmd", output_format = "all")-->
 
 ```{r, results='hide', echo=FALSE, warning=FALSE, message=FALSE}
-library(kableExtra)
+#library(kableExtra)
 ```
 
 # Introduction to HCRs
@@ -130,18 +132,18 @@ Again, repeatedly press the **Advance** button and follow the evolution of the s
 \begin{table}[H]
 \begin{tabular}{| c | C{3cm} | C{3cm} | C{5cm} |}
 \hline
-HCR & Final catch & Final SB/SBF=0 & Notes \\ \hline
-1   &             &                &       \\ 
+& Final catch & Final SB/SBF=0 & Notes \\ \hline
+HCR 1   &             &                &       \\ 
 \footnotesize{(\textit{Belbow}=0.5, \textit{Cmax}=140)}    &             &                &\\
 &&&\\ 
 &&&\\ 
 &&&\\ \hline
-2   &             &                &       \\ 
+HCR 2   &             &                &       \\ 
 \footnotesize{(\textit{Belbow}=0.3, \textit{Cmax}=130)}    &             &                &\\
 &&&\\ 
 &&&\\ 
 &&&\\ \hline
-3   &             &                &       \\ 
+HCR 3   &             &                &       \\ 
 \footnotesize{(\textit{Belbow}=0.8, \textit{Cmax}=150)}    &             &                &\\
 &&&\\ 
 &&&\\ 

diff --git a/tutorials/introHCR.html b/tutorials/introHCR.html
diff --git a/tutorials/introHCR.pdf b/tutorials/introHCR.pdf
diff --git a/tutorials/introUncertainty.Rmd b/tutorials/introUncertainty.Rmd
@@ -5,12 +5,33 @@ date: "2019-21-02"
 output:
   html_document:
     keep_md: yes
+    # tufte - no good
+#  tufte::tufte_handout:
+#    includes:
+#      in_header: mystyle.sty
   pdf_document:
     includes:
       in_header: mystyle.sty
+    latex_engine: xelatex
+mainfont: Calibri Light
 fontsize: 12pt
 ---
 
+
+
+<!--
+output:
+  tufte::tufte_handout: default
+  
+  
+  pdf_document:
+    includes:
+      in_header: mystyle.sty
+fontsize: 12pt
+  
+  
+  -->
+
 <!--use render()-->
 <!-- render("tutorials/measuringPerformance.Rmd", output_format = "all")-->
 
@@ -35,7 +56,7 @@ Start by double-clicking on the **IntroUncertainty** file in the *AMPED* directo
 A black window *should* appear, followed by the app opening in a browser window.
 If this does not happen, something has gone wrong. Sorry...
 
-The layout of the app should show the HCR in the middle, with three time series plots of SB/SBF=0, catch and CPUE (relative to the CPUE in 1999) on the right-hand side and the control buttons on the left-hand side.
+The layout of the app should show the HCR in the middle, with three time series plots of SB/SBF=0, catch and CPUE (relative to the CPUE in 2018) on the right-hand side and the control buttons on the left-hand side.
 There should already be 10 years of catch, SB/SBF=0 and CPUE data in the plots.
 
 <!-- Insert image -->
@@ -270,7 +291,11 @@ Long-term&&&\\ \hline
 Look at the performance in different time periods.
 Remember that we want *Catch variability* to be low.
 
-WHich HCR do you prefer?
+Which HCR do you prefer?
+
+Here we have 3 indicators over 3 time periods giving us a total of 9 PIs to consider. Each PI is reported as a median (average) value plus the 20th and 80th percentiles. This is a lot of information to process!
+You can see that considering more and more indicators can quickly lead to an overwhelming amount of information.
+How we try to understand all of it is covered in the next tutorial.
 
 
 # Summary

diff --git a/tutorials/introUncertainty.html b/tutorials/introUncertainty.html
diff --git a/tutorials/introUncertainty.pdf b/tutorials/introUncertainty.pdf