Rotation

DESCRIPTION

@@ -15,6 +15,7 @@ Imports:
     callr,
     config (>= 0.3.1),
     DT (>= 0.25),
+    ggplot2,
     glue,
     golem (>= 0.3.1),
     htmlwidgets,

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(run_app)
+import(ggplot2)
 import(rmarkdown)
 import(shiny)
 import(shinyvalidate)

R/app_server.R

@@ -109,19 +109,41 @@ app_server <- function(input, output, session) {
   mod_download_server_json("json_zip", user_auth = reactive(input$site))
 
 
-
   ################
 
   # lists of events by block on the currently viewed site
   # accessed like events$by_block[["0"]]
   # has to be done this way, because you can't remove values from reactiveValues
   events <- reactiveValues(by_block = list())
-
+
+
   # start server for the event list
   event_list <- mod_event_list_server("event_list",
                                       events = reactive(events$by_block),
                                       language = reactive(input$language),
                                       site = reactive(input$site))
+
+
+  # Observe the changes in block filter
+  observeEvent(event_list$filters()$block, {
+    # TRUE or FALSE value returned
+    rotation_cycle <- mod_rotation_cycle_server("rotation_cycle",
+                                                rotation = reactive(rotation$by_block),
+                                                site = reactive(input$site),
+                                                block = reactive(event_list$filters()$block))
+
+
+    # Determine if the rotation information is shown on the application or not
+    if( isTRUE(rotation_cycle) ){
+      shinyjs::show("crop_rotation")
+    } else {
+      shinyjs::hide("crop_rotation")
+    }
+  })
+
+
+
+
   # a reactiveVal which holds the currently edited event
   event_to_edit <- event_list$current
 
@@ -218,7 +240,7 @@ app_server <- function(input, output, session) {
     # go through the blocks and save events from the corresponding json file
     # to events$by_block
     for (block in site_blocks) {
-      events$by_block[[block]] <- read_json_file(site1, block)
+      events$by_block[[block]] <- read_json_file(site1, block)$events
     }
   }
 
@@ -269,7 +291,7 @@ app_server <- function(input, output, session) {
       # replacing the old event with the updated one.
       if (editing) {
 
-        orig_block_data <- read_json_file(input$site, orig_event$block)
+        orig_block_data <- read_json_file(input$site, orig_event$block)$events
         event_index <- find_event_index(orig_event, orig_block_data)
 
         if (is.null(event_index)) {
@@ -278,13 +300,20 @@ app_server <- function(input, output, session) {
           return()
         }
 
+        # if rotation information is not null, the fetch it as well. Here it stays
+        # unchanged
+        orig_block_data_rotation <- read_json_file(input$site, orig_event$block)$rotation
+        if ( is.null(orig_block_data_rotation) ) {
+          orig_block_data_rotation <- list()
+        }
+
         # if the block of the event has been changed, delete it from the 
         # original block file.
         # If the event has files associated with it (like images), those will be
         # handled later.
         if (event$block != orig_event$block) {
           orig_block_data[event_index] <- NULL
-          write_json_file(input$site, orig_event$block, orig_block_data)
+          write_json_file(input$site, orig_event$block, orig_block_data, orig_block_data_rotation)
           events$by_block[[orig_event$block]] <- orig_block_data
         }
 
@@ -447,7 +476,7 @@ app_server <- function(input, output, session) {
       # load the json file corresponding to the new block selection (new as in
       # the current event$block value). We load from the file because it might
       # have changed and events$by_block might be out of date
-      new_block_data <- read_json_file(input$site, event$block)
+      new_block_data <- read_json_file(input$site, event$block)$events
 
       # if editing and block didn't change, replace event. 
       # Otherwise append event to the list
@@ -457,8 +486,15 @@ app_server <- function(input, output, session) {
         new_block_data[[length(new_block_data) + 1]] <- event
       }
 
+      # if rotation information is not null, the fetch it as well. Here it stays
+      # unchanged
+      new_block_data_rotation <- read_json_file(input$site, event$block)$rotation
+      if ( is.null(new_block_data_rotation) ) {
+        new_block_data_rotation <- list()
+      }
+
       # save changes
-      write_json_file(input$site, event$block, new_block_data)
+      write_json_file(input$site, event$block, new_block_data, new_block_data_rotation)
       showNotification("Saved successfully.", type = "message")
 
       # update events$by_block
@@ -478,7 +514,7 @@ app_server <- function(input, output, session) {
       event <- event_to_edit()
 
       # retrieve up to date information from the json file
-      block_data <- read_json_file(input$site, event$block)
+      block_data <- read_json_file(input$site, event$block)$events
 
       # find the index of the event to be deleted from the event list
       event_index <- find_event_index(event, block_data)
@@ -511,8 +547,16 @@ app_server <- function(input, output, session) {
       # delete
       block_data[event_index] <- NULL
 
+
+      # if rotation information is not null, the fetch it as well. Here it stays
+      # unchanged
+      block_data_rotation <- read_json_file(input$site, event$block)$rotation
+      if ( is.null(block_data_rotation) ) {
+        block_data_rotation <- list()
+      }
+
       # write changes to json
-      write_json_file(input$site, event$block, block_data)
+      write_json_file(input$site, event$block, block_data, block_data_rotation)
       showNotification("Entry deleted.", type = "message")
 
       # update events list
@@ -575,12 +619,20 @@ app_server <- function(input, output, session) {
 
     }
 
-    block_data <- read_json_file(input$site, event$block)
+    block_data <- read_json_file(input$site, event$block)$events
 
     block_data[[length(block_data) + 1]] <- event
 
+
+    # if rotation information is not null, the fetch it as well. Here it stays
+    # unchanged
+    block_data_rotation <- read_json_file(input$site, event$block)$rotation
+    if ( is.null(block_data_rotation) ) {
+      block_data_rotation <- list()
+    }
+
     # save changes
-    write_json_file(input$site, event$block, block_data)
+    write_json_file(input$site, event$block, block_data, block_data_rotation)
     showNotification("Cloned successfully.", type = "message")
 
     # update events data

R/app_ui.R

@@ -58,7 +58,13 @@ app_ui <- function(request) {
     # add form for entering and viewing information
     shinyjs::hidden(div(id = "form_panel", wellPanel(
       mod_form_ui("form")
-    )))
+    ))),
+
+    br(),
+
+    # Rotation cycle will be shown here
+    shinyjs::hidden(div(id = "crop_rotation", mod_rotation_cycle_ui("rotation_cycle")))
+
   )
 
   tagList(

R/fct_files.R

@@ -43,7 +43,7 @@ create_file_folder <- function(site, block,
 #' @param event_list The list of events to write to the events.json file
 #' @param base_folder Included for testing reasons, the default value should
 #'   otherwise be used
-write_json_file <- function(site, block, event_list, 
+write_json_file <- function(site, block, event_list, rotation_list, 
                             base_folder = json_file_base_folder()) {
 
   # this ensures that the folder to store this file exists
@@ -73,11 +73,25 @@ write_json_file <- function(site, block, event_list,
     }
   }
 
+  # If rotations on the list --> erase the block information like with events
+  if (length(rotation_list) > 0) {
+    for (j in 1:length(rotation_list)) {
+      rotation_list[[j]]$block <- NULL
+
+      rotation <- rotation_list[[j]]
+    }
+  }
+
   # create appropriate structure
   experiment <- list()
   experiment$management <- list()
+
+  # rotation will be part of the management
+  experiment$management$rotation <- rotation_list
+
   experiment$management$events <- event_list
 
+
   # create file
   jsonlite::write_json(experiment, path = file_path, pretty = TRUE, 
                        null = "list", auto_unbox = TRUE)
@@ -105,14 +119,24 @@ read_json_file <- function(site, block,
     return(list())
   }
 
+  management <- NULL
+
   events <- jsonlite::fromJSON(file_path, 
                                simplifyDataFrame = FALSE)$management$events
 
+  rotation <- jsonlite::fromJSON(file_path, 
+                                  simplifyDataFrame = FALSE)$management$rotation
+
   # if there are no events, return an empty list
   if (length(events) == 0) {
     return(list())
   }
 
+  # # if there are no rotation, return an empty list
+  # if (length(rotation) == 0) {
+  #   return(list())
+  # }
+
   # add block information and apply exceptions to each event
   for (i in 1:length(events)) {
     events[[i]]$block <- block
@@ -127,7 +151,19 @@ read_json_file <- function(site, block,
     #####
   }
 
-  return(events)
+  # add block info for rotations
+  if (length(rotation) != 0){
+    for (j in 1:length(rotation)) {
+      rotation[[j]]$block <- block
+    }
+  }
+
+  # Add events and rotation as a list objects which both will be returned
+  # when function is called
+  management$events <- events
+  management$rotation <- rotation
+
+  return(management)
 }
 
 #' Copy a file related to an event and name it appropriately

R/mod_rotation_cycle.R

@@ -0,0 +1,58 @@
+#' rotation_cycle UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd 
+#'
+#' @importFrom shiny NS tagList 
+mod_rotation_cycle_ui <- function(id){
+  ns <- NS(id)
+  tagList(
+    # Header for rotation cycle
+    h5(textOutput("rotation_cycle_title")),
+    #plotOutput(ns("rotation_cycle"))
+    verbatimTextOutput(ns("rotation_cycle"))
+  )
+}
+
+#' rotation_cycle Server Functions
+#'
+#' @noRd 
+#' 
+#' @import ggplot2
+mod_rotation_cycle_server <- function(id, rotation, site, block){ # site needs to be added at some point
+
+  stopifnot(is.reactive(rotation))
+  stopifnot(is.reactive(site))
+  stopifnot(is.reactive(block))
+
+  moduleServer( id, function(input, output, session){
+    ns <- session$ns
+
+    if (dp()) message("Check the crop rotation options")
+    rotation_status <- reactiveVal(FALSE)
+
+      if (!isTruthy(site())) { return() }
+      rotation <- read_json_file(site(), block())$rotation
+      # Rotation status based on if there is rotation information on json -file
+      rotation_status <- ifelse(length(rotation) != 0, TRUE, FALSE)
+
+      if( length(rotation) != 0 ){
+        output$rotation_cycle <- renderText({
+          result <- paste("Rotation info")
+        })
+
+      } else {
+        output$rotation_cycle <- renderText({
+          result <- paste("Rotation information not added for this block")
+        })
+        if (dp()) message("Crop rotation information not found from this site and block")
+      }
+
+    # Return true/false value
+    return(rotation_status)
+
+  })
+}

inst/extdata/display_names.csv

@@ -169,6 +169,7 @@ element_label,guide_text,Guide,Ohje
 element_label,json_dl_label,Events json (zip),Tapah. json (zip)
 element_label,csv_dl_label,Events table (csv),Tapah. kaikki (csv)
 element_label,event_list_title,Events,Tapahtumat
+element_label,rotation_cycle_title,Crop rotation,Vuoroviljely
 #   element_label,editing_table_title,"All %mgmt_operations_event% events in block '%block%'","Kaikki %mgmt_operations_event%-tapahtumat lohkossa '%block%'"
 element_label,table_filter_text_1,"Showing ","Näytetään "
 element_label,table_filter_text_2," events from block "," tapahtumat lohkosta "

inst/extdata/ui_structure.json

@@ -40,6 +40,11 @@
       "type" : "textOutput"
     },
 
+    "rotation_cycle_title" : {
+      "code_name" : "rotation_cycle_title",
+      "type" : "textOutput"
+    },
+
     "json_dl_label" : {
       "code_name" : "json_dl_label",
       "type" : "textOutput"