diff --git a/.RData b/.RData new file mode 100644 index 0000000..5181fd4 Binary files /dev/null and b/.RData differ diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..b9d8cbb --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,12 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^data-raw$ +dev_history.R +^dev$ +$run_dev.* +^LICENSE\.md$ +^app\.R$ +^rsconnect$ +^README\.Rmd$ +^\.github$ +^\./inst/user_doc$ diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..cd53d35 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,35 @@ +# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. +# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions +on: + push: + branches: + - main + - master + - dev + pull_request: + branches: + - main + - master + - dev + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: macOS-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v2 + - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-r@v2 + - name: Install dependencies + run: | + install.packages(c("remotes", "rcmdcheck")) + remotes::install_deps(dependencies = TRUE) + shell: Rscript {0} + - name: Check + run: | + options(crayon.enabled = TRUE) + rcmdcheck::rcmdcheck(args = "--no-manual", error_on = "error") + shell: Rscript {0} diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..643465d --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +.Rproj.user +.Rhistory +.Rdata +.httr-oauth +.DS_Store +app.R +inst/doc +dev/database.sqlite +inst/user_doc/user_instructions.html \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..8f70999 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,47 @@ +Package: fieldactivity +Title: An app for keeping track of field activity +Version: 0.2.1 +Authors@R: c(person('Henri', 'Kajasilta', email = 'henri.kajasilta@fmi.fi', role = c('aut', 'cre')), + person('Otto', 'Kuusela', email = 'otto.kuusela@helsinki.fi', role = 'aut')) +Description: An app for keeping track of field activity in the Field + Observatory project. Built using Shiny, the application allows farmers to + enter information about common farming events like tillage, sowing and + harvest. These event data are stored in .json files, which mostly follow the + ICASA standards for agricultural data. +License: BSD_3_clause + file LICENSE +Imports: + attempt, + bslib, + callr, + config (>= 0.3.1), + DT (>= 0.25), + ggplot2, + glue, + golem (>= 0.3.1), + htmlwidgets, + jsonlite, + methods, + pkgload, + processx, + rmarkdown, + shiny (>= 1.6.0), + shinyjs, + shinymanager (>= 1.0.400), + shinyvalidate (>= 0.1.1), + stringr, + tools, + zip +Encoding: UTF-8 +LazyData: true +RoxygenNote: 7.2.0 +URL: https://github.com/PecanProject/fieldactivity +BugReports: https://github.com/PecanProject/fieldactivity/issues +Suggests: + spelling, + testthat (>= 3.0.0), + shinytest, + knitr, + markdown +Config/testthat/edition: 3 +Language: en-US +VignetteBuilder: knitr diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..ca97725 --- /dev/null +++ b/LICENSE @@ -0,0 +1,3 @@ +YEAR: 2021 +COPYRIGHT HOLDER: fieldactivity authors +ORGANIZATION: Finnish Meteorological Institute \ No newline at end of file diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..0dbaa1f --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,31 @@ +# BSD-3-clause license + +Copyright (c) 2021, fieldactivity authors + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + Neither the name of the Finnish Meteorological Institute nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..056b67a --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,19 @@ +# Generated by roxygen2: do not edit by hand + +export(run_app) +import(ggplot2) +import(rmarkdown) +import(shiny) +import(shinyvalidate) +importFrom(callr,r) +importFrom(glue,glue) +importFrom(golem,activate_js) +importFrom(golem,add_resource_path) +importFrom(golem,bundle_resources) +importFrom(golem,favicon) +importFrom(golem,with_golem_options) +importFrom(shiny,NS) +importFrom(shiny,shinyApp) +importFrom(shiny,tagList) +importFrom(utils,write.csv) +importFrom(zip,zip) diff --git a/R/_disable_autoload.R b/R/_disable_autoload.R new file mode 100644 index 0000000..a8c9436 --- /dev/null +++ b/R/_disable_autoload.R @@ -0,0 +1,3 @@ +# Disabling shiny autoload + +# See ?shiny::loadSupport for more information diff --git a/R/app_config.R b/R/app_config.R new file mode 100644 index 0000000..d0af790 --- /dev/null +++ b/R/app_config.R @@ -0,0 +1,43 @@ +#' Access files in the current app +#' +#' NOTE: If you manually change your package name in the DESCRIPTION, +#' don't forget to change it here too, and in the config file. +#' For a safer name change mechanism, use the `golem::set_golem_name()` function. +#' +#' @param ... character vectors, specifying subdirectory and file(s) +#' within your package. The default, none, returns the root of the app. +#' +#' @noRd +app_sys <- function(...){ + system.file(..., package = "fieldactivity") +} + + +#' Read App Config +#' +#' @param value Value to retrieve from the config file. +#' @param config GOLEM_CONFIG_ACTIVE value. If unset, R_CONFIG_ACTIVE. +#' If unset, "default". +#' @param use_parent Logical, scan the parent directory for config file. +#' +#' @noRd +get_golem_config <- function( + value, + config = Sys.getenv( + "GOLEM_CONFIG_ACTIVE", + Sys.getenv( + "R_CONFIG_ACTIVE", + "default" + ) + ), + use_parent = TRUE +){ + config::get( + value = value, + config = config, + # Modify this if your config file is somewhere else: + file = app_sys("golem-config.yml"), + use_parent = use_parent + ) +} + diff --git a/R/app_server.R b/R/app_server.R new file mode 100644 index 0000000..59f2795 --- /dev/null +++ b/R/app_server.R @@ -0,0 +1,718 @@ +#' The application server-side +#' +#' @param input,output,session Internal parameters for {shiny}. +#' DO NOT REMOVE. +#' @import shiny +#' @importFrom glue glue +#' @noRd +app_server <- function(input, output, session) { + # run interactive themer + #bslib::bs_themer() + + if (dp()) message("Initializing server function") + + # check_credentials returns a function to authenticate users + credential_checker <- shinymanager::check_credentials( + db = golem::get_golem_options("user_db_path"), + passphrase = golem::get_golem_options("user_db_passphrase") + ) + + # call the server part of shinymanager + # weird observation: this has to be after the observeEvent block + # which observes the auth_result$user. If it isn't the site selectInput + # selection is not updated to match the username. + # UPDATE: moved it back and doesn't do anything weird anymore + auth_result <- shinymanager::secure_server(check_credentials = + credential_checker) + + # change login form language when requested + observeEvent(input$login_language, { + #str(reactiveValuesToList(input)) + #updateTextInput(session, "auth-user_id", value = "oma1") + #updateTextInput(session, "auth-user_pwd", value = "oma2") + #shinyjs::click("auth-go_auth") # doesn't work + + if (dp()) message("input$login_language") + + # this function is defined in fct_language.R + set_login_language(input$login_language) + + # TODO: make the language setting communicate to main app + # PROBLEM: shinymanager isolates the app pretty well, so for instance + # communication through session$userData doesn't work + + # this seems to refresh the authentication UI + auth_result <- shinymanager::secure_server(check_credentials = + credential_checker) + + + # Update the authentication page language + mod_auth_page_server("auth_text", input$login_language) + }) + + # runs when logged in + observeEvent(auth_result$user, { + + if (dp()) message("auth_result$user changed") + + if (auth_result$admin == "FALSE") { + # Create a new user that has access to the Carbon action sites. + if (auth_result$user == "ca_user") { + + shinyjs::enable("site") + shinyjs::show("site") + # Subset of site choices for the third user + site_choices <- sites[sites$site_type %in% c('Advanced CarbonAction Site','CarbonAction Site'),]$site + + updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user) + } else if (auth_result$user == "valio_user") { + + shinyjs::enable("site") + shinyjs::show("site") + # Subset of site choices for the third user + site_choices <- sites[grepl("Valio Carbo", sites$site_type),]$site + + updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user) + + } else { + + updateSelectInput(session, "site", selected = auth_result$user) + shinyjs::disable("site") + } + + updateTextInput(session, "uservisible", value = auth_result$user) + shinyjs::disable("uservisible") + + + # shinyjs::show("uservisible") + } else { + shinyjs::enable("site") + shinyjs::show("site") + shinyjs::disable("uservisible") + } + + }) + + if (golem::app_dev()) { + shinyjs::show("site") + } + + ################ + + # Module for download server, need to decide if ui is separated to + # different functions, if more download buttons is required + + mod_download_server_inst("download_ui_1") + + mod_download_server_table("event_table", user_auth = reactive(input$site)) + + 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 + + form <- list( + # change this to change the values of widgets in the form + set_values = reactiveVal(), + # set to TRUE to reset the values of widgets in the form + reset_values = reactiveVal(), + init_signal = reactiveVal(), + values = list(initialised = FALSE) + ) + # start server for the form + # form$values <- mod_form_server("form", + # site = reactive(input$site), + # set_values = form$set_values, + # reset_values = form$reset_values, + # edit_mode = reactive( + # !is.null(event_to_edit())), + # language = reactive(input$language)) + + # update each of the text outputs automatically, including language changes + # and the dynamic updating in editing table title etc. + lapply(text_output_code_names, FUN = function(text_output_code_name) { + # render text + output[[text_output_code_name]] <- renderText({ + if (dp()) message(glue("Rendering text for {text_output_code_name}")) + + get_disp_name(text_output_code_name, input$language) + }) + }) + + observeEvent(event_to_edit(), ignoreNULL = FALSE, ignoreInit = TRUE, { + + if (dp()) message("event_to_edit() changed") + + if (is.null(event_to_edit())) { + # edit mode was disabled + # hide the form and clear values + exit_form() + return() + } + + ### edit mode was enabled, or there was a switch from one event to another + + # fill values on the form and show it + form$set_values(event_to_edit()) + show_form(edit_mode = TRUE) + + }) + + + + # exit sidebar mode + # this is called when saving and when pressing cancel + exit_form <- function() { + if (dp()) message("Hiding form") + + # reset all input fields + form$reset_values(TRUE) + + # hide sidebar + shinyjs::hide("form_panel", anim = TRUE, animType = "slide") + shinyjs::enable("add_event") + shinyjs::disable("clone_event") + if (golem::app_dev() || auth_result$admin == "TRUE") { + shinyjs::enable("site") + } + } + + show_form <- function(edit_mode = FALSE) { + if (dp()) message("Showing form") + + shinyjs::show("form_panel", anim = TRUE, animType = "slide") + shinyjs::disable("add_event") + if (edit_mode) shinyjs::enable("clone_event") + if (golem::app_dev() || auth_result$admin == "TRUE") { + shinyjs::disable("site") + } + + # send the init signal. If this has not been done before, this will cause + # the form to initialise table and fileInput server functions + form$init_signal(TRUE) + } + + # load data from all the json files corresponding to a site and store it in + # separate lists in events$by_block + load_json_data <- function(site1) { + # clear possible previous data + events$by_block <- list() + + # find all blocks on this site + site_blocks <- subset(sites, sites$site == site1)$blocks[[1]] + + # 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 + } + } + + # a function which calls the server function of the form module and adds + # observers to its buttons. This is a separate function because we want to + # delay calling it to improve start up speed. + initialise_form <- function() { + + form$values <<- mod_form_server("form", + site = reactive(input$site), + set_values = form$set_values, + reset_values = form$reset_values, + edit_mode = reactive( + !is.null(event_to_edit())), + language = reactive(input$language), + init_signal = form$init_signal) + + # cancel means we exit edit mode and hide the form + observeEvent(form$values$cancel(), { + if (is.null(event_to_edit())) { + exit_form() + } else { + event_to_edit(NULL) + } + }) + + # save input to a file when save button is pressed + # we are either creating a new event or editing an older one + observeEvent(form$values$save(), { + # fetch new values from the form + event <- form$values$data() + + if (is.null(event)) { + if (dp()) message("All validation rules have not been met") + showNotification(paste("Some of the entered information is not valid.", + "Please check the fields highlighted in red."), + type = "warning") + return() + } + + # are we editing an existing event or creating a new one? + orig_event <- event_to_edit() + editing <- !is.null(orig_event) + + # if we are editing, find the index of the event in the original + # block data list. Also, if the block has been changed, update that + # file. If the block has not changed, we will need the index when + # replacing the old event with the updated one. + if (editing) { + + 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)) { + showNotification("Could not edit entry because it was not + found in the event files.", type = "error") + 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, orig_block_data_rotation) + events$by_block[[orig_event$block]] <- orig_block_data + } + + } + + # Now we need to make sure associated files such as images are handled + # properly. + # + # scenarios: + # 1. original had a file but the variable is no longer relevant + # 2. original had a file and the variable is relevant: + # i. no new file and block and date have not changed + # ii. no new file but block or date has changed + # iii. new file + # 3. original did not have a file: + # i. new file + # ii. no new file + + + + for (fileInput_code_name in fileInput_code_names) { + + orig_path <- orig_event[[fileInput_code_name]] + orig_path_exists <- !is.null(orig_path) & + !identical(orig_path, missingval) + new_value <- event[[fileInput_code_name]] + + # if a fileInput variable is no longer relevant to an event, delete the + # associated file (SCENARIO 1) + if (fileInput_code_name %in% names(orig_event) && + !(fileInput_code_name %in% names(event)) && + orig_path_exists) { + + # delete the file + tryCatch(expr = delete_file(orig_path, input$site, orig_event$block, + filepath_relative = TRUE), + error = function(cnd) { + message(glue("Could not delete file related ", + "to the edited event: {cnd}")) + }) + + next + } + + # if the event doesn't have a file with this fileInput_code_name, skip + # to the next one + if (is.null(new_value)) next + + # should currently saved file be deleted? + clear_value <- is.null(new_value$filepath) & orig_path_exists + # is a new file uploaded? + new_file_uploaded <- new_value$new_file + + if (new_file_uploaded) { + filepath <- new_value$filepath + # move the file into place and get the relative path + # (SCENARIO 3i/2iii) + relative_path <- + tryCatch(expr = + copy_file(filepath, + variable_name = fileInput_code_name, + site = input$site, + block = event$block, + date = event$date), + error = function(cnd) { + showNotification( + "Could not save the image file correctly.", + type = "warning") + message(glue("Error when saving image to ", + "{fileInput_code_name}: {cnd}")) + missingval + }) + + # if the event already has a value in this field, we are replacing the + # file with a new one. We should therefore delete the old file. + # (SCENARIO 2iii) + if (orig_path_exists) { + # delete the file + tryCatch(expr = delete_file(orig_path, input$site, + orig_event$block, + filepath_relative = TRUE), + error = function(cnd) { + message(glue("Could not delete file to ", + "be replaced: {cnd}")) + }) + } + + event[[fileInput_code_name]] <- relative_path + } else if (clear_value) { + # the file was deleted by the user using the delete button. + # Let's actually delete the file and save changes + tryCatch(expr = delete_file(orig_path, input$site, + orig_event$block, filepath_relative = TRUE), + error = function(cnd) { + message(glue("Could not delete file related ", + "to the event: {cnd}")) + }) + + event[[fileInput_code_name]] <- missingval + } else { + + # a new file was not uploaded. + # However, if there is already a file uploaded, we might + # have to rename/move it as the event date or block might + # have changed. We will therefore move the current file + # like it was a new file. + + if (editing && orig_path_exists) { + + if (event$block != orig_event$block | event$date != orig_event$date) { + # we should rename and/or move the file + + # this path is relative to json_file_base_folder() + orig_relative_path <- file.path(input$site, orig_event$block, + orig_path) + + relative_path <- + tryCatch(expr = copy_file( + orig_relative_path, + variable_name = fileInput_code_name, + site = input$site, + block = event$block, + date = event$date, + filepath_is_relative = TRUE, + delete_original = TRUE), + error = function(cnd) { + showNotification( + "Could not rename the image file.", + type = "warning") + message(glue("Error when renaming ", + "image ", + "{variable_name}: {cnd}")) + orig_path + }) + + event[[fileInput_code_name]] <- relative_path + + } else { + # we did not have to move the file and therefore do + # not need to change the current file path + event[[fileInput_code_name]] <- event[[fileInput_code_name]]$filepath + next + } + + } else { + # we are not editing (or path is missingval), so save + # missingval + event[[fileInput_code_name]] <- missingval + } + + } + + } + + if (dp()) { + message("The finished event:") + utils::str(event) + } + + # 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)$events + + # if editing and block didn't change, replace event. + # Otherwise append event to the list + if (editing && orig_event$block == event$block) { + new_block_data[[event_index]] <- event + } else { + 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, new_block_data_rotation) + showNotification("Saved successfully.", type = "message") + + # update events$by_block + events$by_block[[event$block]] <- new_block_data + + # exit sidebar mode + if (editing) { + event_to_edit(NULL) + } else { + exit_form() + } + + }) + + # delete entry when delete button is pressed + observeEvent(form$values$delete(), { + event <- event_to_edit() + + # retrieve up to date information from the json file + 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) + + if (is.null(event_index)) { + showNotification("Could not delete entry because it + was not found in the event files.", type = "error") + return() + } + + # if the event has image files associated with it (e.g. canopeo_image) + # delete those. For this we go through all fileInput variables and check + # whether they are defined in the event + for (fileInput_code_name in fileInput_code_names) { + value <- event[[fileInput_code_name]] + path_exists <- !is.null(value) & !identical(value, missingval) + + if (fileInput_code_name %in% names(event) & path_exists) { + # delete the file + tryCatch(expr = delete_file(value, input$site, event$block, + filepath_relative = TRUE), + error = function(cnd) { + message(glue("Could not delete file related to ", + "the deleted event: {cnd}")) + + }) + } + } + + # 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, block_data_rotation) + showNotification("Entry deleted.", type = "message") + + # update events list + events$by_block[[event$block]] <- block_data + + # exit edit mode + event_to_edit(NULL) + }) + + } + + # show add event UI when requested + observeEvent(input$add_event, { + # note: event_to_edit() should be NULL at this point as the add button is + # disabled during editing + if (!is.null(event_to_edit())) return() + + # if we were not editing previously, copy current table view settings + # (block and activity) into the widgets if they are set to a specific + # value (not "all") + new_values <- list() + activity <- event_list$filters()$activity + block <- event_list$filters()$block + + if (!is.null(activity) && activity != "activity_choice_all") { + new_values$mgmt_operations_event <- activity + } + if (!is.null(block) && block != "block_choice_all") { + new_values$block <- block + } + + if (!identical(new_values, list())) form$set_values(new_values) + + show_form() + }) + + observeEvent(input$clone_event, { + # fetch the event to be cloned + event <- event_to_edit() + + # if the event has files associated with it, those need to be duplicated + for (fileInput_code_name in fileInput_code_names) { + + path <- event[[fileInput_code_name]] + path_exists <- !is.null(path) & !identical(path, missingval) + + if (path_exists) { + # path is relative to events.json. This path is relative to + # json_file_base_folder() : + relative_path <- file.path(input$site, event$block, path) + + clone_file_path <- copy_file(orig_filepath = relative_path, + variable_name = fileInput_code_name, + site = input$site, + block = event$block, + date = event$date, + filepath_is_relative = TRUE) + event[[fileInput_code_name]] <- clone_file_path + } + + } + + 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, block_data_rotation) + showNotification("Cloned successfully.", type = "message") + + # update events data + events$by_block[[event$block]] <- block_data + }) + + # load the site event data into memory (events$by_block) + observeEvent(input$site, ignoreNULL = FALSE, { + + if (dp()) message("input$site was changed") + + if (!isTruthy(input$site)) { + shinyjs::disable("add_event") + return() + } + + shinyjs::enable("add_event") + + if (dp()) message(glue::glue("Loading data for site {input$site}")) + # load the events corresponding to this site into memory + load_json_data(input$site) + + # initialise the form module if it has not been done yet + if (identical(form$values$initialised, FALSE)) { + initialise_form() + } + + }) + + # change language when user requests it + observeEvent(input$language, ignoreInit = TRUE, { + + if (dp()) message("input$language changed") + + # get a list of all input elements which we have to relabel + input_element_names <- names(reactiveValuesToList(input)) + + for (code_name in input_element_names) { + + # TODO: update to use the update_ui_element function + + # find element in the UI structure lookup list + element <- structure_lookup_list[[code_name]] + + # didn't find the element corresponding to code_name + # this should not happen if the element is in + # sidebar_ui_structure.json + if (is.null(element$type)) next + + label <- get_disp_name(element$label, input$language) + + if (element$type == "selectInput") { + + # fetch choices for the selectInput + choices <- get_selectInput_choices(code_name, input$language) + + # make sure we don't change the selected value + current_value <- input[[code_name]] + + if (is.null(choices)) { + updateSelectInput(session, + code_name, + label = ifelse(is.null(label),"",label), + selected = current_value) + } else { + updateSelectInput(session, + code_name, + label = ifelse(is.null(label),"",label), + choices = choices, + selected = current_value) + } + + } else if (element$type == "actionButton") { + updateActionButton(session, + code_name, + label = label) + } + + } + + }) + +} diff --git a/R/app_ui.R b/R/app_ui.R new file mode 100644 index 0000000..cbb4a65 --- /dev/null +++ b/R/app_ui.R @@ -0,0 +1,102 @@ +#' The application User-Interface +#' +#' @param request Internal parameter for `{shiny}`. +#' DO NOT REMOVE. +#' @import shiny +#' @noRd +app_ui <- function(request) { + + # Define the UI of the application + ui <- fluidPage(#theme = bslib::bs_theme(), + + # adding the language to the left side and sitename to the right side on top of the application. + tagList( + # Top of the page elements + div(style="display: inline-block;vertical-align:middle;", + selectInput("language", choices = languages, width = "120px", label = ""), inline = TRUE), + + div(style="display: inline-block;vertical-align:0.15em;", + mod_download_ui("download_ui_1", label = textOutput("guide_text"), purp = "inst")), + + div(style="display: inline-block;position:absolute;right:10em;margin-top:.5em;", + textInput("uservisible", value = " ", width = "175px", + label = textOutput("uservisible_title"))) + ), + + + + # adding "" to the choices makes the default choice empty + shinyjs::hidden(selectInput("site", + label = get_disp_name("site_label", init_lang), + choices = c("", sites$site))), + + # set web page title + titlePanel("", windowTitle = "Field Observatory"), + + + # title to be displayed on the page + h1(textOutput("frontpage_title")), + + # show instructions + div(style = "max-width:500px;", textOutput("frontpage_text")), + + h2(textOutput("event_list_title")), + + # event list module UI + mod_event_list_ui("event_list"), + + # add a little space between the elements + br(), + + actionButton("add_event", label = get_disp_name("add_event_label", init_lang)), + shinyjs::disabled(actionButton("clone_event", + label = get_disp_name("clone_event_label", init_lang))), + + br(), + br(), + + # 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( + # Leave this function for adding external resources + golem_add_external_resources(), + ui + ) +} + +#' Add external Resources to the Application +#' +#' This function is internally used to add external +#' resources inside the Shiny application. +#' +#' @import shiny +#' @importFrom golem add_resource_path activate_js favicon bundle_resources +#' @noRd +golem_add_external_resources <- function(){ + + add_resource_path( + 'www', app_sys('app/www') + ) + + tags$head( + favicon(), + bundle_resources( + path = app_sys('app/www'), + app_title = 'fieldactivity' + ), + # Add here other external resources + # for example, you can add shinyalert::useShinyalert() + shinyjs::useShinyjs(), # enable shinyjs + ) +} + diff --git a/R/fct_event_list.R b/R/fct_event_list.R new file mode 100644 index 0000000..9cc1b4d --- /dev/null +++ b/R/fct_event_list.R @@ -0,0 +1,87 @@ +#' Turn a list of events into a data frame +#' +#' Takes a list of events and makes a data frame with given +#' variables in columns. Also adds a column with the complete event list and a +#' final column for ordering the list by date. +#' +#' @param events The list of events to turn into a data frame +#' @param variable_names The variables which should be displayed in the columns +#' of the data frame. +#' +#' @return A data frame with the events as rows and variable names as columns. +#' +#' @note The function doesn't replace code names with display names. That is +#' done separately so that when the app language is switched, we can change +#' the table display names without having to create it again. +get_data_table <- function(events, variable_names) { + # initialise table + display_data_table <- data.frame() + for (variable_name in variable_names) { + # initialise the corresponding table column + display_data_table[[variable_name]] <- list() + } + # the event column will hold the complete event information as a list + display_data_table$event <- list() + # the date_ordering column will hold dates for ordering the table + display_data_table$date_ordering <- character() + + row_number <- 1 + for (event in events) { + + for (variable_name in variable_names) { + + value <- event[[variable_name]] + if (is.null(value)) { + value <- "" + } + # if value is a vector, it will be turned into a single string + # when the table is converted to a table with display names + + display_data_table[[row_number, variable_name]] <- value + } + + # double brackets allow saving a list nicely + display_data_table[[row_number, "event"]] <- event + display_data_table[row_number, "date_ordering"] <- + as.Date(event$date, format = date_format_json) + + row_number <- row_number + 1 + } + + return(display_data_table) +} + +#' Find the index of an event in a list +#' +#' Find the first index corresponding to the given event in a list of events. +#' An event is considered equal to another if they have exactly the same +#' variables (though not necessarily in the same order) and these variables +#' have exactly the same values. +#' +#' @param event The event whose index to identify +#' @param event_list The list of events where event is to be found +#' +#' @return The index if found, NULL otherwise +find_event_index <- function(event, event_list) { + + if (length(event_list) == 0) { return(NULL) } + + # sort the items in the lists to the same order (alphabetical) + event <- event[order(names(event))] + + # go through all rows in the event list and check if any of them match + for (i in 1:length(event_list)) { + + list_event <- event_list[[i]] + # sort the items in this particular list event, to allow comparison + list_event <- list_event[order(names(list_event))] + + if (identical(event, list_event)) { + return(i) + } + + } + + # We didn't find a match, so return NULL + return(NULL) +} \ No newline at end of file diff --git a/R/fct_files.R b/R/fct_files.R new file mode 100644 index 0000000..a144fde --- /dev/null +++ b/R/fct_files.R @@ -0,0 +1,299 @@ +# Functions for creating and reading the json data files containing the events +# and for managing event-related (image) files. +# Otto Kuusela 2021 + +# path to json file folder +json_file_base_folder <- function() golem::get_golem_options("json_file_path") + +#' Create a folder for a site-block combination +#' +#' Given a site and a block on that site, create a folder under +#' json_file_base_folder where the events.json file and related image files will +#' be stored. If the base folder doesn't exist, the function will throw an +#' error. +#' +#' @param site The site to create the folder for +#' @param block The block to create the folder for +#' @param base_folder Included for testing reasons, the default value should +#' otherwise be used +#' +#' @return TRUE if the directory was created successfully or already exists, +#' FALSE otherwise. +create_file_folder <- function(site, block, + base_folder = json_file_base_folder()) { + # if the events directory (stored in json_file_base_folder) doesn't exist, + # stop + if (!dir.exists(base_folder)) { + stop(glue("Could not find folder {json_file_base_folder}")) + } + + folder_path <- file.path(base_folder, site, block) + if (!dir.exists(folder_path)) { + dir.create(folder_path, recursive = TRUE) + } else { TRUE } +} + +#' Write a given event list to a json file +#' +#' The function will overwrite the current events.json file and replace it with +#' one generated from the supplied list of events +#' +#' @param site The site of the events +#' @param block The block of the events +#' @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, rotation_list, + base_folder = json_file_base_folder()) { + + # this ensures that the folder to store this file exists + create_file_folder(site, block) + + file_path <- file.path(base_folder, site, block, "events.json") + + # if there are events in the list, do the following: + # - erase block information in each event + # - apply other exceptions + if (length(event_list) > 0) { + for (i in 1:length(event_list)) { + event_list[[i]]$block <- NULL + + ##### EXCEPTIONS + event <- event_list[[i]] + + # if the event type is fertilizer application and the fertilizer + # type is organic, change mgmt_operations_event to organic_material + # to conform to the ICASA standard + if (identical(event$mgmt_operations_event, "fertilizer") && + identical(event$fertilizer_type, "fertilizer_type_organic")) { + event_list[[i]]$mgmt_operations_event <- "organic_material" + } + + ##### + } + } + + # 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) +} + +#' Read the events from the events.json file +#' +#' Reads the events from the events.json file specific to this site and block +#' combination and returns as a list of events. +#' +#' @param site The site to read from +#' @param block The block to read from +#' @param base_folder Included for testing reasons, the default value should +#' otherwise be used +#' +#' @return A list of events, which are themselves lists. If the corresponding +#' file does not exist or there are no events, returns an empty list. +read_json_file <- function(site, block, + base_folder = json_file_base_folder()) { + + file_path <- file.path(base_folder, site, block, "events.json") + + # if file doesn't exist or given names are empty, can't read it + if (!file.exists(file_path)) { + 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 + + ##### EXCEPTIONS + + # if mgmt_operations_event is organic_material, change it to fertilizer + if (identical(events[[i]]$mgmt_operations_event, "organic_material")) { + events[[i]]$mgmt_operations_event <- "fertilizer" + } + + ##### + } + + # 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 +#' +#' When a file (image) is uploaded through a fileInput widget, it is saved to a +#' temporary folder. This function copies that file to an appropriate directory +#' and name. The file does not have to be originally in a temporary +#' folder, any file path is ok. Therefore this function can also be used e.g. +#' when cloning and event and the images associated with it need to be +#' duplicated. +#' @param orig_filepath The path of the file to copy +#' @param variable_name Which variable is this file for? E.g. canopeo_image +#' @param site The site where the event took place +#' @param block The block where the event took place +#' @param date The day of the event as a character string, the format must be +#' yyyy-mm-dd +#' @param filepath_is_relative If TRUE, json_file_base_folder will be added to +#' the beginning of filepath +#' @param delete_original Should the original file be deleted after copying? +#' @param base_folder Included for testing reasons, the default value should +#' otherwise be used +#' +#' @details The name will be of the format +#' yyyy-mm-dd_site_block_variable_name_# where # is a number (0, 1, 2, ...) to +#' ensure that files have unique names. +#' +#' @return A path to the new location of the file relative to the events.json +#' file. +#' +#' @importFrom glue glue +copy_file <- function(orig_filepath, variable_name, site, block, date, + filepath_is_relative = FALSE, delete_original = FALSE, + base_folder = json_file_base_folder()) { + # ensures the folder for this site-block combo is there + create_file_folder(site, block) + + # add json_file_base_folder to filepath if requested + if (filepath_is_relative) { + orig_filepath <- file.path(base_folder, orig_filepath) + } + + # check that the temporary file actually exists + if (!file.exists(orig_filepath)) { + stop(glue("The file {orig_filepath} to copy does not exist")) + } + + file_extension <- tolower(tools::file_ext(orig_filepath)) + allowed_extensions <- c("jpg", "jpeg", "tif", "tiff", "png") + # if the image format is not supported, stop + if (!(file_extension %in% allowed_extensions)) { + stop("This file extension is not supported") + } + + # base of the new file name + file_base <- paste(date, site, block, variable_name, sep = "_") + + # path to the final file folder + filepath <- file.path(base_folder, site, block, variable_name) + if (!dir.exists(filepath)) { + dir.create(filepath) + } + + # determine the number to add to the end of the file name to keep file names + # in the folder unique + number <- 0 + while (TRUE) { + file_name <- paste(file_base, number, sep = "_") + file_name <- paste(file_name, file_extension, sep = ".") + if (!file.exists(file.path(filepath, file_name))) { + # we found a unique name. It will be available in file_name after + # the loop + break + } + number <- number + 1 + + # don't loop forever + if (number >= 1000) { + stop("Could not find a unique name for the file") + } + } + + success <- tryCatch(expr = file.copy(from = orig_filepath, + to = file.path(filepath, file_name), + copy.date = TRUE, + overwrite = FALSE), + warning = function(cnd) {message(cnd); FALSE}, + error = function(cnd) {message(cnd); FALSE}) + + # if we succeeded in renaming, delete the original file if requested + if (success & delete_original) { + deleted_original <- tryCatch(expr = file.remove(orig_filepath), + warning = function(cnd) {message(cnd)}, + error = function(cnd) {message(cnd)}) + } + + if (success) { + message(glue("Copied file to {file.path(filepath, file_name)}")) + return(file.path(variable_name, file_name)) + } else { + stop("Error in moving file") + } + +} + +#' Delete a file +#' +#' Delete the file with the path filepath. Used to delete files (images) +#' associated with events, e.g. canopeo_image +#' +#' @param filepath The path to the file which should be deleted. +#' @param filepath_relative Set to TRUE and supply site and block if filepath is +#' relative to the events.json file. This allows the function to figure out +#' the correct path to the file. +#' @param site The site where the event took place +#' @param block The block where the event took place +#' @param base_folder Included for testing reasons, the default value should +#' otherwise be used +#' +#' @importFrom glue glue +delete_file <- function(filepath, site = NULL, block = NULL, + filepath_relative = FALSE, + base_folder = json_file_base_folder()) { + if (filepath_relative) { + filepath <- file.path(base_folder, site, block, filepath) + } + + if (file.exists(filepath)) { + file.remove(filepath) + message(glue("Deleted file {filepath}")) + } else { + stop(glue("Could not delete file {filepath} because it was not found")) + } +} \ No newline at end of file diff --git a/R/fct_language.R b/R/fct_language.R new file mode 100644 index 0000000..3e7eee9 --- /dev/null +++ b/R/fct_language.R @@ -0,0 +1,239 @@ +# Functions for finding the display names of things in different languages +# Otto Kuusela 2021 + +# the path is wrapped inside a function because of this: +# https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html +# see: “Paths hard-coded in R code” +display_name_dict_path <- function() system.file("extdata", "display_names.csv", + package = "fieldactivity") +display_names_dict <- read.csv(display_name_dict_path(), comment.char = "#") + +#' Find code and display names belonging to a given category +#' +#' The categories are defined in the display_names.csv file. If language is +#' undefined, only code names will be returned. If a language is also supplied, +#' then the corresponding display names are set as the names of the vector of +#' code names. +#' +#' @param category The category (e.g. "variable_name") to find the names for +#' @param language (optional) The language of the display names +#' +#' @return A vector of code names. If language was supplied, the display names +#' corresponding to the code names will be the names of the vector. +get_category_names <- function(category, language = NULL) { + # rename argument to make it work with subset + category1 <- category + + category_names <- subset(display_names_dict, + display_names_dict$category == category1) + code_names <- category_names$code_name + + if (!is.null(language)) { + disp_names <- category_names[[language]] + names(code_names) <- disp_names + } + + return(code_names) +} + +#' Get the display names corresponding to given code names +#' +#' @param code_name A vector of code names to get the display names for +#' @param language The language ("disp_name_eng" or "disp_name_fin") of the +#' resulting display names +#' @param is_variable_name If set to TRUE, then only variable names will be +#' searched for display names. If FALSE (the default), only non-variable names +#' will be searched. +#' @param as_names Should the display names be set as the names of the vector +#' of code names? Default is FALSE. +#' +#' @details is_variable_name is needed because there might be clashes between +#' the variable and non-variable code names. E.g. organic_material is both an +#' option in mgmt_operations_event and a variable. The language names +#' ("disp_name_eng" and "disp_name_fin") correspond to the names of the +#' columns in the display_names.csv file. +#' +#' @return The display name(s) as a vector of character strings in the same +#' order as the code names. If a display name is not found or language is +#' undefined, the code name is returned. If as_names is TRUE, the display +#' names are the names of the vector and code names are the values. +get_disp_name <- function(code_name, language = NULL, + is_variable_name = FALSE, as_names = FALSE) { + if (is.null(code_name)) return(NULL) + if (is.null(language)) return(code_name) + + if (is_variable_name) { + rows_to_check <- subset(display_names_dict, + display_names_dict$category == "variable_name") + } else { + rows_to_check <- subset(display_names_dict, + display_names_dict$category != "variable_name") + } + + row_indexes <- match(code_name, rows_to_check$code_name) + display_name <- rows_to_check[row_indexes, language] + + # replace missing display names with the corresponding code names + display_name[is.na(display_name)] <- code_name[is.na(display_name)] + display_name[display_name == missingval] <- "" + + if (as_names) { + names(code_name) <- display_name + display_name <- code_name + } + + return(display_name) +} + +#' Replace code names with display names in an event data frame +#' +#' Also replaces missingvals with "". +#' +#' @param events_with_code_names The data frame with code names that should be +#' turned to display names +#' @param language The language of the display names +#' +#' @return A data frame of the same size but with entries with code names +#' replaced with display names +replace_with_display_names <- function(events_with_code_names, language) { + events_with_display_names <- events_with_code_names + + for (variable_name in names(events_with_code_names)) { + # determine the type of element the variable corresponds to + element <- structure_lookup_list[[variable_name]] + + if (is.null(element$type)) { + # this could be e.g. the date_ordering or event column + next + } + + if (element$type == "selectInput") { + # the pasting is done to ensure we get a nicely formatted name + # when x is a character vector + events_with_display_names[[variable_name]] <- + sapply(events_with_code_names[[variable_name]], + FUN = function(x) { + name <- get_disp_name(x, language = language) + if (length(name) > 1) { + name <- paste(ifelse(name=="", "-", name), + collapse = ", ") + } + name + }) + } else if (element$type %in% + c("textAreaInput", "textInput", "numericInput")) { + events_with_display_names[[variable_name]] <- + sapply(events_with_code_names[[variable_name]], + FUN = function(x) { + if (length(x) > 1) { + paste(ifelse(x==missingval,"-",x), + collapse = ", ") + } else { + ifelse(x==missingval,"",x) + } + }) + } else if (element$type %in% c("dateInput", "dateRangeInput")) { + events_with_display_names[[variable_name]] <- + sapply(events_with_code_names[[variable_name]], + FUN = function(x) { + paste(format(as.Date(x, format = date_format_json), + date_format_display), + collapse = " - ") + }) + } + + } + + return(events_with_display_names) +} + +#' This function sets the labels on the shinymanager login UI +#' +#' @param language The language which should be displayed (either +#' "disp_name_fin" or disp_name_eng) +#' +# TODO: move the actual labels to display_names.csv? +set_login_language <- function(language) { + + # remove possible names from language vector + language <- unname(language) + + # yes we are overwriting the English language. This is by far + # the simplest method + if (identical(language, "disp_name_fin")) { + shinymanager::set_labels( + language = "en", + # the \U codes are UTF-8 codes for Finnish letters a and o with dots + "Please authenticate" = "Kirjaudu sy\U00f6tt\U00e4\U00e4ksesi tapahtumia", + "Username:" = "Sijainti", + "Password:" = "Salasana", + "Login" = "Kirjaudu", + "Logout" = "Kirjaudu ulos" + ) + } else if (identical(language, "disp_name_eng")) { + shinymanager::set_labels( + language = "en", + "Please authenticate" = "Log in to enter management events", + "Username:" = "Site", + "Password:" = "Password", + "Login" = "Login", + "Logout" = "Logout" + ) + } +} + + +#' UI side of the displayed texts in login page +#' +#' @param id +#' +#' @noRd +mod_select_lan <- function(id) { + ns <- NS(id) + + tagList( + p(textOutput(ns("frontpage1")),style="text-align: justify;"), + br(), + readLines(system.file("user_doc", "inst_frontpage.txt", package = "fieldactivity"), warn = F)[3], + br(), + readLines(system.file("user_doc", "inst_frontpage.txt", package = "fieldactivity"), warn = F)[4], + br(), + tags$hr(style="border-color: steelblue;"), + div(style="display: inline-block;vertical-align:middle;", textOutput(ns("frontpage2"))), + div(style="display: inline-block;vertical-align:middle;", tags$a(href="https://pecanproject.github.io/fieldactivity/", target="_blank", textOutput(ns("frontpage3")))), + br(), + div(style="display: inline-block;vertical-align:middle;", textOutput(ns("frontpage4"))), + div(style="display: inline-block;vertical-align:middle;", tags$a(href="https://github.com/PecanProject/fieldactivity/issues", target="_blank", textOutput(ns("frontpage5"))))) + #style="display: inline-block;")) +} + + + + +#' Server side of the language selected in login page +#' +#' @param id +#' @param language This comes from the selected login language +#' +#' @noRd +mod_auth_page_server <- function(id, language) { + + # Create a reactive value, language is not one in this case + i <- reactiveVal() + #stopifnot(is.reactive(language)) + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + + # Give i a value based on the login input language that has been chosen. + i(ifelse(identical(language, "disp_name_eng"), 0, 1)) + + # Outputs for login page, change the short introduction and path to github page + output$frontpage1 <- renderText(readLines(system.file("user_doc", "inst_frontpage.txt", package = "fieldactivity"), warn = F)[1+i()]) + output$frontpage2 <- renderText(readLines(system.file("user_doc", "inst_frontpage.txt", package = "fieldactivity"), warn = F)[5+i()]) + output$frontpage3 <- renderText(ifelse(i() == 0, "webpage", "verkkosivuihin")) + output$frontpage4 <- renderText(readLines(system.file("user_doc", "inst_frontpage.txt", package = "fieldactivity"), warn = F)[7+i()]) + output$frontpage5 <- renderText(ifelse(i() == 0, "here", "t\U00e4\U00e4ll\U00e4")) + }) +} \ No newline at end of file diff --git a/R/fct_ui.R b/R/fct_ui.R new file mode 100644 index 0000000..6c07a8d --- /dev/null +++ b/R/fct_ui.R @@ -0,0 +1,410 @@ +# Builds the ui based on a json file +# e.g. builds additional options for the different activity types +# Otto Kuusela 2021 + +structure_file_path <- function() system.file("extdata", "ui_structure.json", + package = "fieldactivity") +structure <- jsonlite::fromJSON(structure_file_path(), simplifyMatrix = FALSE) +activity_options <- structure$form$mgmt_operations_event$sub_elements + + +#' Recursively apply function to lists in a list +#' @description Recursively apply a function to the elements of a list that +#' are themselves lists. +#' @param x The list of lists to apply the function to +#' @param fun The function to apply to lists +#' @param name_fun Function used to name the elements of the returned list. +#' Should take a list as argument and return the name +#' @param ... arguments to pass to fun +#' @return A one-level list where each element is the value fun returns for a +#' given list in x +rlapply <- function(x, fun, name_fun = NULL, ...) { + + results <- list() + + for (element in x) { + if (!is.list(element)) { + next + } + + # x is a list, so let's test it + result <- fun(element, ...) + + if (!is.null(result)) { + + # if we have a naming function defined, use that + # index is either an actual index or name of the element + if (is.null(name_fun)) { + index <- length(results) + 1 + } else { + index <- name_fun(element) + } + + results[[index]] <- result + } + + # more results might lurk on lower levels of the list. + # So let's investigate those + more_results <- rlapply(element, fun, name_fun, ...) + + if (length(more_results) > 0) { + results <- append(results, more_results) + } + } + + if (length(results) > 1) { + return(results) + } else if (length(results) == 1) { + return(results) + #return(results[[1]]) + } else { + return(NULL) + } + +} + +#' Build lookup list for UI elements +#' @description Build a list where the names are the code names of UI elements +#' and the values are the corresponding element structures (lists) found in +#' ui_structure.json +#' @return The lookup list. +build_structure_lookup_list <- function() { + element_fetcher <- function(x) { + if (!is.null(x$code_name)) { + # we don't need the sub_elements listed, those will come separately + x$sub_elements <- NULL + return(x) + } else { + return(NULL) + } + } + + element_name_fetcher <- function(x) x$code_name + + lookup_list <- rlapply(structure, fun = element_fetcher, + name_fun = element_name_fetcher) + return(lookup_list) +} + +structure_lookup_list <- build_structure_lookup_list() + +# help texts (technically textOutputs) have a different method of updating +# when the language is changed because they are outputs rather than inputs, +# and for that we need a list of the code names of these objects. +# The same goes for data tables (excluding event table). +# We also need the code names of fileInput delete buttons to set up observers +# for them +text_output_code_names <- NULL +data_table_code_names <- NULL +fileInput_code_names <- NULL +for (element in structure_lookup_list) { + if (element$type == "textOutput") { + text_output_code_names <- c(text_output_code_names, element$code_name) + } else if (element$type == "dataTable") { + data_table_code_names <- c(data_table_code_names, element$code_name) + } else if (element$type == "fileInput") { + fileInput_code_names <- c(fileInput_code_names, element$code_name) + } +} + +#' Generate the UI for a list of elements in the structure file. +#' +#' For a given list of widget structures as read from ui_structure.json, +#' create_ui applies create_widget to each widget in the list +#' +#' @param widget_structure_list The list of widget structures (from +#' ui_structure.json) to generate as UI +#' @param ns A namespacing function generated by shiny::NS to apply to the id's +#' of each generated widget +#' +#' @return A list of Shiny widgets +create_ui <- function(widget_structure_list, ns) { + new_elements <- lapply(widget_structure_list, create_widget, ns = ns) + + # if there is a visibility condition, apply it + if (!is.null(widget_structure_list$condition)) { + new_elements <- conditionalPanel( + condition = widget_structure_list$condition, + new_elements, + ns = ns) + } + + return(new_elements) +} + +# creates the individual elements +# the override_label and ... functionalities are used for creating elements +# in dynamic (e.g. multi-crop) data tables. Do NOT supply the label argument in +# the unnamed arguments (...)! +# TODO: refactor. Get rid of those ugly override arguments +create_widget <- function(element, ns = NS(NULL), + override_label = NULL, + override_code_name = NULL, + override_value = NULL, + override_choices = NULL, + override_selected = NULL, + override_placeholder = NULL, ...) { + + # element is a string, i.e. a visibility condition for a element set + # it has already been handled in create_ui + if (!is.list(element)) { + return() + } + + # element is a list of elements, because it doesn't have the type + # attribute. In that case we want to create all of the elements in that list + if (is.null(element$type)) { + return(create_ui(element, ns)) + } + + # the labels will be set to element$label which is a code_name, not a + # display_name, but this is okay as the server will update this as the + # language changes (which also happens when the program starts) + # the following allows overwriting the label through ... + element_label <- get_disp_name(element$label, init_lang) + if (!is.null(override_label)) { + element_label <- override_label + } + + element_code_name <- ns(element$code_name) + if (!is.null(override_code_name)) { + element_code_name <- ns(override_code_name) + } + + element_value <- "" + if (!is.null(override_value)) { + element_value <- override_value + } + + element_choices <- get_selectInput_choices(element$code_name, init_lang) + if (!is.null(override_choices)) { + element_choices <- override_choices + } + + element_placeholder <- get_disp_name(element$placeholder, init_lang) + if (!is.null(override_placeholder)) { + element_placeholder <- override_placeholder + } + + new_element <- if (element$type == "checkboxInput") { + checkboxInput(element_code_name, label = element_label, ...) + } else if (element$type == "selectInput") { + # if multiple is defined (=TRUE) then pass that to selectInput + multiple <- identical(element$multiple, TRUE) + # we don't enter choices yet, that will be handled by the server + selectInput(element_code_name, label = element_label, + choices = element_choices, multiple = multiple, + selected = override_selected, ...) + } else if (element$type == "textOutput") { + if (!is.null(element$style) && element$style == "label") { + strong(textOutput(element_code_name, ...)) + } else { + # these are inteded to look like helpTexts so make text gray + tagList( + span(textOutput(element_code_name, ...), style = "color:gray"), + br() + ) + } + } else if (element$type == "textInput") { + textInput(inputId = element_code_name, label = element_label, + value = element_value, placeholder = element_placeholder, ...) + } else if (element$type == "numericInput") { + numericInput(inputId = element_code_name, + label = element_label, + min = element$min, + max = ifelse(is.null(element$max),NA,element$max), + value = element_value, + step = ifelse(is.null(element$step),"any",element$step), + ...) + } else if (element$type == "textAreaInput") { + textAreaInput(element_code_name, + label = element_label, + resize = "vertical", + value = element_value, + placeholder = element_placeholder, ...) + } else if (element$type == "dataTable") { + mod_table_ui(element_code_name) + } else if (element$type == "fileInput") { + mod_fileInput_ui(element_code_name, element) + } else if (element$type == "dateRangeInput") { + dateRangeInput(element_code_name, + label = element_label, + separator = "-", + weekstart = 1, + max = Sys.Date()) + } else if (element$type == "actionButton") { + # + } + + # put the new element in a conditionalPanel. If no condition is specified, + # the element will be visible by default + #new_element <- conditionalPanel(condition = element$condition, new_element) + + # if there are sub-elements to create, do that + if (!is.null(element$sub_elements)) { + return(list(new_element, + create_ui(element$sub_elements, ns))) + } + + return(new_element) +} + +#' Find the choices for a selectInput given its code name +#' +#' @param selectInput_code_name The code name of the selectInput +#' @param language The language to show the options in. This will be passed to +#' get_disp_name +#' +#' @return A vector of choices (code names). If language was supplied, the names +#' will be the names of the vector. +get_selectInput_choices <- function(selectInput_code_name, language) { + # the choices for a selectInput element can be stored in + # three ways: + # 1) the code names of the choices are given as a vector + # 2) for site and block selectors, there is IGNORE: + # this means that the choices should not be updated here (return NULL) + # 3) the category name for the choices is given. + # in the following if-statement, these are handled + # in this same order + + element_structure <- structure_lookup_list[[selectInput_code_name]] + + if (!identical(element_structure$type, "selectInput") || + is.null(element_structure$choices)) { + return(NULL) + } + + if (length(element_structure$choices) > 1) { + choices <- c("", element_structure$choices) + names(choices) <- c("", get_disp_name(element_structure$choices, + language = language)) + } else if (element_structure$choices == "IGNORE") { + choices <- NULL + } else { + # get_category_names returns both display names and + # code names + choices <- c( + "", + get_category_names(element_structure$choices, + language = language) + ) + } + + return(choices) +} + +#' Update value, label etc. of a UI element. +#' +#' Determines the type of the element and updates its value using shiny's update +#' functions. +#' @param session Current shiny session +#' @param code_name The code name of the UI element to update +#' @param value An atomic vector holding the desired value of the UI element. If +#' NULL, the value of the element is not altered. +#' @param clear_value If set to TRUE, the value of the element is cleared (and +#' any value supplied to value is ignored) +#' @param ... Additional arguments (such as label) to pass to Shiny's update- +#' functions. +#' @importFrom glue glue +update_ui_element <- function(session, code_name, value = NULL, + clear_value = FALSE, ...) { + # find the element from the UI structure lookup list, which has been + # generated in ui_builder.R + element <- structure_lookup_list[[code_name]] + + # didn't find the element corresponding to code_name + # this should not happen if the element is in + # sidebar_ui_structure.json + if (is.null(element$type)) { + stop("UI element type not found, could not update") + } + if (!is.atomic(value)) { + stop("The value given to update_ui_element should be an atomic vector") + } + + # if value is NULL, we need to determine on a widget type basis how to + # clear the value. If it isn't, replace missingvals with "" + if (!is.null(value)) { + # replace missingvals with empty strings + missing_indexes <- identical(value, missingval) + if (any(missing_indexes)) { + value[missing_indexes] <- "" + } + } + + + if (element$type == "selectInput") { + if (clear_value) value <- "" + # setting the selected value to NULL doesn't change the widget's value + updateSelectInput(session, code_name, selected = value, ...) + } else if (element$type == "dateInput") { + # setting value to NULL will reset the date to the current date + value <- if (clear_value) { + NULL + } else { + tryCatch(expr = as.Date(value, format = date_format_json), + warning = function(cnd) NULL) + } + updateDateInput(session, code_name, value = value, ...) + } else if (element$type == "textAreaInput") { + if (clear_value) value <- "" + updateTextAreaInput(session, code_name, value = value, ...) + #} else if (element$type == "checkboxInput") { + # updateCheckboxInput(session, code_name, value = value, ...) + } else if (element$type == "actionButton") { + updateActionButton(session, code_name, ...) + } else if (element$type == "textInput") { + if (clear_value) value <- "" + updateTextInput(session, code_name, value = value, ...) + } else if (element$type == "numericInput") { + # if we are given a non-numeric value, we don't want to start converting + # it. Let's replace it with an empty string (the default value) + # if (!is.numeric(value)) {value <- ""} + if (clear_value) { value <- "" } + updateNumericInput(session, code_name, value = value, ...) + } else if (element$type == "dateRangeInput") { + + if (!is.null(value) & length(value) != 2) { + value <- NULL + warning(glue("Value supplied to the dateRangeInput was not of ", + "length 2, resetting it")) + } + + start <- if (is.null(value) | clear_value) NULL else value[1] + end <- if (is.null(value) | clear_value) NULL else value[2] + + tryCatch(warning = function(cnd) {shinyjs::reset(code_name)}, + updateDateRangeInput(session, code_name, + start = start, end = end)) + } else if (element$type == "fileInput") { + + + } +} + +#' Reset the value of input fields +#' +#' Set the specified input fields to their default empty values. +#' +#' @param session The current Shiny session +#' @param fields_to_clear The names of the variables whose corresponding fields +#' should be cleared +#' @param exceptions Optional vector of variable names which should not be +#' cleared. This is useful if fields_to_clear is supplied with all variable +#' names but there are a few that should not be cleared. +#' @return None, used for side effects. +#' @note This doesn't reset the tables (e.g. harvest_crop_table) -- they reset +#' themselves every time they become hidden. Also doesn't reset fileInputs, +#' they have their own way of clearing their value. +# TODO: is exceptions necessary? +reset_input_fields <- function(session, fields_to_clear, exceptions = c("")) { + + # we never want to clear the site or block + exceptions <- c(exceptions, "site", "block") + + for (code_name in fields_to_clear) { + if (code_name %in% exceptions) next + update_ui_element(session, code_name, clear_value = TRUE) + } + +} diff --git a/R/mod_download.R b/R/mod_download.R new file mode 100644 index 0000000..a7eb776 --- /dev/null +++ b/R/mod_download.R @@ -0,0 +1,282 @@ +#' Download UI Function +#' +#' @description A shiny Module. +#' +#' @param id Internal parameters for {shiny}. +#' @param label Label for the download button +#' @param purp This decides which download happens, this +#' could divided to several download ui functions as well. +#' +#' @noRd +#' +#' @import rmarkdown +#' @importFrom shiny NS tagList +#' @importFrom callr r +#' @importFrom zip zip + +mod_download_ui <- function(id, label, purp) { + ns <- NS(id) + + if(purp == "inst"){ + #tagList( + downloadButton(ns("report"), label, class = "butt", icon = icon("download"), style = "width:85px;") + # #tags$head(tags$style(".butt{width:85px;} .butt{display: flex;} + # .butt{margin-top: 1.45em;}")))) + } else { + # Not decided + } +} + + + + +#' Download Server Functions +#' +#' @noRd +mod_download_server_inst <- function(id) { + + + moduleServer(id, function(input, output, session){ + ns <- session$ns + + output$report <- downloadHandler( + # Name for the downloaded file + filename = "guideFieldactivity.html", + content = function(file) { + params <- list(n = input$n) + + if(dp()) message("Copying instructions to temp file") + + # Paths to the rendered document + used images + report_path <- file.path(tempdir(), "user_instructions.md") + report_img_1 <- file.path(tempdir(), "loginpage.png") + report_img_2 <- file.path(tempdir(), "Layout.png") + report_img_3 <- file.path(tempdir(), "Eventtable.png") + report_img_4 <- file.path(tempdir(), "Addevent.png") + report_img_5 <- file.path(tempdir(), "eventexample_1.png") + + # Copy the actual files to tmp folder. Images need to be on the same folder as instructions .md + file.copy(system.file("user_doc", "user_instructions.md", package = "fieldactivity"), report_path, overwrite = TRUE) + file.copy(system.file("user_doc/images_user_instructions", "loginpage.png", package = "fieldactivity"), report_img_1, overwrite = TRUE) + file.copy(system.file("user_doc/images_user_instructions", "Layout.png", package = "fieldactivity"), report_img_2, overwrite = TRUE) + file.copy(system.file("user_doc/images_user_instructions", "Eventtable.png", package = "fieldactivity"), report_img_3, overwrite = TRUE) + file.copy(system.file("user_doc/images_user_instructions", "Addevent.png", package = "fieldactivity"), report_img_4, overwrite = TRUE) + file.copy(system.file("user_doc/images_user_instructions", "eventexample_1.png", package = "fieldactivity"), report_img_5, overwrite = TRUE) + + # id <- showNotification( + # "Rendering report...", + # duration = 8, + # closeButton = FALSE + # ) + # on.exit(removeNotification(id), add = TRUE) + + if (dp()) message("Moving to rendering the .md file") + + # Path to the instructions .md which will be rendered + callr::r( + render_report, + list(input = report_path, output = file, params = params) + ) + } + ) + }) #Moduleserver close +} + + + +render_report <- function(input, output, params) { + rmarkdown::render(input, + output_file = output, + params = params, + envir = new.env(parent = globalenv()) + + ) +} + + + +#' UI for exporting the eventtable as csv // json zip file +#' +#' @param id Internal parameters for {shiny} +#' @param label Label for download button +#' +#' @noRd +#' + +mod_download_table <- function(id, label) { + ns <- NS(id) + + tagList( + downloadButton(ns("eventtable"), label, class = "butt", icon = icon("download")), + tags$head(tags$style(".butt{width:150px;} .butt{display: flex;}"))) +} + +mod_download_json <- function(id, label) { + ns <- NS(id) + + tagList( + downloadButton(ns("eventjson"), label, class = "butt", icon = icon("download")), + tags$head(tags$style(".butt{width:150px;} .butt{display: flex;}"))) +} + + + + +#' Server side for downloading the csv export +#' +#' @noRd +#' +#' @importFrom utils write.csv +#' +mod_download_server_table <- function(id, user_auth, base_folder = json_file_base_folder()) { + + stopifnot(is.reactive(user_auth)) + + moduleServer(id, function(input, output, session){ + ns <- session$ns + + output$eventtable <- downloadHandler( + # Name for the downloaded file + filename = "event_table_fa.csv", + + content = function(file) { + + if(dp()) message("Fetching the event table observations") + #user <- NULL + if (golem::app_dev()) { + if(dp()) message("Development state") + file_path <- "dev/dev_events" + user <- "qvidja" + + } else { + if(dp()) message("Data path on production") + file_path <- base_folder + + if(dp()) message("Checking current user") + user <- user_auth() + } + # Create the file path based on the production status and the user + file_path <- file.path(file_path, user) + events_file <- NULL + if(length(list.files(file_path)) != 0){ + for(i in list.files(file_path)){ + jsontable <- jsonlite::read_json(file.path(file_path, i, "events.json"), simplifyVector = TRUE)[[1]]$events + if(is.null(events_file)){ + if(!identical(list(), jsontable)){ + events_file <- as.data.frame(cbind(block = i, jsontable)) + } + } else { + events_file <- merge(events_file,as.data.frame(cbind(block = i,jsontable)),all = T) + } + } + + # Flattening the lists and removing extra "," that can cause parsing issues + events_file <- as.data.frame(lapply(events_file, as.character)) + # Might not be suitable, if there are only simple event management stored, + # so only try this modification. + events_file <- try(as.data.frame(lapply(events_file, function(x) gsub(",", " ", x)))) + + if (dp()) message("Creating an export of the events") + write.csv(events_file, file, row.names = FALSE, quote=FALSE) + } else { + write.csv("Error with a file path. Have you stored field management events? If yes, then this error should not occur.", file, row.names = FALSE, quote = FALSE) + } + + } + ) + }) #Moduleserver close +} + + +#' Server side for download button for json-files +#' +#' @param id Internal parameters for {shiny} +#' @param user_auth Site name in order to download correct site files +#' @param base_folder Location of directories in server +#' +#' @noRd +#' + +mod_download_server_json <- function(id, user_auth, base_folder = json_file_base_folder()) { + + stopifnot(is.reactive(user_auth)) + + moduleServer(id, function(input, output, session){ + ns <- session$ns + + output$eventjson <- downloadHandler( + # Name for the downloaded file + # With zip-files it has to be this way, otherwise it won't work + filename = function() { + paste("events_json", "zip", sep=".") + }, + + content = function(file) { + + if(dp()) message("Fetching the event table observations (for json export)") + + if (golem::app_dev()) { + if(dp()) message("Development state") + file_path <- "dev/dev_events" + user <- "qvidja" + + } else { + if(dp()) message("Data path on production") + file_path <- base_folder + + if(dp()) message("Checking current user") + user <- user_auth() + } + # Create the file path based on the production status and the user + file_path <- file.path(file_path, user) + # tmp directory with sub directory for json files + tmpdr <- tempdir() + if(!file.exists(file.path(tmpdr, "json"))){ + dir.create(paste0(tmpdr, "/json")) + } + + # Path to subdirectory + tmpdrjson <- file.path(tmpdr, "json") + + if(length(list.files(file_path)) != 0){ + for(block_name in list.files(file_path)){ + block_json <- file.path(tmpdrjson, paste0("events_", block_name, ".json")) + file.copy(file.path(file_path, block_name, "events.json"), block_json) + } + + if (dp()) message("Creating a zip file of the json files") + zip::zip(zipfile=file, files="json", root = tmpdr) + } else { + #emptydir <- file.path(tmpdr, "Invalid_path.csv") + if(dp()) message("Return a csv with an error") + write.csv("Seems that there isn't any data? Try to create a management event.", file.path(tmpdrjson, "Error.csv"), row.names = FALSE) + zip::zip(zipfile=file, files="json", root = tmpdr) + } + }, + contentType = "application/zip" + ) + }) #Moduleserver close +} + + + + + +#' download Server Function +#' +#' @noRd +# mod_download_serverxx <- function(input, output, session){ +# ns <- session$ns +# data_xi <- "string" +# +# output$report <- downloadHandler( +# +# filename = function(){ +# paste("sitemxt", "csv", sep = ".") +# }, +# +# content = function(file){ +# write.csv(data_xi, file) +# } +# ) +# } diff --git a/R/mod_event_list.R b/R/mod_event_list.R new file mode 100644 index 0000000..6922552 --- /dev/null +++ b/R/mod_event_list.R @@ -0,0 +1,410 @@ +# The function of the event list module is as follows: +# - receives an unfiltered list of event lists to display +# - displays these events along with and according to filter selectors +# - returns +# - the event that is currently selected for editing +# - the choices of the filters + + +#' event_list UI Function +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' +#' @importFrom shiny NS tagList +mod_event_list_ui <- function(id) { + ns <- NS(id) + tagList( + # selector to filter table data + div(style="display: inline-block;vertical-align:middle;", + textOutput(ns("table_filter_text_1"), inline = TRUE)), + div(style="display: inline-block;vertical-align:middle;", + selectInput(ns("event_list_activity_filter"), label = "", + choices = get_disp_name( + c("activity_choice_all", + get_category_names("mgmt_operations_event_choice")), + init_lang, as_names = TRUE), + width = "150px")), + div(style="display: inline-block;vertical-align:middle;", + textOutput(ns("table_filter_text_2"), inline = TRUE)), + div(style="display: inline-block;vertical-align:middle;", + selectInput(ns("event_list_block_filter"), label = "", + choices = get_disp_name("block_choice_all", init_lang, + as_names = TRUE), + width = "100px")), + div(style="display: inline-block;vertical-align:middle;", + textOutput(ns("table_filter_text_3"), inline = TRUE)), + div(style="display: inline-block;vertical-align:middle;", + selectInput(ns("event_list_year_filter"), label = "", + choices = get_disp_name("year_choice_all", init_lang, + as_names = TRUE), + width = "100px")), + div(style="display: inline-block;vertical-align:middle;", "."), + + div(style="display: inline-block;vertical-align:0.2em;position:absolute;right:15em;", + mod_download_json("json_zip", label = textOutput("json_dl_label"))), + + div(style="display: inline-block;vertical-align:0.2em;position:absolute;right:5em;", + mod_download_table("event_table", label = textOutput("csv_dl_label"))), + + # front page data table + DT::dataTableOutput(ns("table")) + ) +} + +#' event_list Server Functions +#' +#' @param id The id of the corresponding UI element +#' @param events A reactive expression holding a list of events to display in the event list +#' @param language A reactive expression holding the current UI language +#' @param site A reactive expression holding the current site name +#' + +mod_event_list_server <- function(id, events, language, site) { + + stopifnot(is.reactive(events)) + stopifnot(is.reactive(language)) + stopifnot(is.reactive(site)) + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # what is the currently selected event in the event list + current_event <- reactiveVal() + # is the currently edited event visible in the event list (or has it been + # filtered out)? + current_event_visible <- TRUE + # what were the table view choices (event_list_block_filter, + # event_list_activity_filter, event_list_year_filter) + # before we started editing? + pre_edit_table_view <- NULL + + #' Update year choices in event list filter + #' + #' Adds as choices all the years for which events have been recorded + update_event_list_year_filter_choices <- function() { + + if (dp()) message("Updating event_list_year_filter choices") + + years <- NULL + + # find years present in event dates + for (event_list in events()) { + for (event in event_list) { + + # this shouldn't happen + if (is.null(event$date)) next + + year <- format(as.Date(event$date, date_format_json), "%Y") + + if (!(year %in% years)) { years <- c(years, year) } + } + } + + years <- sort(years, decreasing = TRUE) + choices <- get_disp_name(c("year_choice_all", years), + language(), as_names = TRUE) + + # retain current selection if possible + current_choice <- input$event_list_year_filter + if (!isTruthy(current_choice) || !(current_choice %in% years)) { + current_choice <- "year_choice_all" + } + + updateSelectInput(session, "event_list_year_filter", selected = current_choice, + choices = choices) + + } + + #' Update block choices in event list filter + #' + #' Add all blocks of the current site as choices + update_event_list_block_filter_choices <- function() { + + if (!isTruthy(site())) { return() } + + if (dp()) message("Updating event_list_block_filter choices") + + choices <- c("block_choice_all", + subset(sites, sites$site == site())$blocks[[1]]) + # the following assumes that no block name is a code name for something + # else + choices <- get_disp_name(choices, language(), as_names = TRUE) + + current_choice <- input$event_list_block_filter + if (!isTruthy(current_choice) || !(current_choice %in% choices)) { + current_choice <- "block_choice_all" + } + + updateSelectInput(session, "event_list_block_filter", + selected = current_choice, + choices = choices) + } + + #' Update activity choices in event list filter + #' + #' Only used when the language is changed. + update_event_list_activity_filter_choices <- function() { + + if (dp()) message("Updating event_list_activity_filter choices") + + choices <- c("activity_choice_all", + get_category_names("mgmt_operations_event_choice")) + choices <- get_disp_name(choices, language(), as_names = TRUE) + + current_choice <- input$event_list_activity_filter + if (!isTruthy(current_choice)) { + current_choice <- "activity_choice_all" + } + + updateSelectInput(session, "event_list_activity_filter", + selected = current_choice, + choices = choices) + } + + # update year choices when events change + observeEvent(events(), ignoreInit = TRUE, { + update_event_list_year_filter_choices() + }) + + # update table activity, block and year choices when the language changes + observeEvent(language(), ignoreInit = TRUE, { + update_event_list_activity_filter_choices() + update_event_list_block_filter_choices() + update_event_list_year_filter_choices() + }) + + # update block choices when site changes + observeEvent(site(), { + if (!isTruthy(site())) { + shinyjs::disable("event_list_block_filter") + return() + } + + shinyjs::enable("event_list_block_filter") + update_event_list_block_filter_choices() + }) + + observeEvent(current_event(), ignoreNULL = FALSE, ignoreInit = TRUE, { + if (dp()) message("selected_event() changed") + + if (is.null(current_event())) { + # edit mode was disabled + + # clear event list selection + if (!is.null(input$table_rows_selected)) { + DT::selectRows(proxy = DT::dataTableProxy("table"), selected = NULL) + } + + # restore table view settings + updateSelectInput(session, "event_list_activity_filter", + selected = pre_edit_table_view$activity) + updateSelectInput(session, "event_list_block_filter", + selected = pre_edit_table_view$block) + updateSelectInput(session, "event_list_year_filter", + selected = pre_edit_table_view$year) + # clear table view settings + pre_edit_table_view <<- NULL + + return() + } + + ### edit mode was enabled, or there was a switch from one event to another + + # save table view (to be restored when editing is over) if no settings + # have been saved previously + if (is.null(pre_edit_table_view)) { + pre_edit_table_view <<- list(activity = input$event_list_activity_filter, + block = input$event_list_block_filter, + year = input$event_list_year_filter) + } + + # change view of the front page table by changing the + # event_list_activity_filter selector + updateSelectInput(session, "event_list_activity_filter", + selected = current_event()$mgmt_operations_event) + }) + + # data to display in the table + table_data <- reactive({ + + # if any of the filters does not have a value, return an empty table + if (!(isTruthy(input$event_list_activity_filter) & + isTruthy(input$event_list_block_filter) & + isTruthy(input$event_list_year_filter))) { + default_variables <- c("block", "mgmt_operations_event", + "date", "mgmt_event_notes") + return(get_data_table(list(), default_variables)) + } + + if (dp()) message("event list table_data reactive running") + + # determine the columns displayed in the table + table_variables <- c("date", "mgmt_event_notes") + if (input$event_list_activity_filter == "activity_choice_all") { + table_variables <- c("mgmt_operations_event", table_variables) + } + if (input$event_list_block_filter == "block_choice_all") { + table_variables <- c("block", table_variables) + } + + # if we are only looking at a specific event type, show columns + # appropriate to it + if (input$event_list_activity_filter != "activity_choice_all") { + hidden_widget_types <- c("textOutput", "dataTable", "fileInput", + "actionButton") + activity_variables <- unlist(rlapply( + activity_options[[input$event_list_activity_filter]], + fun = function(x) { + if (is.null(x$type) || x$type %in% hidden_widget_types || + identical(x$hide_in_event_list, TRUE)) { + NULL + } else { + x$code_name + } + })) + table_variables <- c(table_variables, activity_variables) + } + + # create an event list filtered by user choices + # filter by block + if (input$event_list_block_filter == "block_choice_all") { + event_list <- list() + for (block_data in events()) { + event_list <- c(event_list, block_data) + } + } else { + event_list <- events()[[input$event_list_block_filter]] + } + + # filter by activity type + if (input$event_list_activity_filter != "activity_choice_all") { + event_list <- rlapply(event_list, fun = function(x) + if (x$mgmt_operations_event == input$event_list_activity_filter) {x}) + } + + # filter by year + if (input$event_list_year_filter != "year_choice_all") { + event_list <- rlapply(event_list, fun = function(x) { + event_year <- format(as.Date(x$date, date_format_json), "%Y") + if (event_year == input$event_list_year_filter) {x} + }) + } + + # make event list into a table + data <- get_data_table(event_list, table_variables) + data + }) + + # enable editing of old entries + observeEvent(input$table_rows_selected, ignoreNULL = FALSE, + ignoreInit = TRUE, { + + if (dp()) message("Change of row selection in event list") + + row_index <- input$table_rows_selected + + if (is.null(row_index)) { + # if it was the user de-selecting the event, exit edit mode + # (the other alternative is that the currently edited event + # is not visible in the table and therefore no element can + # be selected) + if (current_event_visible) { + current_event(NULL) + } + return() + } + + # fetch the event data of the selected row + selected_event_data <- table_data()[[row_index, "event"]] + + # set edit mode on. This saves the event we want to edit so + # that it is preserved even if front page table view is + # changed + current_event(selected_event_data) + + }) + + + # render table when language or table data changes + output$table <- DT::renderDataTable(server = FALSE, { + + if (dp()) message("Rendering event list") + + new_data_to_display <- replace_with_display_names( + table_data(), language()) + n_cols <- ncol(new_data_to_display) + + # select the row which we are currently editing + row_number <- NULL + if (!is.null(isolate(current_event()))) { + row_number <- find_event_index(isolate(current_event()), + new_data_to_display$event) + # if we couldn't find the currently edited event in the table, + # prevent clearing the event + current_event_visible <<- !is.null(row_number) + } + + DT::datatable(new_data_to_display, + # allow selection of a single row + selection = list(mode = "single", + selected = row_number), + rownames = FALSE, # hide row numbers + class = "table table-hover", + #autoHideNavigation = TRUE, doesn't work properly with dom + colnames = get_disp_name(names(new_data_to_display), + language = language(), + is_variable_name = TRUE), + options = list(dom = 'tp', # hide unnecessary controls + # order chronologically by hidden column + order = list(n_cols - 1, 'desc'), + columnDefs = list( + # hide all other columns except + # event, date and notes + list(visible = FALSE, + targets = (n_cols - 2):(n_cols - 1)), + # hide sorting arrows + list(orderable = FALSE, targets = + 0:(n_cols - 2))), + pageLength = 15, + language = list( + emptyTable = get_disp_name( + "table_empty_label", language()), + paginate = list( + "next" = get_disp_name( + "table_next_label", language()), + previous = get_disp_name( + "table_previous_label", language())) + ) + )) + }) + + # update each of the text outputs automatically, including language changes + # and the dynamic updating in editing table title etc. + lapply(text_output_code_names, FUN = function(text_output_code_name) { + + # render text + output[[text_output_code_name]] <- renderText({ + + if (dp()) message(glue("Rendering text for {text_output_code_name}")) + + get_disp_name(text_output_code_name, language()) + }) + + }) + + ############## TO RETURN + + list( + current = current_event, + filters = reactive(list( + activity = input$event_list_activity_filter, + block = input$event_list_block_filter, + year = input$event_list_year_filter)) + ) + + }) +} diff --git a/R/mod_fileInput.R b/R/mod_fileInput.R new file mode 100644 index 0000000..ec98ac8 --- /dev/null +++ b/R/mod_fileInput.R @@ -0,0 +1,276 @@ +# This module wraps the standard Shiny fileInput widget and makes it actually +# usable. The responsibilities of this module are as follows: +# - store the relative path of currently stored file +# - recognize when a new file has been uploaded, check the file and supply its +# temp path +# - update the displayed texts on the widget +# - manage the file delete button +# +# the module returns a two-element list: +# - filepath: the path of the file the module currently “holds”, either a +# relative path to a previously saved file that it was given, or an absolute +# path to a file in a temp folder. If this is NULL, this is an indication +# that no file is uploaded or if there was, that file should be deleted. +# Note that this is not necessarily the path that should be saved in the main +# app: if a file was uploaded previously but block has been changed, then the +# file still needs to be moved and renamed. This will be handled in the main +# app. +# - new_file: TRUE if the filepath points to a new file in a temp folder (and +# the filepath is therefore absolute) + + +#' fileInput UI Function +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' +#' @importFrom shiny NS tagList +mod_fileInput_ui <- function(id, widget_structure) { + ns <- NS(id) + tagList( + div(style = "display: flex;", + + div(style = "flex-grow: 1;", + fileInput(ns("file"), + label = get_disp_name(widget_structure$label, init_lang), + accept = widget_structure$filetype)), + + div(style = "margin-left: 5px; padding-top: 26px", + shinyjs::hidden( + actionButton(ns("delete"), + label = get_disp_name("delete_uploaded_file_label", + init_lang), + class = "btn-warning"))) + ) + ) +} + +#' fileInput Server Functions +#' +#' @noRd +mod_fileInput_server <- function(id, language, set_path, reset_path) { + + stopifnot(is.reactive(language)) + stopifnot(is.reactive(set_path)) + stopifnot(is.reactive(reset_path)) + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # hold the latest path + current_path <- reactiveVal() + # is the value in current_path pointing to a new file in a temp directory? + new_file <- reactiveVal(FALSE) + + ############# FUNCTIONS TO MODIFY THE FILEINPUT COMPONENT + + # set new_text to NULL to clear the value + update_value_text <- function(new_text) { + if (is.null(new_text)) { + new_text <- get_disp_name("file_input_placeholder", language()) + } + + session$sendCustomMessage(type = "fileInput-value", + message = list(id = ns("file"), + value = new_text)) + } + + update_label <- function(new_label) { + session$sendCustomMessage(type = "fileInput-label", + message = list(id = ns("file"), + value = new_label)) + } + + update_button_label <- function(new_label) { + session$sendCustomMessage(type = "fileInput-button-label", + message = list(id = ns("file"), + value = new_label)) + } + + hide_progressbar <- function() { + session$sendCustomMessage(type = "fileInput-hide-progressbar", + message = list(id = ns("file"))) + } + + update_progressbar_label <- function(new_label) { + session$sendCustomMessage(type = "fileInput-progressbar-label", + message = list(id = ns("file"), + value = new_label)) + } + + ############# + + # Check the file immediately after it is uploaded, and if its extension + # is not correct, delete the file. + observeEvent(input$file, { + + # path to the uploaded file in temporary folder + tmp_path <- input$file$datapath + file_extension <- tools::file_ext(tmp_path) + allowed_extensions <- c("jpg", "jpeg", "tif", "tiff", "png") + # if the image format is not desired, delete file and clear field + if (!(tolower(file_extension) %in% allowed_extensions)) { + delete_file(tmp_path) + + showNotification( + glue("This file extension is not supported. ", + "Upload a file with one of the ", + "following extensions: ", + paste(allowed_extensions, collapse = ", ")), + type = "error", duration = NULL) + + return() + } + + update_progressbar_label(get_disp_name( + "file_input_progressbar_complete_label", language())) + + # the file is valid, so save its path + current_path(tmp_path) + new_file(TRUE) + + }) + + # when language changes, update labels + observeEvent(language(), { + # update label of widget + label <- structure_lookup_list[[id]]$label + update_label(get_disp_name(label, language())) + # update label on the browse button + update_button_label(get_disp_name("file_input_button_label", language())) + # update delete button label + updateActionButton(session, "delete", + label = get_disp_name("delete_uploaded_file_label", + language())) + # update progress bar complete label (in case it is visible) + update_progressbar_label(get_disp_name( + "file_input_progressbar_complete_label", language())) + + # if no file is uploaded, translate the value text + if (is.null(current_path())) { + update_value_text(NULL) + } + }) + + # when a new relative path is supplied, store it + observeEvent(set_path(), { + + path <- set_path() + if (identical(path, missingval) | identical(path, "")) { + path <- NULL + } + + current_path(path) + new_file(FALSE) + update_value_text(path) + # reset set_path so that a new value can be supplied again through it + set_path(NULL) + }) + + # when reset_path is signaled, do it + observeEvent(reset_path(), { + current_path(NULL) + reset_path(FALSE) + }) + + # control the visibility of the delete button + observeEvent(current_path(), ignoreNULL = FALSE, { + shinyjs::toggle("delete", condition = !is.null(current_path())) + if (is.null(current_path())) { + update_value_text(NULL) + hide_progressbar() + } + }) + + # delete uploaded file when requested + observeEvent(input$delete, { + + # this should not happen as the delete button should be hidden + if (is.null(current_path())) { + shinyjs::hide("delete") + return() + } + + hide_progressbar() + + current_path(NULL) + new_file(FALSE) + + # TODO: if newly uploaded file, delete temp file right away? + + # there are two types of deletions: + # 1. the user has uploaded a new file and wants to delete it + # (non-saved file) + # - there can be a previously saved file if we are editing an event, + # that should then be displayed + # 2. the user has not uploaded a new file, but the event has a + # previously saved file the user wants to delete. + + # the value of a fileInput cannot be reset, so we need to + # compare the current value to the old one to figure out if + # a new value has been entered + # new_file_uploaded <- + # !identical(input[[fileInput_code_name]], + # session$userData$ + # previous_fileInput_value[[fileInput_code_name]]) + # event <- event_to_edit() + # editing <- !is.null(event) + # + # if (new_file_uploaded) { + # + # # # if we are editing, there might be a previous file + # # if (editing) { + # # + # # old_path <- event[[fileInput_code_name]] + # # + # # if (!is.null(old_path) & !identical(old_path, missingval)) { + # # message(glue("Deleting new file and going back to ", + # # "{old_path}")) + # # } else { + # # message("Deleting new file, no previous files") + # # } + # # + # # } else { + # # message("Deleting a newly uploaded file in add mode") + # # } + # + # # clear fileInput + # update_ui_element(session, fileInput_code_name, + # clear_value = TRUE) + # # TODO: delete the actual file? + # + # } else { + # + # # new file was not uploaded. Check if we are editing and there + # # is a previous file we should delete + # old_path <- event[[fileInput_code_name]] + # if (editing && !is.null(old_path) && + # !identical(old_path, missingval)) { + # + # # there is an old file we should delete when the changes + # # to the event are saved. To signal this, let's add a flag + # # to session$userData$previous_fileInput_value + # update_ui_element(session, fileInput_code_name, + # clear_value = TRUE) + # session$userData$previous_fileInput_value[[ + # fileInput_code_name]] <- list(clear_value = TRUE) + # + # } else { + # # the button should not be visible at this point + # message("No new file uploaded and no old file to delete") + # } + # + # } + + }) + + ################ + + return(reactive(list(filepath = current_path(), + new_file = new_file()))) + + }) +} diff --git a/R/mod_form.R b/R/mod_form.R new file mode 100644 index 0000000..88c5a3e --- /dev/null +++ b/R/mod_form.R @@ -0,0 +1,714 @@ +# The function of the form modoule is as follows: +# - contains the widgets for entering the actual information about the event +# - shows the correct widgets depending on the user's choices +# - allows prefilling the widgets with the desired values +# - verifies that the information has been supplied correctly +# - returns the values to the main app in the format they will be saved (e.g. +# "" replaced with missingval) +# - contains the save, cancel and delete buttons and sends their signals to +# the main app + + +#' UI function for the form module +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' +#' @importFrom shiny NS tagList +mod_form_ui <- function(id){ + ns <- NS(id) + tagList( + + # the form contains the widgets for entering information + # about the event + fluidRow( + column(width = 3, + h3(textOutput(ns("form_title")), + style = "margin-bottom = 0px; margin-top = 0px; + margin-block-start = 0px"), + + # in general the choices and labels don't have to be + # defined for selectInputs, as they will be + # populated when the language is changed + # (which also happens when the app starts) + + span(textOutput(ns("required_variables_helptext")), + style = "color:gray"), + br(), + + selectInput(ns("block"), label = get_disp_name("block_label", + init_lang), + choices = ""), + + selectInput(ns("mgmt_operations_event"), + label = get_disp_name("mgmt_operations_event_label", + init_lang), + choices = get_selectInput_choices( + "mgmt_operations_event", init_lang) + ), + + # setting max disallows inputting future events + dateInput( + ns("date"), + format = "dd/mm/yyyy", + label = get_disp_name("date_label", init_lang), + max = Sys.Date(), + value = Sys.Date(), + weekstart = 1 + ), + + textAreaInput( + ns("mgmt_event_notes"), + label = get_disp_name("mgmt_event_notes_label", init_lang), + placeholder = get_disp_name("mgmt_event_notes_placeholder", + init_lang), + resize = "vertical", + height = "70px" + ) + ), + + column(width = 9, + # show a detailed options panel for the different activities + # activity_options and create_ui is defined in utils_ui.R + create_ui(activity_options, ns) + ) + ), + + # the buttons for saving, canceling and deleting + fluidRow( + column(width = 12, + actionButton(ns("save"), label = "Save"), + + actionButton(ns("cancel"), label = "Cancel"), + + shinyjs::hidden(actionButton(ns("delete"), label = "Delete", + class = "btn-warning")) + ) + ) + + ) +} + +#' form Server Functions +#' +#' @param id The id of the corresponding UI element +#' @param site A reactive expression holding the current site name +#' @param set_values Changing the value of this reactive expression sets the +#' values in the form +#' @param reset_values A reactive expression. If set to TRUE, clears the values +#' on the form +#' @param edit_mode A reactive expression holding a boolean value which +#' indicates whether the app is editing an event (TRUE) or creating a purely +#' new one (FALSE) +#' @param language A reactive expression holding the current UI language +#' +#' @import shinyvalidate +#' @noRd +mod_form_server <- function(id, site, set_values, reset_values, edit_mode, + language, init_signal) { + + stopifnot(is.reactive(site)) + stopifnot(is.reactive(set_values)) + stopifnot(is.reactive(reset_values)) + stopifnot(is.reactive(edit_mode)) + stopifnot(is.reactive(language)) + stopifnot(is.reactive(init_signal)) + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + if (dp()) message("Initialising form server function") + + # add input validators + # the idea is that each widget has its own validator. This validator is + # active whenever that widget is in relevant variables. These individual + # validators are then added as subvalidators to main_iv + main_iv <- InputValidator$new() + lapply(get_category_names("variable_name"), FUN = function(variable) { + + widget <- structure_lookup_list[[variable]] + iv <- InputValidator$new() + added_rules <- FALSE + + # add required rule + if (identical(widget$required, TRUE)) { + + if (widget$type == "dateRangeInput") { + iv$add_rule(variable, sv_required(message = "", + test = valid_dateRangeInput)) + } else { + iv$add_rule(variable, sv_required(message = "")) + } + + added_rules <- TRUE + } + + # add minimum rule + if (!is.null(widget$min)) { + iv$add_rule(variable, sv_gte(widget$min, allow_na = TRUE, + message_fmt = "")) + added_rules <- TRUE + } + + # add maximum rule + # using [[ here because $ does partial matching and catches onto + # maxlength + if (!is.null(widget[["max"]])) { + iv$add_rule(variable, sv_lte(widget[["max"]], allow_na = TRUE, + message_fmt = "")) + added_rules <- TRUE + } + + # add integer rule + if (identical(widget$step, as.integer(1))) { + iv$add_rule(variable, sv_integer(message = "", allow_na = TRUE)) + added_rules <- TRUE + } + + # add max length rule + if (!is.null(widget$maxlength)) { + iv$add_rule(variable, function(x) { + if (!isTruthy(x)) return(NULL) + if (nchar(x) <= widget$maxlength) NULL + else glue("Max. {widget$maxlength} characters") + }) + added_rules <- TRUE + } + + if (added_rules) { + # the validator is only active when it is in the current list of + # relevant, regular widgets + iv$condition(reactive({ variable %in% relevant_variables()$regular })) + # add widget validator to main validator + main_iv$add_validator(iv) + } + + }) + # start showing validation messages + main_iv$enable() + + # go through all fields and set maxLength if requested in ui_structure.json + # TODO: do with validation instead + # for (element in structure_lookup_list) { + # if (!is.null(element$maxlength)) { + # js_message <- "$('##code_name').attr('maxlength', #maxlength)" + # js_message <- gsub("#code_name", ns(element$code_name), js_message) + # js_message <- gsub("#maxlength", element$maxlength, js_message) + # shinyjs::runjs(js_message) + # } + # } + + # when site setting is changed, update the block choices on the form + observeEvent(site(), ignoreNULL = FALSE, { + + if (!isTruthy(site())) { + shinyjs::disable("block") + shinyjs::disable("save") + return() + } + + shinyjs::enable("block") + shinyjs::enable("save") + + # update block choices + block_choices <- subset(sites, sites$site == site())$blocks[[1]] + updateSelectInput(session, "block", choices = block_choices) + + }) + + # when set_values is changed, update the values in the form + observeEvent(set_values(), { + + if (dp()) message("Filling the form with values") + + values <- set_values() + + # populate the input widgets with the values corresponding to the + # event, and clear others + for (variable in get_category_names("variable_name")) { + + # get the value corresponding to this variable from the event. + # might be NULL + value <- values[[variable]] + widget <- structure_lookup_list[[variable]] + + # determine if this value should be filled in a table + # for now this is a sufficient condition + variable_table <- get_variable_table(variable) + value_in_table <- !is.null(variable_table) & length(value) > 1 + + if (!(variable %in% names(values)) | value_in_table) { + # clear widget if the event does not contain a value for it + # or value should be shown in a table instead + update_ui_element(session, variable, clear_value = TRUE) + } else if (widget$type == "fileInput") { + files[[variable]]$set_path(value) + } else { + update_ui_element(session, variable, value = value) + } + } + + # then go through all the variables in the event and see if any of + # them should be displayed in the table. If yes, fill the table. + # Other tables do not need to be cleared, as they do that by + # themselves when they become hidden. + for (variable in names(values)) { + variable_table <- get_variable_table(variable) + + if (!is.null(variable_table)) { + tables[[variable_table]]$set_values(values) + # currently there is only one possible table per event + break + } + } + + # change set_values back to NULL so that we can catch the next time its + # value is changed. This doesn't re-trigger this observeEvent as + # observeEvent ignores NULL values by default + set_values(NULL) + }) + + # when reset_values is signaled, reset the values of all widgets + observeEvent(reset_values(), { + + if (identical(reset_values(), FALSE)) return() + + if (dp()) message("Resetting form values") + + reset_input_fields(session, get_category_names("variable_name")) + + # clear fileInput fields separately + for (fileInput_code_name in fileInput_code_names) { + files[[fileInput_code_name]]$reset_path(TRUE) + } + + # fertilizer_element_table is an exception in that it doesn't clear + # itself (it is in "static mode"). Let's clear it by hand: + # TODO: make this automatic too + tables[["fertilizer_element_table"]]$set_values(list()) + + # set value back to FALSE so this can be triggered later as well + # observeEvent ignores FALSE values by default + reset_values(FALSE) + }) + + # show Delete button depending on edit mode + observeEvent(edit_mode(), ignoreNULL = FALSE, { + shinyjs::toggle("delete", condition = edit_mode()) + }) + + # update each of the text outputs automatically, including language changes + # and the dynamic updating in editing table title etc. + # TODO: refactor + lapply(text_output_code_names, FUN = function(text_output_code_name) { + + # render text + output[[text_output_code_name]] <- renderText({ + + if (dp()) message(glue("Rendering text for {text_output_code_name}")) + + text_to_show <- get_disp_name(text_output_code_name, language()) + + #get element from the UI structure lookup list + element <- structure_lookup_list[[text_output_code_name]] + #if the text should be updated dynamically, do that + if (!is.null(element$dynamic)) { + + # there are currently two modes of dynamic text + if (element$dynamic$mode == "input") { + # # the -1 removes the mode element, we don't want it + # patterns <- names(element$dynamic)[-1] + # # use lapply here to get the dependency on input correctly + # replacements <- lapply(patterns, function(pattern) { + # replacement <- input[[ element$dynamic[[pattern]] ]] + # replacement <- get_disp_name(replacement, + # language()) + # text_to_show <<- gsub(pattern, replacement, + # text_to_show) + # replacement + # }) + # + # # if one of the replacements is empty, we don't want to + # # see the text at all + # if ("" %in% replacements) { text_to_show <- "" } + + } else if (element$dynamic$mode == "edit_mode") { + + text_to_show <- if (edit_mode()) { + element$dynamic[["TRUE"]] + } else { + element$dynamic[["FALSE"]] + } + text_to_show <- get_disp_name(text_to_show, language()) + + } + } + text_to_show + }) + + }) + + observeEvent(language(), ignoreInit = TRUE, { + + # get a list of all input elements which we have to relabel + input_element_names <- names(reactiveValuesToList(input)) + + for (code_name in input_element_names) { + + # TODO: update to use the update_ui_element function + + # find element in the UI structure lookup list + element <- structure_lookup_list[[code_name]] + + # didn't find the element corresponding to code_name + # this should not happen if the element is in + # sidebar_ui_structure.json + if (is.null(element$type)) next + + label <- get_disp_name(element$label, language()) + + if (element$type == "selectInput") { + + # fetch choices for the selectInput + choices <- get_selectInput_choices(code_name, language()) + + # make sure we don't change the selected value + current_value <- input[[code_name]] + + if (is.null(choices)) { + updateSelectInput(session, + code_name, + label = ifelse(is.null(label),"",label), + selected = current_value) + } else { + updateSelectInput(session, + code_name, + label = ifelse(is.null(label),"",label), + choices = choices, + selected = current_value) + } + + + } else if (element$type == "dateInput") { + #language_code <- if (input$language == "disp_name_fin") { + # "fi" + #} else { + # "en" + #} + updateDateInput(session, + code_name, + label = label, + #language = language_code + ) + } else if (element$type == "textAreaInput") { + updateTextAreaInput(session, + code_name, + label = label, + placeholder = + get_disp_name( + element$placeholder, + language())) + } else if (element$type == "actionButton") { + updateActionButton(session, + code_name, + label = label) + } else if (element$type == "checkboxInput") { + updateCheckboxInput(session, + code_name, + label = label) + } else if (element$type == "textInput") { + updateTextInput(session, + code_name, + label = label, + placeholder = + get_disp_name( + element$placeholder, + language())) + } else if (element$type == "numericInput") { + updateNumericInput(session, + code_name, + label = label) + } else if (element$type == "dateRangeInput") { + updateDateRangeInput(session, + code_name, + label = label) + } else if (element$type == "fileInput") { + # fileInput modules do their own language changing + } + + } + + + }) + + # initialise the tables list (wihout yet starting the table servers) so + # that we can pre-supply the values to the tables + # sapply with simplify = FALSE is equivalent to lapply + tables <- sapply(data_table_code_names, USE.NAMES = TRUE, simplify = FALSE, + FUN = function(table_code_name) { + set_values <- reactiveVal() + list(set_values = set_values) + }) + + # do the same thing with fileInput modules + files <- sapply(fileInput_code_names, USE.NAMES = TRUE, simplify = FALSE, + FUN = function(fileInput_code_name) { + + set_path <- reactiveVal() + reset_path <- reactiveVal() + + list(set_path = set_path, + reset_path = reset_path) + }) + + # when we get the init_signal, initialise table and fileInput module server + # functions. This "staged" initialisation is done to improve startup speed. + observeEvent(init_signal(), { + + if (dp()) message("Initialising table and fileInput server functions") + + # initialise the table server for each of the dynamically added tables + # the values from the table can be accessed ilke + # tables[[table_code_name]]$result$values() + sapply(data_table_code_names, FUN = function(table_code_name) { + + table_structure <- + structure_lookup_list[[table_code_name]] + + # are we in static mode, i.e. are all row groups of + # type 'static'? If yes, we won't need to supply the + # row_variable_value reactive. Currently this only + # happens with fertilizer_element_table (the columns + # are not defined) + static_mode <- is.null(table_structure$columns) + + # find the row variable. This will be used in the + # reactive below + if (!static_mode) { + for (row_group in table_structure$rows) { + # there is only one dynamic row group + if (row_group$type == 'dynamic') { + row_variable <- row_group$row_variable + row_variable_type <- + structure_lookup_list[[row_variable]]$type + break + } + } + } + + # If we have row groups which depend on widget values + # in the main app, create a reactive from those values. + # This can either be determined by the choices of + # selectInput with multiple selections, or a + # numericInput which represents the number of rows. + row_variable_value <- reactive({ + + if (static_mode) { + return(NULL) + } + + if (row_variable_type == "numericInput") { + number_of_rows <- input[[row_variable]] + + # check status of validator. If it is NULL all is + # ok + if (!isTruthy(number_of_rows) || + !is.null(isolate( + main_iv$validate()[[ns(row_variable)]]))) { + NULL + } else { + as.integer(number_of_rows) + } + + } else if (row_variable_type == "selectInput") { + input[[row_variable]] + } + + }) + + # start the server function + tables[[table_code_name]]$result <<- + mod_table_server(table_code_name, + row_variable_value, + language, + tables[[table_code_name]]$set_values) + }) + + # start server for all fileInput modules + sapply(fileInput_code_names, FUN = function(fileInput_code_name) { + + files[[fileInput_code_name]]$value <<- + mod_fileInput_server(id = fileInput_code_name, + language = language, + set_path = files[[fileInput_code_name]]$set_path, + reset_path = files[[fileInput_code_name]]$reset_path) + }) + + }) + + # when requested, prepare the entered data + form_data <- reactive({ + + if (dp()) message("Calculating form data") + + relevant <- relevant_variables() + relevant_table <- if (identical(relevant$table_code_name, character(0))) { + NULL + } else { + tables[[relevant$table_code_name]]$result + } + + # check that the form and table validation rules have been met + if (!main_iv$is_valid() || + (!is.null(relevant_table) && !relevant_table$valid())) { + return(NULL) + } + + event <- list() + # fill information + for (variable in c(relevant$regular, relevant$table)) { + + # is the variable a fileInput? + is_fileInput <- identical(structure_lookup_list[[variable]]$type, + "fileInput") + + # read value from table if it is available there, otherwise from either + # a fileInput module or a regular input widget + value_to_save <- if (variable %in% relevant$table) { + relevant_table$values()[[variable]] + } else if (is_fileInput) { + files[[variable]]$value() + } else { + input[[variable]] + } + + # if value is character, trim any whitespace around it + if (is.character(value_to_save)) { + value_to_save <- trimws(value_to_save) + } + + # format Date value to character string and replace with "" if that + # fails for some reason + if (inherits(value_to_save, "Date")) { + value_to_save <- tryCatch( + expr = format(value_to_save, date_format_json), + error = function(cnd) { + message(glue("Unable to format date {value_to_save}", + "into string when saving event,", + "replaced with missingval")) + "" + } + ) + } + + # if the value is not defined or empty, replace with missingval + if (length(value_to_save) == 0) { + value_to_save <- missingval + } else { + missing_indexes <- is.na(value_to_save) | value_to_save == "" + if (any(missing_indexes)) { + value_to_save[missing_indexes] <- missingval + } + } + + event[[variable]] <- value_to_save + } + + # return event data + event + }) + + # When requested, calculate a vector with the names of relevant variables. A + # variable is relevant when it is visible in some form, either as a regular + # widget or in a table module. Relevant variables are ones which we want to + # save to a json file given the current choices of the user. For example, + # when the user is making a soil observation event, the variables related + # to that are relevant while other observation variables are not. + # This only works when the form is already open. + relevant_variables <- reactive({ + + if (dp()) message("Calculating relevant variables") + + # these are the variables among which the relevant variables are + all_variables <- get_category_names("variable_name") + + # find all widgets that are currently hidden in the UI. This includes + # regular widgets but also e.g. tables. Note that not all of these are + # irrelevant; the regular form of a widget might be hidden because we want + # to read its values from a table instead. This vector includes also + # tables because that way we can check whether a table is actually hidden. + hidden_widgets <- unlist(rlapply(activity_options, fun = function(x) { + if (!is.null(x$condition)) { + relevant <- evaluate_condition(x$condition, session) + if (!is.null(relevant) && !identical(relevant, TRUE)) { + rlapply(x, fun = function(x) x$code_name) + } + } + })) + + # find variables which are relevant and being entered through a table + table_variables <- NULL + for (table_code_name in data_table_code_names) { + if (!(table_code_name %in% hidden_widgets)) { + table_variables <- c(table_variables, + get_table_variables(table_code_name)) + # currently only one table is visible at a time + break + } + } + + # Report relevant widgets for regular and table widgets separately. + # We get the relevant variables by removing from all variables the widgets + # that are hidden. + # Also report the name of the table which is currently relevant. + list( + regular = setdiff(all_variables, hidden_widgets), + table = table_variables, + table_code_name = setdiff(data_table_code_names, hidden_widgets) + ) + }) + + # When requested, list as a vector the variables among the currently + # relevant variables which are compulsory to be filled out. + required_variables <- reactive({ + + if (dp()) message("Calculating required variables") + + required_widgets <- NULL + required_table_widgets <- NULL + + relevant <- relevant_variables() + + for (variable in relevant$regular) { + if (identical(structure_lookup_list[[variable]]$required, TRUE)) { + required_widgets <- c(required_widgets, variable) + } + } + for (variable in relevant$table) { + if (identical(structure_lookup_list[[variable]]$required, TRUE)) { + required_table_widgets <- c(required_table_widgets, variable) + } + } + + list( + regular = required_widgets, + table = required_table_widgets + ) + + }) + + ################## RETURN VALUE + + list( + data = form_data, + save = reactive(input$save), + cancel = reactive(input$cancel), + delete = reactive(input$delete) + ) + + }) + +} diff --git a/R/mod_form_fct_evaluate_js.R b/R/mod_form_fct_evaluate_js.R new file mode 100644 index 0000000..6188855 --- /dev/null +++ b/R/mod_form_fct_evaluate_js.R @@ -0,0 +1,56 @@ +#' Evalute some javascript conditions from ui_structure.json in R +#' +#' Takes a condition written in javascript notation (visibility conditions in +#' ui_structure.json) and evaluates it in R. +#' +#' @param js_condition The javascript condition to evaluate as a string +#' @param session Current Shiny session in which to evaluate +#' @return Returns either TRUE or FALSE. If the condition could not be +#' evaluated, returns NULL. +#' +#' @note Might not be best coding practice, but works as long as the +#' js_condition doesn't have any typos. eval(parse(...)) is dangerous if it is +#' used directly with user input, but here that is not the case. The user has +#' no access to the ui_structure.json file. +#' +#' Running this function in a reactive context will create reactive +#' dependencies. This is actually useful, because then we know exactly when +#' e.g. relevant variables need to be recalculated. +evaluate_condition <- function(js_condition, session) { + + if (is.null(js_condition) || !is.character(js_condition)) { + return(NULL) + } + + # substitute dots with dollar signs + # (fixed = TRUE means we don't use regex) + condition <- gsub("input.", "session$input$", js_condition, fixed = TRUE) + + # if the condition relates to the length of something, modify it + # to look like R. e.g. change "thing.length > 1" to "length(thing) > 1" + if (stringr::str_detect(condition, ".length")) { + length_index <- stringr::str_locate(condition, ".length") + start <- stringr::str_sub(condition, end = length_index[,"start"]-1) + condition <- paste0("length(", start, ")", + stringr::str_sub(condition, + start = length_index[,"end"] + 1)) + } + + # replace 'true' with 'TRUE' and 'false' with 'FALSE' + if (condition == "true") { + condition <- "TRUE" + } else if (condition == "false") { + condition <- "FALSE" + } + + #message(glue("Evaluating condition {condition}")) + + # parse string into an expression and evaluate it + tryCatch( + expr = eval(parse(text = condition)), + error = function(cnd) { + message(glue("Condition {condition} could not be evaluated: {cnd}")) + NULL + } + ) +} \ No newline at end of file diff --git a/R/mod_rotation_cycle.R b/R/mod_rotation_cycle.R new file mode 100644 index 0000000..09446c9 --- /dev/null +++ b/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) + + }) +} \ No newline at end of file diff --git a/R/mod_table.R b/R/mod_table.R new file mode 100644 index 0000000..baf471b --- /dev/null +++ b/R/mod_table.R @@ -0,0 +1,626 @@ +# Table module +# Otto Kuusela 2021 +# +# Word of warning: this is (unfortunately) a fickle beast. The main problem +# underlying all difficulties related to this module is binding / unbinding the +# widgets presented in the table. Each time the table is changed (rows are added +# / removed or language changes) the previous inputs must be unbound before the +# table disappears and the new inputs appear. These new inputs must then be +# bound after they have been rendered. This sounds simple, but has caused me +# endless trouble. So tread carefully here, things break easily! + +# Print messages to console +table_log <- FALSE + +# javascript callback scripts must be wrapped inside a function. +# EDIT: this makes sense also, see datatables API documentation for example +js_bind_script <- "function() { Shiny.bindAll(this.api().table().node()); }" + +#' Shiny module for data input in table format +#' +#' @description A shiny Module. +#' +#' @param id,input,output,session Internal parameters for {shiny}. +#' +#' @noRd +#' +#' @importFrom shiny NS tagList +mod_table_ui <- function(id) { + ns <- NS(id) + tagList( + DT::dataTableOutput(ns("table")), + br() + ) +} + +#' table Server Functions +#' +#' @param id The id of the corresponding UI element +#' @param row_variable_value A reactive expression holding the value of the +#' variable which determines the rows in a dynamic row group. If there are no +#' dynamic row groups in the table, a reactive expression holding the value +#' NULL. +#' @param language A reactive expression holding the current UI language +#' @param override_values Changing the value of this reactive expression sets +#' the values in the table +#' +#' @import shinyvalidate +#' @noRd +mod_table_server <- function(id, row_variable_value, + language, override_values) { + + stopifnot(is.reactive(row_variable_value)) + stopifnot(is.reactive(language)) + stopifnot(is.reactive(override_values)) + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # This is used to slow things down when the value changes rapidly. + # throttle lets the first invalidation through but holds the subsequent + # ones for 800ms + row_variable_value <- throttle(row_variable_value, millis = 800) + + #### Validate inputs in the table + + iv <- InputValidator$new() + # start showing validation messages + iv$enable() + # which widgets have we already added rules for? + rules_added <- NULL + # Add validation rules for the specified set of widgets. widgets and + # variables should have the same length; the latter has "pure" variable + # names which correspond to the former row-numbered widget names. + # This function will be called when generating the widgets. + add_validation_rules <- function(widgets, variables) { + lapply(1:length(widgets), FUN = function(i) { + + widget_name <- widgets[i] + widget <- structure_lookup_list[[variables[i]]] + + if (widget_name %in% rules_added) return() + + # add required rule + if (identical(widget$required, TRUE)) { + iv$add_rule(widget_name, sv_required(message = "")) + } + + # add minimum rule + if (!is.null(widget$min)) { + iv$add_rule(widget_name, sv_gte(widget$min, allow_na = TRUE, + message_fmt = "")) + } + + # add maximum rule + # using [[ here because $ does partial matching and catches onto + # maxlength + if (!is.null(widget[["max"]])) { + iv$add_rule(widget_name, sv_lte(widget[["max"]], allow_na = TRUE, + message_fmt = "")) + } + + }) + rules_added <- c(rules_added, widgets) + } + + #### Find out useful information about the table + + table_structure <- structure_lookup_list[[id]] + row_groups <- table_structure$rows + # can be NULL, in which case all row groups are of type 'static' + column_names <- table_structure$columns + static_mode <- is.null(column_names) + + if (!static_mode) { + # find the row variable + for (row_group in row_groups) { + if (row_group$type == 'dynamic') { + # row_variable will be available outside this loop + row_variable <- row_group$row_variable + # there is only one dynamic row group + break + } + } + } + + n_cols <- if (static_mode) { + max(sapply(row_groups, FUN = function(x) length(x$variables))) + } else { + length(column_names) + } + + # entered values before we e.g. add rows. This allows us to get the + # values back when generating a new table + old_values <- reactiveVal() + # current values of the table + table_values <- reactiveVal() + + # whether the table is currently rendered or not + rendered <- reactiveVal(FALSE) + + # when the client sends a message that rendering is done, set rendered + # to TRUE + observeEvent(input$rendered, { + rendered(TRUE) + if (table_log) message(glue("input$rendered is {input$rendered}, ", + "rendered set to TRUE ({id})")) + }) + + # when we go hidden, set rendered to FALSE and clear old values + observeEvent(visible(), ignoreNULL = FALSE, ignoreInit = TRUE, + priority = 1, { + if (!visible()) { + if (table_log) message(glue("Rendered set to FALSE. ", + "Clearing old values ({id})")) + rendered(FALSE) + old_values(list()) + } + }) + + # Determine when the table is visible + visible <- reactive({ + if (static_mode) { + # tables in static mode are always "visible" + TRUE + } else { + length(dynamic_rows()) > 1 + } + }) + + + # this triggers the update of table_data when override_values are + # supplied and not when they are reset to NULL. The triggering + # behaviour is controller in the observeEvent below + override_trigger <- reactiveVal(0) + + # this is a trigger for updating the table widgets when rows change + row_trigger <- reactiveVal(0) + + # observeEvent ignores NULL values by default + observeEvent(override_values(), { + if (table_log) { + message(glue("Triggering value pre-filling, ", + "values are ({id})")) + utils::str(override_values()) + } + # update dynamic rows (if any) + if (!static_mode) { + dynamic_rows( + get_dynamic_rows_from_value(row_variable, + override_values()[[row_variable]]) + ) + } + override_trigger(override_trigger() + 1) + }) + + # this allows blocking extra updates caused by the widget in the main + # app changing its value after override_values have just been supplied. + observeEvent(row_variable_value(), ignoreNULL = FALSE, ignoreInit = TRUE, { + # there is no row variable in static mode + if (static_mode) return() + + new_dynamic_rows <- get_dynamic_rows_from_value(row_variable, + row_variable_value()) + + # as.character is needed because sometimes rows are numeric and that + # makes comparison simpler + if (!identical(as.character(new_dynamic_rows), + as.character(dynamic_rows()))) { + if (table_log) message(glue("Triggering the row_trigger because new ", + "rows are ", + "{paste(new_dynamic_rows, collapse = ', ')} ", + "and old ones are ", + "{paste(dynamic_rows(), collapse = ', ')} ", + "({id})")) + dynamic_rows(new_dynamic_rows) + row_trigger(row_trigger() + 1) + } else { + if (table_log) message(glue("Rows are identical so didn't ", + "trigger an update ({id})")) + } + }) + + if (!static_mode) { + # holds the current rows in the dynamic row group as a vector + dynamic_rows <- reactiveVal() + } + + # this unbinds the table elements before they are re-rendered. + # Setting a higher priority ensures this runs before the table render + observe(priority = 2, { + # when to run observer + language() # table is re-generated when language changes + visible() # required, because this updates before row_trigger + row_trigger() + override_trigger() + # require this so that we know the table has already rendered and + # is still visible. + # requiring rendered adds a layer of distance from visible: + # when visibility first goes to FALSE, rendered is still TRUE + # here because this observer has a higher priority than the one + # which sets rendered to FALSE. + req(isolate(rendered())) + session$sendCustomMessage("unbind-table", ns("table")) + if (table_log) message(glue("Sent unbind message ({id})")) + }) + + # this is a flag which, when set to TRUE, blocks the calculation of + # sums on the total row (present on harvest_crop_table). + # This is used to prevent the calculation when the widgets are first created + # and get their initial values in the table_data reactive. + block_sum_calculation <- reactiveVal(FALSE) + + calculate_sum <- function(total_variable) { + if (!static_mode) { + row_value <- isolate(dynamic_rows()) + row_numbers <- if (is.numeric(row_value)) { + row_value + } else { + 1:length(row_value) + } + } + + variable_to_sum <- structure_lookup_list[[total_variable]]$sum_of + values <- NULL + for (row_number in row_numbers) { + element_name <- paste(variable_to_sum, row_number, sep = "_") + values <- c(values, isolate(input[[element_name]])) + } + + value <- sum(values[!is.na(values)]) + update_ui_element(session, total_variable, value = value) + } + + # calculates the widgets that should be in the table + table_data <- reactive({ + # when the widgets should be re-calculated. + # table_data also re-calculates when language changes if table has + # selectInputs, text fields with placeholders or widgets + # with labels (see below) + override_trigger() + row_trigger() + + if (table_log) message(glue("Table calculation begins ({id})")) + + override_vals <- isolate(override_values()) + do_override <- !is.null(override_vals) + + table_to_display <- data.frame(matrix(nrow = 0, ncol = n_cols)) + # column_names can be NULL + names(table_to_display) <- if (is.null(column_names)) { + rep("", n_cols) + } else { + column_names + } + + if (do_override) { + # if we just want to clear the table, let's do that + if (identical(override_vals, list())) { + if (table_log) message(glue("Clearing table ({id})")) + override_values(NULL) + do_override <- FALSE + old_values(list()) + } + } + + # get all the column numbers with numericInputs so we can adjust + # the widths for these columns + #numericInput_columns <- NULL + current_row <- 1 + for (row_group in row_groups) { + + if (row_group$type == 'static') { + + current_col <- 1 + for (variable in row_group$variables) { + + element <- structure_lookup_list[[variable]] + + # if (element$type == "numericInput") { + # numericInput_columns <- + # c(numericInput_columns, + # current_col) + # } + + code_name <- variable + + value <- if (do_override) { + override_vals[[variable]] + } else { + isolate(old_values())[[variable]] + } + + if (!isTruthy(value) || value == missingval) { + value <- "" + } + + #message(glue("Value for {code_name} is {value}")) + + # add choices in the correct language for selectInputs + choices <- NULL + if (identical(element$type, "selectInput")) { + choices <- get_selectInput_choices(variable, language()) + } + + placeholder <- NULL + if (!is.null(element$placeholder)) { + placeholder <- get_disp_name(element$placeholder, + language()) + } + + label <- "" + if (!identical(row_group$hide_labels, TRUE)) { + label <- get_disp_name(element$label, language()) + } + + width <- if (element$type == "numericInput") { + 100 + } else { + 150 + } + + # as character makes the element HTML, which can then be + # not escaped when rendering the table + widget <- as.character( + create_widget(element, + ns = ns, + width = width, + override_code_name = code_name, + override_label = label, + override_value = value, + override_choices = choices, + override_selected = value, + override_placeholder = placeholder + )) + + add_validation_rules(code_name, variable) + + + table_to_display[current_row, current_col] <- widget + current_col <- current_col + 1 + } + + row_name <- ifelse(is.null(row_group$name), current_row, + row_group$name) + rownames(table_to_display)[current_row] <- row_name + + current_row <- current_row + 1 + + } else if (row_group$type == 'dynamic') { + + # the rows in the dynamic row group + rows <- isolate(dynamic_rows()) + + for (row in rows) { + # For dynamic row groups the variables on each row are + # determined by the columns of the table. + # Go through each column and add widgets to the row. + for (variable in column_names) { + + element <- structure_lookup_list[[variable]] + + # if (element$type == "numericInput") { + # numericInput_columns <- + # c(numericInput_columns, + # which(column_names == variable)) + # } + + # the code names for these elements are + # variablename_rownumber + code_name <- paste(variable, current_row, sep = "_") + + # value to show in the widget initially + value <- if (do_override) { + override_vals[[variable]][current_row] + } else { + # fetch old value to show it after rows have changed + old_row_number <- which( + isolate(old_values())[["DYNAMIC_ROWS"]] == + rows[current_row]) + isolate(old_values())[[variable]][old_row_number] + } + + if (!isTruthy(value) || value == missingval) { + value <- "" + } + + #message(glue("Value for {code_name} is {value}")) + + # add choices in the correct language for selectInputs + choices <- NULL + if (identical(element$type, "selectInput")) { + choices <- get_selectInput_choices(variable, language()) + } + + placeholder <- NULL + if (!is.null(element$placeholder)) { + placeholder <- get_disp_name(element$placeholder, + language()) + } + + width <- if (element$type == "numericInput") { + 100 + } else { + 150 + } + + # as character makes the element HTML, which can then be + # not escaped when rendering the table + widget <- as.character( + create_widget(element, + ns = ns, + width = width, + override_code_name = code_name, + override_label = "", + override_value = value, + override_choices = choices, + override_selected = value, + override_placeholder = placeholder + )) + + add_validation_rules(code_name, variable) + + table_to_display[current_row, variable] <- widget + } + + rownames(table_to_display)[current_row] <- row + current_row <- current_row + 1 + } + + } + + } + + # block calculation of sums once when the table becomes visible + block_sum_calculation(TRUE) + if (table_log) message(glue("Calculated table, has ", + "{nrow(table_to_display)} rows ({id})")) + # clear override_values + override_values(NULL) + table_to_display + }) + + output$table <- DT::renderDataTable({ + req(visible()) + if (table_log) message(glue("Starting render, rendered set to FALSE ({id})")) + + rendered(FALSE) + table_to_display <- table_data() + + if (nrow(table_to_display) == 0) { + if (table_log) message(glue("No rows, didn't render ({id})")) + return() + } + + names(table_to_display) <- get_disp_name(names(table_to_display), + language = language(), + is_variable_name = TRUE) + rownames(table_to_display) <- get_disp_name( + rownames(table_to_display), + language = language()) + + # numericInput_columns <- table_data()$numericInput_columns + # if (static_mode) { + # numericInput_columns <- numericInput_columns - 1 + # } + table_to_display <- + DT::datatable( + table_to_display, + escape = FALSE, # makes widgets actual widgets, IMPORTANT + selection = "none", + class = "table table-hover table-condensed", + rownames = !static_mode, # show rownames if not static mode + options = + list(dom = "t", # hide everything except table + # hide sorting arrows + ordering = FALSE, + # binds the inputs when drawing is done + drawCallback = htmlwidgets::JS(js_bind_script), + # calls selectize() on all selectInputs, which + # makes them look the way they should. Also asks + # the client to send the rendering done message. + initComplete = + htmlwidgets::JS(paste0( + "function(settings, json) {", + "do_selectize('", ns("table"), "'); ", + "rendering_done('", ns("rendered"), "'); }" + )), + scrollX = TRUE + )) + # if we are in custom mode, align cells vertically so that the + # widgets are always in line + if (static_mode) { + DT::formatStyle(table_to_display, 0:(n_cols-1), + 'vertical-align' = 'bottom') + } else { + table_to_display + } + + }, server = FALSE) + + + # return the values of the table widgets + # has to run when visibility changes because input values are not + # available otherwise. + # This observer also calculates the sum on the total row in + # harvest_crop_table + observe({ + + value_list <- list() + + if (!rendered()) { + if (table_log) message(glue("Values observe blocked, table not ", + "rendered yet ({id})")) + table_values(value_list) + return() + } + + # Add dependency on table_data() at this point. + # Needed, so that when new widgets are calculated, we add a + # dependency on them + table_data() + + if (table_log) message(glue("Values observe running ({id})")) + + # fetch values from widgets in static row groups + for (row_group in row_groups) { + if (row_group$type == 'static') { + for (variable in row_group$variables) { + value_list[[variable]] <- input[[variable]] + } + } + } + + if (!static_mode) { + row_value <- dynamic_rows() + row_numbers <- if (is.numeric(row_value)) { + row_value + } else { + 1:length(row_value) + } + } + # does not do anything if column names are undefined + for (variable in column_names) { + values <- NULL + + for (row_number in row_numbers) { + element_name <- paste(variable, row_number, sep = "_") + values <- c(values, input[[element_name]]) + } + + # handle calculating the total values when new values are entered + previous_vals <- isolate(table_values())[[variable]] + total_variable <- structure_lookup_list[[variable]]$sum_to + if (!is.null(total_variable) && + !identical(previous_vals, values) && + !isolate(block_sum_calculation())) { + if (table_log) message(glue("Initiating sum calculation for ", + "{total_variable}")) + calculate_sum(total_variable) + } + + value_list[[variable]] <- values + } + + block_sum_calculation(FALSE) + table_values(value_list) + # if there is a dynamic row group, let's add the current rows to old + # values so we can access them when rows change + if (!static_mode) { + value_list <- c(value_list, list(DYNAMIC_ROWS = isolate(dynamic_rows()))) + } + old_values(value_list) + + }) + + ################## RETURN VALUE + + list( + values = table_values, + valid = reactive(iv$is_valid()) + ) + + }) + +} + diff --git a/R/mod_table_utils.R b/R/mod_table_utils.R new file mode 100644 index 0000000..4b211f7 --- /dev/null +++ b/R/mod_table_utils.R @@ -0,0 +1,72 @@ +#' Find the table matching a variable name +#' +#' If a variable's value is entered in a table, return the name of that table +#' @param variable_name The name of the variable of interest +#' @return The code name of the table where the variable is entered, or NULL +#' if not found. +get_variable_table <- function(variable_name) { + + for (table_code_name in data_table_code_names) { + table <- structure_lookup_list[[table_code_name]] + + table_variables <- get_table_variables(table_code_name) + + if (variable_name %in% table_variables) { + return(table_code_name) + } + } + + return(NULL) +} + +#' Find the variables whose value can be entered through a given table +#' +#' @param table_code_name The name of the table whose variables to fetch. +#' @return A vector of variable names whose values are entered in a table. +#' @note If a table has a dynamic row group whose rows are determined by an +#' input widget's value, that widget's variable name will not be returned even +#' though it could be read from the list returned by the table module. +get_table_variables <- function(table_code_name) { + structure <- structure_lookup_list[[table_code_name]] + variables <- NULL + + # if a table has a dynamic row group, add the variables present on the columns + if (!is.null(structure$columns)) { + variables <- c(variables, structure$columns) + } + + # add the variables from all static row groups + for (row_group in structure$rows) { + if (row_group$type == "static") { + variables <- c(variables, row_group$variables) + } + } + + return(variables) +} + +#' Determine the dynamic rows based on row variable value +#' +#' This is used to go from the value of a variable determining the rows in a +#' dynamic row group to the rows themselves. If the row variable is a +#' selectInput, the rows equal the value, but if the row variable is a +#' numericInput, a vector of rows is generated instead +#' +#' @param variable The name of the variable which functions as a row variable in +#' a table +#' @param value The value of the variable +#' +#' @return An atomic vector of rows, either option code names or numbers +get_dynamic_rows_from_value <- function(variable, value) { + row_variable_structure <- structure_lookup_list[[variable]] + + if (row_variable_structure$type == "numericInput") { + if (!isTruthy(value) || value == missingval) { + NULL + } else { + 1:as.integer(value) + } + } else if (row_variable_structure$type == "selectInput") { + value + } +} \ No newline at end of file diff --git a/R/parser/README.md b/R/parser/README.md new file mode 100644 index 0000000..c573c63 --- /dev/null +++ b/R/parser/README.md @@ -0,0 +1,58 @@ +# Field Activity Parser + +### Todo + +Check the current todo list at - [todo.md](/todo.md) + +## Overview + +This project is a Shiny application that generates a dynamic user interface based on a JSON schema. It's designed to create forms for various field activities, with support for multiple languages, different input types, and validation support. + +## Features + +- Dynamic UI generation based on JSON schema +- Multi-language support (English, Finnish, Swedish) +- Support for various input types (select, number, string, textarea) +- Nested object and array handling +- Real-time UI updates on language change + +## File Structure + +- `fct_parser.R`: Contains functions for parsing the JSON schema +- `fct_ui.R`: Contains functions for creating UI elements +- `app_ui.R`: Defines the main UI structure of the Shiny app +- `app_server.R`: Defines the server-side logic of the Shiny app + +## Key Functions + +### fct_parser.R + +- `flatten_schema()`: Flattens the JSON schema by resolving references +- `parse_json_schema()`: Parses the entire JSON schema +- `parse_event()`: Parses individual events from the schema +- `parse_property()`: Parses individual properties from the schema +- `get_multilingual_field()`: Extracts multilingual values for a given field + +### fct_ui.R + +- `create_ui()`: Creates UI elements based on the parsed schema +- `create_properties_ui()`: Creates UI elements for properties, handling nested structures +- `create_widget()`: Creates individual UI widgets based on property type +- `get_select_choices()`: Extracts choices for select inputs +- `update_ui_element()`: Updates existing UI elements (e.g., on language change) + +### app_ui.R + +- `app_ui()`: Defines the main UI structure of the Shiny app +- `golem_add_external_resources()`: Adds external resources to the Shiny app + +### app_server.R + +- `schema_file_path()`: Gets the path to the schema file +- `app_server()`: Defines the server-side logic of the Shiny app, including event handling and UI updates + +## Usage + +```R +golem::run_dev() +``` diff --git a/R/parser/app_server.R b/R/parser/app_server.R new file mode 100644 index 0000000..7c08ed1 --- /dev/null +++ b/R/parser/app_server.R @@ -0,0 +1,77 @@ +#' Get the path to the schema file +#' +#' @return The path to the schema file +schema_file_path <- function() { + system.file("extdata", "schema.json", package = "fieldactivityParser") +} + +#' The application server-side +#' +#' @param input,output,session Internal parameters for {shiny}. +#' DO NOT REMOVE. +#' @import shiny +#' @noRd +app_server <- function(input, output, session) { + # Load and parse the JSON schema + schema <- jsonlite::fromJSON(schema_file_path(), simplifyVector = FALSE) + parsed_schema <- parse_json_schema(schema) + + event_data <- parsed_schema + + # Function to generate event UI + generate_event_ui <- function(event, language) { + if (!is.null(event)) { + event_ui <- create_ui(list(event), ns = NS("dynamic"), language = language) + tagList( + h3(event$title[[language]]), + event_ui + ) + } else { + p("No event data available.") + } + } + + # Render the dynamic UI + output$dynamic_ui <- renderUI({ + event <- event_data + generate_event_ui(event, input$language) + }) + + + + # Update UI elements when language changes + observeEvent(input$language, { + updateSelectInput(session, "selected_event", + choices = sapply(parsed_schema, function(event) event$title[[input$language]]) + ) + + if (!is.null(input$selected_event)) { + # Find the event by matching the title + selected_event_title <- input$selected_event + event <- NULL + for (e in parsed_schema) { + if (e$title[[input$language]] == selected_event_title) { + event <- e + break + } + } + + if (!is.null(event)) { + # Update UI elements for the selected event + lapply(names(event$properties), function(prop_name) { + element <- event$properties[[prop_name]] + if (!is.null(element) && !is.null(element$type)) { + tryCatch( + { + update_ui_element(session, element, NULL, input$language) + }, + error = function(e) { + warning(paste("Error updating UI element:", prop_name, "-", e$message)) + } + ) + } + }) + } + } + }) +} diff --git a/R/parser/app_ui.R b/R/parser/app_ui.R new file mode 100644 index 0000000..3a66054 --- /dev/null +++ b/R/parser/app_ui.R @@ -0,0 +1,54 @@ +#' The application User-Interface +#' +#' This function creates the user interface for the Shiny application. +#' It defines the layout, input controls, and output elements that +#' users will interact with. +#' +#' @param request Internal parameter for `{shiny}`. +#' DO NOT REMOVE. +#' +#' @import shiny +#' @importFrom golem add_resource_path activate_js favicon bundle_resources + + +app_ui <- function(request) { + fluidPage( + shinyjs::useShinyjs(), + titlePanel("Field Activity Parser"), + sidebarLayout( + sidebarPanel( + selectInput("language", "Select Language", choices = c("en", "fi", "sv")), + # uiOutput("event_selector") + ), + mainPanel( + uiOutput("dynamic_ui") + ) + ) + ) +} + + +#' Add external Resources to the Application +#' +#' This function is internally used to add external +#' resources inside the Shiny application. +#' +#' @import shiny +#' @importFrom golem add_resource_path activate_js favicon bundle_resources +#' @noRd +golem_add_external_resources <- function() { + add_resource_path( + "www", + app_sys("app/www") + ) + + tags$head( + favicon(), + bundle_resources( + path = app_sys("app/www"), + app_title = "fieldactivityParser" + ) + # Add here other external resources + # for example, you can add shinyalert::useShinyalert() + ) +} diff --git a/R/parser/fct_parser.R b/R/parser/fct_parser.R new file mode 100644 index 0000000..fd5ad19 --- /dev/null +++ b/R/parser/fct_parser.R @@ -0,0 +1,234 @@ +#' Parse JSON Schema +#' +#' This function takes a complete JSON schema and parses it into a structured format +#' that can be used for UI generation and data validation. +#' +#' @param schema A list representing the complete JSON schema +#' +#' @return A list containing parsed schema information for each event type +#' +#' @details +#' The function iterates through each event in the schema's 'oneOf' array and +#' parses it using the `parse_event` function. The resulting structure is organized +#' by event type. +#' +#' @examples +#' schema <- jsonlite::fromJSON("schema.json", simplifyVector = FALSE) +#' parsed_schema <- parse_json_schema(schema) +parse_json_schema <- function(schema) { + # Iterate through each event in the schema's oneOf array + # for (event in schema) { + # event_type <- event$properties$mgmt_operations_event$const + # parsed_schema[[event_type]] <- parse_event(event, schema) + # } + + event <- parse_event(schema, schema) + + return(event) +} + + +#' Parse Individual Event +#' +#' This function parses a single event from the JSON schema, including its properties +#' and any 'oneOf' sections. +#' +#' @param event A list representing an event in the schema +#' @param schema The complete JSON schema (used for reference if needed) +#' +#' @return A list containing parsed event information, including: +#' - title: A list of titles in different languages +#' - properties: A list of parsed properties for the event +#' - oneOf: A list of parsed options for 'oneOf' sections (if present) +#' +#' @details +#' The function processes each property of the event and any 'oneOf' sections, +#' creating a structured representation of the event. +#' +#' @examples +#' event <- schema$oneOf[[1]] +#' parsed_event <- parse_event(event, schema) +parse_event <- function(event, schema) { + parsed_event <- list( + title = get_multilingual_field(event, "title"), + properties = list(), + oneOf = list() + ) + + # Parse each property of the event + for (prop_name in names(event$properties)) { + prop <- event$properties[[prop_name]] + parsed_event$properties[[prop_name]] <- parse_property(prop, schema) + } + + # Parse oneOf field if present + if (!is.null(event$oneOf)) { + parsed_event$oneOf <- lapply(event$oneOf, function(option) { + list( + title = get_multilingual_field(option, "title"), + properties = lapply(option$properties, function(p) parse_property(p, schema)), + oneOf = lapply(option$oneOf, function(p) { + parse_event(p, schema) + }) + ) + }) + } + + return(parsed_event) +} + + +#' Parse a single property from the JSON schema +#' +#' This function takes a property object from the JSON schema and processes it +#' to create a structured representation that can be used to generate UI elements. +#' It handles various property types, including the 'oneOf' case for multiple options. +#' +#' @param prop A list representing a single property from the JSON schema +#' @param schema The complete JSON schema (used for reference if needed) +#' +#' @return A list containing the parsed property information, including: +#' - type: The data type of the property +#' - title: A list of titles in different languages +#' - description: A list of descriptions in different languages (if available) +#' - enum: A list of possible values for enum types +#' - minimum: The minimum value for numeric types (if applicable) +#' - maximum: The maximum value for numeric types (if applicable) +#' - oneOf: A list of parsed options for 'oneOf' properties +#' - Other fields specific to the property type +#' +#' @details +#' The function handles various property types, including strings, numbers, +#' booleans, and the special 'oneOf' case. For 'oneOf' properties, it recursively +#' parses each option and its properties. +#' +#' @examples +#' prop <- list( +#' type = "string", +#' title = "Example Property", +#' enum = c("Option 1", "Option 2") +#' ) +parse_property <- function(prop, schema) { + parsed_prop <- list( + title = get_multilingual_field(prop, "title"), + type = prop$type + ) + + if (!is.null(prop$format)) { + if (prop$format == "date") { + parsed_prop$type <- "date" + } else if (prop$format == "url") { + parsed_prop <- list() + return(parsed_prop) + } + } + + if (!is.null(prop$allOf)) { + # Handle allOf properties (typically used for references) + parsed_prop$type <- "select" + ref <- prop$allOf[[2]]$`$ref` + if (!is.null(ref)) { + ref_path <- strsplit(sub("^#/", "", ref), "/")[[1]] + ref_def <- Reduce(`[[`, ref_path, schema) + if (!is.null(ref_def$oneOf)) { + parsed_prop$choices <- lapply(ref_def$oneOf, function(choice) { + list(title = get_multilingual_field(choice, "title"), value = choice$const) + }) + } + } + } + + if (!is.null(prop$items)) { + # Handle array items + parsed_prop$items <- parse_property(prop$items, schema) + } + + if (!is.null(prop$properties)) { + # Handle nested object properties + parsed_prop$properties <- lapply(prop$properties, function(p) parse_property(p, schema)) + } + + if (!is.null(prop$`x-ui`)) { + # Handle UI-specific properties + parsed_prop$ui <- prop$`x-ui` + } + + if (!is.null(prop$minimum)) parsed_prop$minimum <- prop$minimum + if (!is.null(prop$maximum)) parsed_prop$maximum <- prop$maximum + + if (!is.null(prop$oneOf)) { + parsed_prop$oneOf <- lapply(prop$oneOf, function(option) { + parsed_option <- list( + title = if (!is.null(option$title)) { + get_multilingual_field(option, "title") + } else { + list(en = option$const, fi = option$const, sv = option$const) + }, + value = option$const + ) + + # print(paste0("parsing oneOf for ", parsed_prop$title$en)) + + # Recursively parse nested properties + if (!is.null(option$properties)) { + parsed_option$properties <- lapply(option$properties, function(p) parse_property(p, schema)) + } + + return(parsed_option) + }) + parsed_prop$type <- "select" + } + + + return(parsed_prop) +} + + + +#' Get Multilingual Field +#' +#' This function extracts multilingual values for a given field from an object. +#' +#' @param obj A list containing multilingual fields +#' @param field The base name of the field +#' +#' @return A list of multilingual values with keys 'en', 'fi', and 'sv' +#' +#' @details +#' The function looks for the base field name and its language-specific variants +#' (e.g., "field_fi" and "field_sv") in the provided object. +#' +#' @examples +#' obj <- list( +#' title = "Example", +#' title_fi = "Esimerkki", +#' title_sv = "Exempel" +#' ) +get_multilingual_field <- function(obj, field) { + languages <- c("en", "fi", "sv") + result <- list() + + for (lang in languages) { + field_name <- if (lang == "en") field else paste0(field, "_", lang) + value <- obj[[field_name]] + + if (!is.null(value)) { + result[[lang]] <- value + } else if (lang != "en") { + # Fallback to English if the language-specific field is not found + result[[lang]] <- obj[[field]] + } + } + + # If English is not available, use the first non-null value + if (is.null(result[["en"]])) { + first_non_null <- Find(function(x) !is.null(x), result) + for (lang in languages) { + if (is.null(result[[lang]])) { + result[[lang]] <- first_non_null + } + } + } + + return(result) +} diff --git a/R/parser/fct_ui.R b/R/parser/fct_ui.R new file mode 100644 index 0000000..9d81b7a --- /dev/null +++ b/R/parser/fct_ui.R @@ -0,0 +1,369 @@ +#' Create UI elements based on parsed schema +#' +#' This function generates the main UI structure for the fertilizer application form +#' based on the parsed JSON schema. +#' +#' @param parsed_schema A list containing the parsed schema structure +#' @param ns A namespace function for Shiny module compatibility +#' @param language The current language code (e.g., "en" for English) +#' +#' @return A tagList containing all UI elements for the fertilizer application form +#' +#' @details +#' The function iterates through each event in the parsed schema and creates UI elements +#' for both common properties and oneOf sections. It uses helper functions +#' create_properties_ui() and create_oneof_ui() to generate these elements. +#' +#' @examples +#' parsed_schema <- parse_json_schema(schema) +create_ui <- function(parsed_schema, ns, language = "en") { + ui_elements <- lapply(parsed_schema, function(event) { + event_oneof <- create_oneof_ui(event$oneOf, ns, language) + event_properties <- create_properties_ui( + event$properties, ns, language, + event_oneof$id, event_oneof$options + ) + tagList(event_properties, event_oneof$elements) + }) + + return(tagList(ui_elements)) +} + + +#' Create UI elements for a set of properties +#' +#' This function generates Shiny UI elements based on the parsed properties +#' from the JSON schema. It handles various property types and creates +#' appropriate input widgets, including the special case for 'oneOf' properties. +#' +#' @param properties A list of parsed properties (output from parse_property) +#' @param ns A namespace function for Shiny module compatibility +#' @param language The current language code (e.g., "en" for English) +#' +#' @return A list of Shiny UI elements corresponding to the input properties +#' +#' @details +#' The function creates UI elements for each property, handling different types: +#' - For simple types (string, number, boolean), it calls create_widget() +#' - For 'oneOf' properties, it creates a select input for choosing the option, +#' and nested property inputs for each option +#' +#' For 'oneOf' properties, the function: +#' 1. Creates a select input for choosing between options +#' 2. Generates UI elements for each option's properties +#' 3. Implements JavaScript to show/hide property inputs based on selection +#' +#' @examples +#' properties <- list( +#' name = list(type = "string", title = list(en = "Name")), +#' age = list(type = "number", title = list(en = "Age")) +#' ) +create_properties_ui <- function(properties, ns, language = "en", oneof_id = NULL, oneof_options = NULL) { + lapply(names(properties), function(prop_name) { + prop <- properties[[prop_name]] + if (!is.null(prop$oneOf)) { + # print(paste0("building ui for ", prop_name)) + # Handle oneOf properties + oneof_id <- ns(paste0(prop_name, "_oneof")) + + # Create options with an empty default option + oneof_options <- + setNames( + sapply(prop$oneOf, function(option) option$value), + sapply(prop$oneOf, function(option) { + if (!is.null(option$title) && !is.null(option$title[[language]])) { + option$title[[language]] + } else { + option$value + } + }) + ) + + + oneof_select <- selectInput(oneof_id, + label = h4(prop$title[[language]]), + choices = oneof_options, + selected = "" + ) + + # Create a uiOutput for nested properties + nested_properties_id <- ns(paste0(prop_name, "_nested")) + nested_properties <- uiOutput(nested_properties_id) + + div( + oneof_select, + nested_properties + ) + } else if (prop$type == "array" && !is.null(prop$items) && prop$items$type == "object") { + # Handle array of objects + array_title <- h4(prop$title[[language]]) + array_items <- create_properties_ui(prop$items$properties, ns, language) + div( + array_title, + div(class = "array-items", array_items) + ) + } else if (prop$type == "object" && !is.null(prop$properties)) { + # Handle nested objects + object_title <- h4(prop$title[[language]]) + object_properties <- create_properties_ui(prop$properties, ns, language) + div( + object_title, + div(class = "object-properties", object_properties) + ) + } else { + # Create individual widget for other property types + div( + create_widget(prop, ns, language, oneof_id, oneof_options) + ) + } + }) +} + + +#' Create UI elements for oneOf sections +#' +#' This function generates UI elements for the oneOf sections in the schema, +#' allowing users to select between different options. +#' +#' @param oneof A list containing the oneOf options from the parsed schema +#' @param ns A namespace function for Shiny module compatibility +#' @param language The current language code (e.g., "en" for English) +#' +#' @return A tagList containing UI elements for the oneOf section +#' +#' @details +#' The function creates a select input for choosing between oneOf options and +#' generates conditional panels for each option's properties. It uses +#' create_properties_ui() to generate UI elements for each option's properties. +#' +#' @examples +#' oneof <- parsed_schema$fertilizer$oneOf +#' oneof_ui <- create_oneof_ui(oneof, ns, "en") +create_oneof_ui <- function(oneof, ns, language = "en", parent = "oneof_select") { + if (length(oneof) == 0) { + return(NULL) + } + + + oneof_id <- ns(paste0(parent, "_oneof")) + oneof_options <- c(" " = " ", sapply(seq_along(oneof), function(i) { + option <- oneof[[i]] + if (!is.null(option$title) && !is.null(option$title[[language]])) { + option$title[[language]] + } else { + paste("Option", i) + } + })) + + oneof_select <- selectInput(oneof_id, label = "Select an option", choices = oneof_options) + + oneof_properties_ui <- lapply(seq_along(oneof), function(i) { + option <- oneof[[i]] + + nested_oneof_ui <- NULL + if (!is.null(option$oneOf)) { + nested_oneof_ui <- create_oneof_ui(option$oneOf, ns, language, paste0(parent, "_", i)) + } + option_properties <- create_properties_ui(option$properties, ns, language, nested_oneof_ui$id, nested_oneof_ui$options) + + conditionalPanel( + condition = sprintf("input['%s'] === '%s'", oneof_id, option$title[[language]]), + tagList(option_properties, nested_oneof_ui$elements) + ) + }) + + return_list <- list(elements = tagList( + # oneof_select, + oneof_properties_ui + ), id = oneof_id, options = oneof_options) +} + + +#' Create individual widget for a property +#' +#' This function generates an appropriate Shiny input widget based on the +#' property type and attributes. +#' +#' @param element A parsed property structure +#' @param ns A namespace function for Shiny module compatibility +#' @param language The current language code (e.g., "en" for English) +#' +#' @return A tagList containing the input widget and validation element +#' +#' @details +#' The function creates different types of input widgets based on the property type: +#' - select: Creates a selectInput with choices from oneOf or choices attribute +#' - number: Creates a numericInput with min and max constraints +#' - string: Creates a textInput or textAreaInput based on UI specifications +#' It also adds a validation element for each input. +#' +#' @examples +#' element <- list(type = "number", title = list(en = "Age"), minimum = 0, maximum = 120) +#' widget <- create_widget(element, ns, "en") +create_widget <- function(element, ns = NS(NULL), language = "en", oneof_id = NULL, oneof_options = NULL) { + if (is.null(element$type)) { + return(NULL) + } + + element_label <- element$title[[language]] + element_code_name <- ns(make.names(element_label)) + + input_element <- switch(element$type, + "select" = { + choices <- if (!is.null(element$oneOf)) { + print(element$oneOf) + setNames( + sapply(element$oneOf, function(choice) choice$value), + sapply(element$oneOf, function(choice) choice$title[[language]]) + ) + } else if (!is.null(element$choices)) { + setNames( + sapply(element$choices, function(choice) choice$value), + sapply(element$choices, function(choice) choice$title[[language]]) + ) + } else { + NULL + } + selectInput( + inputId = element_code_name, label = element_label, + choices = choices, + selected = NULL + ) + }, + "number" = { + numericInput( + inputId = element_code_name, + label = element_label, + value = NULL, + min = if (!is.null(element$minimum)) element$minimum else NA, + max = if (!is.null(element$maximum)) element$maximum else NA + ) + }, + "string" = { + if (!is.null(element$ui) && !is.null(element$ui$`form-type`)) { + if (element$ui$`form-type` == "textAreaInput") { + textAreaInput( + inputId = element_code_name, + label = element_label, + value = "", + resize = "vertical", + placeholder = if (!is.null(element$ui$`form-placeholder`)) element$ui$`form-placeholder` else "" + ) + } else { + textInput( + inputId = element_code_name, + label = element_label, + value = "", + placeholder = if (!is.null(element$ui$`form-placeholder`)) element$ui$`form-placeholder` else "" + ) + } + } else { + textInput( + inputId = element_code_name, + label = element_label, + value = "", + placeholder = if (!is.null(element$ui$`form-placeholder`)) element$ui$`form-placeholder` else "" + ) + } + }, + "date" = { + dateInput( + inputId = element_code_name, + label = element_label, + value = NULL + ) + }, + NULL # Default case for unknown types + ) + + if (!is.null(element$ui) && !is.null(element$ui$oneOf) && !is.null(oneof_id)) { + input_element <- selectInput(oneof_id, label = element_label, choices = oneof_options) + } + + validation_id <- paste0(element_code_name, "_validation") + + tagList( + div( + class = "form-group", + input_element, + tags$div(id = validation_id, class = "invalid-feedback") + ) + ) +} + + + +#' Get choices for select inputs +#' +#' This function extracts and formats choices for select input widgets. +#' +#' @param element The parsed property structure +#' @param language The current language code (e.g., "en" for English) +#' +#' @return A named vector of choices for select inputs +#' +#' @details +#' The function handles two cases for select input choices: +#' 1. Choices defined directly in the element +#' 2. Choices referenced from another part of the schema (not implemented) +#' +#' @examples +#' element <- list(type = "select", choices = list( +#' list(value = "a", title = list(en = "Option A")), +#' list(value = "b", title = list(en = "Option B")) +#' )) +#' choices <- get_select_choices(element, "en") +get_select_choices <- function(element, language = "en") { + if (element$type == "select") { + if (!is.null(element$choices)) { + # If choices are defined in the element, use them + choices <- sapply(element$choices, function(choice) choice$value) + names(choices) <- sapply(element$choices, function(choice) choice$title[[language]]) + return(choices) + } else if (!is.null(element$ref)) { + # If choices are referenced, implement logic to fetch them + # For now, return NULL + return(NULL) + } + } + return(NULL) +} + +#' Update UI element +#' +#' This function updates the value of a UI element based on its type. +#' +#' @param session The current Shiny session +#' @param element The element to update +#' @param value The new value +#' @param language The current language code (e.g., "en" for English) +#' +#' @return NULL (updates are performed via side effects) +#' +#' @details +#' The function updates different types of input widgets: +#' - select: Updates choices and selected value +#' - number: Updates numeric value +#' - string: Updates text value (for both textInput and textAreaInput) +#' +#' @examples +#' # Inside a Shiny server function: +#' update_ui_element(session, element, "new value", "en") +update_ui_element <- function(session, element, value, language = "en") { + if (is.null(element) || is.null(element$type)) { + return(NULL) + } + + element_code_name <- NS("dynamic")(names(element)[1]) + + # Update the UI element based on its type + if (element$type == "select") { + updateSelectInput(session, element_code_name, choices = get_select_choices(element, language), selected = value) + } else if (element$type == "number") { + updateNumericInput(session, element_code_name, value = value) + } else if (element$type == "string" && !is.null(element$ui) && element$ui$`form-type` == "textAreaInput") { + updateTextAreaInput(session, element_code_name, value = value) + } else if (element$type == "string") { + updateTextInput(session, element_code_name, value = value) + } +} diff --git a/R/run_app.R b/R/run_app.R new file mode 100644 index 0000000..d4984e8 --- /dev/null +++ b/R/run_app.R @@ -0,0 +1,57 @@ +#' Run the Shiny Application +#' +#' @param json_file_path Path to a folder used to store the generated .json files +#' @param user_db_path Path to a Shinymanager user database +#' @param user_db_passphrase The passphrase of the user database +#' @param ... arguments to pass to golem_opts. +#' See `?golem::get_golem_options` for more details. +#' @inheritParams shiny::shinyApp +#' +#' @export +#' @importFrom shiny shinyApp +#' @importFrom golem with_golem_options +run_app <- function( + json_file_path, + user_db_path, + user_db_passphrase, + onStart = NULL, + options = list(), + enableBookmarking = NULL, + uiPattern = "/", + ... +) { + + ui <- app_ui + if (golem::app_prod()) { + # set the language of the login UI before it is displayed + set_login_language(init_lang) + # wrap the UI in shinymanager to display the login UI + ui <- shinymanager::secure_app( + ui, + tags_bottom = + tags$div( + selectInput("login_language", + label = "" , + choices = languages), + mod_select_lan("auth_text")), + + + theme = bslib::bs_theme(version = 4), + enable_admin = TRUE, + fab_position = "top-right") + } + + with_golem_options( + app = shinyApp( + ui = ui, + server = app_server, + onStart = onStart, + options = options, + enableBookmarking = enableBookmarking, + uiPattern = uiPattern + ), + golem_opts = list(json_file_path = json_file_path, + user_db_path = user_db_path, + user_db_passphrase = user_db_passphrase, ...) + ) +} diff --git a/R/utils_global.R b/R/utils_global.R new file mode 100644 index 0000000..8f9189a --- /dev/null +++ b/R/utils_global.R @@ -0,0 +1,29 @@ +# missing value in the ICASA standard +missingval <- "-99.0" +date_format_json <- "%Y-%m-%d" +date_format_display <- "%d/%m/%Y" + +# read the csv file containing the sites +#sites_file_path <- "data/FOsites.csv" +# the path is wrapped inside a function because of this: +# https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html +# see: “Paths hard-coded in R code” +sites_file_path <- function() system.file("extdata", "FOsites.csv", + package = "fieldactivity") +sites <- read.csv(sites_file_path()) +# converts block info from csv (e.g. "[0;1]") to vectors of strings ("0" "1") +blocks_to_vector <- function(x) strsplit(substr(x, start = 2, stop = nchar(x)-1), ";") +sites$blocks <- sapply(sites$blocks, blocks_to_vector) + +# options for UI languages +# languages match the names of columns in display_names.csv +# when you give a named vector as the choices for selectInput, the names +# rather than the values will be displayed +# the \U codes are UTF-8 flag emojis +languages <- c("English \U0001f1ec\U0001f1e7" = "disp_name_eng", + "suomi \U0001f1eb\U0001f1ee" = "disp_name_fin") +init_lang <- languages[1] + +# whether to print debug information (short for debug print) +# set the boolean value below to FALSE to suppress prints +dp <- function() TRUE #&& golem::app_dev() \ No newline at end of file diff --git a/R/utils_validation.R b/R/utils_validation.R new file mode 100644 index 0000000..c06480e --- /dev/null +++ b/R/utils_validation.R @@ -0,0 +1,13 @@ +#' Check whether the value of a dateRangeInput is valid +#' +#' @description Both dates need to be supplied for the value to be considered +#' valid, and the start date needs to be on or before the end date +#' +#' @param value The value of the dataRangeInput to validate +#' +#' @return TRUE if value is valid, FALSE if not +valid_dateRangeInput <- function(value) { + date1 = value[1] + date2 = value[2] + isTruthy(date1) && isTruthy(date2) && date1 <= date2 +} \ No newline at end of file diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..ea546c1 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,65 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "man/figures/README-", + out.width = "100%" +) +``` + +# R Shiny app for management data input + + +[![R-CMD-check](https://github.com/Ottis1/fieldactivity/workflows/R-CMD-check/badge.svg)](https://github.com/Ottis1/fieldactivity/actions) + + +An app for keeping track of field activity in the [Field Observatory](https://www.fieldobservatory.org) project. Built using [Shiny](http://shiny.rstudio.com/) and [Golem](https://thinkr-open.github.io/golem/), the application allows farmers to enter information about common farming events like tillage, sowing and harvest. These event data are stored in .json files, which mostly follow the ICASA standards for agricultural data. + +## Installation + + + +You can install the app from [GitHub](https://github.com/) with: + +``` r +# install.packages("devtools") +devtools::install_github("PecanProject/fieldactivity") +``` +## Running the app + +To run the app, call `run_app` with the following arguments to define the json file directory, the user database and the passphrase to the user database: +```{r example, eval=FALSE} +options(golem.app.prod = TRUE) # run in production mode to enable user authentication + +fieldactivity::run_app(json_file_path = "~/my_json_file_folder", + user_db_path = "~/my_user_database.sqlite", + user_db_passphrase = "password123") +``` +Check out the documentation of [Shinymanager](https://datastorm-open.github.io/shinymanager/) (the user authentication system used in the app) to find out how to create the user database. You can also use the supplied R script in `dev/create_user_db.R` for this purpose. + +## Modifying the code + +To modify the code, clone the repository and set the working directory in R to the package folder (or open the RStudio project file `fieldactivity.Rproj`). You should now be able to run the app by running +```{r, eval = FALSE} +golem::run_dev() +``` +Modify `dev/run_dev.R` if necessary, this is the file which `golem::run_dev()` runs. + + +## Meta + +Links that might interest you: + +- [Webpage](https://pecanproject.github.io/fieldactivity/) +- [Issues](https://github.com/PecanProject/fieldactivity/issues) \ No newline at end of file diff --git a/README.md b/README.md index 8b2a7f6..2e87a8f 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,73 @@ + + + # R Shiny app for management data input -## Field Observatory -This is an application with the ultimate purpose of allowing farmers to input field management data. The farmer may input information related to management such as the dates when harvesting and tilling were performed. + + +[![R-CMD-check](https://github.com/Ottis1/fieldactivity/workflows/R-CMD-check/badge.svg)](https://github.com/Ottis1/fieldactivity/actions) + + +An app for keeping track of field activity in the [Field +Observatory](https://www.fieldobservatory.org) project. Built using +[Shiny](http://shiny.rstudio.com/) and +[Golem](https://thinkr-open.github.io/golem/), the application allows +farmers to enter information about common farming events like tillage, +sowing and harvest. These event data are stored in .json files, which +mostly follow the ICASA standards for agricultural data. + +## Installation + + + +You can install the app from [GitHub](https://github.com/) with: + +``` r +# install.packages("devtools") +devtools::install_github("PecanProject/fieldactivity") +``` + +## Running the app + +To run the app, call `run_app` with the following arguments to define +the json file directory, the user database and the passphrase to the +user database: + +``` r +options(golem.app.prod = TRUE) # run in production mode to enable user authentication + +fieldactivity::run_app(json_file_path = "~/my_json_file_folder", + user_db_path = "~/my_user_database.sqlite", + user_db_passphrase = "password123") +``` + +Check out the documentation of +[Shinymanager](https://datastorm-open.github.io/shinymanager/) (the user +authentication system used in the app) to find out how to create the +user database. You can also use the supplied R script in +`dev/create_user_db.R` for this purpose. + +## Modifying the code + +To modify the code, clone the repository and set the working directory +in R to the package folder (or open the RStudio project file +`fieldactivity.Rproj`). You should now be able to run the app by running + +``` r +golem::run_dev() +``` + +Modify `dev/run_dev.R` if necessary, this is the file which +`golem::run_dev()` runs. + +## Meta + +Links that might interest you: -The goal is to produce a .json file based on the given information. \ No newline at end of file +- [Webpage](https://pecanproject.github.io/fieldactivity/) +- [Issues](https://github.com/PecanProject/fieldactivity/issues) diff --git a/app.R b/app.R deleted file mode 100644 index 533b748..0000000 --- a/app.R +++ /dev/null @@ -1,1708 +0,0 @@ -## R Shiny App for Management Data Input -## Field Observatory -# Otto Kuusela 2021 - -library(shiny) -library(jsonlite) -library(shinyjs) # shinyjs is used for e.g. disabling action buttons -library(shinymanager) # for user authentication -library(bslib) # change theme -#library(keyring) # for interacting with system credential store to store db key -library(DT) # fancier data table -library(glue) # used for debug printing -library(stringr) # used esp in evaluate_condition -library(tools) # used to get file extension of uploaded images - -#### AUTHENTICATION STUFF - -# developer mode. If TRUE, logging in is disabled -dev_mode <- TRUE - -# failsafe: ask for the db key only if we really want to. Has to be set by hand -set_db_key <- FALSE -# if the database encryption key is not found and we want to set the key, -# we ask the user to define it -#if (nrow(key_list("FO-mgmt-events-key")) == 0) { -# # throw exception if there is no key and we don't want to define it -# stopifnot(set_db_key) -# -# key_set("FO-mgmt-events-key", "FO-mgmt-events-user") -#} - -# define some credentials -#credentials <- data.frame( -# user = c("shiny", "shinymanager"), # mandatory -# password = c("azerty", "12345"), # mandatory -# admin = c(FALSE, TRUE), -# comment = "Simple and secure authentification mechanism -# for single ‘Shiny’ applications.", -# stringsAsFactors = FALSE -#) - -# Init the database -#create_db( -# credentials_data = credentials, -# sqlite_path = "data/database.sqlite", # will be created -# passphrase = key_get("FO-mgmt-events-key", "FO-mgmt-events-user") -# # passphrase = "passphrase_wihtout_keyring" -#) - -# missing value in the ICASA standard -missingval <- "-99.0" -date_format_json <- "%Y-%m-%d" - -#### / AUTHENTICATION STUFF - -# make helper functions and modules available -source("display_name_helpers.R") -source("table.R") -source("ui_builder.R") -source("json_file_helpers.R") - -# read the csv file containing the sites -sites_file_path <- "data/FOsites.csv" -sites <- read.csv(sites_file_path) - -# converts block info from csv (e.g. "[0;1]") to vectors of strings ("0" "1") -blocks_to_vector <- function(x) strsplit(substr(x, start = 2, stop = nchar(x)-1), ";") -sites$blocks <- sapply(sites$blocks, blocks_to_vector) - -# options for UI languages -# languages match the names of columns in display_names.csv -# when you give a named vector as the choices for selectInput, the names -# rather than the values will be displayed -languages <- c("English 🇬🇧" = "disp_name_eng", - "suomi 🇫🇮" = "disp_name_fin") - -# sets the specified input fields to their default states. -# this doesn't reset the tables (e.g. harvest_crop_table) -- they reset -# themselves every time they become hidden -# TODO: make sure this is always used -reset_input_fields <- function(session, input, fields_to_clear, - exceptions = c("")) { - - # we never want to clear the site or block - exceptions <- c(exceptions, "site", "block") - - for (code_name in fields_to_clear) { - if (code_name %in% exceptions) next - update_ui_element(session, code_name, clear_value = TRUE) - } - -} - -# takes a list of events and makes a data table with given variables in columns. -# also adds a column with the complete event list and a final column for -# ordering the list by date. -# The function doesn't replace code names with display names. That is done -# separately so that when the app language is switched, we can change the -# table display names without having to create it again. -get_data_table <- function(events, variable_names) { - # initialise table - display_data_table <- data.frame() - for (variable_name in variable_names) { - - # get corresponding element and determine whether the column type should - # be list or character - element <- structure_lookup_list[[variable_name]] - #if (!is.null(element$multiple)) { - display_data_table[[variable_name]] <- list() - #} else { - # display_data_table[[variable_name]] <- character() - #} - - } - # the event column will hold the complete event information as a list - display_data_table$event <- list() - # the date_ordering column will hold dates for ordering table - display_data_table$date_ordering <- character() - - row_number <- 1 - for (event in events) { - - for (variable_name in variable_names) { - value <- event[[variable_name]] - if (is.null(value)) { - value <- "" - } - display_data_table[[row_number, variable_name]] <- value - # if value is a vector, it will be turned into a single string - # when the table is converted to a table with display names - } - - # double brackets allow saving a list nicely - display_data_table[[row_number, "event"]] <- event - display_data_table[row_number, "date_ordering"] <- - as.Date(event$date, format = date_format_json) - - row_number <- row_number + 1 - } - return(display_data_table) -} - -# find the (first) index corresponding to the given event in the list of events. -# This is used when editing events -find_event_index <- function(event, event_list) { - - if (length(event_list) == 0) { return(NULL) } - - # sort the items in the lists to the same order (alphabetical) - event <- event[order(names(event))] - - # go through all rows in the event list and check if any of them match - for (i in 1:length(event_list)) { - - list_event <- event_list[[i]] - list_event <- list_event[order(names(list_event))] - - if (identical(event, list_event)) { - return(i) - } - - } - - # We didn't find a match, so return NULL - return(NULL) -} - -# if a variable is in a table (e.g. planting_depth is in a table when -# planted_crop has multiple values), return the code name of that table. -# Otherwise return NULL. -# only_values determines which variables we seek: -# TRUE: only return the table code name if the variable is one whose -# value is entered in the table, e.g. all variables in fertilizer_element_table -# but not harvests_crop in harvest_crop_table, since harvest_crop's value is -# entered in a regular widget. -# FALSE: return table code name if variable is present in the table in any -# form, e.g. harvest_crop also returns harvest_crop_table since it is on the -# rows of that table -get_variable_table <- function(variable_name, only_values = FALSE) { - - for (table_code_name in data_table_code_names) { - table <- structure_lookup_list[[table_code_name]] - - # determine the variable names to check if they match variable_name - names_to_check <- if (is.null(table$columns)) { - # if columns is not defined, the table is in custom mode (e.g. - # fertilizer_element_table) and all variables (stored in rows) are - # to be checked - unlist(table$rows) - } else { - # in a normal table, the “value variables” are given in the columns - if (!only_values) { - c(table$rows, table$columns) - } else { - table$columns - } - } - - if (variable_name %in% names_to_check) { - return(table_code_name) - } - } - - return(NULL) -} - -# js_unbind_script <- paste(sep = "", -# "Shiny.addCustomMessageHandler('unbind-table', function(id) {", -# #alert($('#'+id).find('.shiny-input-container').length); -# "Shiny.unbindAll($('#'+id).find('.shiny-input-container')); -# })") - -# Define UI for the application -# some of the UI (esp. additional options for activities) will be generated -# by create_ui in ui_builder.R -ui <- fluidPage(theme = bslib::bs_theme(version = 4, bootswatch = "lumen"), - useShinyjs(), # enable shinyjs - - includeScript("www/script.js"), - #tags$head(tags$script(HTML(js_unbind_script))), - - selectInput("language", choices = languages, width = "120px", label = ""), - - # adding "" to the choices makes the default choice empty - shinyjs::hidden(selectInput("site", label = "", - choices = c("", sites$site))), - - # set web page title - titlePanel("", windowTitle = "Field Observatory"), - - # title to be displayed on the page - h1(textOutput("window_title")), - - # show instructions - div(style = "max-width:500px;", textOutput("frontpage_text")), - - h2(textOutput("frontpage_table_title")), - - # selector to filter table data - div(style="display: inline-block;vertical-align:middle;", - textOutput("table_filter_text_1", inline = TRUE)), - div(style="display: inline-block;vertical-align:middle;", - selectInput("table_activity", label = "", choices = c(""), - width = "150px")), - div(style="display: inline-block;vertical-align:middle;", - textOutput("table_filter_text_2", inline = TRUE)), - div(style="display: inline-block;vertical-align:middle;", - selectInput("table_block", label = "", choices = c(""), - width = "100px")), - div(style="display: inline-block;vertical-align:middle;", - textOutput("table_filter_text_3", inline = TRUE)), - div(style="display: inline-block;vertical-align:middle;", - selectInput("table_year", label = "", choices = c(""), - width = "100px")), - div(style="display: inline-block;vertical-align:middle;", "."), - - # front page data table - DT::dataTableOutput("mgmt_events_table"), - - # add a little space between the elements - br(), - - actionButton("add_event", label = ""), - shinyjs::disabled(actionButton("clone_event", label = "")), - - br(), - br(), - - # create a sidebar layout - #shinyjs::hidden(div(id = "sidebar", sidebarLayout( - shinyjs::hidden(div(id = "sidebar", wellPanel( - # the sidebar contains the selectors for entering information - # about the event - #sidebarPanel(width = 12, - fluidRow( - column(width = 3, - h3(textOutput("sidebar_title"), - style = "margin-bottom = 0px; margin-top = 0px; - margin-block-start = 0px"), - - # in general the choices and labels don't have to be - # defined for selectInputs, as they will be - # populated when the language is changed - # (which also happens when the app starts) - - span(textOutput("required_variables_helptext"), - style = "color:gray"), - br(), - - selectInput("block", label = "", choices = ""), - - selectInput("mgmt_operations_event", label = "", - choice = ""), - - # setting max disallows inputting future events - dateInput( - "date", - format = "dd/mm/yyyy", - label = "", - max = Sys.Date(), - value = Sys.Date(), - weekstart = 1 - ), - - textAreaInput( - "mgmt_event_notes", - label = "", - placeholder = "", - resize = "vertical", - height = "70px" - ) - ), - - column(width = 9, - # show a detailed options panel for the - # different activities - # activity_options is defined in ui_builder.R - create_ui(activity_options, create_border = FALSE) - )), - - fluidRow( - column(width = 12, - actionButton("save", label = "Save"), - - actionButton("cancel", label = "Cancel"), - - shinyjs::hidden(actionButton("delete", label = "Delete", - class = "btn-warning")) - )) - ) - )) - -) - - -# wrap the ui with the secure_app function which hides the app contents -# until login is successful -if (!dev_mode) { - ui <- secure_app(ui, - # language selector for login page - tags_bottom = selectInput("login_language", - label = "" , - choices = languages), - #tags_top = tagList( - #p("EXAMPLE USER site: ruukki, password: Ruukki1"), - #p("ADMIN site: shinymanager, password: 12345")), - theme = bslib::bs_theme(version = 4, bootswatch = "lumen"), - enable_admin = TRUE, - fab_position = "top-right") -} - - -# Define server logic incl. save button action -server <- function(input, output, session) { - - # run interactive themer - #bs_themer() - - # check_credentials returns a function to authenticate users - # might have to use the hand-typed passphrase option for now when deploying - # to shinyapps.io - credential_checker <- check_credentials( - "data/database.sqlite", - # passphrase = key_get("FO-mgmt-events-key", "FO-mgmt-events-user") - passphrase = "salasana" - ) - - # change login form language when requested - observeEvent(input$login_language, { - #str(reactiveValuesToList(input)) - #updateTextInput(session, "auth-user_id", value = "oma1") - #updateTextInput(session, "auth-user_pwd", value = "oma2") - #shinyjs::click("auth-go_auth") # doesn't work - # yes we are overwriting the English language. This is by far - # the simplest method - - if (input$login_language == "disp_name_fin") { - set_labels( - language = "en", - "Please authenticate" = "Kirjaudu syöttääksesi tapahtumia", - "Username:" = "Sijainti", - "Password:" = "Salasana", - "Login" = "Kirjaudu", - "Logout" = "Kirjaudu ulos" - ) - } else if (input$login_language == "disp_name_eng") { - set_labels( - language = "en", - "Please authenticate" = "Log in to enter management events", - "Username:" = "Site", - "Password:" = "Password", - "Login" = "Login", - "Logout" = "Logout" - ) - } - - # TODO: make the language setting communicate to main app - # PROBLEM: session userData doesn't seem to be saved after - # logging in is complete - - # change the value of the session-specific variable default_language to - # match the login language selector - # session$userData$default_language <- input$login_language - - # this seems to refresh the authentication UI - auth_result <- secure_server(check_credentials = credential_checker) - }) - - # runs when logged in - observeEvent(auth_result$user, { - if (auth_result$admin == "FALSE") { - updateSelectInput(session, "site", selected = auth_result$user) - shinyjs::disable("site") - } else { - shinyjs::enable("site") - shinyjs::show("site") - } - - # here would be good to somehow fetch the language selection from the - # login UI, but it's difficult - }) - - # call the server part of shinymanager - # weird observation: this has to be after the observeEvent block - # which observes the auth_result$user. If it isn't the site selectInput - # selection is not updated to match the username. - auth_result <- secure_server(check_credentials = credential_checker) - - if (dev_mode) { - shinyjs::show("site") - } - - # go through all fields and set maxLength if requested in ui_structure.json - for (element in structure_lookup_list) { - if (!is.null(element$maxlength)) { - js_message <- "$('##code_name').attr('maxlength', #maxlength)" - js_message <- gsub("#code_name", element$code_name, js_message) - js_message <- gsub("#maxlength", element$maxlength, js_message) - shinyjs::runjs(js_message) - } - } - - #frontpage_table_data <- reactiveVal() - #editing_table_data <- reactiveVal() - # initialise in the normal (non-edit) mode - event_to_edit <- reactiveVal() - # lists of events by block on the currently viewed site - # accessed like events$by_block[["0"]] - events <- reactiveValues(by_block = list()) - # per session global variable, indicates whether the currently edited event - # is visible in the front page table - edited_event_visible <- TRUE - # what were the table view choices (table_block, table_activity, table_year) - # before we started editing? - pre_edit_table_view <- NULL - # as fileInput values cannot be reset (even with shinyjs), we need to store - # previous values here (by code_name) to check whether the value has changed - session$userData$previous_fileInput_value <- list() - - observeEvent(event_to_edit(), ignoreNULL = FALSE, ignoreInit = TRUE, { - - if (is.null(event_to_edit())) { - # edit mode was disabled - shinyjs::hide("delete") - shinyjs::disable("clone_event") - - DT::selectRows(proxy = dataTableProxy("mgmt_events_table"), - selected = NULL) - exit_sidebar_mode() - # restore table view settings - updateSelectInput(session, "table_activity", - selected = pre_edit_table_view$activity) - updateSelectInput(session, "table_block", - selected = pre_edit_table_view$block) - updateSelectInput(session, "table_year", - selected = pre_edit_table_view$year) - # clear table view settings - pre_edit_table_view <<- NULL - return() - } - - # edit mode was enabled, or there was a switch from one event to - # another - - # populate the input widgets with the values corresponding to the - # event, and clear others - for (variable_name in get_category_names("variable_name")) { - - # get the value corresponding to this variable from the event. - # might be NULL - value <- event_to_edit()[[variable_name]] - - # determine if this value should be filled in a table - # for now this is a sufficient condition - variable_table <- get_variable_table(variable_name, - only_values = TRUE) - value_in_table <- !is.null(variable_table) & length(value) > 1 - - if (!(variable_name %in% names(event_to_edit())) | value_in_table) { - # clear widget if the event does not contain a value for it - # or value should be shown in a table instead - update_ui_element(session, variable_name, clear_value = TRUE) - } else { - update_ui_element(session, variable_name, value = value) - } - } - - # then go through all the variables in the event and see if any of - # them should be displayed in the table. If yes, fill the table. - # Other tables do not need to be cleared, as they do that by - # themselves when they become hidden. - for (variable_name in names(event_to_edit())) { - variable_table <- get_variable_table(variable_name, - only_values = TRUE) - - if (!is.null(variable_table)) { - prefill_values[[variable_table]](event_to_edit()) - break - } - } - - # save table view (to be restored when editing is over) if no settings - # have been saved previously - if (is.null(pre_edit_table_view)) { - pre_edit_table_view <<- list(activity = input$table_activity, - block = input$table_block, - year = input$table_year) - } - - # change view of the front page table - updateSelectInput(session, "table_activity", - selected = event_to_edit()$mgmt_operations_event) - - shinyjs::show("delete") - shinyjs::show("sidebar") - shinyjs::disable("add_event") - shinyjs::enable("clone_event") - if (dev_mode || auth_result$admin == "TRUE") { - shinyjs::disable("site") - } - - }) - - # exit edit mode - # this is called when saving and when pressing cancel - # TODO: make obsolete - exit_sidebar_mode <- function() { - # reset all input fields - reset_input_fields(session, input, get_category_names("variable_name")) - # hide sidebar - shinyjs::hide("sidebar") - shinyjs::enable("add_event") - if (dev_mode || auth_result$admin == "TRUE") { - shinyjs::enable("site") - } - } - - # load data from all the json files corresponding to a site and store it in - # separate lists in events$by_block - # TODO: move elsewhere, return the list instead of saving it here - # maybe fuse with retrieve_json_info? - load_json_data <- function(site1) { - # clear possible previous data - events$by_block <- list() - - # find all blocks on this site - site_blocks <- subset(sites, site == site1)$blocks[[1]] - - # 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]] <- retrieve_json_info(site1, block) - } - } - - # TODO: this can be sped up by keeping a up-to-date list of event years - update_table_year_choices <- function() { - - years <- NULL - - # find years present in event dates - for (event_list in events$by_block) { - for (event in event_list) { - - # this shouldn't happen - if (is.null(event$date)) next - - year <- format(as.Date(event$date, date_format_json), "%Y") - - if (!(year %in% years)) { years <- c(years, year) } - } - } - - years <- sort(years, decreasing = TRUE) - table_year_choices <- c("year_choice_all", years) - names(table_year_choices) <- get_disp_name(table_year_choices, - input$language) - - # retain current selection if possible - current_choice <- input$table_year - if (!isTruthy(current_choice) || !(current_choice %in% years)) { - current_choice <- "year_choice_all" - } - - updateSelectInput(session, "table_year", selected = current_choice, - choices = table_year_choices) - - } - - update_table_block_choices <- function() { - - if (!isTruthy(input$site)) { return() } - - block_choices <- c("block_choice_all", - subset(sites, site == input$site)$blocks[[1]]) - # the following assumes that no block name is a code name for something - # else - names(block_choices) <- get_disp_name(block_choices, input$language) - - current_choice <- input$table_block - if (!isTruthy(current_choice) || !(current_choice %in% block_choices)) { - current_choice <- "block_choice_all" - } - - updateSelectInput(session, "table_block", selected = current_choice, - choices = block_choices) - } - - update_table_activity_choices <- function() { - - choices_for_table_activity <- - c("activity_choice_all", get_category_names( - "mgmt_operations_event_choice")) - names(choices_for_table_activity) <- - get_disp_name(choices_for_table_activity, input$language) - - current_choice <- input$table_activity - if (!isTruthy(current_choice)) { - current_choice <- "activity_choice_all" - } - - updateSelectInput(session, "table_activity", selected = current_choice, - choices = choices_for_table_activity) - } - - # takes a condition written in javascript notation (visibility conditions - # in ui_structure.json) and evaluates it in R. - # Returns either TRUE or FALSE. If the condition could not be evaluated, - # returns NULL. - # Might not be best coding practice, but works as long as the js_condition - # doesn't have any typos. - evaluate_condition <- function(js_condition) { - - if (is.null(js_condition) || !is.character(js_condition)) { - return(NULL) - } - - # substitute dots with dollar signs - # (fixed = TRUE means we don't use regex) - condition <- gsub("input.", "input$", js_condition, fixed = TRUE) - - # if the condition relates to the length of something, modify it - # to look like R. e.g. change "thing.length > 1" to "length(thing) > 1" - if (str_detect(condition, ".length")) { - length_index <- str_locate(condition, ".length") - start <- str_sub(condition, end = length_index[,"start"]-1) - condition <- paste0("length(", start, ")", - str_sub(condition, - start = length_index[,"end"] + 1)) - } - - # replace 'true' with 'TRUE' and 'false' with 'FALSE' - if (condition == "true") { - condition <- "TRUE" - } else if (condition == "false") { - condition <- "FALSE" - } - - #message(glue("Evaluating condition {condition}")) - - # parse string into an expression and evaluate it - tryCatch( - expr = eval(parse(text = condition)), - error = function(cnd) { - message(glue("Condition {condition} could not be evaluated")) - NULL - } - ) - } - - # update year choices when events change - observeEvent(events$by_block, { - update_table_year_choices() - }) - - # data to display in the table - frontpage_table_data <- reactive({ - - if (!(isTruthy(input$table_activity) & - isTruthy(input$table_block) & - isTruthy(input$table_year))) { - default_variables <- c("block", "mgmt_operations_event", - "date", "mgmt_event_notes") - return(get_data_table(list(), default_variables)) - } - - # determine the columns displayed in the table - table_variables <- c("date", "mgmt_event_notes") - if (input$table_activity == "activity_choice_all") { - table_variables <- c("mgmt_operations_event", table_variables) - } - if (input$table_block == "block_choice_all") { - table_variables <- c("block", table_variables) - } - - # if we are only looking at a specific event type, show columns - # appropriate to it - if (input$table_activity != "activity_choice_all") { - hidden_widget_types <- c("textOutput", "dataTable", "fileInput", - "actionButton") - activity_variables <- unlist(rlapply( - activity_options[[input$table_activity]], - fun = function(x) { - if (is.null(x$type) || x$type %in% hidden_widget_types || - identical(x$hide_in_table, TRUE)) { - NULL - } else { - x$code_name - } - })) - table_variables <- c(table_variables, activity_variables) - } - - # create an event list filtered by user choices - # filter by block - if (input$table_block == "block_choice_all") { - event_list <- list() - for (block_data in events$by_block) { - event_list <- c(event_list, block_data) - } - } else { - event_list <- events$by_block[[input$table_block]] - } - - # filter by activity type - if (input$table_activity != "activity_choice_all") { - event_list <- rlapply(event_list, fun = function(x) - if (x$mgmt_operations_event == input$table_activity) {x}) - } - - # filter by year - if (input$table_year != "year_choice_all") { - event_list <- rlapply(event_list, fun = function(x) { - event_year <- format(as.Date(x$date, date_format_json), "%Y") - if (event_year == input$table_year) {x} - }) - } - - # make event list into a table - data <- get_data_table(event_list, table_variables) - data - - # update currently displayed data - #new_data_to_display <- replace_with_display_names(data, input$language) - #DTproxy <- DT::dataTableProxy("mgmt_events_table", session = session) - #DT::replaceData(DTproxy, new_data_to_display, rownames = FALSE, - # clearSelection = "none") - }) - - # enable editing of old entries - observeEvent(input$mgmt_events_table_rows_selected, ignoreNULL = FALSE, { - - row_index <- input$mgmt_events_table_rows_selected - - if (is.null(row_index)) { - # if it was the user de-selecting the event, exit edit mode - # (the other alternative is that the currently edited event is not - # visible in the table and therefore no element can be selected) - if (edited_event_visible) { - event_to_edit(NULL) - } - return() - } - - # fetch the event data of the selected row - selected_event_data <- frontpage_table_data()[[row_index,"event"]] - - # set edit mode on. This saves the event we want to edit so that it is - # preserved even if front page table view is changed - event_to_edit(selected_event_data) - - }) - - # cancel means we exit edit mode and hide sidebar controls - observeEvent(input$cancel, { - if (is.null(event_to_edit())) { - exit_sidebar_mode() - } else { - event_to_edit(NULL) - } - }) - - # show add event UI when requested - observeEvent(input$add_event, { - # clear all input fields - #reset_input_fields(session, input, get_category_names("variable_name")) - shinyjs::disable("add_event") - - # if we were not editing previously, copy current table view settings - # (block and activity) into the widgets if they are set to a specific - # value (not "all") - # note: event_to_edit() should be NULL as the add button is disabled - # during editing - if (is.null(event_to_edit())) { - if (!is.null(input$table_activity) && - input$table_activity != "activity_choice_all") { - update_ui_element(session, "mgmt_operations_event", - value = input$table_activity) - } - if (!is.null(input$table_block) && - input$table_block != "block_choice_all") { - update_ui_element(session, "block", value = input$table_block) - } - } - - # exit edit mode if we were in it - event_to_edit(NULL) - - # show sidebar - shinyjs::show("sidebar") - - if (dev_mode || auth_result$admin == "TRUE") { - shinyjs::disable("site") - } - }) - - observeEvent(input$clone_event, { - # fetch the event to be cloned - event <- event_to_edit() - - block_data <- retrieve_json_info(input$site, event$block) - - block_data[[length(block_data) + 1]] <- event - - # save changes - write_json_file(input$site, event$block, block_data) - showNotification("Cloned successfully.", type = "message") - - # update events data - events$by_block[[event$block]] <- block_data - }) - - # save input to a file when save button is pressed - # we are either creating a new event or editing an older one - observeEvent(input$save, { - - # are we editing an existing event or creating a new one? - editing <- !is.null(event_to_edit()) - # let's create a list which we will update to match the event info - event <- if (editing) { - event_to_edit() - } else { - list() - } - orig_block <- event$block - orig_date <- event$date - - # if we are editing, find the index of the event in the original - # block data list. Also, if the block has been changed, update that - # file. If the block has not changed, we will need the index when - # replacing the old event with the updated one. - if (editing) { - - orig_block_data <- retrieve_json_info(input$site, orig_block) - event_index <- find_event_index(event, orig_block_data) - - if (is.null(event_index)) { - showNotification("Could not edit entry because it was not - found in the event files.", type = "error") - return() - } - - # if the block of the event has been changed, delete it from the - # original block file - if (orig_block != input$block) { - orig_block_data[event_index] <- NULL - write_json_file(input$site, orig_block, orig_block_data) - events$by_block[[orig_block]] <- orig_block_data - } - - } - - # fill out current_event to match new / updated data. - # find variables that correspond to the selected activity and save - # only those - widget_list <- activity_options[[input$mgmt_operations_event]] - - relevant_variables <- unlist(rlapply(widget_list, - fun = function(x) x$code_name)) - relevant_variables <- c("block", - "mgmt_operations_event", - "date", - "mgmt_event_notes", - relevant_variables) - # if a variable group's visibility condition evaluates to FALSE, - # the variables in the group are not relevant and they are added to - # the list of variables to be skipped. - # This list may include variables which we don't want to skip but - # will actually want to read from a table, not from a regular widget. - # That will be handled later. - skip_variables <- unlist(rlapply(widget_list, fun = function(x) { - if (!is.null(x$condition)) { - relevant <- evaluate_condition(x$condition) - if (!is.null(relevant) && is.na(relevant) || !relevant) { - rlapply(x, fun = function(x) x$code_name) - } - } - })) - - # determine whether we need to read some variables from a table or not - table_to_read <- NULL - for (table_code_name in data_table_code_names) { - if (visible[[table_code_name]]) { - table_to_read <- structure_lookup_list[[table_code_name]] - break - } - } - - # fill / update information - for (variable_name in get_category_names("variable_name")) { - - # will be needed later with fileInputs - widget <- structure_lookup_list[[variable_name]] - - # should the variable's value be read from a table? - read_from_table <- if (!is.null(table_to_read)) { - # if it is in the table's columns, yes - if (variable_name %in% table_to_read$columns) {TRUE} - # if it is in a custom mode table (=fertilizer_element_table) - # then yes too - else if (is.null(table_to_read$columns) & - variable_name %in% unlist(table_to_read$rows)) {TRUE} - # if not, then it is in the rows of the table and we will read - # the value instead from a regular widget - else {FALSE} - } else {FALSE} - - # if this variable is not relevant, make sure it is not included - # in the event data - if (!(variable_name %in% relevant_variables) || - # variable might be in skip_variables if it is read from table - variable_name %in% skip_variables & !read_from_table) { - - # if this variable is a path to a file and it has a value - # stored, we need to delete the file as it is no longer - # relevant to the event - value <- event[[variable_name]] - if (widget$type == "fileInput" && - !is.null(value) && !identical(value, missingval)) { - # delete the file - tryCatch(expr = delete_file(value, input$site, event$block), - error = function(cnd) { - message(glue("Could not delete file related ", - "to the edited event: {cnd}")) - }) - } - - event[variable_name] <- NULL - next - } - - # read value from table if it is available there, otherwise - # read the value from a regular input widget - value_to_save <- if (read_from_table) { - table_data[[table_to_read$code_name]]()[[variable_name]] - } else { - input[[variable_name]] - } - - # if value is character, trim any whitespace around it - if (is.character(value_to_save)) { - value_to_save <- trimws(value_to_save) - } - - # format Date value to character string and replace with "" - # if that fails for some reason - if (class(value_to_save) == "Date") { - value_to_save <- tryCatch( - expr = format(value_to_save, date_format_json), - error = function(cnd) { - message(glue("Unable to format date {value_to_save}", - "into string when saving event,", - "replaced with missingval")) - "" - } - ) - } - - # handle fileInputs that are relevant to the event - if (widget$type == "fileInput") { - - # the value of a fileInput cannot be reset, so we need to - # compare the current value to the old one to figure out if - # a new value has been entered - prev_value <- - session$userData$previous_fileInput_value[[variable_name]] - # should currently saved file be deleted? We know this by - # the flag we set to session$userData when pressing the delete - # button - clear_value <- !is.null(prev_value$clear_value) - # is a new file uploaded? - new_file_uploaded <- !is.null(value_to_save) & - !identical(value_to_save, prev_value) & - !clear_value - old_path <- event[[variable_name]] - - if (new_file_uploaded) { - filepath <- value_to_save$datapath - # move the file into place and get the relative path - relative_path <- - tryCatch(expr = - move_uploaded_file(filepath, - variable_name, - input$site, - input$block, - format(input$date, - date_format_json)), - error = function(cnd) { - showNotification( - "Could not save the image file correctly.", - type = "warning") - message(glue("Error when saving image to ", - "{variable_name}: {cnd}")) - "" - }) - - # if the event already has a value in this field, we are - # replacing the file with a new one. We should therefore - # delete the old file. - if (!is.null(old_path) && !identical(old_path, missingval)) { - # delete the file - tryCatch(expr = delete_file(old_path, input$site, - event$block), - error = function(cnd) { - message(glue("Could not delete file to ", - "be replaced: {cnd}")) - }) - } - - value_to_save <- relative_path - } else if (clear_value) { - # the file was deleted by the user using the delete button. - # Let's actually delete the file and save changes - tryCatch(expr = delete_file(old_path, input$site, - event$block), - error = function(cnd) { - message(glue("Could not delete file related ", - "to the event: {cnd}")) - }) - - value_to_save <- NULL - } else { - # a new file was not uploaded. - # However, if there is already a file uploaded, we might - # have to rename/move it as the event date or block might - # have changed. We will therefore move the current file - # like it was a new file. - - new_date <- format(input$date, date_format_json) - if (editing && !identical(old_path, missingval)) { - - if (input$block != orig_block | new_date != orig_date) { - # we should rename and/or move the file - - old_path <- file.path(input$site, orig_block, - old_path) - - relative_path <- - tryCatch(expr = move_uploaded_file( - old_path, - variable_name, - input$site, - input$block, - new_date, - filepath_is_relative = TRUE), - error = function(cnd) { - showNotification( - "Could not rename the image file.", - type = "warning") - message(glue("Error when renaming ", - "image ", - "{variable_name}: {cnd}")) - old_path - }) - - value_to_save <- relative_path - - } else { - # we did not have to move the file and therefore do - # not need to change the current file path - next - } - - } else { - # we are not editing (or path is missingval), so save - # missingval - value_to_save <- NULL - } - } - } - - - # if the value is not defined or empty, replace with missingval - if (length(value_to_save) == 0) { - value_to_save <- missingval - } else { - missing_indexes <- is.na(value_to_save) | value_to_save == "" - if (any(missing_indexes)) { - value_to_save[missing_indexes] <- missingval - } - } - - # if value has multiple values (e.g. selectInput with possibility - # of selecting multiple values), then make that into a list so that - # it saves nicely into the event list - # if we didn't do this, we'd get an error saying we have too many - # replacement values - #if (length(value_to_save) > 1) { - # value_to_save <- list(value_to_save) - #} - # EDIT: not needed as I changed what's below from [] to [[]] - - event[[variable_name]] <- value_to_save - } - - #message("ALL THE DATA FILLED:") - #str(event) - - # load the json file corresponding to the new block selection (new as in - # the current input$block value). We load from the file because it might - # have changed and events$by_block might be out of date - new_block_data <- retrieve_json_info(input$site, input$block) - - # if editing and block didn't change, replace event. - # Otherwise append event to the list - if (editing && orig_block == input$block) { - new_block_data[[event_index]] <- event - } else { - new_block_data[[length(new_block_data) + 1]] <- event - } - - # save changes - write_json_file(input$site, input$block, new_block_data) - showNotification("Saved successfully.", type = "message") - - # update events$by_block - events$by_block[[input$block]] <- new_block_data - - # exit sidebar mode - if (editing) { - event_to_edit(NULL) - } else { - exit_sidebar_mode() - } - - }) - - # delete entry when delete button is pressed - observeEvent(input$delete, { - event <- event_to_edit() - - # retrieve up to date information from the json file - block_data <- retrieve_json_info(input$site, event$block) - - # find the index of the event to be deleted from the event list - event_index <- find_event_index(event, block_data) - - if (is.null(event_index)) { - showNotification("Could not delete entry because it - was not found in the event files.", type = "error") - return() - } - - # if the event has image files associated with it (e.g. canopeo_image) - # delete those. For this we have to go through all the variables in - # the event and check if they correspond to a fileInput - for (variable in names(event)) { - widget <- structure_lookup_list[[variable]] - value <- event[[variable]] - - if (widget$type == "fileInput" & !identical(value, missingval)) { - # delete the file - tryCatch(expr = delete_file(value, input$site, event$block), - error = function(cnd) { - message(glue("Could not delete file related to ", - "the deleted event: {cnd}")) - - }) - } - } - - # delete - block_data[event_index] <- NULL - - # write changes to json - write_json_file(input$site, event$block, block_data) - showNotification("Entry deleted.", type = "message") - - # update events list - events$by_block[[event$block]] <- block_data - - # exit edit mode - event_to_edit(NULL) - }) - - # change available blocks depending on the site and load the site event - # data into memory (events$by_block) - observeEvent(input$site, { - - if (is.null(input$site) | input$site == "") { - shinyjs::disable("table_block") - shinyjs::disable("block") - shinyjs::disable("add_event") - return() - } - - shinyjs::enable("table_block") - shinyjs::enable("block") - shinyjs::enable("add_event") - - # update table_block choices. - # table_block choices are also updated in the observeEvent for - # input$language to make the block_choice_all name translate - block_choices <- subset(sites, site == input$site)$blocks[[1]] - update_table_block_choices() - updateSelectInput(session, "block", choices = block_choices) - - # load the events corresponding to this site into memory - load_json_data(input$site) - - }) - - required_variables <- reactiveVal(list("site", "block", "date", - "mgmt_operations_event")) - - # change required variables when activity is changed - observeEvent(input$mgmt_operations_event, { - - required_checker <- function(element) { - # if required is defined, it is true - if (!is.null(element$required)) { - return(element$code_name) - } - } - - # find the variables that are compulsory for this activity type - variables <- rlapply( - activity_options[[input$mgmt_operations_event]], - fun = required_checker) - variables <- c(list("site", - "block", - "mgmt_operations_event", - "date"), - variables) - # save to a reactiveval. The inputs are compared against this list of - # variables in an observe() - required_variables(variables) - }) - - # disable the save button if not all necessary info has been filled - observe({ - - #if (!dev_mode) {req(auth_result$admin)} - #req(auth_result$admin) - - # run whenever any of the inputs change. I know this is not ideal, but - # reactivity to input values doesn't work when we dynamically generate - # which inputs we want to access - reactiveValuesToList(input) - - # if (dev_mode || auth_result$admin == "TRUE") { - # if we are in admin or dev mode, - # we don't care about required variables - # return() - # } - - for (required_variable in required_variables()) { - - table_code_name <- get_variable_table(required_variable) - - # read the value from a table or a widget, depending on which one - # is appropriate - current_val <- if (!is.null(table_code_name) && - visible[[table_code_name]]) { - table_data[[table_code_name]]()[[required_variable]] - } else { - input[[required_variable]] - } - - # is.Truthy essentially checks whether input is NULL, NA or "". - # Turning current_val into a list ensures that NULLs are evaluated - # correctly. - is_filled <- sapply(list(current_val), isTruthy) - - if (!all(is_filled)) { - shinyjs::disable("save") - return() - } - } - - shinyjs::enable("save") - }) - - # render frontpage table when input$language or table data changes - output$mgmt_events_table <- DT::renderDataTable(server = FALSE, { - - new_data_to_display <- replace_with_display_names( - frontpage_table_data(), input$language) - n_cols <- ncol(new_data_to_display) - - # select the row which we are currently editing - row_number <- NULL - if (!is.null(isolate(event_to_edit()))) { - row_number <- find_event_index(isolate(event_to_edit()), - new_data_to_display$event) - # if we couldn't find the currently edited event in the table, - # prevent clearing the event - edited_event_visible <<- !is.null(row_number) - } - - datatable(new_data_to_display, - # allow selection of a single row - selection = list(mode = "single", - selected = row_number), - rownames = FALSE, # hide row numbers - class = "table table-hover", - #autoHideNavigation = TRUE, doesn't work properly with dom - colnames = get_disp_name(names(new_data_to_display), - language = input$language, - is_variable_name = TRUE), - options = list(dom = 'tp', # hide unnecessary controls - # order chronologically by hidden column - order = list(n_cols - 1, 'desc'), - columnDefs = list( - # hide all other columns except - # event, date and notes - list(visible = FALSE, - targets = (n_cols - 2):(n_cols - 1)), - # hide sorting arrows - list(orderable = FALSE, targets = - 0:(n_cols - 2))), - pageLength = 15, - language = list( - emptyTable = get_disp_name( - "table_empty_label", input$language), - paginate = list( - "next" = get_disp_name( - "table_next_label", input$language), - previous = get_disp_name( - "table_previous_label", input$language)) - ) - )) - }) - - # holds boolean values which indicate whether the conditions for the - # visibility of data tables are met - visible <- reactiveValues() - - # changing these overrides the values in the table - prefill_values <- list() - - # initialise the table server for each of the dynamically added tables - # sapply with simplify = FALSE is equivalent to lapply - table_data <- sapply(data_table_code_names, - FUN = function(data_table_code_name) { - table_structure <- structure_lookup_list[[data_table_code_name]] - - # are we in custom made, i.e. is this fertilizer_element_table - custom_mode <- is.null(table_structure$columns) - - # what are the names of the rows? This can either be determined by - # the choices of selectInput with multiple selections, or a numericInput - # which represents the number of rows - row_names <- reactive({ - if (!custom_mode) { - row_variable <- structure_lookup_list[[table_structure$rows]] - if (row_variable$type == "numericInput") { - - number_of_rows <- input[[row_variable$code_name]] - - if (!isTruthy(number_of_rows)) { - NULL - } else { - number_of_rows <- max(ceiling(number_of_rows), 1) - 1:number_of_rows - } - - - } else if (row_variable$type == "selectInput") { - input[[row_variable$code_name]] - } - } else { - - # the following is hacky, but basically allows for determining - # when tables in custom mode (only fertilizer_element_table) - # are visible - - if (isTruthy(input$mgmt_operations_event) && - input$mgmt_operations_event == "fertilizer") { - 1:2 - } else { - 0 - } - - } - }) - - # add observer to visibility condition of table. - # table is visible if the length of the variable presented on the rows - # of the table is more than 1 - observeEvent(row_names(), ignoreNULL = FALSE, { - visible[[data_table_code_name]] <- length(row_names()) > 1 - #message(glue("Visibility for {data_table_code_name} is {visible[[data_table_code_name]]}")) - }) - - prefill_values[[data_table_code_name]] <<- reactiveVal() - tableServer(data_table_code_name, row_names, reactive(input$language), - visible = reactive(visible[[data_table_code_name]]), - override_values = prefill_values[[data_table_code_name]]) - }, USE.NAMES = TRUE, simplify = FALSE) - - # observe({ - # for (value in table_data) { - # str(value()) - # } - # }) - - # update each of the text outputs automatically, including language changes - # and the dynamic updating in editing table title etc. - lapply(text_output_code_names, FUN = function(text_output_code_name) { - - # render text - output[[text_output_code_name]] <- renderText({ - - text_to_show <- get_disp_name(text_output_code_name, input$language) - - #get element from the UI structure lookup list - element <- structure_lookup_list[[text_output_code_name]] - #if the text should be updated dynamically, do that - if (!is.null(element$dynamic)) { - - # there are currently two modes of dynamic text - if (element$dynamic$mode == "input") { - # the -1 removes the mode element, we don't want it - patterns <- names(element$dynamic)[-1] - # use lapply here to get the dependency on input correctly - replacements <- lapply(patterns, function(pattern) { - replacement <- input[[ element$dynamic[[pattern]] ]] - replacement <- get_disp_name(replacement, - input$language) - text_to_show <<- gsub(pattern, replacement, - text_to_show) - replacement - }) - - # if one of the replacements is empty, we don't want to - # see the text at all - if ("" %in% replacements) { text_to_show <- "" } - - } else if (element$dynamic$mode == "edit_mode") { - - text_to_show <- if (!is.null(event_to_edit())) { - element$dynamic[["TRUE"]] - } else { - element$dynamic[["FALSE"]] - } - text_to_show <- get_disp_name(text_to_show, input$language) - - } - } - text_to_show - }) - - }) - - # show file delete button when a new file is uploaded by the user. - # Also check the file immediately after it is uploaded, and if its extension - # is not correct, delete the file. - lapply(fileInput_code_names, FUN = function(fileInput_code_name) { - observeEvent(input[[fileInput_code_name]], { - # path to the uploaded file in temporary folder - tmp_path <- input[[fileInput_code_name]]$datapath - file_extension <- tools::file_ext(tmp_path) - allowed_extensions <- c("jpg", "jpeg", "tif", "tiff", "png") - # if the image format is not desired, delete file and clear field - if (!(file_extension %in% allowed_extensions)) { - delete_file(tmp_path, filepath_relative = FALSE) - - showNotification( - glue("This file extension is not supported. ", - "Upload a file with one of the ", - "following extensions: ", - paste(allowed_extensions, collapse = ", ")), - type = "error", duration = NULL) - update_ui_element(session, fileInput_code_name, - clear_value = TRUE) - return() - } - - # a new file was uploaded, so show delete button - delete_button_name <- - structure_lookup_list[[fileInput_code_name]]$delete_button - shinyjs::show(delete_button_name) - }) - }) - - # add observers to fileInput delete buttons - lapply(fileInput_delete_code_names, FUN = function(button_code_name) { - observeEvent(input[[button_code_name]], { - fileInput_code_name <- - structure_lookup_list[[button_code_name]]$fileInput - # there are two types of deletions: - # 1. the user has uploaded a new file and wants to delete it - # (non-saved file) - # - there can be a previously saved file if we are editing an event, - # that should then be displayed - # 2. the user has not uploaded a new file, but the event has a - # previously saved file the user wants to delete. - - # the value of a fileInput cannot be reset, so we need to - # compare the current value to the old one to figure out if - # a new value has been entered - new_file_uploaded <- - !identical(input[[fileInput_code_name]], - session$userData$ - previous_fileInput_value[[fileInput_code_name]]) - event <- event_to_edit() - editing <- !is.null(event) - - if (new_file_uploaded) { - - # # if we are editing, there might be a previous file - # if (editing) { - # - # old_path <- event[[fileInput_code_name]] - # - # if (!is.null(old_path) & !identical(old_path, missingval)) { - # message(glue("Deleting new file and going back to ", - # "{old_path}")) - # } else { - # message("Deleting new file, no previous files") - # } - # - # } else { - # message("Deleting a newly uploaded file in add mode") - # } - - # clear fileInput - update_ui_element(session, fileInput_code_name, - clear_value = TRUE) - # TODO: delete the actual file? - - } else { - - # new file was not uploaded. Check if we are editing and there - # is a previous file we should delete - old_path <- event[[fileInput_code_name]] - if (editing && !is.null(old_path) && - !identical(old_path, missingval)) { - - # there is an old file we should delete when the changes - # to the event are saved. To signal this, let's add a flag - # to session$userData$previous_fileInput_value - update_ui_element(session, fileInput_code_name, - clear_value = TRUE) - session$userData$previous_fileInput_value[[ - fileInput_code_name]] <- list(clear_value = TRUE) - - } else { - # the button should not be visible at this point - message("No new file uploaded and no old file to delete") - } - - } - - }) - }) - - # change language when user requests it - observeEvent(input$language, { - - # we have to handle input and output elements in different ways - - # OUTPUT ELEMENTS: - - # change textOutputs when the language is changed - # one has to use lapply here, for-loop does not work! See - # https://community.rstudio.com/t/how-do-i-use-for-loop-in-rendering-outputs/35761/2 - - # function to render text outputs. Note the pattern matching which - # is used for the editing table title (shown in text_output_handler) - #lapply(text_output_code_names, text_output_handler, session = session, - # input = input, - # output = output) - - # no need to update data tables, their updating is defined in - # update_tables and they update reactively when language changes - - # INPUT ELEMENTS: - - # get a list of all input elements which we have to relabel - input_element_names <- names(reactiveValuesToList(input)) - - for (code_name in input_element_names) { - - # TODO: update to use the update_ui_element function - - # find element in the UI structure lookup list - element <- structure_lookup_list[[code_name]] - - # didn't find the element corresponding to code_name - # this should not happen if the element is in - # sidebar_ui_structure.json - if (is.null(element$type)) next - - label <- get_disp_name(element$label, input$language) - - if (element$type == "selectInput") { - - # fetch choices for the selectInput - choices <- get_selectInput_choices(element, input$language) - - # make sure we don't change the selected value - current_value <- input[[code_name]] - - if (is.null(choices)) { - updateSelectInput(session, - code_name, - label = ifelse(is.null(label),"",label), - selected = current_value) - } else { - updateSelectInput(session, - code_name, - label = ifelse(is.null(label),"",label), - choices = choices, - selected = current_value) - } - - - } else if (element$type == "dateInput") { - #language_code <- if (input$language == "disp_name_fin") { - # "fi" - #} else { - # "en" - #} - updateDateInput(session, - code_name, - label = label, - #language = language_code - ) - } else if (element$type == "textAreaInput") { - updateTextAreaInput(session, - code_name, - label = label, - placeholder = - get_disp_name( - element$placeholder, - input$language)) - } else if (element$type == "actionButton") { - updateActionButton(session, - code_name, - label = label) - } else if (element$type == "checkboxInput") { - updateCheckboxInput(session, - code_name, - label = label) - } else if (element$type == "textInput") { - updateTextInput(session, - code_name, - label = label, - placeholder = - get_disp_name( - element$placeholder, - input$language)) - } else if (element$type == "numericInput") { - updateNumericInput(session, - code_name, - label = label) - } else if (element$type == "dateRangeInput") { - updateDateRangeInput(session, - code_name, - label = label) - } else if (element$type == "fileInput") { - update_ui_element(session, code_name, label = label) - } - - } - - # update table selector choices separately - update_table_block_choices() - update_table_activity_choices() - update_table_year_choices() - }) - -} - -# Run the application -shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/data/FOsites.csv b/data/FOsites.csv deleted file mode 100644 index 5892b51..0000000 --- a/data/FOsites.csv +++ /dev/null @@ -1,23 +0,0 @@ -site,site_type,blocks -mu,Advanced CarbonAction Site,[0;1] -ik,Advanced CarbonAction Site,[0;1] -mi,Advanced CarbonAction Site,[0;1] -pa,Advanced CarbonAction Site,[0;1] -si,Advanced CarbonAction Site,[0;1] -li,Advanced CarbonAction Site,[0;1] -ki,Advanced CarbonAction Site,[0;1] -ja,Advanced CarbonAction Site,[0;1] -ai,Advanced CarbonAction Site,[0;1] -pi,Advanced CarbonAction Site,[0;1] -mo,Advanced CarbonAction Site,[0;1] -pu,Advanced CarbonAction Site,[0;1] -ko,Advanced CarbonAction Site,[0;1] -ni,Advanced CarbonAction Site,[0;1] -jn,Advanced CarbonAction Site,[0;1] -kp,Advanced CarbonAction Site,[0;1] -la,Advanced CarbonAction Site,[0;1] -na,Advanced CarbonAction Site,[0;1] -ae,Advanced CarbonAction Site,[0;1] -ne,Advanced CarbonAction Site,[0;1] -qvidja,Intensive Site,[ec;ca6cm;ca15cm] -ruukki,Intensive Site,[block1;block2;block3;block4;block5;block6;5up;6up] diff --git a/data/database.sqlite b/data/database.sqlite deleted file mode 100644 index cdcb5fc..0000000 Binary files a/data/database.sqlite and /dev/null differ diff --git a/dev/01_start.R b/dev/01_start.R new file mode 100644 index 0000000..7b677fe --- /dev/null +++ b/dev/01_start.R @@ -0,0 +1,69 @@ +# Building a Prod-Ready, Robust Shiny Application. +# +# README: each step of the dev files is optional, and you don't have to +# fill every dev scripts before getting started. +# 01_start.R should be filled at start. +# 02_dev.R should be used to keep track of your development during the project. +# 03_deploy.R should be used once you need to deploy your app. +# +# +######################################## +#### CURRENT FILE: ON START SCRIPT ##### +######################################## + +## Fill the DESCRIPTION ---- +## Add meta data about your application +## +## /!\ Note: if you want to change the name of your app during development, +## either re-run this function, call golem::set_golem_name(), or don't forget +## to change the name in the app_sys() function in app_config.R /!\ +## +golem::fill_desc( + pkg_name = "fieldactivity", # The Name of the package containing the App + pkg_title = "An app for keeping track of field activity", # The Title of the package containing the App + pkg_description = "An app for keeping track of field activity in the Field + Observatory project. Built using Shiny, the application allows farmers to + enter information about common farming events like tillage, sowing and + harvest. These event data are stored in .json files, which mostly follow the + ICASA standards for agricultural data.", # The Description of the package containing the App + author_first_name = "Otto", # Your First Name + author_last_name = "Kuusela", # Your Last Name + author_email = "otto.kuusela@helsinki.fi", # Your Email + repo_url = "https://github.com/Ottis1/fieldactivity" # The URL of the GitHub Repo (optional) +) + +## Set {golem} options ---- +golem::set_golem_options() + +## Create Common Files ---- +## See ?usethis for more information +usethis::use_mit_license() # You can set another license here +usethis::use_readme_rmd( open = FALSE ) +usethis::use_code_of_conduct() +usethis::use_lifecycle_badge( "Experimental" ) +usethis::use_news_md( open = FALSE ) + +## Use git ---- +usethis::use_git() + +## Init Testing Infrastructure ---- +## Create a template for tests +golem::use_recommended_tests() + +## Use Recommended Packages ---- +golem::use_recommended_deps() + +## Favicon ---- +# If you want to change the favicon (default is golem's one) +golem::use_favicon() # path = "path/to/ico". Can be an online file. +golem::remove_favicon() + +## Add helper functions ---- +golem::use_utils_ui() +golem::use_utils_server() + +# You're now set! ---- + +# go to dev/02_dev.R +rstudioapi::navigateToFile( "dev/02_dev.R" ) + diff --git a/dev/02_dev.R b/dev/02_dev.R new file mode 100644 index 0000000..d1bb808 --- /dev/null +++ b/dev/02_dev.R @@ -0,0 +1,115 @@ +# Building a Prod-Ready, Robust Shiny Application. +# +# README: each step of the dev files is optional, and you don't have to +# fill every dev scripts before getting started. +# 01_start.R should be filled at start. +# 02_dev.R should be used to keep track of your development during the project. +# 03_deploy.R should be used once you need to deploy your app. +# +# +################################### +#### CURRENT FILE: DEV SCRIPT ##### +################################### + +# change version number +golem::set_golem_version(version = "0.2.1") +# if golem_wd in inst/golem-config.yml changes to anything other than +# here::here(), this will change it back +golem::set_golem_wd() + +# Engineering + +## Dependencies ---- +## Add one line by package you want to add as dependency +usethis::use_package("shinymanager", min_version = TRUE) +usethis::use_package("bslib") +usethis::use_package("jsonlite") +usethis::use_package("shinyjs") +usethis::use_package("tools") +usethis::use_package("htmlwidgets") +usethis::use_package("methods") +usethis::use_package("shinyvalidate") + + +## Add modules ---- +## Create a module infrastructure in R/ +golem::add_module( name = "table") # Name of the module +golem::add_module( name = "form" ) # Name of the module +golem::add_module(name = "fileInput") +golem::add_module(name = "event_list") + +## Add helper functions ---- +## Creates fct_* and utils_* +golem::add_fct( "json" ) +golem::add_utils("global") +golem::add_fct("evaluate_js", module = "form") +golem::add_fct("event_list") +golem::add_utils("find_table", module = "table") +golem::add_utils("validation") + +## External resources +## Creates .js and .css files at inst/app/www +golem::add_js_file( "script" ) +golem::add_js_handler( "handlers" ) +golem::add_css_file( "custom" ) + +## Add internal datasets ---- +## If you have data in your package +usethis::use_data_raw( name = "my_dataset", open = FALSE ) + +## Tests ---- +## Add one line by test you want to create +usethis::use_test("language") + +# Documentation + +## Vignette ---- +usethis::use_vignette("fieldactivity") +devtools::build_vignettes() + +## Code Coverage---- +## Set the code coverage service ("codecov" or "coveralls") +usethis::use_coverage() + +# Create a summary readme for the testthat subdirectory +covrpage::covrpage() + +## CI ---- +## Use this part of the script if you need to set up a CI +## service for your application +## +## (You'll need GitHub there) +usethis::use_github() + +# GitHub Actions +usethis::use_github_action() +# Chose one of the three +# See https://usethis.r-lib.org/reference/use_github_action.html +usethis::use_github_action_check_release() +usethis::use_github_action_check_standard() +usethis::use_github_action_check_full() +# Add action for PR +usethis::use_github_action_pr_commands() + +# Travis CI +usethis::use_travis() +usethis::use_travis_badge() + +# AppVeyor +usethis::use_appveyor() +usethis::use_appveyor_badge() + +# Circle CI +usethis::use_circleci() +usethis::use_circleci_badge() + +# Jenkins +usethis::use_jenkins() + +# GitLab CI +usethis::use_gitlab_ci() + +# You're now set! ---- +# go to dev/03_deploy.R +rstudioapi::navigateToFile("dev/03_deploy.R") + diff --git a/dev/03_deploy.R b/dev/03_deploy.R new file mode 100644 index 0000000..6933b01 --- /dev/null +++ b/dev/03_deploy.R @@ -0,0 +1,42 @@ +# Building a Prod-Ready, Robust Shiny Application. +# +# README: each step of the dev files is optional, and you don't have to +# fill every dev scripts before getting started. +# 01_start.R should be filled at start. +# 02_dev.R should be used to keep track of your development during the project. +# 03_deploy.R should be used once you need to deploy your app. +# +# +###################################### +#### CURRENT FILE: DEPLOY SCRIPT ##### +###################################### + +# Test your app + +## Run checks ---- +## Check the package before sending to prod +devtools::check() +rhub::check_for_cran() + +# Deploy + +## Local, CRAN or Package Manager ---- +## This will build a tar.gz that can be installed locally, +## sent to CRAN, or to a package manager +devtools::build() + +## RStudio ---- +## If you want to deploy on RStudio related platforms +golem::add_rstudioconnect_file() +golem::add_shinyappsio_file() +golem::add_shinyserver_file() + +## Docker ---- +## If you want to deploy via a generic Dockerfile +golem::add_dockerfile() + +## If you want to deploy to ShinyProxy +golem::add_dockerfile_shinyproxy() + +## If you want to deploy to Heroku +golem::add_dockerfile_heroku() diff --git a/dev/create_user_db.R b/dev/create_user_db.R new file mode 100644 index 0000000..19c09ec --- /dev/null +++ b/dev/create_user_db.R @@ -0,0 +1,22 @@ +# A script to create a new shinymanager user database for the app +# This follows instructions from shinymanager's website: +# https://datastorm-open.github.io/shinymanager/ +# the site illustrates how the keyring package could be used to store the +# database passphrase + +# Define initial credentials (more can be added later through the admin UI) +credentials <- data.frame( + user = c("user", "admin"), + password = c("User1", "12345"), + start = c(NA, NA), # start and expire are optional + expire = c(NA, NA), + admin = c(FALSE, TRUE), + stringsAsFactors = FALSE +) + +# Create the database +shinymanager::create_db( + credentials_data = credentials, + sqlite_path = "path/to/database.sqlite", # will be created + passphrase = "set_the_passphrase_here" +) \ No newline at end of file diff --git a/dev/database.sqlite b/dev/database.sqlite new file mode 100644 index 0000000..fa45c9b Binary files /dev/null and b/dev/database.sqlite differ diff --git a/dev/dev_events/.gitignore b/dev/dev_events/.gitignore new file mode 100644 index 0000000..d6b7ef3 --- /dev/null +++ b/dev/dev_events/.gitignore @@ -0,0 +1,2 @@ +* +!.gitignore diff --git a/dev/run_dev.R b/dev/run_dev.R new file mode 100644 index 0000000..68f68f5 --- /dev/null +++ b/dev/run_dev.R @@ -0,0 +1,20 @@ +# Set options here +options(golem.app.prod = FALSE) # TRUE = production mode, FALSE = development mode + +# Detach all loaded packages and clean your environment +golem::detach_all_attached() +# rm(list=ls(all.names = TRUE)) + +# Document and reload your package +golem::document_and_reload() + +file_path <- if (golem::app_dev()) { + "dev/dev_events" +} else { + "/data/fo-event-files" +} + +# Run the application +run_app(json_file_path = file_path, + user_db_path = "dev/database.sqlite", + user_db_passphrase = "salasana") diff --git a/display_name_helpers.R b/display_name_helpers.R deleted file mode 100644 index d8503fa..0000000 --- a/display_name_helpers.R +++ /dev/null @@ -1,111 +0,0 @@ -# Helper functions to go from code names to pretty display names in the -# correct language -# Otto Kuusela 2021 - -# read the csv file containing the display names -display_name_dict_path <- "data/display_names.csv" -display_names_dict <- read.csv(display_name_dict_path, comment.char = "#") - -date_format_json <- "%Y-%m-%d" -date_format_display <- "%d/%m/%Y" - -# find all code names and display names belonging to a given category -# display names are set as the names, code names are the values -# if language is NULL, only code names are returned -get_category_names <- function(category1, language = NULL) { - - category_names <- subset(display_names_dict, category == category1) - code_names <- category_names$code_name - - if (!is.null(language)) { - disp_names <- category_names[[language]] - names(code_names) <- disp_names - } - - return(code_names) -} - -# get the display name(s) corresponding to a code name (/names) -# returns the display names(s) as a value -# if display name is not found, the code name is returned -# if is_variable_name is set to true, then only variable names will be looked -# at, otherwise only non-variable names will be looked at. This is because -# there might be clashes between the variable and non-variable code names -# e.g. organic_material is both an option in mgmt_operations_event and a -# variable -get_disp_name <- function(code_name, language = NULL, - is_variable_name = FALSE) { - - if (is.null(language)) {return(code_name)} - - if (is_variable_name) { - rows_to_check <- subset(display_names_dict, category == "variable_name") - } else { - rows_to_check <- subset(display_names_dict, category != "variable_name") - } - - row_indexes <- match(code_name, rows_to_check$code_name) - display_name <- rows_to_check[row_indexes, language] - - # replace missing display names with the corresponding code names - display_name[is.na(display_name)] <- code_name[is.na(display_name)] - display_name[display_name == missingval] <- "" - - return(display_name) -} - -# replace code names with display names in an event data frame -# also replaces missingvals -replace_with_display_names <- function(events_with_code_names, language) { - events_with_display_names <- events_with_code_names - - for (variable_name in names(events_with_code_names)) { - # determine the type of element the variable corresponds to - element <- structure_lookup_list[[variable_name]] - - if (is.null(element$type)) { - next - #stop(paste("Could not find element of name",variable_name, - # "in sidebar_ui_structure.json file. Check it!")) - } - - if (element$type == "selectInput") { - # the pasting is done to ensure we get a nicely formatted name - # when x is a character vector - events_with_display_names[[variable_name]] <- - sapply(events_with_code_names[[variable_name]], - FUN = function(x) { - name <- get_disp_name(x, language = language) - if (length(name) > 1) { - name <- paste(ifelse(name=="", "-", name), - collapse = ", ") - } - name - }) - } else if (element$type == "textAreaInput" | - element$type == "textInput" | - element$type == "numericInput") { - events_with_display_names[[variable_name]] <- - sapply(events_with_code_names[[variable_name]], - FUN = function(x) { - if (length(x) > 1) { - paste(ifelse(x==missingval,"-",x), - collapse = ", ") - } else { - ifelse(x==missingval,"",x) - } - }) - } else if (element$type %in% c("dateInput", "dateRangeInput")) { - events_with_display_names[[variable_name]] <- - sapply(events_with_code_names[[variable_name]], - FUN = function(x) { - paste(format(as.Date(x, format = date_format_json), - date_format_display), - collapse = " - ") - }) - } - - } - - return(events_with_display_names) -} \ No newline at end of file diff --git a/fo_management_data_input.Rproj b/fieldactivity.Rproj similarity index 54% rename from fo_management_data_input.Rproj rename to fieldactivity.Rproj index 066341e..eaa6b81 100644 --- a/fo_management_data_input.Rproj +++ b/fieldactivity.Rproj @@ -6,8 +6,13 @@ AlwaysSaveHistory: Default EnableCodeIndexing: Yes UseSpacesForTab: Yes -NumSpacesForTab: 4 +NumSpacesForTab: 2 Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source +PackageRoxygenize: rd,collate,namespace diff --git a/inst/app/www/script.js b/inst/app/www/script.js new file mode 100644 index 0000000..f3a8919 --- /dev/null +++ b/inst/app/www/script.js @@ -0,0 +1,39 @@ +// if it feels like no updates you make to this file have any effect, clear +// your browser cache! It might be using an older version of this file. + +function do_selectize(table_id) { + return $('#'+table_id).find('select').selectize(); +} + +var renderCounter = 0; + +function rendering_done(rendered_id) { + renderCounter++; + Shiny.setInputValue(rendered_id, renderCounter); +} + +Shiny.addCustomMessageHandler('unbind-table', function(id) { + Shiny.unbindAll($('#'+id).find('.shiny-input-container')); +}); + +Shiny.addCustomMessageHandler('fileInput-value', function(message) { + var target = $('#'+message.id).parent().parent().parent().find('input[type=text]'); + target.val(message.value); +}); + +Shiny.addCustomMessageHandler('fileInput-label', function(message) { + $('#'+message.id+"-label").text(message.value); +}); + +Shiny.addCustomMessageHandler('fileInput-button-label', function(message) { + // this different style is required in order to not delete the actual fileInput + $('#'+message.id).parent()[0].childNodes[0].nodeValue = message.value; +}); + +Shiny.addCustomMessageHandler('fileInput-hide-progressbar', function(message) { + $('#'+message.id+"_progress").css("visibility", "hidden"); +}); + +Shiny.addCustomMessageHandler('fileInput-progressbar-label', function(message) { + $('#'+message.id+"_progress").children().text(message.value); +}); diff --git a/inst/extdata/FOsites.csv b/inst/extdata/FOsites.csv new file mode 100644 index 0000000..45d6d05 --- /dev/null +++ b/inst/extdata/FOsites.csv @@ -0,0 +1,125 @@ +site,site_type,blocks +MU,Advanced CarbonAction Site,[0;1] +IK,Advanced CarbonAction Site,[0;1] +MI,Advanced CarbonAction Site,[0;1] +PA,Advanced CarbonAction Site,[0;1] +SI,Advanced CarbonAction Site,[0;1] +LI,Advanced CarbonAction Site,[0;1] +KI,Advanced CarbonAction Site,[0;1] +JA,Advanced CarbonAction Site,[0;1] +AI,Advanced CarbonAction Site,[0;1] +PI,Advanced CarbonAction Site,[0;1] +MO,Advanced CarbonAction Site,[0;1] +PU,Advanced CarbonAction Site,[0;1] +KO,Advanced CarbonAction Site,[0;1] +NI,Advanced CarbonAction Site,[0;1] +JN,Advanced CarbonAction Site,[0;1] +KP,Advanced CarbonAction Site,[0;1] +LA,Advanced CarbonAction Site,[0;1] +NA,Advanced CarbonAction Site,[0;1] +AE,Advanced CarbonAction Site,[0;1] +NE,Advanced CarbonAction Site,[0;1] +MIE,Uvidi Site,[0;1] +HAA,Uvidi Site,[0;1] +SET,Uvidi Site,[0;1] +qvidja,Intensive Site,[ec;ca6cm;ca15cm] +ruukki,Intensive Site,[block1;block2;block3;block4;block5;block6;5up;6up] +haltiala,Intensive Site,[ec] +Hovi,Valio Carbo Farm 1,[Keskipelto;Kotipelto 2-A;Koivikko 1;Suopelto 2;Pitkäniemi 1-A] +Hovi_YARA,Valio Carbo Farm 1,[Keskipelto;Kotipelto 2-A;Koivikko 1;Suopelto 2;Pitkäniemi 1-A] +Koskimäki, Valio Carbo Farm 2,[Kotopakka;Kivimäki] +Koskimäki_YARA, Valio Carbo Farm 2,[Kotopakka;Kivimäki] +Saarela, Valio Carbo Farm 3,[Päiväniemi;Koivistonranta;Pilvineva;Polsonneva;Kytömaa] +Saarela_YARA, Valio Carbo Farm 3,[Päiväniemi;Koivistonranta;Pilvineva;Polsonneva;Kytömaa] +Keskitalo, Valio Carbo Farm 4,[Alapelto B;Alapelto C] +Keskitalo_YARA, Valio Carbo Farm 4,[Alapelto B;Alapelto C] +Valio_example,Valio Carbo Farm,[block1;BarleyField;GrazingExperiment;1;2;A;B] +CA-HV001,CarbonAction Site,[0;1] +CA-HV002,CarbonAction Site,[0;1] +CA-HV003,CarbonAction Site,[0;1] +CA-HV004,CarbonAction Site,[0;1] +CA-HV005,CarbonAction Site,[0;1] +CA-HV006,CarbonAction Site,[0;1] +CA-HV007,CarbonAction Site,[0;1] +CA-HV009,CarbonAction Site,[0;1] +CA-HV010,CarbonAction Site,[0;1] +CA-HV011,CarbonAction Site,[0;1] +CA-HV012,CarbonAction Site,[0;1] +CA-HV013,CarbonAction Site,[0;1] +CA-HV014,CarbonAction Site,[0;1] +CA-HV015,CarbonAction Site,[0;1] +CA-HV016,CarbonAction Site,[0;1] +CA-HV017,CarbonAction Site,[0;1] +CA-HV018,CarbonAction Site,[0;1] +CA-HV019,CarbonAction Site,[0;1] +CA-HV020,CarbonAction Site,[0;1] +CA-HV021,CarbonAction Site,[0;1] +CA-HV024,CarbonAction Site,[0;1] +CA-HV025,CarbonAction Site,[0;1] +CA-HV027,CarbonAction Site,[0;1] +CA-HV028,CarbonAction Site,[0;1] +CA-HV029,CarbonAction Site,[0;1] +CA-HV030,CarbonAction Site,[0;1] +CA-HV031,CarbonAction Site,[0;1] +CA-HV032,CarbonAction Site,[0;1] +CA-HV033,CarbonAction Site,[0;1] +CA-HV034,CarbonAction Site,[0;1] +CA-HV035,CarbonAction Site,[0;1] +CA-HV038,CarbonAction Site,[0;1] +CA-HV041,CarbonAction Site,[0;1] +CA-HV042,CarbonAction Site,[0;1] +CA-HV043,CarbonAction Site,[0;1] +CA-HV044,CarbonAction Site,[0;1] +CA-HV045,CarbonAction Site,[0;1] +CA-HV046,CarbonAction Site,[0;1] +CA-HV047,CarbonAction Site,[0;1] +CA-HV049,CarbonAction Site,[0;1] +CA-HV050,CarbonAction Site,[0;1] +CA-HV052,CarbonAction Site,[0;1] +CA-HV054,CarbonAction Site,[0;1] +CA-HV055,CarbonAction Site,[0;1] +CA-HV056,CarbonAction Site,[0;1] +CA-HV057,CarbonAction Site,[0;1] +CA-HV058,CarbonAction Site,[0;1] +CA-HV060,CarbonAction Site,[0;1] +CA-HV061,CarbonAction Site,[0;1] +CA-HV062,CarbonAction Site,[0;1] +CA-HV063,CarbonAction Site,[0;1] +CA-HV064,CarbonAction Site,[0;1] +CA-HV065,CarbonAction Site,[0;1] +CA-HV066,CarbonAction Site,[0;1] +CA-HV067,CarbonAction Site,[0;1] +CA-HV070,CarbonAction Site,[0;1] +CA-HV071,CarbonAction Site,[0;1] +CA-HV072,CarbonAction Site,[0;1] +CA-HV073,CarbonAction Site,[0;1] +CA-HV074,CarbonAction Site,[0;1] +CA-HV075,CarbonAction Site,[0;1] +CA-HV076,CarbonAction Site,[0;1] +CA-HV077,CarbonAction Site,[0;1] +CA-HV078,CarbonAction Site,[0;1] +CA-HV079,CarbonAction Site,[0;1] +CA-HV081,CarbonAction Site,[0;1] +CA-HV083,CarbonAction Site,[0;1] +CA-HV084,CarbonAction Site,[0;1] +CA-HV085,CarbonAction Site,[0;1] +CA-HV086,CarbonAction Site,[0;1] +CA-HV087,CarbonAction Site,[0;1] +CA-HV088,CarbonAction Site,[0;1] +CA-HV089,CarbonAction Site,[0;1] +CA-HV090,CarbonAction Site,[0;1] +CA-HV091,CarbonAction Site,[0;1] +CA-HV093,CarbonAction Site,[0;1] +CA-HV095,CarbonAction Site,[0;1] +CA-HV096,CarbonAction Site,[0;1] +CA-HV097,CarbonAction Site,[0;1] +CA-HV098,CarbonAction Site,[0;1] +CA-HV101,CarbonAction Site,[0;1] +CA-HV103,CarbonAction Site,[0;1] +CA-HV104,CarbonAction Site,[0;1] +CA-HV105,CarbonAction Site,[0;1] +CA-HV106,CarbonAction Site,[0;1] +Hoja,Svensk Kolinlagring Site,[18A;18C;18E;29A] +Otaniemi,CO-CARBON,[Old lawn;New lawn] +Viikki,SMEAR-Agri,[Alaniitty 1;Alaniitty 2;Keski-hakala] +Hauho,Lantmännen Site,[1] diff --git a/data/display_names.csv b/inst/extdata/display_names.csv similarity index 76% rename from data/display_names.csv rename to inst/extdata/display_names.csv index d2c3057..2cb7088 100644 --- a/data/display_names.csv +++ b/inst/extdata/display_names.csv @@ -7,21 +7,21 @@ mgmt_operations_event_choice,chemicals,chemicals application,kemikaalin levitys mgmt_operations_event_choice,grazing,grazing,laidunnus # not ICASA mgmt_operations_event_choice,weeding,mechanical extraction of weeds,rikkaruohojen kitkeminen mgmt_operations_event_choice,irrigation,irrigation,kastelu -mgmt_operations_event_choice,mowing,mowing,ruohonleikkuu +mgmt_operations_event_choice,mowing,mowing,niitto mgmt_operations_event_choice,observation,observation,havainto mgmt_operations_event_choice,bed_prep,raised bed preparation,kasvatuslaatikoiden valmistelu -mgmt_operations_event_choice,inorg_mulch,placement of inorganic mulch,epäorgaanisen katteen levitys -mgmt_operations_event_choice,Inorg_mul_rem,removal of inorganic mulch,epäorgaanisen katteen poisto +mgmt_operations_event_choice,inorg_mulch,placement of mulch,katteen levitys +mgmt_operations_event_choice,Inorg_mul_rem,removal of mulch,katteen poisto # mgmt_operations_event_choice,organic_material,organic material application,eloperäisen aineen levitys mgmt_operations_event_choice,other,other,muu # -# the following are the “all” choices for frontpage selectors +# the following are the “all” choices for frontpage table filters # activity_choice,activity_choice_all,all,kaikki block_choice,block_choice_all,all,kaikki year_choice,year_choice_all,all,kaikki # -# variable names (these show up in the tables) +# variable names (these show up in tables) # variable_name,block,Block,Lohko variable_name,mgmt_operations_event,Event,Tapahtuma @@ -44,7 +44,7 @@ variable_name,harv_yield_harv_f_wt,"Yield, fresh weight (t/ha)","Sato, märkäpa variable_name,yield_C_at_harvest,Carbon (C) in yield (kg/ha),Hiilen (C) määrä sadossa (kg/ha) # not in ICASA variable_name,harvest_moisture,Yield moisture (%),Sadon kosteus (%) variable_name,harvest_method,Harvest method,Korjuutapa -variable_name,harvest_cut_height,Height of cut (cm),Niittokorkeus (cm) +variable_name,harvest_cut_height,Height of cut (cm),Leikkuukorkeus (cm) variable_name,plant_density_harvest,Plant density at harvest (plants/m2),Kasvitiheys korjuuhetkellä (kasveja/m2) variable_name,harvest_residue_placement,Harvest residue placement,Korjuutähteiden sijoituspaikka variable_name,harvest_comments,Harvest comments,Sadonkorjuukommentit @@ -57,6 +57,8 @@ variable_name,tillage_operations_depth,Tillage depth (cm),Muokkaussyvyys (cm) variable_name,tillage_treatment_notes,Tillage notes,Muistiinpanot muokkauksesta variable_name,fertilizer_type,Fertilizer type,Lannoitteen tyyppi variable_name,organic_material,Organic material,Eloperäinen aine +# variable_name,fert_animal,Fertilizer animal,Lannoite eläin +variable_name,animal_fert_usage,Fert animal,Lannoite e variable_name,org_matter_moisture_conc,Moisture concentration (%),Aineen kosteus (%) variable_name,org_matter_carbon_conc,Carbon (C) concentration (%),Hiilen (C) määrä aineessa (%) variable_name,fertilizer_product_name,Name of fertilizer,Lannoitteen nimi @@ -65,7 +67,8 @@ variable_name,fertilizer_material_source,Fertilizer material source,Lannoitteen variable_name,fertilizer_applic_method,Application method,Levitystapa variable_name,application_depth_fert,Application depth (cm),Levityssyvyys (cm) variable_name,fertilizer_total_amount,Total amount of fertilizer (kg/ha),Lannoitteen kokonaismäärä (kg/ha) -variable_name,N_in_applied_fertilizer,Amount of nitrogen (N) in fertilizer (kg/ha),Typen (N) määrä lannoitteessa (kg/ha) +variable_name,N_in_applied_fertilizer,Amount of total nitrogen (N) in fertilizer (kg/ha),Typen (N) määrä lannoitteessa (kg/ha) +variable_name,N_in_soluble_fertilizer,Amount of soluble nitrogen (N) in fertilizer (kg/ha), Liukenevan typen (N) määrä lannoitteessa (kg/ha) variable_name,phosphorus_applied_fert,Amount of phosphorus (P) in fertilizer (kg/ha),Fosforin (P) määrä lannoitteessa (kg/ha) variable_name,fertilizer_K_applied,Amount of potassium (K) in fertilizer (kg/ha),Kaliumin (K) määrä lannoitteessa (kg/ha) variable_name,S_in_applied_fertilizer,Amount of sulphur (S) in fertilizer (kg/ha),Rikin (S) määrä lannoitteessa (kg/ha) @@ -85,8 +88,8 @@ variable_name,grazing_species_age_group,Livestock age group (yr),Eläinten ikär variable_name,livestock_density,Livestock density (number/ha),Eläinten tiheys (eläintä/ha) variable_name,grazing_intensity,Grazing intensity (kg/ha),Laidunnusintensiteetti (kg/ha) variable_name,grazing_period,Grazing period,Laidunnusjakso -variable_name,grazing_type,Grazing type,Laidunnuksen tyyppi, -variable_name,grazing_area,Grazing area (ha),Laidunnettava ala (ha), +variable_name,grazing_type,Grazing type,Laidunnuksen tyyppi +variable_name,grazing_area,Grazing area (ha),Laidunnettava ala (ha) variable_name,grazing_material_removed_prop,Proportion of material removed (%),Syödyn aineksen määrä (%) variable_name,grazing_starting_height,Starting height (cm),Aloituspituus (cm) variable_name,grazing_end_height,End height (cm),Lopetuspituus (cm) @@ -104,20 +107,36 @@ variable_name,chemical_applic_target,Chemical application target,Kemikaalinlevit variable_name,chemical_applic_method,Chemical application method,Kemikaalinlevitystapa variable_name,chemical_applic_amount,Chemical amount (kg/ha),Kemikaalin määrä (kg/ha) variable_name,application_depth_chem,Chemical application depth (cm),Kemikaalinlevityssyvyys (cm) +variable_name,application_ph_start,pH before the application,pH ennen toimenpidettä +variable_name,application_ph_end,pH after the application,pH jälkeen toimenpiteen variable_name,chemical_applic_notes,Chemical application notes,Kemikaalinlevitysmuistiinpanot variable_name,observation_type,Observation type,Havainnon tyyppi variable_name,soil_layer_count,Number of layers in soil sample,Maanäytteen kerrosten lukumäärä variable_name,soil_layer_top_depth,"Soil layer depth, top (cm)","Kerroksen yläosan syvyys (cm)" -variable_name,soil_layer_base_depth,"Soil layer depth, bottom (cm)","Kerroksen alaosan syvyys (cm)", +variable_name,soil_layer_base_depth,"Soil layer depth, bottom (cm)","Kerroksen alaosan syvyys (cm)" variable_name,soil_classification_by_layer,Soil structure (MARA card),Maan rakenne (MARA-kortti) +variable_name,soil_bulk_density_moist,Bulk density (g/cm3),Irtotiheys (g/cm3) +variable_name,soil_water_wilting_pt,Soil water content at wilting point (cm3/cm3),Nuutumispiste (cm3/cm3) +variable_name,soil_water_field_cap_1,"Soil water content at field capacity, 30 kPA (cm3/cm3)", "Kenttäkapasiteetti, 30 kPA (cm3/cm3)" +variable_name,soil_water_saturated,Soil water content at saturation (cm3/cm3),Kylläisyyspiste (cm3/cm3) +variable_name,soil_silt_fraction,Soil silt fraction (%),Maaperän lietteen osuus (%) +variable_name,soil_sand_fraction,Soil sand fraction (%),Maaperän hiekan osuus (%) +variable_name,soil_clay_fraction,Soil clay fraction (%),Maaperän saven osuus (%) +variable_name,soil_organic_matter_layer,Total soil organic matter (kg[OM]/ha),Maaperän orgaaninen aines (kg[OA]/ha) +variable_name,soil_organic_C_perc_layer,Total soil organic carbon content (%),Orgaanisen hiilen osuus (%) variable_name,root_depth,Root depth (m),Juurten syvyys (m) variable_name,soil_compactification_depth,Soil compactification depth (cm),Tiivistymän syvyys (cm) variable_name,earthworm_count,Number of earthworms,Lierojen lukumäärä variable_name,soil_image,Photo of soil,Kuva maaperästä -variable_name,growth_stage,Plant growth stage,Kasvuvaihe +variable_name,growth_stage,Plant growth stage,Kasvuaste variable_name,plant_density,Plant density (plants/m2),Kasvitiheys (kasveja/m2) variable_name,specific_leaf_area,Specific leaf area (cm2/g),Ominaislehtiala (cm2/g) variable_name,leaf_area_index,Leaf area index (m2/m2),Lehtialaindeksi (m2/m2) +variable_name,total_biomass_dw,"Total biomass, dry weight (kg/ha)","Kokonaisbiomassa, kuivapaino (kg/ha)" +variable_name,tops_C,Carbon in aboveground biomass (kg[C]/ha),Biomassa maanpinnalla (kg[C]/ha) +variable_name,tops_C_std,Standard deviation of aboveground biomass C (meas.),Maanpäällisen biomassan (mittausten) keskihajonta +variable_name,roots_C,Carbon in belowground biomass (kg[C]/ha),Biomassa maanpinnan alapuolella (kg[C]/ha) +variable_name,roots_C_std,Standard deviation of belowground biomass C (meas.),Maanalaisen biomassan (mittausten) keskihajonta variable_name,canopy_height,Canopy height (m),Latvuston korkeus (m) variable_name,canopeo_reading,Canopeo reading,Canopeo-lukema variable_name,canopeo_image,Canopeo image,Canopeo-kuva @@ -143,16 +162,18 @@ variable_name,other_notes,Notes,Muistiinpanot # # labels for widgets, incl. help texts etc. # -element_label,window_title,Enter Management Events,Syötä tilanhoitotapahtumia -element_label,frontpage_text,Welcome! Here you can add new events and files and modify previously entered entries. Click on an event in the list to view details or to edit it.,Tervetuloa! Täällä voit lisätä uusia tapahtumia ja muokata aiemmin syöttämiäsi tapahtumia. Klikkaa tapahtumaa nähdäksesi lisätietoja tai muokataksesi sitä. -element_label,frontpage_table_title,Events,Tapahtumat +element_label,frontpage_title,Enter Field Management Events,Syötä tilanhoitotapahtumia +element_label,frontpage_text,"Welcome! Here you can add new events and files and modify previously entered entries. Click on an event in the list to view details or to edit it.","Tervetuloa! Täällä voit lisätä uusia tapahtumia ja muokata aiemmin syöttämiäsi tapahtumia. Klikkaa tapahtumaa nähdäksesi lisätietoja tai muokataksesi sitä." +element_label,uservisible_title,Site,Sijainti +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 " element_label,table_filter_text_3," and from year "," ja vuodelta " -element_label,table_activity_label,Choose which event types to display:,Valitse mitkä tapahtumatyypit näytetään: -element_label,table_block_label,Choose which blocks' events to display:,Valitse minkä lohkojen tapahtumat näytetään: -element_label,table_year_label,Choose which years' events to display:,Valitse minkä vuosien tapahtumat näytetään: element_label,table_empty_label,No events to display,Ei tapahtumia element_label,table_previous_label,Previous,Edellinen element_label,table_next_label,Next,Seuraava @@ -160,18 +181,24 @@ element_label,add_event_label,Add event,Lisää tapahtuma element_label,clone_event_label,Clone event,Monista tapahtuma element_label,required_variables_helptext,*Required,*Pakollinen element_label,site_label,Select the site*:,Valitse sijainti*: -element_label,block_label,Select the block*:,Valitse lohko*: -element_label,mgmt_operations_event_label,Select the activity*:,Valitse tapahtuma*: -element_label,date_label,Select the date when the activity was performed*:,Valitse päivä jolloin tapahtuma tapahtui*: -element_label,mgmt_event_notes_label,Description:,Kuvaus: -element_label,mgmt_event_notes_placeholder,"A high level description of the event, e.g. “first harvest of the year”, “spring fertilization” or “protection against rot”. This will appear on the event list.","Yleinen kuvaus tapahtumasta, esim. “vuoden ensimmäinen sadonkorjuu”, “kevätlannoitus” tai “suoja mädäntymistä vastaan”. Tämä tulee näkyviin tapahtumalistaan." element_label,save_label,Save,Tallenna element_label,cancel_label,Cancel,Peruuta element_label,delete_label,Delete,Poista -element_label,sidebar_title_edit,Edit event,Muokkaa tapahtumaa -element_label,sidebar_title_add,Add event,Lisää tapahtuma +element_label,form_title_edit,Edit event,Muokkaa tapahtumaa +element_label,form_title_add,Add event,Lisää tapahtuma element_label,file_input_button_label,Browse...,Selaa... element_label,file_input_placeholder,No file selected,Tiedostoa ei valittu +element_label,file_input_progressbar_complete_label,Upload complete,Tiedosto ladattu +element_label,delete_uploaded_file_label,Delete,Poista +element_label,total_row_name,Total,Yhteensä +# +# +# +element_label,block_label,Select the block*:,Valitse lohko*: +element_label,mgmt_operations_event_label,Select the activity*:,Valitse tapahtuma*: +element_label,date_label,Select the date when the activity was performed*:,Valitse päivä jolloin tapahtuma tapahtui*: +element_label,mgmt_event_notes_label,Description:,Kuvaus: +element_label,mgmt_event_notes_placeholder,"A high level description of the event, e.g. “first harvest of the year” or “spring fertilization”. This will appear on the event list.","Yleinen kuvaus tapahtumasta, esim. “vuoden ensimmäinen sadonkorjuu” tai “kevätlannoitus”. Tämä tulee näkyviin tapahtumalistaan." element_label,planted_crop_label,Planted crop*:,Kylvetty kasvi*: element_label,planting_material_weight_label,Weight of seeds (kg/ha):,Siementen määrä (kg/ha): element_label,planting_depth_label,Sowing depth (mm):,Kylvösyvyys (mm): @@ -179,14 +206,14 @@ element_label,planting_material_source_label,Source of seeds:,Siementen alkuper element_label,planting_material_source_placeholder,"Commercial / own seeds, seed cultivar, etc.","Ostetut / omat siemenet, lajike, jne." element_label,planting_notes_label,Notes about the sowing:,Kylvömuistiinpanoja: element_label,planting_notes_placeholder,"Any notes or observations about the event, e.g. “soil was drier than usual at the time of sowing”","Mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. “maa oli tavallista kuivempi”" -element_label,harvest_area_label,Harvest area (ha)*:,Pinta-ala (ha)*: -element_label,harvest_yield_harvest_dw_total_label,"Yield, total dry weight (kg/ha)*:","Sato, kuivapaino yhteensä (kg/ha)*:" # not in ICASA +element_label,harvest_area_label,Harvest area (ha):,Pinta-ala (ha): +element_label,harvest_yield_harvest_dw_total_label,"Yield, total dry weight (kg/ha):","Sato, kuivapaino yhteensä (kg/ha):" # not in ICASA element_label,harv_yield_harv_f_wt_total_label,"Yield, total fresh weight (t/ha):","Sato, märkäpaino yhteensä (t/ha):" # not in ICASA element_label,yield_C_at_harvest_total_label,"Carbon (C) in yield, total (kg/ha):",Hiilen (C) määrä sadossa yhteensä (kg/ha): # not in ICASA element_label,harvest_crop_label,Harvested crop*:,Korjattu laji*: element_label,harvest_operat_component_label,Crop component harvested:,Kerätty kasvinosa: element_label,canopy_height_harvest_label,Canopy height at harvest (m):,Kasvuston korkeus korjuuhetkellä (m): -element_label,harvest_cut_height_label,Height of cut (cm):,Niittokorkeus (cm): +element_label,harvest_cut_height_label,Height of cut (cm):,Leikkuukorkeus (cm): element_label,harvest_yield_harvest_dw_label,"Yield, dry weight (kg/ha):","Sato, kuivapaino (kg/ha):" element_label,harv_yield_harv_f_wt_label,"Yield, fresh weight (t/ha):","Sato, märkäpaino (t/ha):" element_label,harvest_moisture_label,"Yield moisture (%):","Sadon kosteus (%):" @@ -204,6 +231,8 @@ element_label,tillage_treatment_notes_label,Tillage notes:,Muistiinpanot muokkau element_label,tillage_treatment_notes_placeholder,"Any notes or observations about the event, e.g. “had to stop tillage and continue the next day”","Mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. “jatkoin muokkausta seuraavana päivänä”" element_label,fertilizer_type_label,Fertilizer type*:,Lannoitteen tyyppi*: element_label,organic_material_label,Organic material:,Eloperäinen aine: +element_label,animal_fert_usage_label,Animal fertilizer:,Eläimen lannoite: +element_label,animal_fert_usage_placeholder,"Which animal fertilizer, e.g. pig, horse, cow","Minkä eläimen lannoitetta, esim. sika, hevonen, lehmä" element_label,org_matter_moisture_conc_label,Moisture concentration (%):,Aineen kosteus (%): element_label,org_matter_carbon_conc_label,Carbon (C) concentration (%):,Hiilen (C) määrä aineessa (%): element_label,fertilizer_product_name_label,Name of fertilizer:,Lannoitteen nimi: @@ -214,6 +243,7 @@ element_label,fertilizer_applic_method_label,Application method:,Levitystapa: element_label,application_depth_fert_label,Application depth (cm):,Levityssyvyys (cm): element_label,fertilizer_total_amount_label,Total amount of fertilizer (kg/ha)*:,Lannoitteen kokonaismäärä (kg/ha)*: element_label,N_in_applied_fertilizer_label,nitrogen (N),typpi (N) +element_label,N_in_soluble_fertilizer_label,soluble nitrogen (N),liukeneva typpi (N) element_label,phosphorus_applied_fert_label,phosphorus (P),fosfori (P) element_label,fertilizer_K_applied_label,potassium (K),kalium (K) element_label,S_in_applied_fertilizer_label,sulphur (S),rikki (S) @@ -272,21 +302,37 @@ element_label,chemical_applic_target_label,Chemical application target*:,Kemikaa element_label,chemical_applic_method_label,Chemical application method:,Kemikaalinlevitystapa: element_label,chemical_applic_amount_label,Chemical amount (kg/ha):,Kemikaalin määrä (kg/ha): element_label,application_depth_chem_label,Chemical application depth (cm):,Kemikaalinlevityssyvyys (cm): +element_label,application_ph_start_label,pH before the application:,pH toimenpidettä ennen: +element_label,application_ph_end_label,pH after the application:,pH toimenpiteen jälkeen: element_label,chemical_applic_notes_label,Chemical application notes:,Kemikaalinlevitysmuistiinpanot: element_label,chemical_applic_notes_placeholder,"Any notes or observations about the event, e.g. “rot affecting X % of plants”","Mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. “mätää X % kasveista”" element_label,observation_type_label,Observation type*:,Havainnon tyyppi*: element_label,soil_layer_count_label,Number of layers in soil sample:,Maanäytteen kerrosten lukumäärä: element_label,soil_layer_top_depth_label,"Soil layer depth, top (cm):","Kerroksen yläosan syvyys (cm):" -element_label,soil_layer_base_depth_label,"Soil layer depth, bottom (cm):","Kerroksen alaosan syvyys (cm):", +element_label,soil_layer_base_depth_label,"Soil layer depth, bottom (cm):","Kerroksen alaosan syvyys (cm):" element_label,soil_classification_by_layer_label,Soil structure (MARA card):,Maan rakenne (MARA-kortti): +element_label,soil_bulk_density_moist_label,Bulk density (g/cm3):,Irtotiheys (g/cm3): +element_label,soil_water_wilting_pt_label,Soil water content at wilting point (cm3/cm3):,Nuutumispiste (cm3/cm3): +element_label,soil_water_field_cap_1_label,"Soil water content at field capacity, 30 kPA (cm3/cm3):", "Kenttäkapasiteetti, 30 kPA (cm3/cm3):" +element_label,soil_water_saturated_label,Soil water content at saturation (cm3/cm3):,Kylläisyyspiste (cm3/cm3): +element_label,soil_silt_fraction_label,Soil silt fraction (%):,Maaperän lietteen osuus (%): +element_label,soil_sand_fraction_label,Soil sand fraction (%):,Maaperän hiekan osuus (%): +element_label,soil_clay_fraction_label,Soil clay fraction (%):,Maaperän saven osuus (%): +element_label,soil_organic_matter_layer_label,Total soil organic matter (kg[OM]/ha):,Maaperän orgaaninen aines (kg[OA]/ha): +element_label,soil_organic_C_perc_layer_label,Total soil organic carbon content (%):,Orgaanisen hiilen osuus (%): element_label,root_depth_label,Root depth (m):,Juurten syvyys (m): element_label,soil_compactification_depth_label,Soil compactification depth (cm):,Tiivistymän syvyys (cm): element_label,earthworm_count_label,Number of earthworms:,Lierojen lukumäärä: element_label,soil_image_label,Photo of soil:,Kuva maaperästä: -element_label,growth_stage_label,Plant growth stage:,Kasvuvaihe: +element_label,growth_stage_label,Plant growth stage:,Kasvuaste: element_label,plant_density_label,Plant density (plants/m2):,Kasvitiheys (plants/m2): element_label,specific_leaf_area_label,Specific leaf area (cm2/g):,Ominaislehtiala (cm2/g): element_label,leaf_area_index_label,Leaf area index (m2/m2):,Lehtialaindeksi (m2/m2): +element_label,total_biomass_dw_label,"Total biomass, dry weight (kg/ha):","Kokonaisbiomassa, kuivapaino (kg/ha):" +element_label,tops_C_label,Carbon in aboveground biomass (kg[C]/ha):,Hiiltä biomassassa maanpinnalla (kg[C]/ha): +element_label,tops_C_std_label,Standard deviation of aboveground biomass C (meas.):,Maanpäällisen hiilibiomassan (mittausten) keskihajonta: +element_label,roots_C_label,Carbon in belowground biomass (kg[C]/ha):,Hiiltä biomassassa maanpinnan alapuolella (kg[C]/ha): +element_label,roots_C_std_label,Standard deviation of belowground biomass C (meas.):,Maanalaisen hiilibiomassan (mittausten) keskihajonta: element_label,canopy_height_label,Canopy height (m):,Latvuston korkeus (m): element_label,canopeo_reading_label,Canopeo reading:,Canopeo-lukema: element_label,canopeo_image_label,Canopeo image:,Canopeo-kuva: @@ -314,7 +360,6 @@ element_label,weeding_notes_placeholder,"Any notes or observations about the eve element_label,bed_prep_notes_label,Notes on the preparation of raised beds:,Muistiinpanot kasvatuslaatikoiden valmistelusta: element_label,bed_prep_notes_placeholder,"Any notes or observations about the event, e.g. “used the beds from last year”","Mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. “käytettiin samoja kasvatuslaatikoita kuin edellisenä vuonna”" element_label,other_notes_label,Event notes*:,Muistiinpanoja tapahtumasta*: -element_label,delete_uploaded_file_label,Delete,Poista # ############### others # @@ -323,17 +368,49 @@ CRID,WHT,Wheat (Triticum spp.),Vehnä (Triticum spp.) CRID,OAT,Oats (Avena sativa),Kaura (Avena sativa) CRID,RYE,Rye (Secale cereale),Ruis (Secale cereale) CRID,BAR,Barley (Hordeum vulgare),Ohra (Hordeum vulgare) +CRID,TRT,Triticale (x Triticosecale),Ruisvehnä (x Triticosecale) +CRID,EMW,Emmer wheat (Triticum dicoccon), Emmervehnä (Triticum dicoccon) #not ICASA CRID,ZZ1,Mixed grain,Seosvilja +CRID,ZZ3,Mixed grass,Seosruoho CRID,BWH,Buckwheat (Fagopyrum esculentum),Tattari (Fagopyrum esculentum) CRID,POT,Potato (Solanum tuberosum),Peruna (Solanum tuberosum) -CRID,SBT,Sugar beet (Beta vulgaris var. altissima),Sokerijuurikas (Beta vulgaris var. altissima) +CRID,SBT,Sugar beet (Beta vulgaris var. altissima),Sokerijuurikas (Beta vulgaris var. altissima) CRID,PEA,Pea (Pisum sativum),Herne (Pisum sativum) CRID,FBN,Faba bean (Vicia faba),Härkäpapu (Vicia faba) +CRID,FHSO,Hemp seed oil (Finola),Öljyhamppu (Finola) # not ICASA but Hemp would be CRID,RYP,Turnip rape (Brassica rapa subsp. oleifera),Rypsi (Brassica rapa subsp. oleifera) # not ICASA CRID,RAP,Rapeseed (Brassica napus subsp. napus),Rapsi (Brassica napus subsp. napus) CRID,FLX,Flax (Linum usitatissimum),Pellava (Linum usitatissimum) CRID,CCA,Caraway (Carum carvi),Kumina (Carum carvi) # not ICASA CRID,PHA,Reed canary grass (Phalaris arundinacea),Ruokohelpi (Phalaris arundinacea) #not ICASA +CRID,RCL,Red clover (Trifolium pratense),Puna-apila (Trifolium pratense) +CRID,WCL,White clover (Trifolium repens),Valkoapila (Trifolium repens) # not ICASA +CRID,WSC,White sweetclover (Melilotus albus),Valkomesikkä (Melilotus albus) # not ICASA +CRID,BFT,Bird's-foot trefoil (Lotus corniculatus),Keltamaite(Lotus corniculatus) #not ICASA +CRID,CRC,Crimson glover (Trifolium incarnatum),Veriapila (Trifolium incarnatum) #not ICASA +CRID,ACL,Alsike clover (Trifolium hybridum),Alsikeapila (Trifolium hybridum) # not ICASA +CRID,ALC,Aleksandria clover (Trifolium Alexandrinum L), Aleksandrian apila (Trifolium Alexandrinum L) #not ICASA +CRID,ALF,Alfalfa (Medicago sativa),Sinimailanen (Medicago sativa) +CRID,RSO,Oilseed radish (Raphanus sativus var. oleiformis),Öljyretikka (Raphanus sativus var. oleiformis) # not ICASA +CRID,RAD,(Tillage) radish (Raphanus sativus), Muokkausretikka (Raphanus sativus) +CRID,VSA,Common vetch (Vicia sativa),Rehuvirna (Vicia sativa) # not ICASA +CRID,BRI,Smooth brome (Bromus inermis),Rehukattara (Bromus inermis) # not ICASA +CRID,FEP,Meadow fescue (Festuca pratensis),Nurminata (Festuca pratensis) # not ICASA +CRID,CAM,Camelina (Camelina sativa),Ruistankio (Camelina sativa) +CRID,CAG,Cat grass (Dactylis glomerata),Koiranheinä (Dactylis glomerata) # not ICASA +CRID,SIM,Sickle medic (Medicago falcata),Rehumailanen (Medicago falcata) #not ICASA +CRID,RGP,Perennial ryegrass (Lolium perenne),Englanninraiheinä (Lolium perenne) +CRID,POA,Kentucky bluegrass (Poa pratensis),Niittynurmikka (Poa pratensis) # not ICASA +CRID,SDR,Sudan grass (Sorghum × drummondii),Sudaninruoho (Sorghum × drummondii) # not ICASA +CRID,SPE,Spelt (Triticum spelta),Speltti (Triticum spelta) # not ICASA +CRID,SUN,Sunflower (Helianthus annuus),Auringonkukka (Helianthus annuus) +CRID,RGA,Annual ryegrass (Festuca perennis / Lolium multiflorum),Italianraiheinä (Festuca perennis / Lolium multiflorum) # Latin name different in ICASA +CRID,TFS,Tall fescue (Festuca arundinacea / Schedonorus arundinaceus),Ruokonata (Festuca arundinacea / Schedonorus arundinaceus) # Latin name different in ICASA +CRID,HVT,Hairy vetch (Vicia villosa),Ruisvirna (Vicia villosa) +CRID,TRM,Persian clover (Trifolium resupinatum var. majus),Persianapila (Trifolium resupinatum var. majus) # not ICASA +CRID,XFL,Hybrid fescue (x Festulolium loliaceum),Rainata (x Festulolium loliaceum) # not ICASA not sure about the names +CRID,CII,Common chicory (Cichorium intybus),Sikuri (Cichorium intybus) # not ICASA +CRID,PHT,Lacy phacelia (Phacelia tanacetifolia),Aitohunajakukka (Phacelia tanacetifolia) HACOM,canopy,Canopy,Latvusto HACOM,leaf,Leaves,Lehdet HACOM,grain,"Grain, legume seeds","Jyvä, palkokasvin siemen" @@ -341,14 +418,14 @@ HACOM,silage,Silage,Säilörehu HACOM,tuber,"Tuber, root, etc.","Mukula, juuri, yms." HACOM,fruit,Fruit,Hedelmä #HACOM,fiber,Fiber,Kuitu -#HACOM,seed_cotton,"Cotton boil, including lint","Puuvillakeite, myös nukka" +# HACOM,seed_cotton,"Cotton boil, including lint","Puuvillakeite, myös nukka" HACOM,stem,Stem,Varsi HARM,HM001,Combined,Leikkuupuimuri -#HARM,HM002,"Hand cut, machine threshed","Leikattu käsin, puitu koneella" -#HARM,HM003,"Hand cut, hand threshed","Leikattu käsin, puitu käsin" +# HARM,HM002,"Hand cut, machine threshed","Leikattu käsin, puitu koneella" +# HARM,HM003,"Hand cut, hand threshed","Leikattu käsin, puitu käsin" HARM,HM004,"Hand picked, no further processing","Poimittu käsin, ei muuta prosessointia" HARM,HM005,"Hand picked, machine processing","Poimittu käsin, prosessoitu koneella" -#HARM,HM006,Cotton stripper,Puuvillakone +# HARM,HM006,Cotton stripper,Puuvillakone HARM,HM007,Hay,Heinä # not in ICASA HARM,HM008,Silage,Säilörehu # not in ICASA HARM,HM009,Potato harvester,Perunannostokone # not in ICASA @@ -365,33 +442,33 @@ OMCD,RE004,Liquid manure,Lietelanta OMCD,RE005,Compost,Komposti OMCD,RE006,Bark,Kaarna OMCD,RE101,Generic legume residue,Palkokasvijäte -#OMCD,RE102,Cowpea residue,RE102-käännös -#OMCD,RE103,Mucuna residue,RE103-käännös -#OMCD,RE104,Peanut residue,RE104-käännös -#OMCD,RE105,Pigeon Pea residue,RE105-käännös -#OMCD,RE106,Soybean residue,RE106-käännös -#OMCD,RE107,Alfalfa residue,RE107-käännös -#OMCD,RE108,Chickpea forage,RE108-käännös +# OMCD,RE102,Cowpea residue,RE102-käännös +# OMCD,RE103,Mucuna residue,RE103-käännös +# OMCD,RE104,Peanut residue,RE104-käännös +# OMCD,RE105,Pigeon Pea residue,RE105-käännös +# OMCD,RE106,Soybean residue,RE106-käännös +# OMCD,RE107,Alfalfa residue,RE107-käännös +# OMCD,RE108,Chickpea forage,RE108-käännös OMCD,RE109,Faba bean,Härkäpapu OMCD,RE110,Pea residue,Hernejäte OMCD,RE111,Hairy vetch,Ruisvirna OMCD,RE201,Generic cereal crop residue,Viljakasvijäte -#OMCD,RE202,Pearl millet residue,RE202-käännös -#OMCD,RE203,Maize residue,RE203-käännös -#OMCD,RE204,Sorghum residue,RE204-käännös +# OMCD,RE202,Pearl millet residue,RE202-käännös +# OMCD,RE203,Maize residue,RE203-käännös +# OMCD,RE204,Sorghum residue,RE204-käännös OMCD,RE205,Wheat residue,Vehnäjäte OMCD,RE206,Barley,Ohra -#OMCD,RE207,Rice,Riisi +# OMCD,RE207,Rice,Riisi OMCD,RE208,Rye,Ruis OMCD,RE301,Generic grass,Ruohokasvi -#OMCD,RE302,Bahiagrass,Bahiagrass-käännös +# OMCD,RE302,Bahiagrass,Bahiagrass-käännös OMCD,RE303,Bermudagrass,Varvasheinä OMCD,RE304,Switchgrass,Lännenhirssi OMCD,RE305,brachiaria,viittaheinät OMCD,RE306,forage grasses,nurmikasvit -#OMCD,RE401,Bush fallow residue,Bush fallow residue -käännös -#OMCD,RE402,Sugarcane,Sokeriruoko -#OMCD,RE403,Pineapple,Pineapple-käännös +# OMCD,RE401,Bush fallow residue,Bush fallow residue -käännös +# OMCD,RE402,Sugarcane,Sokeriruoko +# OMCD,RE403,Pineapple,Pineapple-käännös OMCD,RE999,Decomposed crop residue,Maatunut kasvijäte OMCD,REOTHER,Other,Muu FEACD,AP001,"Broadcast, not incorporated","Levitetty pinnalle, ei sekoitettu" @@ -400,7 +477,7 @@ FEACD,AP003,Banded on surface,Nauhoina pinnalla FEACD,AP004,Banded beneath surface,Sijoituslannoitus FEACD,AP005,Applied in irrigation water,Kasteluveden mukana FEACD,AP006,Foliar spray,Suihkutettu lehdelle -FEACD,AP007,Bottom of hole,Bottom of hole-käännös +FEACD,AP007,Bottom of hole,Bottom of hole -käännös FEACD,AP008,On the seed,Siemenen pinnassa FEACD,AP009,Injected,Ruiskutettu pinnan alle # FEACD,AP011,"Broadcast on flooded/saturated soil, none in soil",AP011-käännös @@ -411,56 +488,63 @@ FEACD,AP009,Injected,Ruiskutettu pinnan alle # FEACD,AP016,"Broadcast on flooded/saturated soil, 75% in soil",AP016-käännös # FEACD,AP017,"Broadcast on flooded/saturated soil, 90% in soil",AP017-käännös # FEACD,AP018,"Band on saturated soil, 2cm flood, 92% in soil",AP018-käännös -#FEACD,AP019,"Deeply placed urea super granules/pellets, 95% in soil","Deeply placed urea super granules/pellets, 95% in soil -käännös" -#FEACD,AP020,"Deeply placed urea super granules/pellets, 100% in soil","Deeply placed urea super granules/pellets, 100% in soil -käännös" +# FEACD,AP019,"Deeply placed urea super granules/pellets, 95% in soil","Deeply placed urea super granules/pellets, 95% in soil -käännös" +# FEACD,AP020,"Deeply placed urea super granules/pellets, 100% in soil","Deeply placed urea super granules/pellets, 100% in soil -käännös" FEACD,AP999,Method unknown/not given,Tapa ei tiedossa +# Related to soil amendment substance, not found from ICASA table! +FECD,FE996,Bio char,Biohiili +FECD,FE997,Peat,Turve +FECD,FE998,Sawdust,Sahanpuru +FECD,FE999,Wood chip,Puulastu # the following tillage_practice choices are not from ICASA tillage_practice_choice,tillage_practice_primary,Primary (residue incorporation),Perusmuokkaus tillage_practice_choice,tillage_practice_secondary,Secondary (seedbed),Kylvömuokkaus tillage_practice_choice,tillage_practice_tertiary,Tertiary (weed control),Rikkakasvien torjunta -#TIIMP,TI001,V-Ripper,TI001-käännös -TIIMP,TI002,Subsoiler,Jankkuri (subsoiler?) -TIIMP,TI003,Mould-board plough,Mould-board plough-käännös # in ICASA this is Moldboard plow 20cm depth, here we use it for all depths -#TIIMP,TI004,"Chisel plow, sweeps",TI004-käännös -#TIIMP,TI005,"Chisel plow, straight point",TI005-käännös -#TIIMP,TI006,"Chisel plow, twisted shovels",TI006-käännös -#TIIMP,TI007,Disk plow,TI007-käännös -#TIIMP,TI008,"Disk, 1-way",TI008-käännös +# TIIMP,TI001,V-Ripper,TI001-käännös +TIIMP,TI002,Subsoiler,Jankkuri +TIIMP,TI003,Mould-board plough,Kyntöaura # in ICASA this is Moldboard plow 20cm depth here we use it for all depths +# TIIMP,TI004,"Chisel plow, sweeps",TI004-käännös +# TIIMP,TI005,"Chisel plow, straight point",TI005-käännös +# TIIMP,TI006,"Chisel plow, twisted shovels",TI006-käännös +# TIIMP,TI007,Disk plow,TI007-käännös +# TIIMP,TI008,"Disk, 1-way",TI008-käännös TIIMP,TI009,"Disk, tandem",Lautasäes -#TIIMP,TI010,"Disk, double disk",TI010-käännös +# TIIMP,TI010,"Disk, double disk",TI010-käännös TIIMP,TI011,"Cultivator, field",Kultivaattori -#TIIMP,TI012,"Cultivator, row",TI012-käännös -#TIIMP,TI013,"Cultivator, ridge till",TI013-käännös -#TIIMP,TI014,"Harrow, spike",TI014-käännös +# TIIMP,TI012,"Cultivator, row",TI012-käännös +# TIIMP,TI013,"Cultivator, ridge till",TI013-käännös +# TIIMP,TI014,"Harrow, spike",TI014-käännös TIIMP,TI015,"Harrow, tine",Joustopiikkiäes -TIIMP,TI016,Lister,Lister-käännös -#TIIMP,TI017,Bedder,Bedder-käännös -TIIMP,TI018,Blade cultivator,Blade cultivator -käännös -#TIIMP,TI019,"Fertilizer applicator, anhydr",TI019-käännös +TIIMP,TI016,Lister,Multain +# TIIMP,TI017,Bedder,Bedder-käännös +TIIMP,TI018,Blade cultivator,Hara +# TIIMP,TI019,"Fertilizer applicator, anhydr",TI019-käännös TIIMP,TI020,Manure injector,Lannansijoituskone (Manure injector?) -#TIIMP,TI022,Mulch treader,TI022-käännös -#TIIMP,TI023,Plank,TI023-käännös -TIIMP,TI024,Roller packer,Roller packer -käännös -TIIMP,TI025,"Drill, double-disk","Drill, double-disk -käännös" -#TIIMP,TI026,"Drill, deep furrow",TI026-käännös -TIIMP,TI031,"Drill, no-till","Drill, no-till -käännös" -#TIIMP,TI032,"Drill, no-till (into sod)",TI032-käännös -TIIMP,TI033,"Planter, row","Planter, row -käännös" -#TIIMP,TI034,"Planter, no-till",TI034-käännös -#TIIMP,TI035,Planting stick (hand),TI035-käännös -#TIIMP,TI036,Matraca hand planter,TI036-käännös -#TIIMP,TI037,Rod weeder,TI037-käännös -TIIMP,TI038,Rotary hoe,Rotary hoe -käännös -#TIIMP,TI039,"Roller harrow, cultipacker",TI039-käännös -#TIIMP,TI041,Moldboard plow 25cm,TI041-käännös -#TIIMP,TI042,Moldboard plow 30 cm,TI042-käännös -#TIIMP,TI043,Strip tillage,TI043-käännös +# TIIMP,TI022,Mulch treader,TI022-käännös +# TIIMP,TI023,Plank,TI023-käännös +TIIMP,TI024,Roller packer,Jyrä (roller packer?) +TIIMP,TI025,"Drill, double-disk","Suorakylvökone, kaksoiskiekot (drill, double disk?)" +# TIIMP,TI026,"Drill, deep furrow",TI026-käännös +TIIMP,TI031,"Drill, no-till","Suorakylvökone, ei muokkausta (drill, no-till?)" +# TIIMP,TI032,"Drill, no-till (into sod)",TI032-käännös +TIIMP,TI033,"Planter, row","Kylvökone (planter, row?)" +# TIIMP,TI034,"Planter, no-till",TI034-käännös +# TIIMP,TI035,Planting stick (hand),TI035-käännös +# TIIMP,TI036,Matraca hand planter,TI036-käännös +# TIIMP,TI037,Rod weeder,TI037-käännös +TIIMP,TI038,Rotary hoe,Maanjyrsin (rotary hoe?) +# TIIMP,TI039,"Roller harrow, cultipacker",TI039-käännös +# TIIMP,TI041,Moldboard plow 25cm,TI041-käännös +# TIIMP,TI042,Moldboard plow 30 cm,TI042-käännös +# TIIMP,TI043,Strip tillage,TI043-käännös TIIMP,TI044,Tine weeder,Rikkaäes #not on ICASA +TIIMP,TI045,Spade disk harrow,Lapiorullaäes #not on ICASA TIIMP,TI999,Other,Muu #not on ICASA # the following fertilizer_type_choice tags are not in ICASA fertilizer_type_choice,fertilizer_type_organic,Organic,Eloperäinen lannoite fertilizer_type_choice,fertilizer_type_mineral,Mineral,Väkilannoite fertilizer_type_choice,fertilizer_type_soil_amendment,Soil amendment,Maanparannusaine +# grazing_species_choice,grazing_species_cattle,Cattle,Nautakarja grazing_species_choice,grazing_species_sheep,Sheep,Lampaat grazing_species_choice,grazing_species_goat,Goats,Vuohet @@ -468,18 +552,22 @@ grazing_species_choice,grazing_species_mix,Mix,Useita grazing_species_choice,grazing_species_other,Other,Muu grazing_species_age_group_choice,grazing_species_age_group_mix,Mix,Useita grazing_type_choice,grazing_type_continuous,Continuous,Jatkuva -grazing_type_choice,grazing_type_rotation,Rotation,Kiertolaidunnus -grazing_type_choice,grazing_type_mob_grazing,Mob grazing,Mob grazing -käännös -grazing_type_choice,grazing_type_strip,Strip,Strip-käännös -grazing_type_choice,grazing_type_multi_species,Multi-species,Multi-species-käännös -grazing_type_choice,grazing_type_creep,Creep,Creep-käännös, -grazing_type_choice,grazing_type_forward,Forward,Forward-käännös +grazing_type_choice,grazing_type_rotation,Rotation,Lohkosyöttö +grazing_type_choice,grazing_type_mob_grazing,Mob grazing,Intensiivinen lohkosyöttö +grazing_type_choice,grazing_type_strip,Strip,Kaistasyöttö +grazing_type_choice,grazing_type_multi_species,Multi-species,Sekalaidunnus +grazing_type_choice,grazing_type_creep,Creep,Nuoret eläimet paremmalle lohkolle (Creep?) +grazing_type_choice,grazing_type_forward,Forward,Kaksoislaidunnus grazing_type_choice,grazing_type_other,Other,Muu -chemical_type_choice,chemical_type_insecticide,Insecticide,Hyönteismyrkky -chemical_type_choice,chemical_type_herbicide,Herbicide,Rikkaruohomyrkky -chemical_type_choice,chemical_type_fungicide,Fungicide,Sienimyrkky +chemical_type_choice,chemical_type_insecticide,Insecticide,Hyönteistorjunta-aine +chemical_type_choice,chemical_type_herbicide,Herbicide,Rikkakasvien torjunta-aine +chemical_type_choice,chemical_type_fungicide,Fungicide,Sienitautien torjunta-aine chemical_type_choice,chemical_type_growth_regulator,Growth regulator,Kasvunsääde -active_substance,AS001,(E,E)-8,10-dodekadien-1-oli,(E,E)-8,10-dodekadien-1-oli +chemical_type_choice,chemical_type_lime_application,Lime application, Kalkin levitys +chemical_type_choice,chemical_type_gypsum_application,Gypsum application,Kipsin levitys +# source for active substances (in Finnish): +# https://www.kemidigi.fi/kasvinsuojeluainerekisteri/haku +active_substance,AS001,"(E,E)-8,10-dodekadien-1-oli","(E,E)-8,10-dodekadien-1-oli" active_substance,AS002,(Z)-11-tetradeken-1-yyliasetaatti,(Z)-11-tetradeken-1-yyliasetaatti active_substance,AS003,"1,4-dimetyylinaftaleeni","1,4-dimetyylinaftaleeni" active_substance,AS004,"2,4-D","2,4-D" @@ -659,15 +747,15 @@ active_substance,AS177,Tritikonatsoli,Tritikonatsoli active_substance,AS178,Tritosulfuroni,Tritosulfuroni active_substance,AS179,Urea,Urea active_substance,AS180,viherminttuöljy,viherminttuöljy -CH_TARGETS,BIRD,Birds,Linnut +# CH_TARGETS,BIRD,Birds,Linnut # this is apparently illegal CH_TARGETS,PCLA,Defoliation %,Lehtikato CH_TARGETS,PDLA,Diseased leaf area %,Tautia lehdissä -CH_TARGETS,PSTDS,General pest and diseases losses (due to rot, tikka, leafminer, etc.),Yleiset tuhoeläin- ja tautivahingot (mätä, miinaajat jne.) +CH_TARGETS,PSTDS,"General pest and diseases losses (due to rot, tikka, leafminer, etc.)","Yleiset tuhoeläin- ja tautivahingot (mätä, miinaajat jne.)" CH_TARGETS,PRP,Reduction in photosynthetic rate %,Lasku yhteyttämisnopeudessa % CH_TARGETS,WORM,Worm (generic),Madot CH_TARGETS,LEAF_MIN,Leafminer,Miinaajat -CH_TARGETS,STINKB,Stink bug,Typpyluteet(?) -CH_TARGETS,LOOPER,Looper,Looper-käännös +CH_TARGETS,STINKB,Stink bug,Typpyluteet (Stink bug?) +CH_TARGETS,LOOPER,Looper,Yökkösentoukat (Looper?) CH_TARGETS,CATERP,Caterpillar,Perhostoukat CH_TARGETS,INSECT,Insect (generic),Hyönteiset CH_TARGETS,RABBIT,Rabbit,Jänikset @@ -685,6 +773,7 @@ CH_TARGETS,DROUGHT,Drought,Kuivuus CH_TARGETS,WEATHER,Weather damage (generic),Yleiset säävahingot CH_TARGETS,BRLFWD,Broad-leafed weeds,Leveälehtiset rikkakasvit CH_TARGETS,WEED,Weeds (generic),Yleiset rikkakasvit +CH_TARGETS,ACIDITY,Acidity (pH),Happamuus (pH) observation_type_choice,observation_type_soil,Soil,Maaperä observation_type_choice,observation_type_vegetation,Vegetation,Kasvillisuus observation_type_choice,observation_type_water,Water,Vesi @@ -705,33 +794,33 @@ growth_stage_choice,growth_stage_budding,Budding,Budding-käännös growth_stage_choice,growth_stage_blooming,Blooming,Blooming-käännös growth_stage_choice,growth_stage_seeding,Seeding,Seeding-käännös growth_stage_choice,growth_stage_maturity,Maturity,Maturity-käännös -IROP,IR001,Furrow,Furrow-käännös -IROP,IR002,Alternating furrows,Alternating furrows-käännös +IROP,IR001,Furrow,Vakokastelu +IROP,IR002,Alternating furrows,Vuorotteleva vakokastelu (alternating furrows?) IROP,IR003,Flood,Tulva IROP,IR004,Sprinkler,Sadetin -IROP,IR005,Drip or trickle,Drip or trickle -käännös -#IROP,IR006,Flood depth, -#IROP,IR007,Water table depth, -#IROP,IR008,Percolation rate, -#IROP,IR009,Bund height, -#IROP,IR010,Puddling (for Rice only) -#IROP,IR011,Constant flood depth, -IROP,IR012,Subsurface (buried) drip,Subsurface (buried) drip -käännös +IROP,IR005,Drip or trickle,Tihkukastelu +# IROP,IR006,Flood depth, +# IROP,IR007,Water table depth, +# IROP,IR008,Percolation rate, +# IROP,IR009,Bund height, +# IROP,IR010,Puddling (for Rice only) +# IROP,IR011,Constant flood depth, +IROP,IR012,Subsurface (buried) drip,Maanalainen tihkukastelu IROP,IR999,Unknown/not given,Ei tiedossa -MLTP,MT001,Polyethylene sheet - solid,Katemuovi (PE) (Polyethylene sheet?) -MLTP,MT002,Polyethylene sheet - perforated,Rei'itetty katemuovi (PE) (Polyethylene sheet - perforated?) +MLTP,MT001,Polyethylene sheet - solid,Katemuovi (PE) +MLTP,MT002,Polyethylene sheet - perforated,Rei'itetty katemuovi (PE) MLTP,MT003,Landscape fabric,Maisemointikangas MLTP,MT004,Paper,Paperi MLTP,MT005,Grass clippings,Leikattu ruoho MLTP,MT006,Pine needles,Männynneulaset MLTP,MT007,Straw,Olki -MLTP,MT008,Foil,Foil-käännös -MLTP,MT009,Foil coated plastic,Foil coated with plastic -käännös -MLTP,MT010,Photodegradable plastic,Photodegradable plastic -käännös +MLTP,MT008,Foil,Folio (foil?) +MLTP,MT009,Foil coated plastic,Muovipäällysteinen folio (foil coated with plastic?) +MLTP,MT010,Photodegradable plastic,Valohajoava muovi MLTP,MT999,Not given/unknown,Ei tiedossa MLCOL,MC001,Transparent,Läpinäkyvä MLCOL,MC002,White,Valkoinen MLCOL,MC003,Black,Musta MLCOL,MC004,Brown,Ruskea -MLCOL,MC005,Gray,Harmaa +MLCOL,MC005,Grey,Harmaa MLCOL,MC006,Light straw color,Olki diff --git a/inst/extdata/management-event.schema.json b/inst/extdata/management-event.schema.json new file mode 100644 index 0000000..c35f6cc --- /dev/null +++ b/inst/extdata/management-event.schema.json @@ -0,0 +1,3815 @@ +{ + "$schema": "http://json-schema.org/draft-07/schema", + "$id": "management-event.schema.json", + "@context": { + "@language": "en", + "title": { + "@id": "dc:title", + "@language": "en" + }, + "title_fi": { + "@id": "dc:title", + "@language": "fi" + }, + "title_sv": { + "@id": "dc:title", + "@language": "sv" + }, + "unitless_title": { + "@id": "fo:unitless_title", + "@language": "en" + }, + "unitless_title_fi": { + "@id": "fo:unitless_title", + "@language": "fi" + }, + "unitless_title_sv": { + "@id": "fo:unitless_title", + "@language": "sv" + }, + "description": { + "@id": "dc:description", + "@language": "en" + }, + "description_fi": { + "@id": "dc:description", + "@language": "fi" + }, + "description_sv": { + "@id": "dc:description", + "@language": "sv" + }, + "form-placeholder": { + "@id": "fo:form-placeholder", + "@language": "en" + }, + "form-placeholder_fi": { + "@id": "fo:form-placeholder", + "@language": "fi" + }, + "form-placeholder_sv": { + "@id": "fo:form-placeholder", + "@language": "sv" + } + }, + "title": "management event", + "title_fi": "tilanhoitotapahtuma", + "title_sv": "inträffande av metoden", + "type": "object", + "properties": { + "$schema": { + "type": "string", + "format": "url", + "const": "https://raw.githubusercontent.com/hamk-uas/fieldobservatory-data-schemas/main/management-event.schema.json" + }, + "mgmt_operations_event": { + "title": "event", + "title_en": "event", + "title_fi": "tapahtuma", + "type": "string", + "x-ui": { + "discriminator": true + } + }, + "date": { + "title": "date", + "title_en": "the date when the activity was performed", + "title_fi": "päivä jolloin tapahtuma tapahtui", + "type": "string", + "format": "date" + }, + "mgmt_event_short_notes": { + "title": "description", + "title_en": "description", + "title_fi": "kuvaus", + "type": "string", + "x-ui": { + "placeholder": "A high level description of the event, e.g. \"first harvest of the year\" or \"spring fertilization\". This will appear on the event list.", + "placeholder_fi": "Yleinen kuvaus tapahtumasta, esim. \"vuoden ensimmäinen sadonkorjuu\" tai \"kevätlannoitus\". Tämä tulee näkyviin tapahtumalistaan." + } + } + }, + "oneOf": [ + { + "$id": "#planting", + "title": "sowing", + "title2": "planting", + "title_fi": "kylvö", + "title_sv": "sådd", + "properties": { + "mgmt_operations_event": { + "title": "sowing", + "title2": "planting", + "title_fi": "kylvö", + "title_sv": "sådd", + "const": "planting" + }, + "planting_list": { + "type": "array", + "title": "planting list", + "title_fi": "kylvölista", + "items": { + "type": "object", + "properties": { + "planted_crop": { + "allOf": [ + { + "title": "planted crop", + "title_fi": "kylvetty laji", + "title_sv": "sådd gröda" + }, + { + "$ref": "#/$defs/crop_ident_ICASA" + } + ] + }, + "planting_material_weight": { + "title": "weight of seeds (kg/ha)", + "title2": "planting material weight (kg/ha)", + "title_fi": "siementen määrä (kg/ha)", + "title2_fi": "kylvetyn materiaalin paino (kg/ha)", + "title_sv": "vikt av sådd material (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "weight of seeds", + "unitless_title2": "planting material weight", + "unitless_title_fi": "siementen määrä", + "unitless_title2_fi": "kylvetyn materiaalin paino", + "unitless_title_sv": "vikt av sådd material" + } + }, + "planting_depth": { + "title": "sowing depth (mm)", + "title2": "planting depth (mm)", + "title_fi": "kylvösyvyys (mm)", + "title2_fi": "sådjup (mm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "mm", + "unitless_title": "sowing depth", + "unitless_title2": "planting depth", + "unitless_title_fi": "kylvösyvyys", + "unitless_title2_fi": "sådjup" + } + }, + "planting_material_source": { + "title": "source of seeds", + "title2": "planting material source", + "title_fi": "siementen alkuperä", + "title2_fi": "kylvetyn materiaalin alkuperä", + "title_sv": "ursprung på sådda materialet", + "type": "string", + "x-ui": { + "form-type": "textInput", + "form-placeholder": "commercial / own seeds, seed cultivar, etc.", + "form-placeholder_fi": "ostetut / omat siemenet, lajike, jne." + } + } + }, + "required": [ + "planted_crop" + ] + }, + "minItems": 1 + }, + "mgmt_event_long_notes": { + "title": "sowing notes", + "title2": "planting notes", + "title_fi": "kylvömuistiinpanoja", + "title2_fi": "kylvömuistiinpanot", + "title_sv": "såddanteckningar", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"soil was drier than usual at the time of sowing\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. \"maa oli tavallista kuivempi\"" + } + } + }, + "required": [ + "date", + "planting_list" + ] + }, + { + "$id": "#fertilizer", + "title": "fertilizer application", + "title_fi": "lannoitteen levitys", + "title_sv": "spridning av gödslingsmedel", + "properties": { + "mgmt_operations_event": { + "title": "fertilizer application", + "title_fi": "lannoitteen levitys", + "title_sv": "spridning av gödslingsmedel", + "const": "fertilizer" + }, + "N_in_applied_fertilizer": { + "title": "amount of total nitrogen (N) in fertilizer (kg/ha)", + "title2": "amount of nitrogen (N) in fertilizer (kg/ha)", + "title_fi": "typen (N) määrä lannoitteessa (kg/ha)", + "title_sv": "mängden lväve (N) i gödseln (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of total nitrogen (N) in fertilizer", + "unitless_title2": "amount of nitrogen (N) in fertilizer", + "unitless_title_fi": "typen (N) määrä lannoitteessa", + "unitless_title_sv": "mängden lväve (N) i gödseln" + } + }, + "N_in_soluble_fertilizer": { + "title": "amount of soluble nitrogen (N) in fertilizer (kg/ha)", + "title_fi": "liukenevan typen (N) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of soluble nitrogen (N) in fertilizer", + "unitless_title_fi": "liukenevan typen (N) määrä lannoitteessa" + } + }, + "phosphorus_applied_fert": { + "title": "amount of phosphorus (P) in fertilizer (kg/ha)", + "title_fi": "fosforin (P) määrä lannoitteessa (kg/ha)", + "title_sv": "mängden fosfor (P) i gödseln (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of phosphorus (P) in fertilizer", + "unitless_title_fi": "fosforin (P) määrä lannoitteessa", + "unitless_title_sv": "mängden fosfor (P) i gödseln" + } + }, + "fertilizer_K_applied": { + "title": "amount of potassium (K) in fertilizer (kg/ha)", + "title_fi": "kaliumin (K) määrä lannoitteessa (kg/ha)", + "title_sv": "mängden kalium (K) i gödseln (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of potassium (K) in fertilizer", + "unitless_title_fi": "kaliumin (K) määrä lannoitteessa", + "unitless_title_sv": "mängden kalium (K) i gödseln" + } + }, + "S_in_applied_fertilizer": { + "title": "amount of sulphur (S) in fertilizer (kg/ha)", + "title_fi": "rikin (S) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of sulphur (S) in fertilizer", + "unitless_title_fi": "rikin (S) määrä lannoitteessa" + } + }, + "Ca_in_applied_fertilizer": { + "title": "amount of calcium (Ca) in fertilizer (kg/ha)", + "title_fi": "kalsiumin (Ca) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of calcium (Ca) in fertilizer", + "unitless_title_fi": "kalsiumin (Ca) määrä lannoitteessa" + } + }, + "Mg_in_applied_fertilizer": { + "title": "amount of magnesium (Mg) in fertilizer (kg/ha)", + "title_fi": "magnesiumin (Mg) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of magnesium (Mg) in fertilizer", + "unitless_title_fi": "magnesiumin (Mg) määrä lannoitteessa" + } + }, + "Na_in_applied_fertilizer": { + "title": "amount of sodium (Na) in fertilizer (kg/ha)", + "title_fi": "natriumin (Na) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of sodium (Na) in fertilizer", + "unitless_title_fi": "natriumin (Na) määrä lannoitteessa" + } + }, + "Cu_in_applied_fertilizer": { + "title": "amount of copper (Cu) in fertilizer (kg/ha)", + "title_fi": "kuparin (Cu) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of copper (Cu) in fertilizer", + "unitless_title_fi": "kuparin (Cu) määrä lannoitteessa" + } + }, + "Zn_in_applied_fertilizer": { + "title": "amount of zinc (Zn) in fertilizer (kg/ha)", + "title_fi": "sinkin (Zn) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of zinc (Zn) in fertilizer", + "unitless_title_fi": "sinkin (Zn) määrä lannoitteessa" + } + }, + "B_in_applied_fertilizer": { + "title": "amount of boron (B) in fertilizer (kg/ha)", + "title_fi": "boorin (B) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of boron (B) in fertilizer", + "unitless_title_fi": "boorin (B) määrä lannoitteessa" + } + }, + "Mn_in_applied_fertilizer": { + "title": "amount of manganese (Mn) in fertilizer (kg/ha)", + "title_fi": "mangaanin (Mn) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of manganese (Mn) in fertilizer", + "unitless_title_fi": "mangaanin (Mn) määrä lannoitteessa" + } + }, + "Se_in_applied_fertilizer": { + "title": "amount of selenium (Se) in fertilizer (kg/ha)", + "title_fi": "seleenin (Se) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of selenium (Se) in fertilizer", + "unitless_title_fi": "seleenin (Se) määrä lannoitteessa" + } + }, + "Fe_in_applied_fertilizer": { + "title": "amount of iron (Fe) in fertilizer (kg/ha)", + "title_fi": "raudan (Fe) määrä lannoitteessa (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "amount of iron (Fe) in fertilizer", + "unitless_title_fi": "raudan (Fe) määrä lannoitteessa" + } + }, + "other_element_in_applied_fertilizer": { + "title": "other elements in fertilizer (kg/ha)", + "title_fi": "muut ravinteet lannoitteessa (kg/ha)", + "type": "string" + }, + "fertilizer_type": { + "title": "fertilizer type", + "title_fi": "lannoitteen tyyppi", + "type": "string", + "x-ui": { + "discriminator": true + } + }, + "fertilizer_applic_method": { + "allOf": [ + { + "title": "application method", + "title_fi": "levitystapa" + }, + { + "$ref": "#/$defs/fertilizer_applic_method" + } + ] + }, + "application_depth_fert": { + "title": "application depth (cm)", + "title_fi": "levityssyvyys (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "application depth", + "unitless_title_fi": "levityssyvyys" + } + }, + "fertilizer_total_amount": { + "title": "total amount of fertilizer (kg/ha)", + "title_fi": "lannoitteen kokonaismäärä (kg/ha)", + "title_sv": "totala mändgen gödsel (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "total amount of fertilizer", + "unitless_title_fi": "lannoitteen kokonaismäärä", + "unitless_title_sv": "totala mändgen gödsel" + } + }, + "mgmt_event_long_notes": { + "title": "notes on fertilizer application", + "title_fi": "muistiinpanoja lannoitteen levityksestä", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"biostimulant was added because the field suffered from drought\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. \"lisäsin biostimulanttia pellon kuivuuden vuoksi\"" + } + } + }, + "oneOf": [ + { + "title": "mineral", + "title_fi": "väkilannoite", + "properties": { + "fertilizer_type": { + "title": "mineral", + "title_fi": "väkilannoite", + "const": "fertilizer_type_mineral" + }, + "fertilizer_product_name" : { + "title": "name of fertilizer", + "title_fi": "lannoitteen nimi", + "type" : "string" + } + } + }, + { + "title": "soil amendment", + "title_fi": "maanparannusaine", + "properties": { + "fertilizer_type": { + "title": "soil amendment", + "title_fi": "maanparannusaine", + "const": "fertilizer_type_soil_amendment" + }, + "fertilizer_material": { + "title": "soil amendment substance", + "title_fi": "maanparannusaine", + "type": "string", + "oneOf": [ + { + "title": "Bio char", + "title_fi": "Biohiili", + "const": "FE996" + }, + { + "title": "Peat", + "title_fi": "Turve", + "const": "FE997" + }, + { + "title": "Sawdust", + "title_fi": "Sahanpuru", + "const": "FE998" + }, + { + "title": "Wood chip", + "title_fi": "Puulastu", + "const": "FE999" + } + ] + }, + "fertilizer_material_source": { + "title": "fertilizer material source", + "title_fi": "Lannoitteen alkuperä", + "type" : "string", + "x-ui": { + "placeholder" : "e.g. local stables or own farm or Commercial (brand)", + "placeholder_fi" : "esim. paikallinen talli, oma tila tai kaupallinen (tuotteen nimi)" + } + } + } + }, + { + "title": "organic material application", + "title_fi": "eloperäisen lannoitteen levitys", + "title_sv": "applicering av organiskt material", + "properties": { + "fertilizer_type": { + "title": "organic material", + "title_fi": "eloperäinen aine", + "title_sv": "organisk material", + "const": "fertilizer_type_organic" + }, + "organic_material": { + "title": "organic material", + "title_fi": "eloperäinen aine", + "title_sv": "organisk material", + "type": "string", + "oneOf": [ + { + "title": "generic crop residue", + "title_fi": "yleinen kasvijäte", + "title_sv": "allmänna växtrester", + "const": "RE001" + }, + { + "title": "green manure", + "title_fi": "viherlannoitus", + "title_sv": "gröngödsel", + "const": "RE002" + }, + { + "title": "barnyard manure", + "title_fi": "kuivalanta", + "title_sv": "gårdsgödsel", + "const": "RE003" + }, + { + "title": "liquid manure", + "title_fi": "lietelanta", + "title_sv": "slamgödsel", + "const": "RE004" + }, + { + "title": "compost", + "title_fi": "komposti", + "title_sv": "kompost", + "const": "RE005" + }, + { + "title": "bark", + "title_fi": "puun kuori", + "title_sv": "bark", + "const": "RE006" + }, + { + "title": "generic legume residue", + "title_fi": "palkokasvijäte", + "title_sv": "baljväxtrester", + "const": "RE101" + }, + { + "title": "faba bean", + "title_fi": "härkäpapu", + "title_sv": "bondböna", + "const": "RE109" + }, + { + "title": "pea residue", + "title_fi": "hernejäte", + "title_sv": "ärtavfall", + "const": "RE110" + }, + { + "title": "hairy vetch", + "title_fi": "ruisvirna", + "title_sv": "luddvicker", + "const": "RE111" + }, + { + "title": "generic cereal crop residue", + "title_fi": "viljakasvijäte", + "title_sv": "spannmålsavfall", + "const": "RE201" + }, + { + "title": "wheat residue", + "title_fi": "vehnäjäte", + "title_sv": "veteavfall", + "const": "RE205" + }, + { + "title": "barley", + "title_fi": "ohra", + "title_sv": "korn", + "const": "RE206" + }, + { + "title": "rye", + "title_fi": "ruis", + "title_sv": "råg", + "const": "RE208" + }, + { + "title": "generic grass", + "title_fi": "ruohokasvi", + "title_sv": "gräsväxti", + "const": "RE301" + }, + { + "title": "bermudagrass", + "title_fi": "varvasheinä", + "title_sv": "hundtandsgräs", + "const": "RE303" + }, + { + "title": "switchgrass", + "title_fi": "lännenhirssi", + "title_sv": "jungfruhirs", + "const": "RE304" + }, + { + "title": "brachiaria", + "title_fi": "viittaheinät", + "title_sv": "brachiaria", + "const": "RE305" + }, + { + "title": "forage grasses", + "title_fi": "nurmikasvit", + "title_sv": "vallväxter", + "const": "RE306" + }, + { + "title": "decomposed crop residue", + "title_fi": "maatunut kasvijäte", + "title_sv": "nedbrutet växtavfall", + "const": "RE999" + }, + { + "title": "other", + "title_fi": "muu", + "const": "REOTHER" + } + ] + }, + "org_matter_moisture_conc" : { + "title": "moisture concentration (%)", + "title_fi": "aineen kosteus (%)", + "x-ui": { + "unitless_title": "moisture concentration", + "unitless_title_fi": "aineen kosteus", + "unit": "%" + }, + "type" : "number", + "minimum" : 0, + "maximum" : 100 + }, + "org_matter_carbon_conc" : { + "title": "carbon (C) concentration in material (%)", + "title_fi": "hiilen (C) määrä aineessa (%)", + "x-ui": { + "unitless_title": "carbon (C) concentration", + "unitless_title_fi": "hiilen (C) määrä aineessa", + "unit": "%" + }, + "type": "number", + "min" : 0, + "max" : 100 + }, + "org_material_c_to_n": { + "title": "C:N ratio in material", + "title_fi": "C:N suhde aineessa", + "type": "number", + "min": 0 + }, + "fertilizer_material_source" : { + "title": "fertilizer material source", + "title_fi": "Lannoitteen alkuperä", + "type" : "string", + "x-ui": { + "placeholder" : "e.g. local stables or own farm or Commercial (brand)", + "placeholder_fi" : "esim. paikallinen talli, oma tila tai kaupallinen (tuotteen nimi)" + } + }, + "animal_fert_usage": { + "title": "animal fertilizer", + "title_fi": "eläimen lannoite", + "type": "string", + "x-ui": { + "placeholder": "which animal fertilizer, e.g. pig, horse, cow", + "placeholder_fi": "minkä eläimen lannoitetta, esim. sika, hevonen, lehmä" + } + } + } + } + ], + "required": [ + "date", + "fertilizer_type", + "fertilizer_total_amount" + ] + }, + { + "$id": "#tillage", + "title": "tillage", + "title2": "tillage application", + "title_fi": "maanmuokkaus", + "title2_fi": "maan muokkaus", + "title_sv": "markens bearbetning", + "properties": { + "mgmt_operations_event": { + "title": "tillage", + "title2": "tillage application", + "title_fi": "maanmuokkaus", + "title2_fi": "maan muokkaus", + "title_sv": "markens bearbetning", + "const": "tillage" + }, + "tillage_practice": { + "title": "tillage type", + "title_fi": "muokkaustyyppi", + "type": "string", + "oneOf": [ + { + "title": "primary (residue incorporation)", + "title_fi": "perusmuokkaus", + "const": "tillage_practice_primary" + }, + { + "title": "secondary (seedbed)", + "title_fi": "kylvömuokkaus", + "const": "tillage_practice_secondary" + }, + { + "title": "tertiary (weed control)", + "title_fi": "rikkakasvien torjunta", + "const": "tillage_practice_tertiary" + } + ] + }, + "tillage_implement": { + "title": "tillage implement", + "title_fi": "muokkausväline", + "title_sv": "bearbetningsredskap", + "type": "string", + "oneOf": [ + { + "title": "subsoiler", + "title_fi": "jankkuri", + "const": "TI002" + }, + { + "title": "mould-board plough", + "title_fi": "kyntöaura", + "const": "TI003" + }, + { + "title": "disk, tandem", + "title_fi": "lautasäes", + "const": "TI009" + }, + { + "title": "cultivator, field", + "title_fi": "kultivaattori", + "const": "TI011" + }, + { + "title": "harrow, tine", + "title_fi": "joustopiikkiäes", + "const": "TI015" + }, + { + "title": "lister", + "title_fi": "multain", + "const": "TI016" + }, + { + "title": "blade cultivator", + "title_fi": "hara", + "const": "TI018" + }, + { + "title": "manure injector", + "title_fi": "lannansijoituskone (Manure injector?)", + "const": "TI020" + }, + { + "title": "roller packer", + "title_fi": "jyrä (roller packer?)", + "const": "TI024" + }, + { + "title": "drill, double-disk", + "title_fi": "suorakylvökone, kaksoiskiekot (drill, double disk?)", + "const": "TI025" + }, + { + "title": "drill, no-till", + "title_fi": "suorakylvökone, ei muokkausta (drill, no-till?)", + "const": "TI031" + }, + { + "title": "planter, row", + "title_fi": "kylvökone (planter, row?)", + "const": "TI033" + }, + { + "title": "rotary hoe", + "title_fi": "maanjyrsin (rotary hoe?)", + "const": "TI038" + }, + { + "title": "tine weeder", + "title_fi": "rikkaäes", + "const": "TI044" + }, + { + "title": "other", + "title_fi": "muu", + "const": "TI999" + } + ] + }, + "tillage_operations_depth": { + "title": "tillage depth (cm)", + "title_fi": "muokkaussyvyys (cm)", + "title_sv": "bearbetningsdjup (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "tillage depth", + "unitless_title_fi": "muokkaussyvyys", + "unitless_title_sv": "bearbetningsdjup" + } + }, + "mgmt_event_long_notes": { + "title": "tillage notes", + "title_fi": "muistiinpanot muokkauksesta", + "title_sv": "anteckningar på bearbetning", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"had to stop tillage and continue the next day\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. \"jatkoin muokkausta seuraavana päivänä\"" + } + } + }, + "required": [ + "date", + "tillage_practice" + ] + }, + { + "$id": "#harvest", + "title": "harvest", + "title_fi": "sadonkorjuu", + "title_sv": "skörd", + "description": "If you left the harvest residue on the field, please add a new event (fertilizer application or tillage) accordingly.", + "description_en": "If you left the harvest residue on the field, please add a new event (fertilizer application or tillage) accordingly.", + "description_fi": "Jos jätit korjuutähteet pellolle, tee tästä uusi soveltuva tapahtuma (lannoitus- tai maanmuokkaus-).", + "properties": { + "mgmt_operations_event": { + "title": "harvest", + "title_fi": "sadonkorjuu", + "title_sv": "skörd", + "const": "harvest" + }, + "harvest_area": { + "title": "harvest area (ha)", + "title_fi": "pinta-ala (ha)", + "title2_fi": "korjattu pinta-ala (ha)", + "title_sv": "skördat område (ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "ha", + "unitless_title": "harvest area", + "unitless_title_fi": "pinta-ala", + "unitless_title2_fi": "korjattu pinta-ala", + "unitless_title_sv": "skördat område" + } + }, + "harvest_list": { + "type": "array", + "title": "harvested items", + "title_fi": "sadonkorjuun kohteet", + "items": { + "type": "object", + "properties": { + "harvest_crop": { + "allOf": [ + { + "title": "harvest crop", + "title_fi": "korjattu laji", + "title_sv": "skördad gröda" + }, + { + "$ref": "#/$defs/crop_ident_ICASA" + } + ] + }, + "harvest_moisture": { + "title": "yield moisture (%)", + "title_fi": "sadon kosteus (%)", + "type": "number", + "minimum": 0, + "maximum": 100, + "x-ui": { + "unit": "%", + "unitless_title": "yield moisture", + "unitless_title_fi": "sadon kosteus" + } + }, + "harvest_method": { + "title": "harvest method", + "title_fi": "korjuutapa", + "title_sv": "skördemetod", + "type": "string", + "oneOf": [ + { + "title": "combined", + "title_fi": "leikkuupuimuri", + "title_sv": "skördetröska", + "const": "HM001" + }, + { + "title": "hand picked, no further processing", + "title_fi": "poimittu käsin, ei muuta prosessointia", + "title_sv": "handplockat, ingen övrig bearbetning", + "const": "HM004" + }, + { + "title": "hand picked, machine processing", + "title_fi": "poimittu käsin, prosessoitu koneella", + "title_sv": "handplockat, maskin bearbetat", + "const": "HM005" + }, + { + "title": "hay", + "title_fi": "heinä", + "const": "HM007" + }, + { + "title": "silage", + "title_fi": "säilörehu", + "const": "HM008" + }, + { + "title": "potato harvester", + "title_fi": "perunannostokone", + "const": "HM009" + }, + { + "title": "sugar beet harvester", + "title_fi": "juurikkaannostokone", + "const": "HM010" + } + ] + }, + "harvest_operat_component": { + "title": "crop component harvested", + "title_fi": "kerätty kasvinosa", + "title2_fi": "korjattu kasvinosa", + "title_sv": "skördad växtdel", + "type": "string", + "oneOf": [ + { + "title": "canopy", + "title_fi": "latvusto", + "title_sv": "krontak", + "const": "canopy" + }, + { + "title": "leaves", + "title_fi": "lehdet", + "title_sv": "blad", + "const": "leaf" + }, + { + "title": "grain, legume seeds", + "title_fi": "jyvä, palkokasvin siemen", + "title_sv": "korn, baljväxtens frö", + "const": "grain" + }, + { + "title": "silage", + "title_fi": "säilörehu", + "title_sv": "ensilage", + "const": "silage" + }, + { + "title": "tuber, root, etc.", + "title_fi": "mukula, juuri, yms.", + "title_sv": "knöl, rot, etc.", + "const": "tuber" + }, + { + "title": "fruit", + "title_fi": "hedelmä", + "title_sv": "frukt", + "const": "fruit" + }, + { + "title": "stem", + "title_fi": "varsi", + "title_sv": "stjälk", + "const": "stem" + } + ] + }, + "canopy_height_harvest": { + "title": "canopy height (m)", + "title_fi": "kasvuston korkeus (m)", + "title_sv": "växtlighetens höjd (m)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m", + "unitless_title": "canopy height", + "unitless_title_fi": "kasvuston korkeus", + "unitless_title_sv": "växtlighetens höjd" + } + }, + "harvest_cut_height": { + "title": "height of cut (cm)", + "title_fi": "leikkuukorkeus (cm)", + "title_sv": "klipphöjd (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "height of cut", + "unitless_title_fi": "leikkuukorkeus", + "unitless_title_sv": "klipphöjd" + } + }, + "plant_density_harvest": { + "title": "plant density at harvest (plants/m²)", + "title_fi": "kasvitiheys korjuuhetkellä (kasveja/m²)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m⁻²", + "unitless_title": "plant density at harvest", + "unitless_title_fi": "kasvitiheys korjuuhetkellä" + } + }, + "harvest_residue_placement": { + "title": "harvest residue placement", + "title_fi": "korjuutähteiden sijoituspaikka", + "title2_fi": "korjatun kasvinosan sijoituspaikka", + "type": "string", + "oneOf": [ + { + "title": "left in the field as green manure", + "title_fi": "jätetty pellolle viherlannoitukseksi", + "const": "harvest_residue_placement_green_manure" + }, + { + "title": "left in the field for tillage incorporation", + "title_fi": "jätetty pellolle kyntämällä sekoittamista varten", + "const": "harvest_residue_placement_tillage" + }, + { + "title": "burned", + "title_fi": "poltettu", + "const": "harvest_residue_placement_burned" + }, + { + "title": "removed from the field", + "title_fi": "poistettu pellolta", + "const": "harvest_residue_placement_removed" + } + ] + }, + "harvest_yield_harvest_dw": { + "title": "yield, dry weight (kg/ha)", + "title_fi": "sato, kuivapaino (kg/ha)", + "title_sv": "skörd, torrvikt (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "yield, dry weight", + "unitless_title_fi": "sato, kuivapaino", + "unitless_title_sv": "skörd, torrvikt" + } + }, + "harv_yield_harv_f_wt": { + "title": "yield, fresh weight (t/ha)", + "title_fi": "sato, märkäpaino (t/ha)", + "title2_fi": "sato, tuorepaino (t/ha)", + "title_sv": "skörd, färskvikt (t/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "t/ha", + "unitless_title": "yield, fresh weight", + "unitless_title_fi": "sato, märkäpaino", + "unitless_title2_fi": "sato, tuorepaino", + "unitless_title_sv": "skörd, färskvikt" + } + }, + "yield_C_at_harvest": { + "title": "carbon (C) in yield (kg/ha)", + "title_fi": "hiilen (C) määrä sadossa (kg/ha)", + "title_sv": "mängden kol (C) i skörden (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "carbon (C) in yield", + "unitless_title_fi": "hiilen (C) määrä sadossa", + "unitless_title_sv": "mängden kol (C) i skörden" + } + } + }, + "required": [ + "harvest_crop" + ] + }, + "minItems": 1 + }, + "harvest_yield_harvest_dw_total": { + "title": "yield, total dry weight (kg/ha)", + "title2": "total yield, dry weight (kg/ha)", + "title_fi": "sato, kuivapaino yhteensä (kg/ha)", + "title2_fi": "kokonaissato, kuivapaino (kg/ha)", + "title_sv": "totala skörden, torrvikt (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "yield, total dry weight", + "unitless_title2": "total yield, dry weight", + "unitless_title_fi": "sato, kuivapaino yhteensä", + "unitless_title2_fi": "kokonaissato, kuivapaino", + "unitless_title_sv": "totala skörden, torrvikt", + "total_of_list": "harvest_list", + "total_of_property": "harvest_yield_harvest_dw" + } + }, + "harv_yield_harv_f_wt_total": { + "title": "yield, total fresh weight (t/ha)", + "title_fi": "sato, märkäpaino yhteensä (t/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "t/ha", + "unitless_title": "yield, total fresh weight", + "unitless_title_fi": "sato, märkäpaino yhteensä", + "total_of_list": "harvest_list", + "total_of_property": "harv_yield_harv_f_wt" + } + }, + "yield_C_at_harvest_total": { + "title": "carbon (C) in yield, total (kg/ha)", + "title2": "total carbon (C) in yield (kg/ha)", + "title_fi": "hiilen (C) määrä sadossa yhteensä (kg/ha)", + "title2_fi": "hiilen (C) kokonaismäärä sadossa (kg/ha)", + "title_sv": "totala mängden kol (C) i skörden (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "carbon (C) in yield, total", + "unitless_title2": "total carbon (C) in yield", + "unitless_title_fi": "hiilen (C) määrä sadossa yhteensä", + "unitless_title2_fi": "hiilen (C) kokonaismäärä sadossa", + "unitless_title_sv": "totala mängden kol (C) i skörden", + "total_of_list": "harvest_list", + "total_of_property": "yield_C_at_harvest" + } + }, + "mgmt_event_long_notes": { + "title": "harvest comments", + "title2": "comments", + "title_fi": "sadonkorjuukommentit", + "title_sv": "kommentarer", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"cutting height was not uniform\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. \"leikkuukorkeus ei ollut sama kaikkialla\"" + } + } + }, + "required": [ + "date", + "harvest_list" + ] + }, + { + "$id": "#chemicals", + "title": "chemicals application", + "title_fi": "kemikaalin levitys", + "title_sv": "applicering av kemikalier", + "properties": { + "mgmt_operations_event": { + "title": "chemicals application", + "title_fi": "kemikaalin levitys", + "title_sv": "applicering av kemikalier", + "const": "chemicals" + }, + "chemical_type": { + "title": "chemical type", + "title_fi": "kemikaalin tyyppi", + "type": "string", + "oneOf": [ + { + "title": "insecticide", + "title_fi": "hyönteistorjunta-aine", + "const": "chemical_type_insecticide" + }, + { + "title": "herbicide", + "title_fi": "rikkakasvien torjunta-aine", + "const": "chemical_type_herbicide" + }, + { + "title": "fungicide", + "title_fi": "sienitautien torjunta-aine", + "const": "chemical_type_fungicide" + }, + { + "title": "growth regulator", + "title_fi": "kasvunsääde", + "const": "chemical_type_growth_regulator" + }, + { + "title": "lime application", + "title_fi": "kalkin levitys", + "const": "chemical_type_lime_application" + }, + { + "title": "gypsum application", + "title_fi": "kipsin levitys", + "const": "chemical_type_gypsum_application" + } + ] + }, + "chemical_product_name": { + "title": "chemical product name", + "title_fi": "kemikaalivalmisteen nimi", + "type": "string" + }, + "chemical_applic_material_list": { + "title": "list of active substances in chemical", + "title_fi": "lista kemikaalin tehoaineista", + "type": "array", + "items": { + "type": "object", + "properties": { + "chemical_applic_material": { + "title": "active substance in chemical", + "title_fi": "kemikaalin tehoaine", + "type": "string", + "oneOf": [ + { + "title": "(E,E)-8,10-dodekadien-1-oli", + "title_fi": "(E,E)-8,10-dodekadien-1-oli", + "const": "AS001" + }, + { + "title": "(Z)-11-tetradeken-1-yyliasetaatti", + "title_fi": "(Z)-11-tetradeken-1-yyliasetaatti", + "const": "AS002" + }, + { + "title": "1,4-dimetyylinaftaleeni", + "title_fi": "1,4-dimetyylinaftaleeni", + "const": "AS003" + }, + { + "title": "2,4-D", + "title_fi": "2,4-D", + "const": "AS004" + }, + { + "title": "6-bentsyyliadeniini", + "title_fi": "6-bentsyyliadeniini", + "const": "AS005" + }, + { + "title": "Abamektiini", + "title_fi": "Abamektiini", + "const": "AS006" + }, + { + "title": "aklonifeeni", + "title_fi": "aklonifeeni", + "const": "AS007" + }, + { + "title": "Alfa-sypermetriini", + "title_fi": "Alfa-sypermetriini", + "const": "AS008" + }, + { + "title": "Alumiinifosfidi", + "title_fi": "Alumiinifosfidi", + "const": "AS009" + }, + { + "title": "Amidosulfuroni", + "title_fi": "Amidosulfuroni", + "const": "AS010" + }, + { + "title": "Aminopyralidi", + "title_fi": "Aminopyralidi", + "const": "AS011" + }, + { + "title": "Amisulbromi (ISO)", + "title_fi": "Amisulbromi (ISO)", + "const": "AS012" + }, + { + "title": "Asetamipridi", + "title_fi": "Asetamipridi", + "const": "AS013" + }, + { + "title": "Atsoksistrobiini (ISO)", + "title_fi": "Atsoksistrobiini (ISO)", + "const": "AS014" + }, + { + "title": "Bacillus amyloliquefaciens (kanta MBI 600)", + "title_fi": "Bacillus amyloliquefaciens (kanta MBI 600)", + "const": "AS015" + }, + { + "title": "Bacillus subtilis QST 713", + "title_fi": "Bacillus subtilis QST 713", + "const": "AS016" + }, + { + "title": "Bacillus thuringiensis subsp. aizawai (kanta GC-91)", + "title_fi": "Bacillus thuringiensis subsp. aizawai (kanta GC-91)", + "const": "AS017" + }, + { + "title": "Beauveria bassiana GHA", + "title_fi": "Beauveria bassiana GHA", + "const": "AS018" + }, + { + "title": "Bentatsoni", + "title_fi": "Bentatsoni", + "const": "AS019" + }, + { + "title": "Bentsoehappo", + "title_fi": "Bentsoehappo", + "const": "AS020" + }, + { + "title": "Bentsovindiflupyyri (ISO)", + "title_fi": "Bentsovindiflupyyri (ISO)", + "const": "AS021" + }, + { + "title": "Bifenatsaatti (ISO)", + "title_fi": "Bifenatsaatti (ISO)", + "const": "AS022" + }, + { + "title": "Bifenoksi", + "title_fi": "Bifenoksi", + "const": "AS023" + }, + { + "title": "Biksafeeni", + "title_fi": "Biksafeeni", + "const": "AS024" + }, + { + "title": "Boskalidi", + "title_fi": "Boskalidi", + "const": "AS025" + }, + { + "title": "Bromoksiniili", + "title_fi": "Bromoksiniili", + "const": "AS026" + }, + { + "title": "Buprofetsiini", + "title_fi": "Buprofetsiini", + "const": "AS027" + }, + { + "title": "Coniothyrium minitans, strain CON/M/91-08", + "title_fi": "Coniothyrium minitans, strain CON/M/91-08", + "const": "AS028" + }, + { + "title": "Cydia pomonella granulovirus (CpGV)", + "title_fi": "Cydia pomonella granulovirus (CpGV)", + "const": "AS029" + }, + { + "title": "Daminotsidi", + "title_fi": "Daminotsidi", + "const": "AS030" + }, + { + "title": "Deltametriini", + "title_fi": "Deltametriini", + "const": "AS031" + }, + { + "title": "Difenokonatsoli", + "title_fi": "Difenokonatsoli", + "const": "AS032" + }, + { + "title": "Diflufenikaani", + "title_fi": "Diflufenikaani", + "const": "AS033" + }, + { + "title": "Dikamba", + "title_fi": "Dikamba", + "const": "AS034" + }, + { + "title": "Diklorproppi-P", + "title_fi": "Diklorproppi-P", + "const": "AS035" + }, + { + "title": "Dikvatti", + "title_fi": "Dikvatti", + "const": "AS036" + }, + { + "title": "Dimetenamidi-P (ISO)", + "title_fi": "Dimetenamidi-P (ISO)", + "const": "AS037" + }, + { + "title": "Dimetomorfi", + "title_fi": "Dimetomorfi", + "const": "AS038" + }, + { + "title": "Ditianoni", + "title_fi": "Ditianoni", + "const": "AS039" + }, + { + "title": "dodiini", + "title_fi": "dodiini", + "const": "AS040" + }, + { + "title": "Esfenvaleraatti", + "title_fi": "Esfenvaleraatti", + "const": "AS041" + }, + { + "title": "etefoni", + "title_fi": "etefoni", + "const": "AS042" + }, + { + "title": "Etikkahappo", + "title_fi": "Etikkahappo", + "const": "AS043" + }, + { + "title": "Etofumesaatti (ISO)", + "title_fi": "Etofumesaatti (ISO)", + "const": "AS044" + }, + { + "title": "Fenheksamidi", + "title_fi": "Fenheksamidi", + "const": "AS045" + }, + { + "title": "Fenmedifaami", + "title_fi": "Fenmedifaami", + "const": "AS046" + }, + { + "title": "Fenoksaproppi-P-etyyli (ISO)", + "title_fi": "Fenoksaproppi-P-etyyli (ISO)", + "const": "AS047" + }, + { + "title": "Fenpyratsamiini", + "title_fi": "Fenpyratsamiini", + "const": "AS048" + }, + { + "title": "fenpyroksimaatti (ISO)", + "title_fi": "fenpyroksimaatti (ISO)", + "const": "AS049" + }, + { + "title": "Flonikamidi (ISO)", + "title_fi": "Flonikamidi (ISO)", + "const": "AS050" + }, + { + "title": "Florasulaami", + "title_fi": "Florasulaami", + "const": "AS051" + }, + { + "title": "Fluatsifoppi-P-butyyli", + "title_fi": "Fluatsifoppi-P-butyyli", + "const": "AS052" + }, + { + "title": "Fluatsinami", + "title_fi": "Fluatsinami", + "const": "AS053" + }, + { + "title": "Fludioksiniili (ISO)", + "title_fi": "Fludioksiniili (ISO)", + "const": "AS054" + }, + { + "title": "Fludioksoniili", + "title_fi": "Fludioksoniili", + "const": "AS055" + }, + { + "title": "fluksapyroksadi", + "title_fi": "fluksapyroksadi", + "const": "AS056" + }, + { + "title": "Fluopikolidi", + "title_fi": "Fluopikolidi", + "const": "AS057" + }, + { + "title": "Fluopyraami (ISO)", + "title_fi": "Fluopyraami (ISO)", + "const": "AS058" + }, + { + "title": "Flupyradifuroni", + "title_fi": "Flupyradifuroni", + "const": "AS059" + }, + { + "title": "fluroksipyyri", + "title_fi": "fluroksipyyri", + "const": "AS060" + }, + { + "title": "fluroksipyyri-meptyyli (ISO)", + "title_fi": "fluroksipyyri-meptyyli (ISO)", + "const": "AS061" + }, + { + "title": "Flutolaniili", + "title_fi": "Flutolaniili", + "const": "AS062" + }, + { + "title": "Foramsulfuroni", + "title_fi": "Foramsulfuroni", + "const": "AS063" + }, + { + "title": "Fosetyyli", + "title_fi": "Fosetyyli", + "const": "AS064" + }, + { + "title": "Fosetyyli-alumiini", + "title_fi": "Fosetyyli-alumiini", + "const": "AS065" + }, + { + "title": "Gamma-syhalotriini", + "title_fi": "Gamma-syhalotriini", + "const": "AS066" + }, + { + "title": "Gibberelliini (GA4 ja GA7 seos)", + "title_fi": "Gibberelliini (GA4 ja GA7 seos)", + "const": "AS067" + }, + { + "title": "Gliocladium catenulatum -sienen rihmastoa ja itiöitä", + "title_fi": "Gliocladium catenulatum -sienen rihmastoa ja itiöitä", + "const": "AS068" + }, + { + "title": "Glyfosaatti (glyfosaatin ammoniumsuolana)", + "title_fi": "Glyfosaatti (glyfosaatin ammoniumsuolana)", + "const": "AS069" + }, + { + "title": "Glyfosaatti (Glyfosaatin dimetyyliamiinisuolana)", + "title_fi": "Glyfosaatti (Glyfosaatin dimetyyliamiinisuolana)", + "const": "AS070" + }, + { + "title": "Glyfosaatti (glyfosaatin isopropyyliamiinisuolana)", + "title_fi": "Glyfosaatti (glyfosaatin isopropyyliamiinisuolana)", + "const": "AS071" + }, + { + "title": "Glyfosaatti (glyfosaatin kaliumsuolana)", + "title_fi": "Glyfosaatti (glyfosaatin kaliumsuolana)", + "const": "AS072" + }, + { + "title": "Halauksifeeni-metyyli", + "title_fi": "Halauksifeeni-metyyli", + "const": "AS073" + }, + { + "title": "Harmaaorvakka-sienen itiöitä", + "title_fi": "Harmaaorvakka-sienen itiöitä", + "const": "AS074" + }, + { + "title": "heksytiatsoksi (ISO)", + "title_fi": "heksytiatsoksi (ISO)", + "const": "AS075" + }, + { + "title": "hymeksatsoli (ISO)", + "title_fi": "hymeksatsoli (ISO)", + "const": "AS076" + }, + { + "title": "Imatsaliili", + "title_fi": "Imatsaliili", + "const": "AS077" + }, + { + "title": "Imatsamoksi", + "title_fi": "Imatsamoksi", + "const": "AS078" + }, + { + "title": "Imidaklopridi", + "title_fi": "Imidaklopridi", + "const": "AS079" + }, + { + "title": "Indoksakarbi", + "title_fi": "Indoksakarbi", + "const": "AS080" + }, + { + "title": "Isaria fumosorosea, kanta Apopka 97", + "title_fi": "Isaria fumosorosea, kanta Apopka 97", + "const": "AS081" + }, + { + "title": "Isoksabeeni", + "title_fi": "Isoksabeeni", + "const": "AS082" + }, + { + "title": "Isopyratsaami", + "title_fi": "Isopyratsaami", + "const": "AS083" + }, + { + "title": "Jodosulfuroni-metyyli-natrium", + "title_fi": "Jodosulfuroni-metyyli-natrium", + "const": "AS084" + }, + { + "title": "Kaliumfosfonaatit (kaliumvetyfosfonaatti + dikaliumfosfonaatti)", + "title_fi": "Kaliumfosfonaatit (kaliumvetyfosfonaatti + dikaliumfosfonaatti)", + "const": "AS085" + }, + { + "title": "Kapriinihappo", + "title_fi": "Kapriinihappo", + "const": "AS086" + }, + { + "title": "Kapryylihappo", + "title_fi": "Kapryylihappo", + "const": "AS087" + }, + { + "title": "Kaptaani", + "title_fi": "Kaptaani", + "const": "AS088" + }, + { + "title": "Karfentratsoni-etyyli", + "title_fi": "Karfentratsoni-etyyli", + "const": "AS089" + }, + { + "title": "Kletodiimi (ISO)", + "title_fi": "Kletodiimi (ISO)", + "const": "AS090" + }, + { + "title": "Klomatsoni", + "title_fi": "Klomatsoni", + "const": "AS091" + }, + { + "title": "Klopyralidi", + "title_fi": "Klopyralidi", + "const": "AS092" + }, + { + "title": "Klorantraniliproli", + "title_fi": "Klorantraniliproli", + "const": "AS093" + }, + { + "title": "Klormekvattikloridi", + "title_fi": "Klormekvattikloridi", + "const": "AS094" + }, + { + "title": "Kresoksiimi-metyyli", + "title_fi": "Kresoksiimi-metyyli", + "const": "AS095" + }, + { + "title": "Kvinmerakki", + "title_fi": "Kvinmerakki", + "const": "AS096" + }, + { + "title": "Kvitsalofoppi-P-etyyli", + "title_fi": "Kvitsalofoppi-P-etyyli", + "const": "AS097" + }, + { + "title": "Lambda-syhalotriini", + "title_fi": "Lambda-syhalotriini", + "const": "AS098" + }, + { + "title": "Lampaanrasva", + "title_fi": "Lampaanrasva", + "const": "AS099" + }, + { + "title": "Magnesiumfosfidi", + "title_fi": "Magnesiumfosfidi", + "const": "AS100" + }, + { + "title": "Maleiinihydratsidi", + "title_fi": "Maleiinihydratsidi", + "const": "AS101" + }, + { + "title": "Mandipropamidi (ISO)", + "title_fi": "Mandipropamidi (ISO)", + "const": "AS102" + }, + { + "title": "Mankotsebi", + "title_fi": "Mankotsebi", + "const": "AS103" + }, + { + "title": "MCPA", + "title_fi": "MCPA", + "const": "AS104" + }, + { + "title": "mefentriflukonatsoli", + "title_fi": "mefentriflukonatsoli", + "const": "AS105" + }, + { + "title": "Mekoproppi-P", + "title_fi": "Mekoproppi-P", + "const": "AS106" + }, + { + "title": "Mepanipyriimi", + "title_fi": "Mepanipyriimi", + "const": "AS107" + }, + { + "title": "mepikvattikloridi", + "title_fi": "mepikvattikloridi", + "const": "AS108" + }, + { + "title": "Mesosulfuroni-metyyli (ISO)", + "title_fi": "Mesosulfuroni-metyyli (ISO)", + "const": "AS109" + }, + { + "title": "Metalaksyyli-M", + "title_fi": "Metalaksyyli-M", + "const": "AS110" + }, + { + "title": "metamitroni", + "title_fi": "metamitroni", + "const": "AS111" + }, + { + "title": "Metatsakloori", + "title_fi": "Metatsakloori", + "const": "AS112" + }, + { + "title": "Metkonatsoli", + "title_fi": "Metkonatsoli", + "const": "AS113" + }, + { + "title": "Metobromuroni", + "title_fi": "Metobromuroni", + "const": "AS114" + }, + { + "title": "Metributsiini", + "title_fi": "Metributsiini", + "const": "AS115" + }, + { + "title": "Metsulfuroni-metyyli", + "title_fi": "Metsulfuroni-metyyli", + "const": "AS116" + }, + { + "title": "Napropamidi", + "title_fi": "Napropamidi", + "const": "AS117" + }, + { + "title": "Oksatiapiproliini", + "title_fi": "Oksatiapiproliini", + "const": "AS118" + }, + { + "title": "Paklobutratsoli (ISO)", + "title_fi": "Paklobutratsoli (ISO)", + "const": "AS119" + }, + { + "title": "Parafiiniöljy (CAS-nro 64742-46-7)", + "title_fi": "Parafiiniöljy (CAS-nro 64742-46-7)", + "const": "AS120" + }, + { + "title": "Parafiiniöljy (CAS-nro 8042-47-5)", + "title_fi": "Parafiiniöljy (CAS-nro 8042-47-5)", + "const": "AS121" + }, + { + "title": "Pelargonihappo", + "title_fi": "Pelargonihappo", + "const": "AS122" + }, + { + "title": "Pendimetaliini", + "title_fi": "Pendimetaliini", + "const": "AS123" + }, + { + "title": "penflufeeni", + "title_fi": "penflufeeni", + "const": "AS124" + }, + { + "title": "Penkonatsoli", + "title_fi": "Penkonatsoli", + "const": "AS125" + }, + { + "title": "Pepinon mosaiikkivirus (kannan CH2 isolaatti 1906)", + "title_fi": "Pepinon mosaiikkivirus (kannan CH2 isolaatti 1906)", + "const": "AS126" + }, + { + "title": "Pikloraami", + "title_fi": "Pikloraami", + "const": "AS127" + }, + { + "title": "Pinoksadeeni (ISO)", + "title_fi": "Pinoksadeeni (ISO)", + "const": "AS128" + }, + { + "title": "Proheksadionikalsium", + "title_fi": "Proheksadionikalsium", + "const": "AS129" + }, + { + "title": "Prokinatsidi", + "title_fi": "Prokinatsidi", + "const": "AS130" + }, + { + "title": "Propakvitsafoppi", + "title_fi": "Propakvitsafoppi", + "const": "AS131" + }, + { + "title": "Propamokarbi", + "title_fi": "Propamokarbi", + "const": "AS132" + }, + { + "title": "Propamokarbi-hydrokloridi", + "title_fi": "Propamokarbi-hydrokloridi", + "const": "AS133" + }, + { + "title": "Propoksikarbatsoni-natrium", + "title_fi": "Propoksikarbatsoni-natrium", + "const": "AS134" + }, + { + "title": "Prosulfokarbi", + "title_fi": "Prosulfokarbi", + "const": "AS135" + }, + { + "title": "Protiokonatsoli", + "title_fi": "Protiokonatsoli", + "const": "AS136" + }, + { + "title": "Pseudomonas chlororaphis MA 342", + "title_fi": "Pseudomonas chlororaphis MA 342", + "const": "AS137" + }, + { + "title": "Pyraflufeeni-etyyli (ISO)", + "title_fi": "Pyraflufeeni-etyyli (ISO)", + "const": "AS138" + }, + { + "title": "Pyraklostrobiini", + "title_fi": "Pyraklostrobiini", + "const": "AS139" + }, + { + "title": "Pyretriinit", + "title_fi": "Pyretriinit", + "const": "AS140" + }, + { + "title": "Pyridaatti (ISO)", + "title_fi": "Pyridaatti (ISO)", + "const": "AS141" + }, + { + "title": "Pyrimetaniili", + "title_fi": "Pyrimetaniili", + "const": "AS142" + }, + { + "title": "Pyriofenoni", + "title_fi": "Pyriofenoni", + "const": "AS143" + }, + { + "title": "Pyroksulaami", + "title_fi": "Pyroksulaami", + "const": "AS144" + }, + { + "title": "Rapsiöljy", + "title_fi": "Rapsiöljy", + "const": "AS145" + }, + { + "title": "Rasvahappojen kaliumsuoloja", + "title_fi": "Rasvahappojen kaliumsuoloja", + "const": "AS146" + }, + { + "title": "Rautafosfaatti", + "title_fi": "Rautafosfaatti", + "const": "AS147" + }, + { + "title": "Rautasulfaatti", + "title_fi": "Rautasulfaatti", + "const": "AS148" + }, + { + "title": "Rimsulfuroni", + "title_fi": "Rimsulfuroni", + "const": "AS149" + }, + { + "title": "Rypsiöljy", + "title_fi": "Rypsiöljy", + "const": "AS150" + }, + { + "title": "Sedaksaani", + "title_fi": "Sedaksaani", + "const": "AS151" + }, + { + "title": "Spirodiklofeeni (ISO)", + "title_fi": "Spirodiklofeeni (ISO)", + "const": "AS152" + }, + { + "title": "spiroksamiini", + "title_fi": "spiroksamiini", + "const": "AS153" + }, + { + "title": "Spirotetramaatti (ISO)", + "title_fi": "Spirotetramaatti (ISO)", + "const": "AS154" + }, + { + "title": "Streptomyces K61 -sädebakteerin rihmastoa ja itiöitä", + "title_fi": "Streptomyces K61 -sädebakteerin rihmastoa ja itiöitä", + "const": "AS155" + }, + { + "title": "Sulfosulfuroni", + "title_fi": "Sulfosulfuroni", + "const": "AS156" + }, + { + "title": "Syantraniiliproli", + "title_fi": "Syantraniiliproli", + "const": "AS157" + }, + { + "title": "Syatsofamidi", + "title_fi": "Syatsofamidi", + "const": "AS158" + }, + { + "title": "Sykloksidiimi", + "title_fi": "Sykloksidiimi", + "const": "AS159" + }, + { + "title": "symoksaniili", + "title_fi": "symoksaniili", + "const": "AS160" + }, + { + "title": "Sypermetriini", + "title_fi": "Sypermetriini", + "const": "AS161" + }, + { + "title": "Syprodiniili", + "title_fi": "Syprodiniili", + "const": "AS162" + }, + { + "title": "Syprokonatsoli", + "title_fi": "Syprokonatsoli", + "const": "AS163" + }, + { + "title": "tau-fluvalinaatti", + "title_fi": "tau-fluvalinaatti", + "const": "AS164" + }, + { + "title": "Tebukonatsoli", + "title_fi": "Tebukonatsoli", + "const": "AS165" + }, + { + "title": "Terpenoidien seos QRD 460", + "title_fi": "Terpenoidien seos QRD 460", + "const": "AS166" + }, + { + "title": "Tiaklopridi", + "title_fi": "Tiaklopridi", + "const": "AS167" + }, + { + "title": "Tieenikarbatsoni-metyyli", + "title_fi": "Tieenikarbatsoni-metyyli", + "const": "AS168" + }, + { + "title": "Tifensulfuroni-metyyli", + "title_fi": "Tifensulfuroni-metyyli", + "const": "AS169" + }, + { + "title": "Tiofanaatti-metyyli", + "title_fi": "Tiofanaatti-metyyli", + "const": "AS170" + }, + { + "title": "Tolklofossi-metyyli", + "title_fi": "Tolklofossi-metyyli", + "const": "AS171" + }, + { + "title": "Tribenuronimetyyli (ISO)", + "title_fi": "Tribenuronimetyyli (ISO)", + "const": "AS172" + }, + { + "title": "Trichoderma harzianum (kanta T-22)", + "title_fi": "Trichoderma harzianum (kanta T-22)", + "const": "AS173" + }, + { + "title": "Trifloksistrobiini", + "title_fi": "Trifloksistrobiini", + "const": "AS174" + }, + { + "title": "Triflusulfuroni-metyyli", + "title_fi": "Triflusulfuroni-metyyli", + "const": "AS175" + }, + { + "title": "Trineksapakki-etyyli", + "title_fi": "Trineksapakki-etyyli", + "const": "AS176" + }, + { + "title": "Tritikonatsoli", + "title_fi": "Tritikonatsoli", + "const": "AS177" + }, + { + "title": "Tritosulfuroni", + "title_fi": "Tritosulfuroni", + "const": "AS178" + }, + { + "title": "Urea", + "title_fi": "Urea", + "const": "AS179" + }, + { + "title": "viherminttuöljy", + "title_fi": "viherminttuöljy", + "const": "AS180" + } + ] + } + } + } + }, + "chemical_applic_target": { + "title": "chemical application target", + "title_fi": "kemikaalinlevityksen kohde", + "description": "source (in Finnish): https://www.kemidigi.fi/kasvinsuojeluainerekisteri/haku", + "type": "string", + "oneOf": [ + { + "title": "defoliation %", + "title_fi": "lehtikato", + "const": "PCLA" + }, + { + "title": "diseased leaf area %", + "title_fi": "tautia lehdissä", + "const": "PDLA" + }, + { + "title": "general pest and diseases losses (due to rot, tikka, leafminer, etc.)", + "title_fi": "yleiset tuhoeläin- ja tautivahingot (mätä, miinaajat jne.)", + "const": "PSTDS" + }, + { + "title": "reduction in photosynthetic rate %", + "title_fi": "lasku yhteyttämisnopeudessa %", + "const": "PRP" + }, + { + "title": "worm (generic)", + "title_fi": "madot", + "const": "WORM" + }, + { + "title": "leafminer", + "title_fi": "miinaajat", + "const": "LEAF_MIN" + }, + { + "title": "stink bug", + "title_fi": "typpyluteet (Stink bug?)", + "const": "STINKB" + }, + { + "title": "looper", + "title_fi": "yökkösentoukat (Looper?)", + "const": "LOOPER" + }, + { + "title": "caterpillar", + "title_fi": "perhostoukat", + "const": "CATERP" + }, + { + "title": "insect (generic)", + "title_fi": "hyönteiset", + "const": "INSECT" + }, + { + "title": "rabbit", + "title_fi": "jänikset", + "const": "RABBIT" + }, + { + "title": "deer", + "title_fi": "hirvieläimet", + "const": "DEER" + }, + { + "title": "mammal (generic)", + "title_fi": "yleiset nisäkkäät", + "const": "MAMMAL" + }, + { + "title": "root-knot nematode", + "title_fi": "meloidogyne spp.", + "const": "RKN" + }, + { + "title": "nematode (generic)", + "title_fi": "sukkulamadot", + "const": "NEMATODE" + }, + { + "title": "potato spindle tuber viroid", + "title_fi": "perunan sukkulamukulaviroidi", + "const": "PSTVd" + }, + { + "title": "viroid (generic)", + "title_fi": "viroidit", + "const": "VIROID" + }, + { + "title": "bean common mosaic virus", + "title_fi": "bean common mosaic virus", + "const": "BCMV" + }, + { + "title": "virus (generic)", + "title_fi": "yleiset virukset", + "const": "VIRUS" + }, + { + "title": "hail storm damage", + "title_fi": "raekuurovahingot", + "const": "HAIL" + }, + { + "title": "wind damage", + "title_fi": "tuulivahingot", + "const": "WIND" + }, + { + "title": "drought", + "title_fi": "kuivuus", + "const": "DROUGHT" + }, + { + "title": "weather damage (generic)", + "title_fi": "yleiset säävahingot", + "const": "WEATHER" + }, + { + "title": "broad-leafed weeds", + "title_fi": "leveälehtiset rikkakasvit", + "const": "BRLFWD" + }, + { + "title": "weeds (generic)", + "title_fi": "yleiset rikkakasvit", + "const": "WEED" + }, + { + "title": "acidity (pH)", + "title_fi": "happamuus (pH)", + "const": "ACIDITY" + } + ] + }, + "chemical_applic_method": { + "allOf": [ + { + "title": "chemical application method", + "title_fi": "kemikaalinlevitystapa" + }, + { + "$ref": "#/$defs/fertilizer_applic_method" + } + ] + }, + "chemical_applic_amount": { + "title": "chemical amount (kg/ha)", + "title_fi": "kemikaalin määrä (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "chemical amount", + "unitless_title_fi": "kemikaalin määrä" + } + }, + "application_depth_chem": { + "title": "chemical application depth (cm)", + "title_fi": "kemikaalinlevityssyvyys (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "chemical application depth", + "unitless_title_fi": "kemikaalinlevityssyvyys" + } + }, + "application_ph_start" : { + "title" : "pH before the application", + "title_fi" : "pH ennen toimenpidettä", + "type": "number", + "minimum" : 0, + "maximum" : 14 + }, + "application_ph_end" : { + "title": "pH after the application", + "title_fi": "pH jälkeen toimenpiteen", + "type": "number", + "minimum" : 0, + "maximum" : 14 + }, + "mgmt_event_long_notes": { + "title": "chemical application notes", + "title_fi": "kemikaalinlevitysmuistiinpanot", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"rot affecting X % of plants\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. \"mätää X % kasveista\"" + } + } + }, + "required": [ + "date", + "chemical_type", + "chemical_product_name", + "chemical_applic_target" + ] + }, + { + "$id": "#grazing", + "title": "grazing", + "title_fi": "laidunnus", + "title_sv": "betning", + "properties": { + "mgmt_operations_event": { + "title": "grazing", + "title_fi": "laidunnus", + "title_sv": "betning", + "const": "grazing" + }, + "grazing_species": { + "title": "grazing species", + "title_fi": "laiduntava laji", + "title_sv": "betande art", + "type": "string", + "oneOf": [ + { + "title": "cattle", + "title_fi": "nautakarja", + "title_sv": "nötkreatur", + "const": "grazing_species_cattle" + }, + { + "title": "sheep", + "title_fi": "lampaat", + "const": "grazing_species_sheep" + }, + { + "title": "goats", + "title_fi": "vuohet", + "const": "grazing_species_goat" + }, + { + "title": "mix", + "title_fi": "useita", + "const": "grazing_species_mix" + }, + { + "title": "other", + "title_fi": "muu", + "const": "grazing_species_other" + } + ] + }, + "grazing_species_age_group": { + "title": "livestock age group (yr)", + "title_fi": "eläinten ikäryhmä (v)", + "type": "string", + "oneOf": [ + { + "title": "0-1", + "const": "0-1" + }, + { + "title": "1-2", + "const": "1-2" + }, + { + "title": "2-3", + "const": "2-3" + }, + { + "title": "3-5", + "const": "3-5" + }, + { + "title": "5-10", + "const": "5-10" + }, + { + "title": "10+", + "const": "10+" + }, + { + "title": "mix", + "title_fi": "useita", + "const": "grazing_species_age_group_mix" + } + ] + }, + "livestock_density": { + "title": "livestock density (number/ha)", + "title_fi": "eläinten tiheys (eläintä/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "ha⁻¹", + "unitless_title": "livestock density", + "unitless_title_fi": "eläinten tiheys" + } + }, + "grazing_intensity": { + "title": "grazing intensity (kg/ha)", + "title_fi": "laidunnusintensiteetti (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "grazing intensity", + "unitless_title_fi": "laidunnusintensiteetti" + } + }, + "date": { + "title": "start date", + "title_fi": "alkamispäivä", + "title_sv": "startdatum", + "type": "string", + "format": "date" + }, + "end_date": { + "title": "end date", + "title_fi": "päättymispäivä", + "title_sv": "slutdatum", + "type": "string", + "format": "date" + }, + "grazing_type": { + "title": "grazing type", + "title_fi": "laidunnuksen tyyppi", + "title_sv": "betstyp", + "type": "string", + "oneOf": [ + { + "title": "continuous", + "title_fi": "jatkuva", + "const": "grazing_type_continuous" + }, + { + "title": "rotation", + "title_fi": "lohkosyöttö", + "title_sv": "rotationsbetning", + "const": "grazing_type_rotation" + }, + { + "title": "mob grazing", + "title_fi": "intensiivinen lohkosyöttö", + "const": "grazing_type_mob_grazing" + }, + { + "title": "strip", + "title_fi": "kaistasyöttö", + "const": "grazing_type_strip" + }, + { + "title": "multi-species", + "title_fi": "sekalaidunnus", + "const": "grazing_type_multi_species" + }, + { + "title": "creep", + "title_fi": "nuoret eläimet paremmalle lohkolle (Creep?)", + "const": "grazing_type_creep" + }, + { + "title": "forward", + "title_fi": "kaksoislaidunnus", + "const": "grazing_type_forward" + }, + { + "title": "other", + "title_fi": "muu", + "const": "grazing_type_other" + } + ] + }, + "grazing_area": { + "title": "grazing area (ha)", + "title_fi": "laidunnettava ala (ha)", + "type": "number", + "minimum": 1, + "x-ui": { + "unit": "ha", + "unitless_title": "grazing area", + "unitless_title_fi": "laidunnettava ala" + } + }, + "grazing_material_removed_prop": { + "title": "proportion of material removed (%)", + "title_fi": "syödyn aineksen määrä (%)", + "type": "number", + "minimum": 0, + "maximum": 100, + "x-ui": { + "unit": "%", + "unitless_title": "proportion of material removed", + "unitless_title_fi": "syödyn aineksen määrä" + } + }, + "grazing_starting_height": { + "title": "starting height (cm)", + "title_fi": "aloituspituus (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "starting height", + "unitless_title_fi": "aloituspituus" + } + }, + "grazing_end_height": { + "title": "end height (cm)", + "title_fi": "lopetuspituus (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "end height", + "unitless_title_fi": "lopetuspituus" + } + }, + "mgmt_event_long_notes": { + "title": "grazing notes", + "title_fi": "laidunnusmuistiinpanot", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"animals were too late to the field\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. \"eläimet vietiin pellolle liian myöhään\"" + } + } + }, + "required": [ + "grazing_species", + "date", + "end_date" + ] + }, + { + "$id": "#weeding", + "title": "mechanical extraction of weeds", + "title_fi": "rikkaruohojen kitkeminen", + "title_sv": "rensning av ogräs", + "properties": { + "mgmt_operations_event": { + "title": "mechanical extraction of weeds", + "title_fi": "rikkaruohojen kitkeminen", + "title_sv": "rensning av ogräs", + "const": "weeding" + }, + "mgmt_event_long_notes": { + "title": "notes on the extraction of weeds", + "title_fi": "muistiinpanot rikkakasvien kitkemisestä", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"the weeds had very deep roots\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. \"rikkakasvien juuret olivat syvällä\"" + } + } + }, + "required": [ + "date" + ] + }, + { + "$id": "#irrigation", + "title": "irrigation", + "title2": "irrigation application", + "title_fi": "kastelu", + "title_sv": "bevattning", + "properties": { + "mgmt_operations_event": { + "title": "irrigation", + "title2": "irrigation application", + "title_fi": "kastelu", + "title_sv": "bevattning", + "const": "irrigation" + }, + "irrigation_operation": { + "title": "irrigation method", + "title_fi": "kastelujärjestelmä", + "type": "string", + "oneOf": [ + { + "title": "furrow", + "title_fi": "vakokastelu", + "const": "IR001" + }, + { + "title": "alternating furrows", + "title_fi": "vuorotteleva vakokastelu (alternating furrows?)", + "const": "IR002" + }, + { + "title": "flood", + "title_fi": "tulva", + "const": "IR003" + }, + { + "title": "sprinkler", + "title_fi": "sadetin", + "const": "IR004" + }, + { + "title": "drip or trickle", + "title_fi": "tihkukastelu", + "const": "IR005" + }, + { + "title": "subsurface (buried) drip", + "title_fi": "maanalainen tihkukastelu", + "const": "IR012" + } + ] + }, + "irrig_amount_depth": { + "title": "irrigation amount (depth, mm)", + "title_fi": "kastelun määrä (veden syvyys, mm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "mm", + "unitless_title": "irrigation amount", + "unitless_title_fi": "kastelun määrä" + } + }, + "irrigation_applic_depth": { + "title": "irrigation depth (cm)", + "title_fi": "kastelusyvyys (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "irrigation depth", + "unitless_title_fi": "kastelusyvyys" + } + }, + "mgmt_event_long_notes": { + "title": "irrigation notes", + "title_fi": "kastelumuistiinpanot", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"drip line flow rate seems a bit low\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. \"tippukasteluletkun virtausnopeus vaikuttaa melko hitaalta\"" + } + } + }, + "required": [ + "date", + "irrig_amount_depth" + ] + }, + { + "$id": "#mowing", + "title": "mowing", + "title_fi": "niitto", + "title2_fi": "ruohonleikkuu", + "title_sv": "gräsklippning", + "properties": { + "mgmt_operations_event": { + "title": "mowing", + "title_fi": "niitto", + "title2_fi": "ruohonleikkuu", + "title_sv": "gräsklippning", + "const": "mowing" + }, + "mowed_crop": { + "allOf": [ + { + "title": "mowed crop", + "title_fi": "leikattu kasvi" + }, + { + "$ref": "#/$defs/crop_ident_ICASA" + } + ] + }, + "mowed_area": { + "title": "mowed area (ha)", + "title_fi": "leikattu ala (ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "ha", + "unitless_title": "mowed area", + "unitless_title_fi": "leikattu ala" + } + }, + "mowing_canopy_height": { + "title": "canopy height before mowing (m)", + "title_fi": "kasvuston korkeus ennen leikkuuta (m)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m", + "unitless_title": "canopy height before mowing", + "unitless_title_fi": "kasvuston korkeus ennen leikkuuta" + } + }, + "mowing_cut_height": { + "title": "cut height (cm)", + "title_fi": "leikkuukorkeus (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "cut height", + "unitless_title_fi": "leikkuukorkeus" + } + }, + "mgmt_event_long_notes": { + "title": "mowing notes", + "title_fi": "muistiinpanot leikkuusta", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"mowing height was not uniform\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havaintoja, esim. \"leikkuukorkeus ei ollut sama kaikkialla\"" + } + } + }, + "required": [ + "date", + "mowed_crop" + ] + }, + { + "$id": "#observation", + "title": "observation", + "title_fi": "havainto", + "title_sv": "observation", + "properties": { + "mgmt_operations_event": { + "title": "observation", + "title_fi": "havainto", + "title_sv": "observation", + "const": "observation" + }, + "observation_type": { + "title": "observation type", + "title_fi": "havainnon tyyppi", + "type": "string", + "x-ui": { + "discriminator": true + } + }, + "mgmt_event_long_notes": { + "title": "observations", + "title_fi": "havainnot", + "type": "string" + } + }, + "required": [ + "date", + "observation_type" + ], + "oneOf": [ + { + "title": "soil observation", + "title_fi": "maaperähavainto", + "properties": { + "observation_type": { + "title": "soil", + "title_fi": "maaperä", + "const": "observation_type_soil" + }, + "soil_layer_list": { + "type": "array", + "title": "soil layers", + "title_fi": "maakerrokset", + "items": { + "type": "object", + "properties": { + "soil_layer_top_depth": { + "type": "number", + "minimum": 0, + "title": "soil layer depth, top (cm)", + "title_fi": "kerroksen yläosan syvyys (cm)", + "x-ui": { + "unit": "cm", + "unitless_title": "soil layer depth, top", + "unitless_title_fi": "kerroksen yläosan syvyys" + } + }, + "soil_layer_base_depth": { + "type": "number", + "minimum": 0, + "title": "soil layer depth, bottom (cm)", + "title_fi": "kerroksen alaosan syvyys (cm)", + "x-ui": { + "unit": "cm", + "unitless_title": "soil layer depth, top", + "unitless_title_fi": "kerroksen yläosan syvyys" + } + }, + "soil_classification_by_layer": { + "type": "string", + "title": "soil structure (VESS or MARA score card)", + "title_fi": "maan rakenne (MARA-kortti)", + "description": "visual evaluation of soil structure (Ball et al. 2007, Franco et al. 2019)", + "oneOf": [ + { + "const": "soil_classification_1", + "title": "structure quality 1 friable", + "title_fi": "luokka 1 erittäin tiivis", + "title_sv": "klass 1 mycket kompakt" + }, + { + "const": "soil_classification_2", + "title": "structure quality 2 intact", + "title_fi": "luokka 2 tiivis", + "title_sv": "klass 2 kompakt" + }, + { + "const": "soil_classification_3", + "title": "structure quality 3 firm", + "title_fi": "luokka 3 kiinteä", + "title_sv": "klass 3 fast" + }, + { + "const": "soil_classification_4", + "title": "structure quality 4 compact", + "title_fi": "luokka 4 tiivistymätön", + "title_sv": "klass 4 opackad" + }, + { + "const": "soil_classification_5", + "title": "structure quality 5 very compact", + "title_fi": "luokka 5 mureneva", + "title_sv": "klass 5 lucker" + } + ] + }, + "soil_bulk_density_moist": { + "title": "bulk density (g/cm³)", + "title_fi": "irtotiheys (g/cm³)", + "x-ui": { + "unitless_title": "bulk density", + "unitless_title_fi": "irtotiheys", + "unit": "g/cm³" + }, + "type": "number", + "minimum": 0 + }, + "soil_water_wilting_pt": { + "title": "soil water content at wilting point (cm³/cm³)", + "title_fi": "nuutumispiste (cm³/cm³)", + "x-ui": { + "unitless_title": "soil water content at wilting point", + "unitless_title_fi": "nuutumispiste", + "unit": "cm³/cm³" + }, + "type": "number", + "minimum": 0 + }, + "soil_water_field_cap_1": { + "title": "soil water content at field capacity, 30 kPA (cm³/cm³)", + "title_fi": "kenttäkapasiteetti, 30 kPA (cm³/cm³)", + "x-ui": { + "unitless_title": "soil water content at field capacity, 30 kPA", + "unitless_title_fi": "kenttäkapasiteetti, 30 kPA", + "unit": "cm³/cm³" + }, + "type": "number", + "minimum": 0 + }, + "soil_water_saturated": { + "title": "soil water content at saturation (cm³/cm³)", + "title_fi": "kylläisyyspiste (cm³/cm³)", + "x-ui": { + "unitless_title": "soil water content at saturation", + "unitless_title_fi": "kylläisyyspiste", + "unit": "cm³/cm³" + }, + "type": "number", + "minimum": 0 + }, + "soil_silt_fraction": { + "title": "soil silt fraction (%)", + "title_fi": "maaperän lietteen osuus (%)", + "x-ui": { + "unitless_title": "soil silt fraction", + "unitless_title_fi": "maaperän lietteen osuus", + "unit": "%" + }, + "type": "number", + "minimum": 0 + }, + "soil_sand_fraction": { + "title": "soil sand fraction (%)", + "title_fi": "maaperän hiekan osuus (%)", + "x-ui": { + "unitless_title": "soil sand fraction", + "unitless_title_fi": "maaperän hiekan osuus", + "unit": "%" + }, + "type": "number", + "minimum": 0 + }, + "soil_clay_fraction": { + "title": "soil clay fraction (%)", + "title_fi": "maaperän saven osuus (%)", + "x-ui": { + "unitless_title": "soil clay fraction", + "unitless_title_fi": "maaperän saven osuus", + "unit": "%" + }, + "type": "number", + "minimum": 0 + }, + "soil_organic_matter_layer": { + "title": "total soil organic matter (kg/ha)", + "title_fi": "maaperän orgaaninen aines (kg/ha)", + "x-ui": { + "unitless_title": "total soil organic matter", + "unitless_title_fi": "maaperän orgaaninen aines", + "unit": "kg/ha" + }, + "type": "number", + "minimum": 0 + }, + "soil_organic_C_perc_layer": { + "title": "total soil organic carbon content (%)", + "title_fi": "orgaanisen hiilen osuus (%)", + "x-ui": { + "unitless_title": "total soil organic carbon content", + "unitless_title_fi": "orgaanisen hiilen osuus", + "unit": "%" + }, + "type": "number", + "minimum": 0 + } + } + } + }, + "root_depth": { + "title": "root depth (m)", + "title_fi": "juurten syvyys (m)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m", + "unitless_title": "root depth", + "unitless_title_fi": "juurten syvyys" + } + }, + "soil_compactification_depth": { + "title": "soil compactification depth (cm)", + "title_fi": "tiivistymän syvyys (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "soil compactification depth", + "unitless_title_fi": "tiivistymän syvyys" + } + }, + "earthworm_count": { + "title": "number of earthworms", + "title_fi": "lierojen lukumäärä", + "type": "integer", + "minimum": 0 + } + } + }, + { + "title": "vegetation observation", + "title_fi": "kasvillisuushavainto", + "properties": { + "observation_type": { + "title": "vegetation", + "title_fi": "kasvillisuus", + "const": "observation_type_vegetation" + }, + "growth_stage": { + "title": "plant growth stage", + "title_fi": "kasvuaste", + "type": "string", + "oneOf": [ + { + "title": "germination", + "title_fi": "itäminen", + "const": "growth_stage_germination" + }, + { + "title": "first pod", + "title_fi": "first pod -käännös", + "const": "growth_stage_first_pod" + }, + { + "title": "pegging", + "title_fi": "pegging-käännös", + "const": "growth_stage_pegging" + }, + { + "title": "budding", + "title_fi": "budding-käännös", + "const": "growth_stage_budding" + }, + { + "title": "blooming", + "title_fi": "blooming-käännös", + "const": "growth_stage_blooming" + }, + { + "title": "seeding", + "title_fi": "seeding-käännös", + "const": "growth_stage_seeding" + }, + { + "title": "maturity", + "title_fi": "maturity-käännös", + "const": "growth_stage_maturity" + } + ] + }, + "plant_density": { + "title": "plant density (plants/m²)", + "title_fi": "kasvitiheys (kasveja/m²)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m⁻²", + "unitless_title": "plant density", + "unitless_title_fi": "kasvitiheys" + } + }, + "specific_leaf_area": { + "title": "specific leaf area (cm²/g)", + "title_fi": "ominaislehtiala (cm²/g)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm²/g", + "unitless_title": "specific leaf area", + "unitless_title_fi": "ominaislehtiala" + } + }, + "leaf_area_index": { + "title": "leaf area index (m²/m²)", + "title_fi": "lehtialaindeksi (m²/m²)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m²/m²", + "unitless_title": "leaf area index", + "unitless_title_fi": "lehtialaindeksi" + } + }, + "total_biomass_dw": { + "title": "total biomass, dry weight (kg/ha)", + "title_fi": "kokonaisbiomassa, kuivapaino (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "total biomass, dry weight", + "unitless_title_fi": "kokonaisbiomassa, kuivapaino" + } + }, + "tops_C": { + "title": "carbon (C) in aboveground biomass (kg/ha)", + "title_fi": "hiilen määrä (C) biomassassa maanpinnalla (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "carbon (C) in aboveground biomass", + "unitless_title_fi": "hiilen määrä (C) biomassa maanpinnalla" + } + }, + "tops_C_std": { + "title": "standard deviation of carbon (C) in aboveground biomass (meas.) (kg/ha)", + "title_fi": "maanpäällisen biomassan C (mittausten) keskihajonta (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "standard deviation of carbon (C) in aboveground biomass (meas.)", + "unitless_title_fi": "maanpäällisen biomassan hiilen (C) mittausten keskihajonta" + } + }, + "roots_C": { + "title": "carbon (C) in belowground biomass (kg/ha)", + "title_fi": "hiilen määrä (C) biomassassa maanpinnan alapuolella (kg[C]/ha):", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "carbon (C) in belowground biomass", + "unitless_title_fi": "hiilen määrä (C) biomassassa maanpinnan alapuolella" + } + }, + "roots_C_std": { + "title": "standard deviation of carbon (C) in belowground biomass (kg/ha)", + "title_fi": "maanalaisen hiilibiomassan hiilen (C) mittausten keskihajonta: (kg/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/ha", + "unitless_title": "standard deviation of belowground biomass C (meas.)", + "unitless_title_fi": "maanalaisen hiilibiomassan C (mittausten) keskihajonta" + } + }, + "canopy_height": { + "title": "canopy height (m)", + "title_fi": "latvuston korkeus (m)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "m", + "unitless_title": "canopy height", + "unitless_title_fi": "latvuston korkeus" + } + }, + "canopeo_reading": { + "title": "canopeo reading", + "title_fi": "canopeo-lukema", + "type": "number", + "minimum": 0 + } + } + }, + { + "title": "water observation", + "title_fi": "vesihavainto", + "properties": { + "observation_type": { + "title": "water observation", + "title_fi": "vesihavainto", + "const": "observation_type_water" + }, + "floodwater_depth": { + "title": "floodwater depth (mm)", + "title_fi": "tulvaveden syvyys (mm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "mm", + "unitless_title": "floodwater depth", + "unitless_title_fi": "tulvaveden syvyys" + } + }, + "water_table_depth": { + "title": "water table level (cm)", + "title_fi": "pohjaveden pinnan syvyys (cm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "cm", + "unitless_title": "water table level", + "unitless_title_fi": "pohjaveden pinnan syvyys" + } + } + } + }, + { + "title": "animals", + "title_fi": "eläimet", + "properties": { + "observation_type": { + "title": "animals", + "title_fi": "eläimet", + "const": "observation_type_animals" + } + } + }, + { + "title": "pests", + "title_fi": "tuholaiset", + "properties": { + "observation_type": { + "title": "pests", + "title_fi": "tuholaiset", + "const": "observation_type_pests" + }, + "plant_pop_reduct_cum": { + "title": "amount of plants eaten (%, cumulative)", + "title_fi": "syötyjen kasvien määrä (%, kumulatiivinen)", + "type": "number", + "minimum": 0, + "maximum": 0, + "x-ui": { + "unit": "%", + "unitless_title": "amount of plants eaten", + "unitless_title_fi": "syötyjen kasvien määrä" + } + } + } + }, + { + "title": "disturbance", + "title_fi": "häiriö", + "properties": { + "observation_type": { + "title": "disturbance", + "title_fi": "häiriö", + "const": "observation_type_disturbance" + } + } + }, + { + "title": "management", + "title_fi": "tilanhoito", + "properties": { + "observation_type": { + "title": "management", + "title_fi": "tilanhoito", + "const": "observation_type_management" + }, + "fuel_amount": { + "title": "fuel used (liters/ha)", + "title_fi": "käytetty polttoaine (litraa/ha)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "L/ha", + "unitless_title": "fuel used", + "unitless_title_fi": "käytetty polttoaine" + } + } + } + }, + { + "title": "other", + "title_fi": "muu", + "properties": { + "observation_type": { + "title": "other", + "title_fi": "muu", + "const": "observation_type_other" + } + } + } + ] + }, + { + "$id": "#bed_prep", + "title": "raised bed preparation", + "title_fi": "kasvatuslaatikoiden valmistelu", + "title2_fi": "kohopenkki", + "title_sv": "upphöjd odlingsbädd", + "properties": { + "mgmt_operations_event": { + "title": "raised bed preparation", + "title_fi": "kasvatuslaatikoiden valmistelu", + "title2_fi": "kohopenkki", + "title_sv": "upphöjd odlingsbädd", + "const": "bed_prep" + }, + "mgmt_event_long_notes": { + "title": "notes on the preparation of raised beds", + "title_fi": "muistiinpanot kasvatuslaatikoiden valmistelusta", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"used the beds from last year\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. \"käytettiin samoja kasvatuslaatikoita kuin edellisenä vuonna\"" + } + } + }, + "required": [ + "date" + ] + }, + { + "$id": "#inorg_mulch", + "title": "placement of mulch", + "title2": "placement of inorganic mulch", + "title_fi": "katteen levitys", + "title_sv": "applicering av oorganisk kompost", + "properties": { + "mgmt_operations_event": { + "title": "placement of mulch", + "title2": "placement of inorganic mulch", + "title_fi": "katteen levitys", + "title_sv": "applicering av oorganisk kompost", + "const": "inorg_mulch" + }, + "mulch_type": { + "allOf": [ + { + "title": "mulch type", + "title_fi": "katteen tyyppi" + }, + { + "$ref": "#/$defs/mulch_type" + } + ] + }, + "mulch_thickness": { + "title": "mulch thickness (mm)", + "title_fi": "katteen paksuus (mm)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "mm", + "unitless_title": "mulch thickness", + "unitless_title_fi": "katteen paksuus" + } + }, + "mulch_cover_fraction": { + "title": "fraction of surface covered (%)", + "title_fi": "peitto-osuus (%)", + "type": "number", + "minimum": 0, + "maximum": 100, + "x-ui": { + "unit": "%", + "unitless_title": "fraction of surface covered", + "unitless_title_fi": "peitto-osuus" + } + }, + "mulch_color": { + "title": "mulch colour", + "title_fi": "katteen väri", + "type": "string", + "oneOf": [ + { + "title": "transparent", + "title_fi": "läpinäkyvä", + "const": "MC001" + }, + { + "title": "white", + "title_fi": "valkoinen", + "const": "MC002" + }, + { + "title": "black", + "title_fi": "musta", + "const": "MC003" + }, + { + "title": "brown", + "title_fi": "ruskea", + "const": "MC004" + }, + { + "title": "grey", + "title_fi": "harmaa", + "const": "MC005" + }, + { + "title": "light straw color", + "title_fi": "olki", + "const": "MC006" + } + ] + }, + "mgmt_event_long_notes": { + "title": "mulch placement notes", + "title_fi": "katteenlevitysmuistiinpanot", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"mulch was placed only on the northern half of the field\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. \"kate levitettiin ainoastaan pellon pohjoiselle puoliskolle\"" + } + } + }, + "required": [ + "date", + "mulch_type" + ] + }, + { + "$id": "#Inorg_mul_rem", + "title": "removal of mulch", + "title2": "removal of inorganic mulch", + "title_fi": "katteen poisto", + "title_sv": "borttagning av oorganisk kompost", + "properties": { + "mgmt_operations_event": { + "title": "removal of mulch", + "title2": "removal of inorganic mulch", + "title_fi": "katteen poisto", + "title_sv": "borttagning av oorganisk kompost", + "const": "Inorg_mul_rem" + }, + "mulch_type_remove": { + "allOf": [ + { + "title": "type of removed mulch", + "title_fi": "poistetun katteen tyyppi" + }, + { + "$ref": "#/$defs/mulch_type" + } + ] + }, + "mgmt_event_long_notes": { + "title": "mulch removal notes", + "title_fi": "katteenpoistomuistiinpanot", + "type": "string", + "x-ui": { + "form-type": "textAreaInput", + "form-placeholder": "any notes or observations about the event, e.g. \"the mulch was recycled\"", + "form-placeholder_fi": "mitä tahansa tapahtumaan liittyviä muistiinpanoja tai havintoja, esim. \"kate kierrätettiin\"" + } + } + }, + "required": [ + "date", + "mulch_type_remove" + ] + }, + { + "$id": "#measurement", + "title": "measurement", + "title_fi": "mittaus", + "properties": { + "mgmt_operations_event": { + "title": "measurement", + "title_fi": "mittaus", + "const": "measurement" + }, + "carbon_soil_tot": { + "title": "average carbon in 1 m soil column (kg/m²)", + "title_fi": "hiiltä keskimäärin 1 m maakolonnissa (kg/m²)", + "title_sv": "kol i medeltal i 1 m markpelare (kg/m²)", + "type": "number", + "minimum": 0, + "x-ui": { + "unit": "kg/m²", + "unitless_title": "average carbon in 1 m soil column", + "unitless_title_fi": "hiiltä keskimäärin 1 m maakolonnissa", + "unitless_title_sv": "kol i medeltal i 1 m markpelare" + } + }, + "carbon_soil_tot_sd": { + "title": "standard deviation", + "title_fi": "keskihajonta", + "title_sv": "standardavvikelse", + "type": "number", + "minimum": 0 + } + } + }, + { + "$id": "#other", + "title": "other", + "title2": "other management event", + "title_fi": "muu", + "title2_fi": "muu toimenpide", + "title_sv": "annan åtgärd", + "properties": { + "mgmt_operations_event": { + "title": "other", + "title2": "other management event", + "title_fi": "muu", + "title2_fi": "muu toimenpide", + "title_sv": "annan åtgärd", + "const": "other" + }, + "mgmt_event_long_notes": { + "title": "notes", + "title_fi": "muistiinpanot", + "type": "string" + } + }, + "required": [ + "date", + "mgmt_event_long_notes" + ] + } + ], + "$defs": { + "crop_ident_ICASA": { + "type": "string", + "oneOf": [ + { + "title": "timothy (Phleum pratense)", + "title_fi": "timotei (Phleum pratense)", + "title_sv": "timotej (Phleum pratense)", + "const": "FRG" + }, + { + "title": "wheat (Triticum spp.)", + "title_fi": "vehnä (Triticum spp.)", + "title_sv": "vete (Triticum spp.)", + "const": "WHT" + }, + { + "title": "oats (Avena sativa)", + "title_fi": "kaura (Avena sativa)", + "title_sv": "havre (Avena sativa)", + "const": "OAT" + }, + { + "title": "rye (Secale cereale)", + "title_fi": "ruis (Secale cereale)", + "const": "RYE" + }, + { + "title": "barley (Hordeum vulgare)", + "title_fi": "ohra (Hordeum vulgare)", + "title_sv": "korn (Hordeum vulgare)", + "const": "BAR" + }, + { + "title": "mixed grain", + "title_fi": "seosvilja", + "const": "ZZ1" + }, + { + "title": "Mixed grass", + "title_fi": "Seosruoho", + "const": "ZZ3" + }, + { + "title": "buckwheat (Fagopyrum esculentum)", + "title_fi": "tattari (Fagopyrum esculentum)", + "const": "BWH" + }, + { + "title": "potato (Solanum tuberosum)", + "title_fi": "peruna (Solanum tuberosum)", + "const": "POT" + }, + { + "title": "sugar beet (Beta vulgaris var. altissima)", + "title_fi": "sokerijuurikas (Beta vulgaris var. altissima)", + "const": "SBT" + }, + { + "title": "pea (Pisum sativum)", + "title_fi": "herne (Pisum sativum)", + "const": "PEA" + }, + { + "title": "faba bean (Vicia faba)", + "title_fi": "härkäpapu (Vicia faba)", + "const": "FBN" + }, + { + "title": "turnip rape (Brassica rapa subsp. oleifera)", + "title_fi": "rypsi (Brassica rapa subsp. oleifera)", + "const": "RYP" + }, + { + "title": "rapeseed (Brassica napus subsp. napus)", + "title_fi": "rapsi (Brassica napus subsp. napus)", + "const": "RAP" + }, + { + "title": "flax (Linum usitatissimum)", + "title_fi": "pellava (Linum usitatissimum)", + "const": "FLX" + }, + { + "title": "caraway (Carum carvi)", + "title_fi": "kumina (Carum carvi)", + "const": "CCA" + }, + { + "title": "reed canary grass (Phalaris arundinacea)", + "title_fi": "ruokohelpi (Phalaris arundinacea)", + "const": "PHA" + }, + { + "title": "red clover (Trifolium pratense)", + "title_fi": "puna-apila (Trifolium pratense)", + "const": "RCL" + }, + { + "title": "white clover (Trifolium repens)", + "title_fi": "valkoapila (Trifolium repens)", + "const": "WCL" + }, + { + "title": "alsike clover (Trifolium hybridum)", + "title_fi": "alsikeapila (Trifolium hybridum)", + "const": "ACL" + }, + { + "title": "alfalfa (Medicago sativa)", + "title_fi": "sinimailanen (Medicago sativa)", + "const": "ALF" + }, + { + "title": "oilseed radish (Raphanus sativus var. oleiformis)", + "title_fi": "öljyretikka (Raphanus sativus var. oleiformis)", + "const": "RSO" + }, + { + "title": "common vetch (Vicia sativa)", + "title_fi": "rehuvirna (Vicia sativa)", + "const": "VSA" + }, + { + "title": "smooth brome (Bromus inermis)", + "title_fi": "rehukattara (Bromus inermis)", + "const": "BRI" + }, + { + "title": "meadow fescue (Festuca pratensis)", + "title_fi": "nurminata (Festuca pratensis)", + "title_sv": "ängssvingel (Festuca pratensis)", + "const": "FEP" + }, + { + "title": "perennial ryegrass (Lolium perenne)", + "title_fi": "englanninraiheinä (Lolium perenne)", + "const": "RGP" + }, + { + "title": "kentucky bluegrass (Poa pratensis)", + "title_fi": "niittynurmikka (Poa pratensis)", + "const": "POA" + }, + { + "title": "sudan grass (Sorghum × drummondii)", + "title_fi": "sudaninruoho (Sorghum × drummondii)", + "const": "SDR" + }, + { + "title": "annual ryegrass (Festuca perennis / Lolium multiflorum)", + "title_fi": "italianraiheinä (Festuca perennis / Lolium multiflorum)", + "const": "RGA" + }, + { + "title": "tall fescue (Festuca arundinacea / Schedonorus arundinaceus)", + "title_fi": "ruokonata (Festuca arundinacea / Schedonorus arundinaceus)", + "const": "TFS" + }, + { + "title": "hairy vetch (Vicia villosa)", + "title_fi": "ruisvirna (Vicia villosa)", + "const": "HVT" + }, + { + "title": "persian clover (Trifolium resupinatum var. majus)", + "title_fi": "persianapila (Trifolium resupinatum var. majus)", + "const": "TRM" + }, + { + "title": "hybrid fescue (x Festulolium loliaceum)", + "title_fi": "rainata (x Festulolium loliaceum)", + "const": "XFL" + }, + { + "title": "common chicory (Cichorium intybus)", + "title_fi": "sikuri (Cichorium intybus)", + "const": "CII" + }, + { + "title": "lacy phacelia (Phacelia tanacetifolia)", + "title_fi": "aitohunajakukka (Phacelia tanacetifolia)", + "const": "PHT" + } + ] + }, + "fertilizer_applic_method": { + "type": "string", + "oneOf": [ + { + "title": "broadcast, not incorporated", + "title_fi": "levitetty pinnalle, ei sekoitettu", + "const": "AP001" + }, + { + "title": "broadcast, incorporated", + "title_fi": "levitetty ja sekoitettu", + "const": "AP002" + }, + { + "title": "banded on surface", + "title_fi": "nauhoina pinnalla", + "const": "AP003" + }, + { + "title": "banded beneath surface", + "title_fi": "sijoituslannoitus", + "const": "AP004" + }, + { + "title": "applied in irrigation water", + "title_fi": "kasteluveden mukana", + "const": "AP005" + }, + { + "title": "foliar spray", + "title_fi": "suihkutettu lehdelle", + "const": "AP006" + }, + { + "title": "bottom of hole", + "title_fi": "bottom of hole -käännös", + "const": "AP007" + }, + { + "title": "on the seed", + "title_fi": "siemenen pinnassa", + "const": "AP008" + }, + { + "title": "injected", + "title_fi": "ruiskutettu pinnan alle", + "const": "AP009" + } + ] + }, + "mulch_type": { + "type": "string", + "oneOf": [ + { + "title": "polyethylene sheet - solid", + "title_fi": "katemuovi (PE)", + "const": "MT001" + }, + { + "title": "polyethylene sheet - perforated", + "title_fi": "rei'itetty katemuovi (PE)", + "const": "MT002" + }, + { + "title": "landscape fabric", + "title_fi": "maisemointikangas", + "const": "MT003" + }, + { + "title": "paper", + "title_fi": "paperi", + "const": "MT004" + }, + { + "title": "grass clippings", + "title_fi": "leikattu ruoho", + "const": "MT005" + }, + { + "title": "pine needles", + "title_fi": "männynneulaset", + "const": "MT006" + }, + { + "title": "straw", + "title_fi": "olki", + "const": "MT007" + }, + { + "title": "foil", + "title_fi": "folio (foil?)", + "const": "MT008" + }, + { + "title": "foil coated plastic", + "title_fi": "muovipäällysteinen folio (foil coated with plastic?)", + "const": "MT009" + }, + { + "title": "photodegradable plastic", + "title_fi": "valohajoava muovi", + "const": "MT010" + } + ] + } + }, + "required": [ + "mgmt_operations_event" + ] +} \ No newline at end of file diff --git a/data/ui_structure.json b/inst/extdata/ui_structure.json similarity index 70% rename from data/ui_structure.json rename to inst/extdata/ui_structure.json index 561c9db..58adbb6 100644 --- a/data/ui_structure.json +++ b/inst/extdata/ui_structure.json @@ -1,7 +1,32 @@ { "frontpage" : { - "window_title" : { - "code_name" : "window_title", + + "site": { + "code_name": "site", + "type": "selectInput", + "label": "site_label", + "choices": "IGNORE", + "required" : true + }, + + "uservisible" : { + "code_name" : "uservisible", + "type" : "textInput", + "value": "temp" + }, + + "uservisible_title" : { + "code_name" : "uservisible_title", + "type" : "textOutput" + }, + + "guide_text" : { + "code_name" : "guide_text", + "type" : "textOutput" + }, + + "frontpage_title" : { + "code_name" : "frontpage_title", "type" : "textOutput" }, @@ -10,8 +35,23 @@ "type" : "textOutput" }, - "frontpage_table_title" : { - "code_name" : "frontpage_table_title", + "event_list_title" : { + "code_name" : "event_list_title", + "type" : "textOutput" + }, + + "rotation_cycle_title" : { + "code_name" : "rotation_cycle_title", + "type" : "textOutput" + }, + + "json_dl_label" : { + "code_name" : "json_dl_label", + "type" : "textOutput" + }, + + "csv_dl_label" : { + "code_name" : "csv_dl_label", "type" : "textOutput" }, @@ -30,20 +70,20 @@ "type" : "textOutput" }, - "table_activity" : { - "code_name" : "table_activity", + "event_list_activity_filter" : { + "code_name" : "event_list_activity_filter", "type" : "selectInput", "choices" : "IGNORE" }, - "table_block" : { - "code_name" : "table_block", + "event_list_block_filter" : { + "code_name" : "event_list_block_filter", "type" : "selectInput", "choices" : "IGNORE" }, - "table_year" : { - "code_name" : "table_year", + "event_list_year_filter" : { + "code_name" : "event_list_year_filter", "type" : "selectInput", "choices" : "IGNORE" }, @@ -61,14 +101,14 @@ } }, - "sidebar" : { - "sidebar_title": { - "code_name" : "sidebar_title", + "form" : { + "form_title": { + "code_name" : "form_title", "type" : "textOutput", "dynamic" : { "mode" : "edit_mode", - "TRUE" : "sidebar_title_edit", - "FALSE" : "sidebar_title_add" + "TRUE" : "form_title_edit", + "FALSE" : "form_title_add" } }, @@ -77,14 +117,6 @@ "type" : "textOutput" }, - "site": { - "code_name": "site", - "type": "selectInput", - "label": "site_label", - "choices": "IGNORE", - "required" : true - }, - "block": { "code_name": "block", "type": "selectInput", @@ -112,14 +144,21 @@ "multiple" : true, "required" : true, "sub_elements" : { + "multiple" : { "condition" : "input.planted_crop.length > 1", "planted_crop_table" : { "code_name" : "planted_crop_table", "type" : "dataTable", - "columns" : ["planting_material_weight", "planting_depth", "planting_material_source"], - "rows" : "planted_crop" + "columns" : ["planting_material_weight", "planting_depth", + "planting_material_source"], + "rows" : { + "crops" : { + "row_variable" : "planted_crop", + "type" : "dynamic" + } + } } }, @@ -129,14 +168,14 @@ "planting_material_weight" : { "code_name" : "planting_material_weight", "type" : "numericInput", - "min" : "0", + "min" : 0, "label" : "planting_material_weight_label" }, "planting_depth" : { "code_name" : "planting_depth", "type" : "numericInput", - "min" : "0", + "min" : 0, "label" : "planting_depth_label" }, @@ -166,8 +205,8 @@ "code_name" : "harvest_area", "type" : "numericInput", "label" : "harvest_area_label", - "min" : "0", - "required" : true + "min" : 0 + //"required" : true }, "harvest_crop" : { @@ -179,52 +218,71 @@ "required" : true, "sub_elements" : { - "always" : { - "condition" : "true", + "multiple" : { + "condition" : "input.harvest_crop.length > 1", + + "harvest_crop_table" : { + "code_name" : "harvest_crop_table", + "type" : "dataTable", + "columns" : ["harvest_yield_harvest_dw", + "harv_yield_harv_f_wt", "yield_C_at_harvest", + "harvest_moisture", "harvest_method", + "harvest_operat_component", "canopy_height_harvest", + "harvest_cut_height", "plant_density_harvest", + "harvest_residue_placement"], + "rows" : { + "crops" : { + "row_variable" : "harvest_crop", + "type" : "dynamic" + }, + + "total" : { + "variables" : ["harvest_yield_harvest_dw_total", + "harv_yield_harv_f_wt_total", + "yield_C_at_harvest_total"], + "type" : "static", + "name" : "total_row_name", + "hide_labels" : true + } + } + } + }, + + "single" : { + "condition" : "input.harvest_crop.length <= 1", + "harvest_yield_harvest_dw_total" : { "code_name" : "harvest_yield_harvest_dw_total", "type" : "numericInput", "label" : "harvest_yield_harvest_dw_total_label", - "min" : "0", - "required" : true + "min" : 0, + "sum_of" : "harvest_yield_harvest_dw" + //"required" : true }, "harv_yield_harv_f_wt_total" : { "code_name" : "harv_yield_harv_f_wt_total", "type" : "numericInput", "label" : "harv_yield_harv_f_wt_total_label", - "min" : "0" + "min" : 0, + "sum_of" : "harv_yield_harv_f_wt" }, "yield_C_at_harvest_total" : { "code_name" : "yield_C_at_harvest_total", "type" : "numericInput", "label" : "yield_C_at_harvest_total_label", - "min" : "0" - } - }, - - "multiple" : { - "condition" : "input.harvest_crop.length > 1", - - "harvest_crop_table" : { - "code_name" : "harvest_crop_table", - "type" : "dataTable", - "columns" : ["harvest_yield_harvest_dw", "harv_yield_harv_f_wt", "yield_C_at_harvest", "harvest_moisture", "harvest_method", "harvest_operat_component", "canopy_height_harvest", "harvest_cut_height", "plant_density_harvest", "harvest_residue_placement"], - "rows" : "harvest_crop" - } - }, - - "single" : { - "condition" : "input.harvest_crop.length <= 1", + "min" : 0, + "sum_of" : "yield_C_at_harvest" + }, "harvest_moisture" : { "code_name" : "harvest_moisture", "type" : "numericInput", "label" : "harvest_moisture_label", - "min" : "0", - "max" : "100" + "min" : 0, + "max" : 100 }, "harvest_method" : { @@ -239,28 +297,28 @@ "type" : "selectInput", "choices" : "HACOM", "label" : "harvest_operat_component_label", - "hide_in_table" : true + "hide_in_event_list" : true }, "canopy_height_harvest" : { "code_name" : "canopy_height_harvest", "type" : "numericInput", "label" : "canopy_height_harvest_label", - "min" : "0" + "min" : 0 }, "harvest_cut_height" : { "code_name" : "harvest_cut_height", "type" : "numericInput", "label" : "harvest_cut_height_label", - "min" : "0" + "min" : 0 }, "plant_density_harvest" : { "code_name" : "plant_density_harvest", "type" : "numericInput", "label" : "plant_density_harvest_label", - "min" : "0" + "min" : 0 }, "harvest_residue_placement" : { @@ -279,24 +337,27 @@ "code_name" : "harvest_yield_harvest_dw", "type" : "numericInput", "label" : "harvest_yield_harvest_dw_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true, + "sum_to" : "harvest_yield_harvest_dw_total" }, "harv_yield_harv_f_wt" : { "code_name" : "harv_yield_harv_f_wt", "type" : "numericInput", "label" : "harv_yield_harv_f_wt_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true, + "sum_to" : "harv_yield_harv_f_wt_total" }, "yield_C_at_harvest" : { "code_name" : "yield_C_at_harvest", "type" : "numericInput", "label" : "yield_C_at_harvest_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true, + "sum_to" : "yield_C_at_harvest_total" } } @@ -313,7 +374,7 @@ "type" : "textAreaInput", "label" : "harvest_comments_label", "placeholder" : "harvest_comments_placeholder", - "hide_in_table" : true + "hide_in_event_list" : true } }, @@ -340,7 +401,7 @@ "code_name" : "tillage_operations_depth", "type" : "numericInput", "label" : "tillage_operations_depth_label", - "min" : "0" + "min" : 0 }, "tillage_treatment_notes" : { @@ -370,21 +431,32 @@ "label" : "organic_material_label", "choices" : "OMCD" }, + + "fert_animal" : { + "condition" : "input.organic_material == 'RE003' | input.organic_material == 'RE004'", + + "animal_fert_usage" : { + "code_name" : "animal_fert_usage", + "type" : "textInput", + "label" : "animal_fert_usage_label", + "placeholder" : "animal_fert_usage_placeholder" + } + }, "org_matter_moisture_conc" : { "code_name" : "org_matter_moisture_conc", "type" : "numericInput", "label" : "org_matter_moisture_conc_label", - "min" : "0", - "max" : "100" + "min" : 0, + "max" : 100 }, "org_matter_carbon_conc" : { "code_name" : "org_matter_carbon_conc", "type": "numericInput", "label" : "org_matter_carbon_conc_label", - "min" : "0", - "max" : "100" + "min" : 0, + "max" : 100 } }, @@ -434,14 +506,14 @@ "code_name" : "application_depth_fert", "type" : "numericInput", "label" : "application_depth_fert_label", - "min" : "0" + "min" : 0 }, "fertilizer_total_amount" : { "code_name" : "fertilizer_total_amount", "type" : "numericInput", "label" : "fertilizer_total_amount_label", - "min" : "0", + "min" : 0, "required" : true }, @@ -454,7 +526,27 @@ "fertilizer_element_table" : { "code_name" : "fertilizer_element_table", "type" : "dataTable", - "rows" : [["N_in_applied_fertilizer", "phosphorus_applied_fert", "fertilizer_K_applied", "S_in_applied_fertilizer", "Ca_in_applied_fertilizer", "Mg_in_applied_fertilizer", "Na_in_applied_fertilizer"], ["Cu_in_applied_fertilizer", "Zn_in_applied_fertilizer", "B_in_applied_fertilizer", "Mn_in_applied_fertilizer", "Se_in_applied_fertilizer", "Fe_in_applied_fertilizer", "other_element_in_applied_fertilizer"]] + "rows" : { + + "row1" : { + "variables" : ["N_in_applied_fertilizer", "N_in_soluble_fertilizer", + "phosphorus_applied_fert", "fertilizer_K_applied", + "S_in_applied_fertilizer", "Ca_in_applied_fertilizer", + "Mg_in_applied_fertilizer", "Na_in_applied_fertilizer"], + "type" : "static" + }, + + "row2" : { + "variables" : ["Cu_in_applied_fertilizer", + "Zn_in_applied_fertilizer", "B_in_applied_fertilizer", + "Mn_in_applied_fertilizer", "Se_in_applied_fertilizer", + "Fe_in_applied_fertilizer", + "other_element_in_applied_fertilizer"], + "type" : "static" + } + + } + }, "hidden" : { @@ -464,111 +556,119 @@ "code_name" : "N_in_applied_fertilizer", "type" : "numericInput", "label" : "N_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true + }, + + "N_in_soluble_fertilizer" : { + "code_name" : "N_in_soluble_fertilizer", + "type" : "numericInput", + "label" : "N_in_soluble_fertilizer_label", + "min" : 0, + "hide_in_event_list" : true }, "phosphorus_applied_fert" : { "code_name" : "phosphorus_applied_fert", "type" : "numericInput", "label" : "phosphorus_applied_fert_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "fertilizer_K_applied" : { "code_name" : "fertilizer_K_applied", "type" : "numericInput", "label" : "fertilizer_K_applied_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "S_in_applied_fertilizer" : { "code_name" : "S_in_applied_fertilizer", "type" : "numericInput", "label" : "S_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Ca_in_applied_fertilizer" : { "code_name" : "Ca_in_applied_fertilizer", "type" : "numericInput", "label" : "Ca_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Mg_in_applied_fertilizer" : { "code_name" : "Mg_in_applied_fertilizer", "type" : "numericInput", "label" : "Mg_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Na_in_applied_fertilizer" : { "code_name" : "Na_in_applied_fertilizer", "type" : "numericInput", "label" : "Na_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Cu_in_applied_fertilizer" : { "code_name" : "Cu_in_applied_fertilizer", "type" : "numericInput", "label" : "Cu_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Zn_in_applied_fertilizer" : { "code_name" : "Zn_in_applied_fertilizer", "type" : "numericInput", "label" : "Zn_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "B_in_applied_fertilizer" : { "code_name" : "B_in_applied_fertilizer", "type" : "numericInput", "label" : "B_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Mn_in_applied_fertilizer" : { "code_name" : "Mn_in_applied_fertilizer", "type" : "numericInput", "label" : "Mn_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Se_in_applied_fertilizer" : { "code_name" : "Se_in_applied_fertilizer", "type" : "numericInput", "label" : "Se_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "Fe_in_applied_fertilizer" : { "code_name" : "Fe_in_applied_fertilizer", "type" : "numericInput", "label" : "Fe_in_applied_fertilizer_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "other_element_in_applied_fertilizer" : { "code_name" : "other_element_in_applied_fertilizer", "type" : "textInput", "label" : "other_element_in_applied_fertilizer_label", - "hide_in_table" : true + "hide_in_event_list" : true } }, @@ -597,7 +697,8 @@ "code_name" : "grazing_species_age_group", "type" : "selectInput", "label" : "grazing_species_age_group_label", - "choices" : ["0-1","1-2","2-3","3-5","5-10","10+","grazing_species_age_group_mix"] + "choices" : ["0-1","1-2","2-3","3-5","5-10","10+", + "grazing_species_age_group_mix"] }, "livestock_density" : { @@ -680,7 +781,7 @@ "code_name" : "mowed_area", "type" : "numericInput", "label" : "mowed_area_label", - "min" : "0" + "min" : 0 }, "mowing_method" : { @@ -694,14 +795,14 @@ "code_name" : "mowing_canopy_height", "type" : "numericInput", "label" : "mowing_canopy_height_label", - "min" : "0" + "min" : 0 }, "mowing_cut_height" : { "code_name" : "mowing_cut_height", "type" : "numericInput", "label" : "mowing_cut_height_label", - "min" : "0" + "min" : 0 }, "mowing_notes" : { @@ -730,12 +831,16 @@ "required" : true }, - "chemical_applic_material" : { - "code_name" : "chemical_applic_material", - "type" : "selectInput", - "label" : "chemical_applic_material_label", - "choices" : "active_substance", - "multiple" : true + "chemical_type_substance" : { + "condition" : "input.chemical_type != 'chemical_type_lime_application'", + + "chemical_applic_material" : { + "code_name" : "chemical_applic_material", + "type" : "selectInput", + "label" : "chemical_applic_material_label", + "choices" : "active_substance", + "multiple" : true + } }, "chemical_applic_target" : { @@ -757,7 +862,7 @@ "code_name" : "chemical_applic_amount", "type" : "numericInput", "label" : "chemical_applic_amount_label", - "min" : 1 + "min" : 0 }, "application_depth_chem" : { @@ -766,6 +871,26 @@ "label" : "application_depth_chem_label", "min" : 0 }, + + "pH_change_in_application" : { + "condition" : "input.chemical_type == 'chemical_type_lime_application'", + + "application_ph_start" : { + "code_name" : "application_ph_start", + "type" : "numericInput", + "label" : "application_ph_start_label", + "min" : 0, + "max" : 14 + }, + + "application_ph_end" : { + "code_name" : "application_ph_end", + "type" : "numericInput", + "label" : "application_ph_end_label", + "min" : 0, + "max" : 14 + } + }, "chemical_applic_notes" : { "code_name" : "chemical_applic_notes", @@ -793,9 +918,10 @@ "code_name" : "soil_layer_count", "type" : "numericInput", "label" : "soil_layer_count_label", - "min" : "1", + "min" : 1, + "max" : 10, "step" : 1, - "hide_in_table" : true, + "hide_in_event_list" : true, "sub_elements" : { "multiple" : { @@ -804,8 +930,19 @@ "soil_layer_count_table" : { "code_name" : "soil_layer_count_table", "type" : "dataTable", - "columns" : ["soil_layer_top_depth", "soil_layer_base_depth", "soil_classification_by_layer"], - "rows" : "soil_layer_count" + "columns" : ["soil_layer_top_depth", + "soil_layer_base_depth", "soil_classification_by_layer", + "soil_bulk_density_moist", "soil_water_wilting_pt", + "soil_water_field_cap_1", "soil_water_saturated", + "soil_silt_fraction", "soil_sand_fraction", + "soil_clay_fraction", "soil_organic_matter_layer", + "soil_organic_C_perc_layer"], + "rows" : { + "soil_layers" : { + "row_variable" : "soil_layer_count", + "type" : "dynamic" + } + } } }, @@ -816,16 +953,16 @@ "code_name" : "soil_layer_top_depth", "type" : "numericInput", "label" : "soil_layer_top_depth_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "soil_layer_base_depth" : { "code_name" : "soil_layer_base_depth", "type" : "numericInput", "label" : "soil_layer_base_depth_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "soil_classification_by_layer" : { @@ -833,7 +970,79 @@ "type" : "selectInput", "label" : "soil_classification_by_layer_label", "choices" : "soil_classification_by_layer_choice", - "hide_in_table" : true + "hide_in_event_list" : true + }, + + "soil_bulk_density_moist" : { + "code_name" : "soil_bulk_density_moist", + "type" : "numericInput", + "label" : "soil_bulk_density_moist_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_water_wilting_pt" : { + "code_name" : "soil_water_wilting_pt", + "type" : "numericInput", + "label" : "soil_water_wilting_pt_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_water_field_cap_1" : { + "code_name" : "soil_water_field_cap_1", + "type" : "numericInput", + "label" : "soil_water_field_cap_1_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_water_saturated" : { + "code_name" : "soil_water_saturated", + "type" : "numericInput", + "label" : "soil_water_saturated_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_silt_fraction" : { + "code_name" : "soil_silt_fraction", + "type" : "numericInput", + "label" : "soil_silt_fraction_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_sand_fraction" : { + "code_name" : "soil_sand_fraction", + "type" : "numericInput", + "label" : "soil_sand_fraction_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_clay_fraction" : { + "code_name" : "soil_clay_fraction", + "type" : "numericInput", + "label" : "soil_clay_fraction_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_organic_matter_layer" : { + "code_name" : "soil_organic_matter_layer", + "type" : "numericInput", + "label" : "soil_organic_matter_layer_label", + "min" : 0, + "hide_in_event_list" : true + }, + + "soil_organic_C_perc_layer" : { + "code_name" : "soil_organic_C_perc_layer", + "type" : "numericInput", + "label" : "soil_organic_C_perc_layer_label", + "min" : 0, + "hide_in_event_list" : true } } @@ -844,39 +1053,31 @@ "code_name" : "root_depth", "type" : "numericInput", "label" : "root_depth_label", - "min" : "0" + "min" : 0 }, "soil_compactification_depth" : { "code_name" : "soil_compactification_depth", "type" : "numericInput", "label" : "soil_compactification_depth_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "earthworm_count" : { "code_name" : "earthworm_count", "type" : "numericInput", "label" : "earthworm_count_label", - "min" : "0", - "step" : "1", - "hide_in_table" : true + "min" : 0, + "step" : 1, + "hide_in_event_list" : true }, "soil_image" : { "code_name" : "soil_image", "type" : "fileInput", "filetype" : "image/*", - "label" : "soil_image_label", - "delete_button" : "soil_image_delete" - }, - - "soil_image_delete" : { - "code_name" : "soil_image_delete", - "type" : "actionButton", - "label" : "delete_uploaded_file_label", - "fileInput" : "soil_image" + "label" : "soil_image_label" } }, @@ -889,60 +1090,88 @@ "type" : "selectInput", "label" : "growth_stage_label", "choices" : "growth_stage_choice", - "hide_in_table" : true + "hide_in_event_list" : true }, "plant_density" : { "code_name" : "plant_density", "type" : "numericInput", "label" : "plant_density_label", - "min" : "0" + "min" : 0 }, "specific_leaf_area" : { "code_name" : "specific_leaf_area", "type" : "numericInput", "label" : "specific_leaf_area_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "leaf_area_index" : { "code_name" : "leaf_area_index", "type" : "numericInput", "label" : "leaf_area_index_label", - "min" : "0" + "min" : 0 + }, + + "total_biomass_dw" : { + "code_name" : "total_biomass_dw", + "type" : "numericInput", + "label" : "total_biomass_dw_label", + "min" : 0 + }, + + "tops_C" : { + "code_name" : "tops_C", + "type" : "numericInput", + "label" : "tops_C_label", + "min" : 0 + }, + + "tops_C_std" : { + "code_name" : "tops_C_std", + "type" : "numericInput", + "label" : "tops_C_std_label", + "min" : 0 + }, + + "roots_C" : { + "code_name" : "roots_C", + "type" : "numericInput", + "label" : "roots_C_label", + "min" : 0 + }, + + "roots_C_std" : { + "code_name" : "roots_C_std", + "type" : "numericInput", + "label" : "roots_C_std_label", + "min" : 0 }, "canopy_height" : { "code_name" : "canopy_height", "type" : "numericInput", "label" : "canopy_height_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "canopeo_reading" : { "code_name" : "canopeo_reading", "type" : "numericInput", "label" : "canopeo_reading_label", - "min" : "0" + "min" : 0 }, "canopeo_image" : { "code_name" : "canopeo_image", "type" : "fileInput", "filetype" : "image/*", - "label" : "canopeo_image_label", - "delete_button" : "canopeo_image_delete" - }, - - "canopeo_image_delete" : { - "code_name" : "canopeo_image_delete", - "type" : "actionButton", - "label" : "delete_uploaded_file_label", - "fileInput" : "canopeo_image" + "label" : "canopeo_image_label" } + }, "water" : { @@ -952,16 +1181,16 @@ "code_name" : "floodwater_depth", "type" : "numericInput", "label" : "floodwater_depth_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true }, "water_table_depth" : { "code_name" : "water_table_depth", "type" : "numericInput", "label" : "water_table_depth_label", - "min" : "0", - "hide_in_table" : true + "min" : 0, + "hide_in_event_list" : true } }, @@ -972,9 +1201,9 @@ "code_name" : "plant_pop_reduct_cum", "type" : "numericInput", "label" : "plant_pop_reduct_cum_label", - "min" : "0", - "max" : "100", - "hide_in_table" : true + "min" : 0, + "max" : 0, + "hide_in_event_list" : true } }, @@ -985,7 +1214,7 @@ "code_name" : "fuel_amount", "type" : "numericInput", "label" : "fuel_amount_label", - "min" : "0" + "min" : 0 } }, @@ -1139,7 +1368,7 @@ "type" : "textAreaInput", "label" : "mgmt_event_notes_label", "placeholder" : "mgmt_event_notes_placeholder", - "maxlength" : "80" + "maxlength" : 80 }, "save" : { @@ -1158,16 +1387,7 @@ "code_name" : "delete", "type" : "actionButton", "label" : "delete_label" - }, - - "editing_table_title" : { - "code_name" : "editing_table_title", - "type" : "textOutput", - "dynamic" : { - "mode" : "input", - "%mgmt_operations_event%" : "mgmt_operations_event", - "%block%" : "block" - } } + } } diff --git a/inst/golem-config.yml b/inst/golem-config.yml new file mode 100644 index 0000000..38237c3 --- /dev/null +++ b/inst/golem-config.yml @@ -0,0 +1,8 @@ +default: + golem_name: fieldactivity + golem_version: 0.2.1 + app_prod: no +production: + app_prod: yes +dev: + golem_wd: !expr here::here() diff --git a/inst/user_doc/images_user_instructions/Addevent.png b/inst/user_doc/images_user_instructions/Addevent.png new file mode 100644 index 0000000..b035e01 Binary files /dev/null and b/inst/user_doc/images_user_instructions/Addevent.png differ diff --git a/inst/user_doc/images_user_instructions/Eventtable.png b/inst/user_doc/images_user_instructions/Eventtable.png new file mode 100644 index 0000000..5fd7dba Binary files /dev/null and b/inst/user_doc/images_user_instructions/Eventtable.png differ diff --git a/inst/user_doc/images_user_instructions/Layout.png b/inst/user_doc/images_user_instructions/Layout.png new file mode 100644 index 0000000..dba40c2 Binary files /dev/null and b/inst/user_doc/images_user_instructions/Layout.png differ diff --git a/inst/user_doc/images_user_instructions/eventexample_1.png b/inst/user_doc/images_user_instructions/eventexample_1.png new file mode 100644 index 0000000..3903058 Binary files /dev/null and b/inst/user_doc/images_user_instructions/eventexample_1.png differ diff --git a/inst/user_doc/images_user_instructions/loginpage.png b/inst/user_doc/images_user_instructions/loginpage.png new file mode 100644 index 0000000..564dc3d Binary files /dev/null and b/inst/user_doc/images_user_instructions/loginpage.png differ diff --git a/inst/user_doc/images_user_instructions/overlaynotes.png b/inst/user_doc/images_user_instructions/overlaynotes.png new file mode 100644 index 0000000..2612a72 Binary files /dev/null and b/inst/user_doc/images_user_instructions/overlaynotes.png differ diff --git a/inst/user_doc/inst_frontpage.txt b/inst/user_doc/inst_frontpage.txt new file mode 100644 index 0000000..88bc3f5 --- /dev/null +++ b/inst/user_doc/inst_frontpage.txt @@ -0,0 +1,8 @@ +In order to use the application, you should have a site account registered. If you don’t have an account yet, see the contact persons below for requesting one, otherwise you should be able to fill in the provided sitename and password to login. Instructions in detail are available when logged in to the application or from the guide tab on fieldactivity webpage. +Käyttääksesi sovellusta sinulla täytyy olla sovellukseen rekisteröity tila. Jos tämä on tehty, voit kirjautua sovellukseen saamiesi käyttäjätietojen avulla (sijainti ja salasana), muussa tapauksessa ota yhteyttä alla oleviin henkilöihin tilasi rekisteröimistä varten. Opas sovelluksen käyttämiseksi on saatavilla kirjautumisen jälkeen tai sovelluksen verkkosivuilta (toistaiseksi vain englanniksi). +Henri Kajasilta        henri.kajasilta@fmi.fi        [Eng / Fin] +Istem Fer                istem.fer@fmi.fi                [Eng] +Check fieldactivity +Tutustu sovelluksen +Fill in feature/bug issues +Ilmianna kehityskohteita ja ongelmia diff --git a/inst/user_doc/user_instructions.md b/inst/user_doc/user_instructions.md new file mode 100644 index 0000000..541ce12 --- /dev/null +++ b/inst/user_doc/user_instructions.md @@ -0,0 +1,85 @@ +--- +title: "Instructions to use fieldactivity" +output: + html_document: + toc: yes +pagetitle: fieldactivity +--- + + +### Login +In order to use the application, you should have a site account registered. If you don’t have an account yet, see the contact section for requesting one, otherwise you should be able to fill in the provided sitename and password to login. + + +![Login page](loginpage.png) + + + + +### Layout +The UI of the application is simple, but we will provide an overview of what functionalities and views the user can utilise. + +1. Change the language between English and Finnish. +2. Check the sitename you have logged in with. Next to this field, by pressing plus sign (+), it gives an option to logout. + +![Overview of layout of the application](Layout.png) + + +3. Change the shown subset of the events based on the type of events, block and year. + +As a default, all of the events from all of the (available) blocks and years are visible for the user. With the first option menu, the user is able to select which type of events she wants to keep visible on the summary table. With the second and third option menus, the user can pick the block and the year respectively to be displayed. If there are multiple events displayed, on the bottom of the table there is a navigation tool to switch the shown page. + +![Summary table of the events](Eventtable.png) + + +### Filling in events +Options for filling in the event will open, when pressing the *Add event* button. Start filling in the management event information by first choosing the block wherein the event has occurred, the name of this activity/event and a date for when it was conducted. One may also provide a short description that will be visible in the event table and later on give a quick reminder to which occurrence the event was related. + + +![Adding a new event](Addevent.png) + +After choosing the type of activity, one should fill in the data about this activity. Different types of activities have different fields to be filled in, for example, after choosing tillage one should fill in the type of tillage, how the tillage was implemented and what the depth of the tillage was. Required option fields are marked with a star sign (*). + +Here are some notes that generally apply to all of the activities and that are good to keep in mind when filling in the form: + +- Every event has to be logged in as its own event. In other words, even though some of the events can happen simultaneously and can in one’s mind be summarised as one event, it may require two or more records in application. For example tillage and sowing should be handled separately even in reality they happened simultaneously or back to back. + +- Pay attention to the units and in which form the application wants the numeric values. Units can change within the same form as some fields may request for example kg/ha while other fields may require t/ha. However, the desired unit is stated in the field so guessing is not required. It also doesn’t matter if the decimal point is indicated with “.” or “,”, the application recognizes both practices. + +- The application indicates with red border lines, if some required value is missing from the form. It is not usually required to fill in all of the fields and some of the fields may be difficult even for farmers to fill in. However, we hope that the user tries to fill in the events with care and as accurately as they are able to. This ensures that the data is valid for future usage in research purposes. + +- **Events can be modified after saving them**, so there is no need to stress about doing something irreversible. + + +![Example of the view for filling in the (tilling) event](eventexample_1.png) + + +### Clone event +Any event can be cloned, and as the action implies, it creates a new event holding the same information as the event it was cloned from. However, like any other event, this new cloned event can be modified. This is practical for instance in situations wherein the same field management events have been conducted to several blocks. By cloning the event, the user can then easily change a block and save the record in order to have the same management event for several sites. The *Clone event* button is found next to the *Add event* button. + + +### Delete event +When choosing an event from the summary table, it is possible to edit the chosen event. Within this editing option, it is also possible to delete the event. + + + + +### Purpose of the application +The application is created to collect data of the field management events in a uniform way. The data collected through this application is used in the ecosystem models with a purpose to simulate carbon and other greenhouse gas exchanges in the field. Field management events play a key role in estimating such matters in agricultural environments. + + +### Contact information + +Henri Kajasilta      henri.kajasilta@fmi.fi      [Eng / Fin] +Istem Fer              istem.fer@fmi.fi              [Eng] + + +You may contact us, if you are facing one or several of the following situations: + +- Add (your) site to the application +- Reset the site/user password +- Report a possible bug in the application +- You want to request a feature that is currently not available +- You want to know more about the app + +Regarding the new features and bug fixes, you can also fill in a github issue [**here**](https://github.com/Ottis1/fieldactivity/issues) without contacting us. diff --git a/inst/user_instructions.html b/inst/user_instructions.html new file mode 100644 index 0000000..4f5b119 --- /dev/null +++ b/inst/user_instructions.html @@ -0,0 +1,290 @@ + + + + + + + + + + + + + +fieldactivity + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + +
+ +
+ +
+

Login

+

In order to use the application, you should have a site account registered. If you don’t have an account yet, see the contact section for requesting one, otherwise you should be able to fill in the provided sitename and password to login.

+
+ +

Login page view

+
+
+
+

Layout

+

The UI of the application is simple, but we will provide an overview of what functionalities and views the user can utilise.

+
    +
  1. Change the language between English and Finnish.
    2. +
  2. Check the sitename you have logged in with.
    3. +
  3. Change the shown subset of the events based on the type of events, block and year.
    4. +
+
+ +

Overview of layout of the application

+
+
+
+

Filling in events

+

Start filling in the management event information by first choosing the block wherein the event has occurred, the name of this activity/event and a date for when it was conducted. One may also provide a short description that will be visible in the event table and later on give a quick reminder to which occurrence the event was related.

+

After choosing the type of activity, one should fill in the data about this activity. Different types of activities have different fields to be filled in, for example, after choosing tillage one should fill in the type of tillage, how the tillage was implemented and what the depth of the tillage was.

+

Here are some notes that generally apply to all of the activities and that are good to keep in mind when filling in the form:

+ +
+ +

Example of the view for filling in the (tilling) event

+
+
+
+

Purpose of the application

+

The application is created to collect data of the field management events in a uniform way. The data collected through this application is used in the ecosystem models with a purpose to simulate carbon and other greenhouse gas exchanges in the field. Field management events play a key role in estimating such matters in agricultural environments.

+
+
+

Contact information

+

Henri Kajasilta           [Eng / Fin]
+Istem Fer                           [Eng]

+

You may contact us, if you are facing one or several of the following situations:

+ +

Regarding the new features and bug fixes, you can also fill in a github issue here without contacting us.

+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/json_file_helpers.R b/json_file_helpers.R deleted file mode 100644 index f5577f7..0000000 --- a/json_file_helpers.R +++ /dev/null @@ -1,209 +0,0 @@ -# Functions for creating and reading the json data files containing the events -# Otto Kuusela 2021 - -# missing value in the ICASA standard -missingval <- "-99.0" -# relative path to json file folder -json_file_base_folder <- "data/management_events" -#json_file_base_folder <- "/data/fo-event-files" - -# create_json_file <- function(file_path) { -# -# # if the events directory (stored in json_file_base_folder) doesn't exist, -# # stop -# if (!file.exists(json_file_base_folder)) { -# stop(glue("Could not find folder {json_file_base_folder}")) -# #dir.create(json_file_base_folder, recursive = TRUE) -# } -# -# if (!file.exists(file_path)) -# -# # create structure with no events -# experiment <- list() -# experiment$management <- list() -# experiment$management$events <- list() -# -# # create file -# jsonlite::write_json(experiment, path = file_path, pretty = TRUE, -# null = 'list', auto_unbox = TRUE) -# -# } - -create_file_folder <- function(site, block) { - # if the events directory (stored in json_file_base_folder) doesn't exist, - # stop - if (!dir.exists(json_file_base_folder)) { - stop(glue("Could not find folder {json_file_base_folder}")) - } - - folder_path <- file.path(json_file_base_folder, site, block) - if (!dir.exists(folder_path)) { - dir.create(folder_path, recursive = TRUE) - } -} - -# write a given event list to a json file, overwriting everything in it -write_json_file <- function(site, block, new_list) { - - # this ensures that the folder to store this file exists - create_file_folder(site, block) - - file_path <- file.path(json_file_base_folder, site, block, "events.json") - - # create appropriate structure - experiment <- list() - experiment$management <- list() - experiment$management$events <- new_list - - # erase block information in each event if there are any events in the list - if (length(experiment$management$events) > 0) { - for (i in 1:length(experiment$management$events)) { - experiment$management$events[[i]]$block <- NULL - } - } - - # create file - jsonlite::write_json(experiment, path = file_path, pretty = TRUE, - null = "list", auto_unbox = TRUE) -} - -# retrieve the events of a specific site and block and return as a NESTED LIST. -# this retrieves the events in the same "format" as they will be saved back -# later, i.e. with code names, "-99.0" for missing values etc. -# the only difference is the block value, which will be removed when saving -# back to a json file. -retrieve_json_info <- function(site, block) { - file_path <- file.path(json_file_base_folder, site, block, "events.json") - - # if file doesn't exist or given names are empty, can't read it - if (!file.exists(file_path) | site == "" | block == "") { - return(list()) - } - - events <- jsonlite::fromJSON(file_path, - simplifyDataFrame = FALSE)$management$events - - # if there are no events, return an empty list - if (length(events) == 0) { - return(list()) - } - - # add block information to each event - for (i in 1:length(events)) { - events[[i]]$block <- block - } - - return(events) -} - -# when a file is uploaded through a fileInput widget, it is saved to a temporary -# folder. This function moves that file to an appropriate directory and also -# renames it. The name will be of the format -# yyyy-mm-dd_site_block_variable_name_# where # is a number (0, 1, 2, ...) to -# ensure that files have unique names. The date is the date of the event, and -# it needs to be in yyyy-mm-dd format! -# if filepath_is_relative is set to TRUE, the path in tmp_filepath should -# be preceded by json_file-base_folder -move_uploaded_file <- function(tmp_filepath, variable_name, site, block, date, - filepath_is_relative = FALSE) { - # ensures the folder for this site-block combo is there - create_file_folder(site, block) - - # modify tmp_filepath if it is relative to events.json - if (filepath_is_relative) { - tmp_filepath <- file.path(json_file_base_folder, tmp_filepath) - } - - # check that the temporary file actually exists - if (!file.exists(tmp_filepath)) { - stop(glue("The file {tmp_filepath} to move does not exist")) - } - - file_extension <- tools::file_ext(tmp_filepath) - allowed_extensions <- c("jpg", "jpeg", "tif", "tiff", "png") - # if the image format is not supported, stop - if (!(file_extension %in% allowed_extensions)) { - stop("This file extension is not supported") - } - - # base of the new file name - file_base <- paste(date, site, block, variable_name, sep = "_") - - tmp_file_name <- basename(tmp_filepath) - - # path to the final file folder - filepath <- file.path(json_file_base_folder, site, block, variable_name) - if (!dir.exists(filepath)) { - dir.create(filepath) - } - - # determine the number to add to the end of the file name to keep file names - # in the folder unique - number <- 0 - while (TRUE) { - file_name <- paste(file_base, number, sep = "_") - file_name <- paste(file_name, file_extension, sep = ".") - if (!file.exists(file.path(filepath, file_name))) { - # we found a unique name. It will be available in file_name after - # the loop - break - } - number <- number + 1 - - # don't loop forever - if (number >= 1000) { - stop("Could not find a unique name for the file") - } - } - - # if the filepath is relative, it means the file indicated by tmp_filepath - # is already under the json_file_base_folder, and therefore we do not need - # to copy the file there. However, if the file is in e.g. /tmp/..., we - # do need to copy first as directly renaming causes an error - if (filepath_is_relative) { - success <- tryCatch(expr = file.rename( - from = tmp_filepath, - to = file.path(filepath, file_name)), - warning = function(cnd) {message(cnd); FALSE}, - error = function(cnd) {message(cnd); FALSE}) - } else { - success <- tryCatch(expr = file.copy(from = tmp_filepath, - to = filepath, copy.date = TRUE, - overwrite = TRUE), - warning = function(cnd) {message(cnd); FALSE}, - error = function(cnd) {message(cnd); FALSE}) - - if (success) { - success <- tryCatch(expr = file.rename( - from = file.path(filepath, tmp_file_name), - to = file.path(filepath, file_name)), - warning = function(cnd) {message(cnd); FALSE}, - error = function(cnd) {message(cnd); FALSE}) - } - } - - if (success) { - message(glue("Moved file to {file.path(filepath, file_name)}")) - return(file.path(variable_name, file_name)) - } else { - stop("Error in moving file") - } - -} - -# delete the file with the path filepath. If the path is relative to the -# events.json file, this should be indicated with filepath_relative so we can -# figure out the correct path -delete_file <- function(filepath, - site = NULL, block = NULL, filepath_relative = TRUE) { - if (filepath_relative) { - filepath <- file.path(json_file_base_folder, site, block, filepath) - } - - if (file.exists(filepath)) { - file.remove(filepath) - message(glue("Deleted file {filepath}")) - } else { - stop(glue("Could not delete file {filepath} because it was not found")) - } -} \ No newline at end of file diff --git a/man/build_structure_lookup_list.Rd b/man/build_structure_lookup_list.Rd new file mode 100644 index 0000000..85d9835 --- /dev/null +++ b/man/build_structure_lookup_list.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_ui.R +\name{build_structure_lookup_list} +\alias{build_structure_lookup_list} +\title{Build lookup list for UI elements} +\usage{ +build_structure_lookup_list() +} +\value{ +The lookup list. +} +\description{ +Build a list where the names are the code names of UI elements +and the values are the corresponding element structures (lists) found in +ui_structure.json +} diff --git a/man/copy_file.Rd b/man/copy_file.Rd new file mode 100644 index 0000000..68ba4c3 --- /dev/null +++ b/man/copy_file.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_files.R +\name{copy_file} +\alias{copy_file} +\title{Copy a file related to an event and name it appropriately} +\usage{ +copy_file( + orig_filepath, + variable_name, + site, + block, + date, + filepath_is_relative = FALSE, + delete_original = FALSE, + base_folder = json_file_base_folder() +) +} +\arguments{ +\item{orig_filepath}{The path of the file to copy} + +\item{variable_name}{Which variable is this file for? E.g. canopeo_image} + +\item{site}{The site where the event took place} + +\item{block}{The block where the event took place} + +\item{date}{The day of the event as a character string, the format must be +yyyy-mm-dd} + +\item{filepath_is_relative}{If TRUE, json_file_base_folder will be added to +the beginning of filepath} + +\item{delete_original}{Should the original file be deleted after copying?} + +\item{base_folder}{Included for testing reasons, the default value should +otherwise be used} +} +\value{ +A path to the new location of the file relative to the events.json + file. +} +\description{ +When a file (image) is uploaded through a fileInput widget, it is saved to a +temporary folder. This function copies that file to an appropriate directory +and name. The file does not have to be originally in a temporary +folder, any file path is ok. Therefore this function can also be used e.g. +when cloning and event and the images associated with it need to be +duplicated. +} +\details{ +The name will be of the format +yyyy-mm-dd_site_block_variable_name_# where # is a number (0, 1, 2, ...) to +ensure that files have unique names. +} diff --git a/man/create_file_folder.Rd b/man/create_file_folder.Rd new file mode 100644 index 0000000..dd9d346 --- /dev/null +++ b/man/create_file_folder.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_files.R +\name{create_file_folder} +\alias{create_file_folder} +\title{Create a folder for a site-block combination} +\usage{ +create_file_folder(site, block, base_folder = json_file_base_folder()) +} +\arguments{ +\item{site}{The site to create the folder for} + +\item{block}{The block to create the folder for} + +\item{base_folder}{Included for testing reasons, the default value should +otherwise be used} +} +\value{ +TRUE if the directory was created successfully or already exists, + FALSE otherwise. +} +\description{ +Given a site and a block on that site, create a folder under +json_file_base_folder where the events.json file and related image files will +be stored. If the base folder doesn't exist, the function will throw an +error. +} diff --git a/man/create_ui.Rd b/man/create_ui.Rd new file mode 100644 index 0000000..482c239 --- /dev/null +++ b/man/create_ui.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_ui.R +\name{create_ui} +\alias{create_ui} +\title{Generate the UI for a list of elements in the structure file.} +\usage{ +create_ui(widget_structure_list, ns) +} +\arguments{ +\item{widget_structure_list}{The list of widget structures (from +ui_structure.json) to generate as UI} + +\item{ns}{A namespacing function generated by shiny::NS to apply to the id's +of each generated widget} +} +\value{ +A list of Shiny widgets +} +\description{ +For a given list of widget structures as read from ui_structure.json, +create_ui applies create_widget to each widget in the list +} diff --git a/man/delete_file.Rd b/man/delete_file.Rd new file mode 100644 index 0000000..826c962 --- /dev/null +++ b/man/delete_file.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_files.R +\name{delete_file} +\alias{delete_file} +\title{Delete a file} +\usage{ +delete_file( + filepath, + site = NULL, + block = NULL, + filepath_relative = FALSE, + base_folder = json_file_base_folder() +) +} +\arguments{ +\item{filepath}{The path to the file which should be deleted.} + +\item{site}{The site where the event took place} + +\item{block}{The block where the event took place} + +\item{filepath_relative}{Set to TRUE and supply site and block if filepath is +relative to the events.json file. This allows the function to figure out +the correct path to the file.} + +\item{base_folder}{Included for testing reasons, the default value should +otherwise be used} +} +\description{ +Delete the file with the path filepath. Used to delete files (images) +associated with events, e.g. canopeo_image +} diff --git a/man/evaluate_condition.Rd b/man/evaluate_condition.Rd new file mode 100644 index 0000000..d15acfc --- /dev/null +++ b/man/evaluate_condition.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_form_fct_evaluate_js.R +\name{evaluate_condition} +\alias{evaluate_condition} +\title{Evalute some javascript conditions from ui_structure.json in R} +\usage{ +evaluate_condition(js_condition, session) +} +\arguments{ +\item{js_condition}{The javascript condition to evaluate as a string} + +\item{session}{Current Shiny session in which to evaluate} +} +\value{ +Returns either TRUE or FALSE. If the condition could not be + evaluated, returns NULL. +} +\description{ +Takes a condition written in javascript notation (visibility conditions in +ui_structure.json) and evaluates it in R. +} +\note{ +Might not be best coding practice, but works as long as the + js_condition doesn't have any typos. eval(parse(...)) is dangerous if it is + used directly with user input, but here that is not the case. The user has + no access to the ui_structure.json file. + + Running this function in a reactive context will create reactive + dependencies. This is actually useful, because then we know exactly when + e.g. relevant variables need to be recalculated. +} diff --git a/man/figures/README-pressure-1.png b/man/figures/README-pressure-1.png new file mode 100644 index 0000000..e0fd0c0 Binary files /dev/null and b/man/figures/README-pressure-1.png differ diff --git a/man/find_event_index.Rd b/man/find_event_index.Rd new file mode 100644 index 0000000..03838e7 --- /dev/null +++ b/man/find_event_index.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_event_list.R +\name{find_event_index} +\alias{find_event_index} +\title{Find the index of an event in a list} +\usage{ +find_event_index(event, event_list) +} +\arguments{ +\item{event}{The event whose index to identify} + +\item{event_list}{The list of events where event is to be found} +} +\value{ +The index if found, NULL otherwise +} +\description{ +Find the first index corresponding to the given event in a list of events. +An event is considered equal to another if they have exactly the same +variables (though not necessarily in the same order) and these variables +have exactly the same values. +} diff --git a/man/get_category_names.Rd b/man/get_category_names.Rd new file mode 100644 index 0000000..3e997cd --- /dev/null +++ b/man/get_category_names.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_language.R +\name{get_category_names} +\alias{get_category_names} +\title{Find code and display names belonging to a given category} +\usage{ +get_category_names(category, language = NULL) +} +\arguments{ +\item{category}{The category (e.g. "variable_name") to find the names for} + +\item{language}{(optional) The language of the display names} +} +\value{ +A vector of code names. If language was supplied, the display names + corresponding to the code names will be the names of the vector. +} +\description{ +The categories are defined in the display_names.csv file. If language is +undefined, only code names will be returned. If a language is also supplied, +then the corresponding display names are set as the names of the vector of +code names. +} diff --git a/man/get_data_table.Rd b/man/get_data_table.Rd new file mode 100644 index 0000000..f1c046e --- /dev/null +++ b/man/get_data_table.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_event_list.R +\name{get_data_table} +\alias{get_data_table} +\title{Turn a list of events into a data frame} +\usage{ +get_data_table(events, variable_names) +} +\arguments{ +\item{events}{The list of events to turn into a data frame} + +\item{variable_names}{The variables which should be displayed in the columns +of the data frame.} +} +\value{ +A data frame with the events as rows and variable names as columns. +} +\description{ +Takes a list of events and makes a data frame with given + variables in columns. Also adds a column with the complete event list and a + final column for ordering the list by date. +} +\note{ +The function doesn't replace code names with display names. That is + done separately so that when the app language is switched, we can change + the table display names without having to create it again. +} diff --git a/man/get_disp_name.Rd b/man/get_disp_name.Rd new file mode 100644 index 0000000..b9c728b --- /dev/null +++ b/man/get_disp_name.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_language.R +\name{get_disp_name} +\alias{get_disp_name} +\title{Get the display names corresponding to given code names} +\usage{ +get_disp_name( + code_name, + language = NULL, + is_variable_name = FALSE, + as_names = FALSE +) +} +\arguments{ +\item{code_name}{A vector of code names to get the display names for} + +\item{language}{The language ("disp_name_eng" or "disp_name_fin") of the +resulting display names} + +\item{is_variable_name}{If set to TRUE, then only variable names will be +searched for display names. If FALSE (the default), only non-variable names +will be searched.} + +\item{as_names}{Should the display names be set as the names of the vector +of code names? Default is FALSE.} +} +\value{ +The display name(s) as a vector of character strings in the same + order as the code names. If a display name is not found or language is + undefined, the code name is returned. If as_names is TRUE, the display + names are the names of the vector and code names are the values. +} +\description{ +Get the display names corresponding to given code names +} +\details{ +is_variable_name is needed because there might be clashes between + the variable and non-variable code names. E.g. organic_material is both an + option in mgmt_operations_event and a variable. The language names + ("disp_name_eng" and "disp_name_fin") correspond to the names of the + columns in the display_names.csv file. +} diff --git a/man/get_dynamic_rows_from_value.Rd b/man/get_dynamic_rows_from_value.Rd new file mode 100644 index 0000000..aa1135e --- /dev/null +++ b/man/get_dynamic_rows_from_value.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_table_utils.R +\name{get_dynamic_rows_from_value} +\alias{get_dynamic_rows_from_value} +\title{Determine the dynamic rows based on row variable value} +\usage{ +get_dynamic_rows_from_value(variable, value) +} +\arguments{ +\item{variable}{The name of the variable which functions as a row variable in +a table} + +\item{value}{The value of the variable} +} +\value{ +An atomic vector of rows, either option code names or numbers +} +\description{ +This is used to go from the value of a variable determining the rows in a +dynamic row group to the rows themselves. If the row variable is a +selectInput, the rows equal the value, but if the row variable is a +numericInput, a vector of rows is generated instead +} diff --git a/man/get_selectInput_choices.Rd b/man/get_selectInput_choices.Rd new file mode 100644 index 0000000..e0e6541 --- /dev/null +++ b/man/get_selectInput_choices.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_ui.R +\name{get_selectInput_choices} +\alias{get_selectInput_choices} +\title{Find the choices for a selectInput given its code name} +\usage{ +get_selectInput_choices(selectInput_code_name, language) +} +\arguments{ +\item{selectInput_code_name}{The code name of the selectInput} + +\item{language}{The language to show the options in. This will be passed to +get_disp_name} +} +\value{ +A vector of choices (code names). If language was supplied, the names + will be the names of the vector. +} +\description{ +Find the choices for a selectInput given its code name +} diff --git a/man/get_table_variables.Rd b/man/get_table_variables.Rd new file mode 100644 index 0000000..d9be700 --- /dev/null +++ b/man/get_table_variables.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_table_utils.R +\name{get_table_variables} +\alias{get_table_variables} +\title{Find the variables whose value can be entered through a given table} +\usage{ +get_table_variables(table_code_name) +} +\arguments{ +\item{table_code_name}{The name of the table whose variables to fetch.} +} +\value{ +A vector of variable names whose values are entered in a table. +} +\description{ +Find the variables whose value can be entered through a given table +} +\note{ +If a table has a dynamic row group whose rows are determined by an + input widget's value, that widget's variable name will not be returned even + though it could be read from the list returned by the table module. +} diff --git a/man/get_variable_table.Rd b/man/get_variable_table.Rd new file mode 100644 index 0000000..da769f7 --- /dev/null +++ b/man/get_variable_table.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_table_utils.R +\name{get_variable_table} +\alias{get_variable_table} +\title{Find the table matching a variable name} +\usage{ +get_variable_table(variable_name) +} +\arguments{ +\item{variable_name}{The name of the variable of interest} +} +\value{ +The code name of the table where the variable is entered, or NULL + if not found. +} +\description{ +If a variable's value is entered in a table, return the name of that table +} diff --git a/man/mod_event_list_server.Rd b/man/mod_event_list_server.Rd new file mode 100644 index 0000000..4bac58c --- /dev/null +++ b/man/mod_event_list_server.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_event_list.R +\name{mod_event_list_server} +\alias{mod_event_list_server} +\title{event_list Server Functions} +\usage{ +mod_event_list_server(id, events, language, site) +} +\arguments{ +\item{id}{The id of the corresponding UI element} + +\item{events}{A reactive expression holding a list of events to display in the event list} + +\item{language}{A reactive expression holding the current UI language} + +\item{site}{A reactive expression holding the current site name + +Update year choices in event list filter + +Adds as choices all the years for which events have been recorded +Update block choices in event list filter + +Add all blocks of the current site as choices +Update activity choices in event list filter + +Only used when the language is changed.} +} +\description{ +event_list Server Functions +} diff --git a/man/read_json_file.Rd b/man/read_json_file.Rd new file mode 100644 index 0000000..776a99c --- /dev/null +++ b/man/read_json_file.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_files.R +\name{read_json_file} +\alias{read_json_file} +\title{Read the events from the events.json file} +\usage{ +read_json_file(site, block, base_folder = json_file_base_folder()) +} +\arguments{ +\item{site}{The site to read from} + +\item{block}{The block to read from} + +\item{base_folder}{Included for testing reasons, the default value should +otherwise be used} +} +\value{ +A list of events, which are themselves lists. If the corresponding + file does not exist or there are no events, returns an empty list. +} +\description{ +Reads the events from the events.json file specific to this site and block +combination and returns as a list of events. +} diff --git a/man/replace_with_display_names.Rd b/man/replace_with_display_names.Rd new file mode 100644 index 0000000..fbc4510 --- /dev/null +++ b/man/replace_with_display_names.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_language.R +\name{replace_with_display_names} +\alias{replace_with_display_names} +\title{Replace code names with display names in an event data frame} +\usage{ +replace_with_display_names(events_with_code_names, language) +} +\arguments{ +\item{events_with_code_names}{The data frame with code names that should be +turned to display names} + +\item{language}{The language of the display names} +} +\value{ +A data frame of the same size but with entries with code names + replaced with display names +} +\description{ +Also replaces missingvals with "". +} diff --git a/man/reset_input_fields.Rd b/man/reset_input_fields.Rd new file mode 100644 index 0000000..1774e7e --- /dev/null +++ b/man/reset_input_fields.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_ui.R +\name{reset_input_fields} +\alias{reset_input_fields} +\title{Reset the value of input fields} +\usage{ +reset_input_fields(session, fields_to_clear, exceptions = c("")) +} +\arguments{ +\item{session}{The current Shiny session} + +\item{fields_to_clear}{The names of the variables whose corresponding fields +should be cleared} + +\item{exceptions}{Optional vector of variable names which should not be +cleared. This is useful if fields_to_clear is supplied with all variable +names but there are a few that should not be cleared.} +} +\value{ +None, used for side effects. +} +\description{ +Set the specified input fields to their default empty values. +} +\note{ +This doesn't reset the tables (e.g. harvest_crop_table) -- they reset + themselves every time they become hidden. Also doesn't reset fileInputs, + they have their own way of clearing their value. +} diff --git a/man/rlapply.Rd b/man/rlapply.Rd new file mode 100644 index 0000000..8c0ed66 --- /dev/null +++ b/man/rlapply.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_ui.R +\name{rlapply} +\alias{rlapply} +\title{Recursively apply function to lists in a list} +\usage{ +rlapply(x, fun, name_fun = NULL, ...) +} +\arguments{ +\item{x}{The list of lists to apply the function to} + +\item{fun}{The function to apply to lists} + +\item{name_fun}{Function used to name the elements of the returned list. +Should take a list as argument and return the name} + +\item{...}{arguments to pass to fun} +} +\value{ +A one-level list where each element is the value fun returns for a +given list in x +} +\description{ +Recursively apply a function to the elements of a list that +are themselves lists. +} diff --git a/man/run_app.Rd b/man/run_app.Rd new file mode 100644 index 0000000..54ee413 --- /dev/null +++ b/man/run_app.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run_app.R +\name{run_app} +\alias{run_app} +\title{Run the Shiny Application} +\usage{ +run_app( + json_file_path, + user_db_path, + user_db_passphrase, + onStart = NULL, + options = list(), + enableBookmarking = NULL, + uiPattern = "/", + ... +) +} +\arguments{ +\item{json_file_path}{Path to a folder used to store the generated .json files} + +\item{user_db_path}{Path to a Shinymanager user database} + +\item{user_db_passphrase}{The passphrase of the user database} + +\item{onStart}{A function that will be called before the app is actually run. +This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir} +case, a \code{global.R} file can be used for this purpose.} + +\item{options}{Named options that should be passed to the \code{runApp} call +(these can be any of the following: "port", "launch.browser", "host", "quiet", +"display.mode" and "test.mode"). You can also specify \code{width} and +\code{height} parameters which provide a hint to the embedding environment +about the ideal height/width for the app.} + +\item{enableBookmarking}{Can be one of \code{"url"}, \code{"server"}, or +\code{"disable"}. The default value, \code{NULL}, will respect the setting from +any previous calls to \code{\link[shiny:enableBookmarking]{enableBookmarking()}}. See \code{\link[shiny:enableBookmarking]{enableBookmarking()}} +for more information on bookmarking your app.} + +\item{uiPattern}{A regular expression that will be applied to each \code{GET} +request to determine whether the \code{ui} should be used to handle the +request. Note that the entire request path must match the regular +expression in order for the match to be considered successful.} + +\item{...}{arguments to pass to golem_opts. +See `?golem::get_golem_options` for more details.} +} +\description{ +Run the Shiny Application +} diff --git a/man/set_login_language.Rd b/man/set_login_language.Rd new file mode 100644 index 0000000..253fb3e --- /dev/null +++ b/man/set_login_language.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_language.R +\name{set_login_language} +\alias{set_login_language} +\title{This function sets the labels on the shinymanager login UI} +\usage{ +set_login_language(language) +} +\arguments{ +\item{language}{The language which should be displayed (either +"disp_name_fin" or disp_name_eng)} +} +\description{ +This function sets the labels on the shinymanager login UI +} diff --git a/man/update_ui_element.Rd b/man/update_ui_element.Rd new file mode 100644 index 0000000..af39ed5 --- /dev/null +++ b/man/update_ui_element.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_ui.R +\name{update_ui_element} +\alias{update_ui_element} +\title{Update value, label etc. of a UI element.} +\usage{ +update_ui_element(session, code_name, value = NULL, clear_value = FALSE, ...) +} +\arguments{ +\item{session}{Current shiny session} + +\item{code_name}{The code name of the UI element to update} + +\item{value}{An atomic vector holding the desired value of the UI element. If +NULL, the value of the element is not altered.} + +\item{clear_value}{If set to TRUE, the value of the element is cleared (and +any value supplied to value is ignored)} + +\item{...}{Additional arguments (such as label) to pass to Shiny's update- +functions.} +} +\description{ +Determines the type of the element and updates its value using shiny's update + functions. +} diff --git a/man/valid_dateRangeInput.Rd b/man/valid_dateRangeInput.Rd new file mode 100644 index 0000000..990a830 --- /dev/null +++ b/man/valid_dateRangeInput.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_validation.R +\name{valid_dateRangeInput} +\alias{valid_dateRangeInput} +\title{Check whether the value of a dateRangeInput is valid} +\usage{ +valid_dateRangeInput(value) +} +\arguments{ +\item{value}{The value of the dataRangeInput to validate} +} +\value{ +TRUE if value is valid, FALSE if not +} +\description{ +Both dates need to be supplied for the value to be considered + valid, and the start date needs to be on or before the end date +} diff --git a/man/write_json_file.Rd b/man/write_json_file.Rd new file mode 100644 index 0000000..1772c3a --- /dev/null +++ b/man/write_json_file.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_files.R +\name{write_json_file} +\alias{write_json_file} +\title{Write a given event list to a json file} +\usage{ +write_json_file( + site, + block, + event_list, + rotation_list, + base_folder = json_file_base_folder() +) +} +\arguments{ +\item{site}{The site of the events} + +\item{block}{The block of the events} + +\item{event_list}{The list of events to write to the events.json file} + +\item{base_folder}{Included for testing reasons, the default value should +otherwise be used} +} +\description{ +The function will overwrite the current events.json file and replace it with +one generated from the supplied list of events +} diff --git a/table.R b/table.R deleted file mode 100644 index fba954a..0000000 --- a/table.R +++ /dev/null @@ -1,631 +0,0 @@ -# Shiny module for data input in table format -# Otto Kuusela 2021 - -# missing value in the ICASA standard -missingval <- "-99.0" -log <- FALSE - -# TODO: move these to the javascript file -# javascript callback scripts must be wrapped inside a function for some reason -# EDIT: this makes sense also, see datatables API documentation for example -js_bind_script <- "function() { Shiny.bindAll(this.api().table().node()); }" - -# js_selectize_script <- function(ns) { -# paste(sep = "", -# "function() { ", -# "Shiny.onInputChange('", ns("rendered"), "', true);", -# "return $('#", ns("table"), "').find('select').selectize(); }") -#} -# remember to give the id through the NS function -# js_add_listener <- function(id) { -# paste(sep = "", -# "function add_listener() { ", -# "alert('Adding listener!');", -# "$('#", id, "').on( 'preDraw.dt', function() {", -# "alert('Heard preDraw event!');", -# "Shiny.unbindAll($('#", id, "').find('table').DataTable().table().node());", -# "})}") -# } - -tableInput <- function(id) { - - tagList(#includeScript("www/script.js"), - #tags$head(tags$script(HTML(js_unbind_script))), - # tags$head(tags$script(HTML(paste(sep = "", - # "$(document).ready(function() {", - # "('#", NS(id, "table"), "').on('preDraw.dt', function() {", - # " Shiny.onInputChange('", NS(id, "rendered"), "', false); });", - # "});" - # )))), - #tags$head(tags$script(HTML(js_selectize_script(NS(id, "table"))))), - DT::dataTableOutput(NS(id, "table")), - br()) -} - -# override values are to be supplied in the same format that the table returns, -# i.e. a list with variable names and the values as vectors under those. -# They also have to include a row_names component -tableServer <- function(id, row_names, language, visible, - override_values = NULL) { - - stopifnot(is.reactive(row_names)) - stopifnot(is.reactive(language)) - stopifnot(is.reactive(visible)) - stopifnot(is.reactive(override_values)) - - moduleServer(id, function(input, output, session) { - - # get corresponding element info to determine which widgets to add to - # the table - table_structure <- structure_lookup_list[[id]] - row_variable <- table_structure$rows - - # if the column variables are not defined, we are in custom mode. This - # happens with fertilizer_element_table - custom_mode <- is.null(table_structure$columns) - if (custom_mode) { - n_cols <- max(sapply(row_variable, length)) - n_rows <- length(row_variable) - variables <- unlist(row_variable) - } else { - variables <- table_structure$columns - n_cols <- length(variables) - } - - # this unbinds the table elements before they are re-rendered. - # Setting a higher priority ensures this runs before the table render - observe(priority = 1, { - # when to run observer - row_trigger() - language() - visible() - override_trigger() - # require this so that we know the table has already rendered - req(isolate(input$table_rows_current), visible()) - #message("Sent unbind message") - session$sendCustomMessage("unbind-table", NS(id, "table")) - }) - - # whether the table is currently rendered or not - rendered <- reactiveVal(FALSE) - - # when the server sends a message that rendering is done, set rendered - # to TRUE - observeEvent(input$rendered, { - rendered(TRUE) - if (log) message(glue("input$rendered is {input$rendered}, ", - "rendered set to TRUE ({id})")) - }) - - # when we go hidden, set rendered to FALSE - observeEvent(visible(), ignoreNULL = FALSE, { - if (!visible()) { - if (log) message(glue("Rendered set to FALSE. ", - "Clearing old values ({id})")) - rendered(FALSE) - old_values(list()) - } - }) - - #n_rows <- reactive({ - - # override_trigger() - # row_names() - # - # if (!is.null(isolate(override_values()))) { - # length(isolate(override_values()$row_names)) - # } else { - # length(row_names()) - # } - #}) - - # this is a trigger which triggers the update of table_data when - # we want to. We want to trigger when override_values changes to a non- - # NULL value, but not when we change it back to a NULL. The triggering - # behaviour is controller in the observeEvent below - override_trigger <- reactiveVal(0) - - # this is a flag which prevents updating the table once after values - # have been prefilled. This is to prevent the update that is caused - # by updating the widget corresponding to rows in the main app - # block_update <- reactiveVal(FALSE) - - # this is a trigger for updating the table widgets when rows change - row_trigger <- reactiveVal(0) - - # this ignores NULL values - observeEvent(override_values(), { - if (log) { - message(glue("Triggering value pre-filling, ", - "values are ({id})")) - str(override_values()) - } - override_trigger(override_trigger() + 1) - }) - - # this allows blocking extra updates - observeEvent(row_names(), ignoreNULL = FALSE, { - if (custom_mode) { - if (length(row_names()) == 2) { - if (log) message("Triggering row trigger in custom mode") - row_trigger(row_trigger() + 1) - } - return() - } - - #message("Row_names observer") - current_row_names <- table_values()[[row_variable]] - # as.character is needed because sometimes row_names() are numeric - if (!identical(as.character(row_names()), - as.character(current_row_names))) { - if (log) message(glue("Triggering the row_trigger because ", - "new rows are {paste(row_names(), collapse = ', ')} and ", - "old ones are {paste(current_row_names, collapse = ', ')}", - "({id})")) - row_trigger(row_trigger() + 1) - } else { - if (log) message(glue("Row names are identical so didn't ", - "trigger an update ({id})")) - } - }) - - # clear old data when visibility changes to hidden - # observeEvent(visible(), { - # if (!visible()) { - # vals <- list() - # vals[[row_variable]] <- table_values() - # old_values(table_values) - # message("Cleared old values") - # } - # }) - - table_data <- reactive({ - override_trigger() - row_trigger() - - if (log) message(glue("Table calculation begins ({id})")) - - override_vals <- isolate(override_values()) - do_override <- !is.null(override_vals) - - table_to_display <- data.frame(matrix(nrow = 0, ncol = n_cols)) - names(table_to_display) <- variables - - # check that the variables in override values are correct - if (do_override) { - #if (log) message("Doing override in table calculation") - # if we just want to clear the table, let's do that - if (identical(override_vals, list())) { - override_values(NULL) - return(table_to_display) - } - if (!all(variables %in% names(override_vals))) { - message(glue("The override values supplied to table {id} ", - "are missing some variables, the table ", - "will not be rendered")) - override_values(NULL) - return(table_to_display) - } - } - - - rows <- if (do_override) { - - # if overriding, determine the appropriate rows - row_variable_structure <- - structure_lookup_list[[row_variable]] - if (row_variable_structure$type == "numericInput") { - - number_of_rows <- override_vals[[row_variable]] - - if (!isTruthy(number_of_rows) || - number_of_rows == missingval) { - NULL - } else { - number_of_rows <- - max(ceiling(as.numeric(number_of_rows)), 1) - 1:number_of_rows - } - - } else if (row_variable_structure$type == "selectInput") { - override_vals[[row_variable]] - } - - } else { - isolate(row_names()) - } - - if (length(rows) == 0) { - override_values(NULL) - return(table_to_display) - } - - - for (variable_name in variables) { - element <- structure_lookup_list[[variable_name]] - - width <- if (element$type == "numericInput") { - "80px" - } else if (element$type == "textInput") { - "110px" - } else { - "150px" - } - - for (row_number in 1:length(rows)) { - - # the code names for these elements are - # variablename_rownumber - code_name <- NS(id, - paste(variable_name, row_number, sep = "_")) - - value <- if (do_override) { - override_vals[[variable_name]][row_number] - } else { - old_row_number <- which( - isolate(old_values())[[row_variable]] == - rows[row_number]) - isolate(old_values())[[variable_name]][old_row_number] - } - - if (!isTruthy(value) || value == missingval) { - value <- "" - } - - #message(glue("Value for {code_name} is {value}")) - - # add choices in the correct language for selectInputs - choices <- NULL - if (element$type == "selectInput") { - choices <- get_selectInput_choices(element, language()) - } - - placeholder <- NULL - if (!is.null(element$placeholder)) { - placeholder <- get_disp_name(element$placeholder, - language()) - } - - # as character makes the element HTML, which can then be - # not escaped when rendering the table - widget <- as.character( - create_element(element, - #width = width, - override_code_name = code_name, - override_label = "", - override_value = value, - override_choices = choices, - override_selected = value, - override_placeholder = placeholder - )) - - - table_to_display[row_number, variable_name] <- widget - } - } - - # add code names to the row names. These will be changed to display - # names when rendering - rownames(table_to_display) <- rows - - # if you want to add observers to these widgets here, you need to do - # it like this using lapply - # lapply(1:n_rows, FUN = function(row_number) { - # lapply(columns, FUN = function(column_name) { - # code_name <- paste(column_name, row_number, sep = "_") - # observeEvent(input[[code_name]], { - # message(input[[code_name]]) - # }) - # }) - # }) - - # clear override_values - isolate(override_values(NULL)) - if (log) message(glue("Calculated table, has ", - "{nrow(table_to_display)} rows")) - table_to_display - }) - - # this is just like the table_data reactive, but used for when the - # table is in custom mode - custom_table_data <- reactive({ - override_trigger() - row_trigger() - - if (log) message(glue("Table calculation begins ({id})")) - - override_vals <- isolate(override_values()) - do_override <- !is.null(override_vals) - - table_to_display <- - data.frame(matrix(nrow = n_rows, ncol = n_cols)) - names(table_to_display) <- rep("", n_cols) - - # check that the variables in override values are correct - if (do_override) { - #if (log) message("Doing override in table calculation") - # if we just want to clear the table, let's do that - if (identical(override_vals, list())) { - override_values(NULL) - return(table_to_display) - } - if (!all(variables %in% names(override_vals))) { - message(glue("The override values supplied to table {id} ", - "are missing some variables, the table ", - "will not be rendered")) - override_values(NULL) - return(table_to_display) - } - } - - current_row <- 1 - for (row in row_variable) { - current_col <- 1 - for (variable in row) { - - element <- structure_lookup_list[[variable]] - code_name <- NS(id, variable) - - value <- if (do_override) { - override_vals[[variable]] - } else { - isolate(old_values())[[variable]] - } - - if (!isTruthy(value) || value == missingval) { - value <- "" - } - - #message(glue("Value for {code_name} is {value}")) - - # add choices in the correct language for selectInputs - choices <- NULL - if (element$type == "selectInput") { - choices <- get_selectInput_choices(element, language()) - } - - placeholder <- NULL - if (!is.null(element$placeholder)) { - placeholder <- get_disp_name(element$placeholder, - language()) - } - - # as character makes the element HTML, which can then be - # not escaped when rendering the table - widget <- as.character( - create_element(element, - #width = width, - override_code_name = code_name, - override_label = get_disp_name( - element$label,isolate(language())), - override_value = value, - override_choices = choices, - override_selected = value, - override_placeholder = placeholder - )) - - - table_to_display[current_row, current_col] <- widget - current_col <- current_col + 1 - } - current_row <- current_row + 1 - } - - # if you want to add observers to these widgets here, you need to do - # it like this using lapply - # lapply(1:n_rows, FUN = function(row_number) { - # lapply(columns, FUN = function(column_name) { - # code_name <- paste(column_name, row_number, sep = "_") - # observeEvent(input[[code_name]], { - # message(input[[code_name]]) - # }) - # }) - # }) - - # clear override_values - isolate(override_values(NULL)) - if (log) message(glue("Calculated table, has ", - "{nrow(table_to_display)} rows")) - table_to_display - }) - - # narrow use case: update widget labels to match the correct - # language. This is only needed in fertilizer_element_table, because - # that is the only time we have labels on the widgets - observeEvent(language(), { - req(rendered(), custom_mode) - #str(reactiveValuesToList(input)) - if (log) message(glue("Updating widget languages ({id})")) - for (variable in variables) { - element <- structure_lookup_list[[variable]] - update_ui_element(session, variable, label = - get_disp_name(element$label, language())) - } - }) - - output$table <- DT::renderDataTable({ - - #message("Table rendering initiated") - - # added language here; does it cause issues? - - table_to_display <- if (custom_mode) { - req(visible(), custom_table_data(), language()) - custom_table_data() - } else { - req(visible(), table_data(), language()) - table_data() - } - - if (log) message(glue("Rendering table ({id})")) - - if (nrow(table_to_display) == 0) { - if (log) message(glue("No rows, didn't render ({id})")) - return() - } - - if (!custom_mode) { - names(table_to_display) <- get_disp_name(variables, - language = language(), - is_variable_name = TRUE) - rownames(table_to_display) <- get_disp_name( - rownames(table_to_display), - language = language()) - } else { - names(table_to_display) <- rep("", n_cols) - } - - table_to_display <- - datatable( - table_to_display, - escape = FALSE, - selection = "none", - class = "table table-hover table-condensed", - rownames = !custom_mode, - options = - list(dom = "t", - # hide sorting arrows - ordering = FALSE, - # binds the inputs when drawing is done - drawCallback = JS(js_bind_script), - # calls selectize() on all selectInputs, which - # makes them look the way they should. Also tell - # the client to send the rendering done message. - initComplete = - JS(paste0( - "function(settings, json) {", - "do_selectize('", NS(id, "table"), "'); ", - "rendering_done('", NS(id, "rendered"), "'); }" - )) - )) - # if we are in custom mode, align cells vertically so that the - # widgets are always in line - if (custom_mode) { - formatStyle(table_to_display, 0:(n_cols-1), - 'vertical-align' = 'bottom') - } else { - table_to_display - } - - }, server = FALSE) - - # entered values before we e.g. add rows. This allows us to fetch - # the back when generating a new table - old_values <- reactiveVal() - table_values <-reactiveVal() - - # return the values of the table widgets - # has to run when visibility changes because input values are not - # available otherwise - observe({ - - value_list <- list() - if (custom_mode) { - if (!rendered()) { - if (log) message(glue("Values observe blocked ({id})")) - table_values(value_list) - return() - } - } else { - value_list[[row_variable]] <- rownames(table_data()) - if (length(value_list[[row_variable]]) == 0 | !rendered()) { - #old_values(value_list) - if (log) message(glue("Values observe blocked ({id})")) - #return(value_list) - table_values(value_list) - return() - } - } - - if (log) message(glue("Values observe running ({id})")) - - for (variable in variables) { - values <- NULL - if (custom_mode) { - values <- input[[variable]] - } else { - for (row_number in 1:length(value_list[[row_variable]])) { - element_name <- paste(variable, row_number, sep = "_") - values <- c(values, input[[element_name]]) - } - } - value_list[[variable]] <- values - } - - old_values(value_list) - table_values(value_list) - }) - - table_values - }) -} - -########################################## -# example application that uses the module - -tableApp <- function() { - ui <- fluidPage( - - sidebarLayout( - - sidebarPanel(width = 5, - selectInput("crop", label = "Choose crops", - choices = get_category_names("CRID"), - multiple = TRUE), - selectInput("language", label = "Choose language", - choices = c("disp_name_eng", - "disp_name_fin")), - verbatimTextOutput("debug_text_output"), - actionButton("override_values_button", - label = "Override values") - - ), - - mainPanel(width = 7, - uiOutput("table_ui"), - ) - - ) - - ) - server <- function(input, output, session) { - condition <- reactiveVal(FALSE) - observeEvent(input$crop, { - result <- length(input$crop) > 1 - condition(result) - }) - - override_values <- reactiveVal(NULL) - - data <- tableServer("harvest_crop_table", reactive(input$crop), - reactive(input$language), condition, - override_values = override_values) - - output$debug_text_output <- renderPrint({ str(data()) }) - - output$table_ui <- renderUI({ - if (condition()) { - if (log) message("UI rendering") - tableInput("harvest_crop_table") - } - }) - - observeEvent(input$override_values_button, { - values <- list(harvest_crop = c("FRG", "OAT"), - harvest_operat_component = c("canopy", "leaf"), - canopy_height_harvest = c(0.4, 0.5), - harvest_yield_harvest_dw = c("1", "2"), - harv_yield_harv_f_wt = c(3,1), - harvest_method = c("HM001", "HM002"), - harvest_cut_height = c(0.3, 0.3)) - override_values(values) - updateSelectInput(session, "crop", selected = c("FRG", "OAT")) - }) - - observe({ - str(data()) - }) - } - - shinyApp(ui, server) -} \ No newline at end of file diff --git a/tests/spelling.R b/tests/spelling.R new file mode 100644 index 0000000..6713838 --- /dev/null +++ b/tests/spelling.R @@ -0,0 +1,3 @@ +if(requireNamespace('spelling', quietly = TRUE)) + spelling::spell_check_test(vignettes = TRUE, error = FALSE, + skip_on_cran = TRUE) diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..b20c06b --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(fieldactivity) + +test_check("fieldactivity") diff --git a/tests/testthat/test-download.R b/tests/testthat/test-download.R new file mode 100644 index 0000000..fcb58bd --- /dev/null +++ b/tests/testthat/test-download.R @@ -0,0 +1,28 @@ +test_that("is download functional", { + # Check that the size of guide makes sense when it is downloaded + testServer(mod_download_server_inst, { + #stopifnot(grepl(".html", output$report)) + print(output$report) + expect_true(grepl("guideFieldactivity.html", output$report)) + expect_true(file.info(output$report)$size > 10000) + }) + + site <- reactive("qvidja") + + # Check that file exist when downloading csv + testServer(mod_download_server_table, args = list(user_auth = site), { + expect_true(file.exists(output$eventtable)) + expect_true(file.size(output$eventtable) > 70) + }) + + + # Check that file exist when downloading zip + testServer(mod_download_server_json, args = list(user_auth = site), { + expect_true(file.exists(output$eventjson)) + expect_true(grepl(".zip", output$eventjson)) + + + data <- unzip(output$eventjson, list=TRUE) + expect_true(length(data) > 1) + }) +}) diff --git a/tests/testthat/test-fct_language.R b/tests/testthat/test-fct_language.R new file mode 100644 index 0000000..133c894 --- /dev/null +++ b/tests/testthat/test-fct_language.R @@ -0,0 +1,35 @@ +test_that("display name file is available", { + + file_exists <- file.exists(app_sys("extdata", "display_names.csv")) + expect_true(file_exists) + +}) + +test_that("code names are translated correctly", { + + # load display name file + namedata <- read.csv(app_sys("extdata", "display_names.csv"), + comment.char = "#") + # take ten random row numbers + rows <- sample(x = nrow(namedata), size = 10) + # get code names translations and whether they are variable names or not + code_names <- namedata[rows, "code_name"] + finnish <- namedata[rows, "disp_name_fin"] + english <- namedata[rows, "disp_name_eng"] + is_variable_name <- (namedata$category == "variable_name")[rows] + + for (i in 1:10) { + # is Finnish correct? + expect_equal(get_disp_name(code_names[i], + "disp_name_fin", + is_variable_name = is_variable_name[i]), + finnish[i]) + # is English correct? + expect_equal(get_disp_name(code_names[i], + "disp_name_eng", + is_variable_name = is_variable_name[i]), + english[i]) + + } + +}) \ No newline at end of file diff --git a/tests/testthat/test-golem-recommended.R b/tests/testthat/test-golem-recommended.R new file mode 100644 index 0000000..8b8f4e3 --- /dev/null +++ b/tests/testthat/test-golem-recommended.R @@ -0,0 +1,27 @@ +test_that("app ui", { + ui <- app_ui() + golem::expect_shinytaglist(ui) + # Check that formals have not been removed + fmls <- formals(app_ui) + for (i in c("request")){ + expect_true(i %in% names(fmls)) + } +}) + +test_that("app server", { + server <- app_server + expect_type(server, "closure") + # Check that formals have not been removed + fmls <- formals(app_server) + for (i in c("input", "output", "session")){ + expect_true(i %in% names(fmls)) + } +}) + +# Configure this test to fit your need +test_that( + "app launches",{ + skip("golem::expect_running seems buggy ATM") + golem::expect_running(sleep = 5) + } +) diff --git a/tests/testthat/test-mod_table.R b/tests/testthat/test-mod_table.R new file mode 100644 index 0000000..f52bb64 --- /dev/null +++ b/tests/testthat/test-mod_table.R @@ -0,0 +1,34 @@ +# library(shinytest) +# +# # a helper function which creates a new app for testing the table module +# create_table_test_app <- function(table_code_name) { +# +# row_variable <- "harvest_crop" +# +# ui <- fluidPage(mod_table_ui(id = table_code_name), +# selectInput(row_variable, label = row_variable, +# choices = c("FRG", "WHT", "BAR"), multiple = TRUE), +# selectInput("language", label = "lang", +# choices = c("disp_name_eng", "disp_name_fin"))) +# +# server <- function(input, output, session) { +# +# override_values <- shiny::reactiveVal() +# +# mod_table_server(table_code_name, +# row_variable_value = reactive(input$harvest_crop), +# language = reactive(input$language), +# override_values = override_values) +# } +# +# shinytest::ShinyDriver$new(shiny::shinyApp(ui, server)) +# +# } +# +# test_that("harvest_crop_table works", { +# app <- create_table_test_app("harvest_crop_table") +# +# app$setInputs(language = "disp_name_fin", harvest_crop = c("FRG", "WHT")) +# +# expect_equal(TRUE, TRUE) +# }) diff --git a/tests/testthat/test_files/database.sqlite b/tests/testthat/test_files/database.sqlite new file mode 100644 index 0000000..cf67f84 Binary files /dev/null and b/tests/testthat/test_files/database.sqlite differ diff --git a/ui_builder.R b/ui_builder.R deleted file mode 100644 index b734ba5..0000000 --- a/ui_builder.R +++ /dev/null @@ -1,414 +0,0 @@ -# Builds the ui based on a json file -# e.g. builds additional options for the different activity types -# Otto Kuusela 2021 - -structure_file_path <- "data/ui_structure.json" -structure <- jsonlite::fromJSON(structure_file_path, simplifyMatrix = FALSE) -activity_options <- structure$sidebar$mgmt_operations_event$sub_elements - -# function which recursively applies a function to the elements of a list that -# are themselves lists. -# returns the values returned by fun as a list -rlapply <- function(x, fun, name_fun = NULL, ...) { - - results <- list() - - for (element in x) { - if (!is.list(element)) { - next - } - - # x is a list, so let's test it - result <- fun(element, ...) - - if (!is.null(result)) { - - # if we have a naming function defined, use that - # index is either an actual index or name of the element - if (is.null(name_fun)) { - index <- length(results) + 1 - } else { - index <- name_fun(element) - } - - results[[index]] <- result - } - - # more results might lurk on lower levels of the list. - # So let's investigate those - more_results <- rlapply(element, fun, name_fun, ...) - - if (length(more_results) > 0) { - results <- append(results, more_results) - } - } - - if (length(results) > 1) { - return(results) - } else if (length(results) == 1) { - return(results) - #return(results[[1]]) - } else { - return(NULL) - } - -} - -build_structure_lookup_list <- function() { - element_fetcher <- function(x) { - if (!is.null(x$code_name)) { - # we don't need the sub_elements listed, those will come separately - x$sub_elements <- NULL - return(x) - } else { - return(NULL) - } - } - - element_name_fetcher <- function(x) { return(x$code_name) } - - lookup_list <- rlapply(structure, fun = element_fetcher, - name_fun = element_name_fetcher) - return(lookup_list) -} - -structure_lookup_list <- build_structure_lookup_list() - -# help texts (technically textOutputs) have a different method of updating -# when the language is changed because they are outputs rather than inputs, -# and for that we need a list of the code names of these objects. -# The same goes for data tables (excluding event table). -# We also need the code names of fileInput delete buttons to set up observers -# for them -text_output_code_names <- NULL -data_table_code_names <- NULL -fileInput_delete_code_names <- NULL -fileInput_code_names <- NULL -for (element in structure_lookup_list) { - if (element$type == "textOutput") { - text_output_code_names <- c(text_output_code_names, element$code_name) - } else if (element$type == "dataTable") { - data_table_code_names <- c(data_table_code_names, element$code_name) - } else if (element$type == "actionButton" && !is.null(element$fileInput)) { - fileInput_delete_code_names <- c(fileInput_delete_code_names, - element$code_name) - } else if (element$type == "fileInput") { - fileInput_code_names <- c(fileInput_code_names, element$code_name) - } -} - -# creates the ui for a list of elements in the structure file. -# create_border specifies whether a border should be drawn around the -# elements in the input_list. It is typically set to false when calling -# create_ui for the entire activity_options list, and true otherwise -create_ui <- function(input_list, create_border) { - new_elements <- lapply(input_list, create_element) - - if (create_border) { - new_elements <- wellPanel(new_elements) - } - - # if there is a visibility condition, apply it - if (!is.null(input_list$condition)) { - new_elements <- conditionalPanel( - condition = input_list$condition, new_elements) - } - - return(new_elements) -} - -# creates the individual elements -# the override_label and ... functionalities are used for creating elements -# in dynamic (e.g. multi-crop) data tables. Do NOT supply the label argument in -# the unnamed arguments (...)! -create_element <- function(element, override_label = NULL, - override_code_name = NULL, - override_value = NULL, - override_choices = NULL, - override_selected = NULL, - override_placeholder = NULL, ...) { - - # element is a string, i.e. a visibility condition for a element set - # it has already been handled in create_ui - if (!is.list(element)) { - return() - } - - # element is a list of elements, because it doesn't have the type - # attribute. In that case we want to create all of the elements in that list - if (is.null(element$type)) { - return(create_ui(element, create_border = FALSE)) - } - - # the labels will be set to element$label which is a code_name, not a - # display_name, but this is okay as the server will update this as the - # language changes (which also happens when the program starts) - # the following allows overwriting the label through ... - element_label <- element$label - if (!is.null(override_label)) { - element_label <- override_label - } - - element_code_name <- element$code_name - if (!is.null(override_code_name)) { - element_code_name <- override_code_name - } - - element_value <- "" - if (!is.null(override_value)) { - element_value <- override_value - } - - element_choices <- "" - if (!is.null(override_choices)) { - element_choices <- override_choices - } - - element_placeholder <- element$placeholder - if (!is.null(override_placeholder)) { - element_placeholder <- override_placeholder - } - - new_element <- if (element$type == "checkboxInput") { - checkboxInput(element_code_name, label = element_label, ...) - } else if (element$type == "selectInput") { - # if multiple is defined (=TRUE) then pass that to selectInput - multiple <- ifelse(is.null(element$multiple), FALSE, TRUE) - # we don't enter choices yet, that will be handled by the server - selectInput(element_code_name, label = element_label, - choices = element_choices, multiple = multiple, - selected = override_selected, ...) - } else if (element$type == "textOutput") { - if (!is.null(element$style) && element$style == "label") { - textOutput(element_code_name, ...) - } else { - # these are inteded to look like helpTexts so make text gray - tagList( - span(textOutput(element_code_name, ...), style = "color:gray"), - br()) - } - } else if (element$type == "textInput") { - textInput(inputId = element_code_name, label = element_label, - value = element_value, placeholder = element_placeholder, ...) - } else if (element$type == "numericInput") { - numericInput(inputId = element_code_name, - label = element_label, - min = element$min, - max = ifelse(is.null(element$max),NA,element$max), - value = element_value, - step = ifelse(is.null(element$step),"any",element$step), - ...) - } else if (element$type == "textAreaInput") { - textAreaInput(element_code_name, - label = element_label, - resize = "vertical", - value = element_value, - placeholder = element_placeholder, ...) - } else if (element$type == "dataTable") { - tableInput(element_code_name) - } else if (element$type == "fileInput") { - # create the fileInput and the corresponding delete button now so that - # they can be aligned properly - delete_button <- structure_lookup_list[[element$delete_button]] - div(style = "display: flex;", - div(style="flex-grow: 1;", - fileInput(element_code_name, - label = element_label, - accept = element$filetype, ...)), - div(style="margin-left: 5px; padding-top: 26px", - shinyjs::hidden(actionButton(delete_button$code_name, - label = delete_button$label, - class = "btn-warning"))) - ) - } else if (element$type == "dateRangeInput") { - dateRangeInput(element_code_name, - label = element_label, - separator = "-", - weekstart = 1, - max = Sys.Date()) - } else if (element$type == "actionButton") { - # these are always fileInput delete buttons and are handled there - } - - # put the new element in a conditionalPanel. If no condition is specified, - # the element will be visible by default - #new_element <- conditionalPanel(condition = element$condition, new_element) - - # if there are sub-elements to create, do that - if (!is.null(element$sub_elements)) { - return(list(new_element, - create_ui(element$sub_elements, create_border = FALSE))) - } - - return(new_element) -} - -# return choices for a selectInput given its structure -# (as read from ui_structure.json) -get_selectInput_choices <- function(element_structure, language) { - # the choices for a selectInput element can be stored in - # three ways: - # 1) the code names of the choices are given as a vector - # 2) for site and block selectors, there is IGNORE: - # this means that the choices should not be updated here (return NULL) - # 3) the category name for the choices is given. - # in the following if-statement, these are handled - # in this same order - if (is.null(element_structure$choices)) { - choices <- NULL - } else if (length(element_structure$choices) > 1) { - choices <- c("", element_structure$choices) - names(choices) <- c("", get_disp_name( - element_structure$choices, - language = language)) - } else if (element_structure$choices == "IGNORE") { - choices <- NULL - } else { - # get_category_names returns both display names and - # code names - choices <- c( - "", - get_category_names(element_structure$choices, - language = language) - ) - } - - return(choices) -} - -# function for updating a UI element. The function determines the type of the -# element and updates its value. The value should be an atomic vector. -# if value is set to NULL, the value of the element is not touched. -# If clear_value is set to TRUE, the value of the element is cleared -update_ui_element <- function(session, code_name, value = NULL, - clear_value = FALSE, ...) { - # find the element from the UI structure lookup list, which has been - # generated in ui_builder.R - element <- structure_lookup_list[[code_name]] - - # didn't find the element corresponding to code_name - # this should not happen if the element is in - # sidebar_ui_structure.json - if (is.null(element$type)) { - stop("UI element type not found, could not update") - } - if (!is.atomic(value)) { - stop("The value given to update_ui_element should be an atomic vector") - } - - # if value is NULL, we need to determine on a widget type basis how to - # clear the value. If it isn't, replace missingvals with "" - if (!is.null(value)) { - # replace missingvals with empty strings - missing_indexes <- value == missingval - if (any(missing_indexes)) { - value[missing_indexes] <- "" - } - } - - - if (element$type == "selectInput") { - # if value is a list (e.g. multiple crops selected in harvest_crop) - # turn it into a character vector - # if (is.list(value)) { - # print("List was turned to vector when updating selectInput") - # value <- value[[1]] - # } - if (clear_value) value <- "" - # setting the selected value to NULL doesn't change the widget's value - updateSelectInput(session, code_name, selected = value, ...) - } else if (element$type == "dateInput") { - # setting value to NULL will reset the date to the current date - value <- if (clear_value) { - NULL - } else { - tryCatch(expr = as.Date(value, format = date_format_json), - warning = function(cnd) NULL) - } - updateDateInput(session, code_name, value = value, ...) - } else if (element$type == "textAreaInput") { - if (clear_value) value <- "" - updateTextAreaInput(session, code_name, value = value, ...) - #} else if (element$type == "checkboxInput") { - # updateCheckboxInput(session, code_name, value = value, ...) - } else if (element$type == "actionButton") { - updateActionButton(session, code_name, ...) - } else if (element$type == "textInput") { - if (clear_value) value <- "" - updateTextInput(session, code_name, value = value, ...) - } else if (element$type == "numericInput") { - # if we are given a non-numeric value, we don't want to start converting - # it. Let's replace it with an empty string (the default value) - # if (!is.numeric(value)) {value <- ""} - if (clear_value) { value <- "" } - updateNumericInput(session, code_name, value = value, ...) - } else if (element$type == "dateRangeInput") { - - if (!is.null(value) & length(value) != 2) { - value <- NULL - warning(glue("Value supplied to the dateRangeInput was not of ", - "length 2, resetting it")) - } - - start <- if (is.null(value) | clear_value) NULL else value[1] - end <- if (is.null(value) | clear_value) NULL else value[2] - - tryCatch(warning = function(cnd) {shinyjs::reset(code_name)}, - updateDateRangeInput(session, code_name, - start = start, end = end)) - } else if (element$type == "fileInput") { - - if (identical(value, "")) { - value <- NULL - clear_value <- TRUE - } - - if (!is.null(value)) { - #value <- "1 file uploaded" - session$sendCustomMessage(type = "fileInput-value", - message = list(id = code_name, - value = value)) - # show file delete button - #message(glue("Showing {element$delete_button}")) - shinyjs::show(element$delete_button) - } - - if (clear_value) { - # this clears the text on the widget, but not is value - shinyjs::reset(code_name) - # save current value. Whenever the save button is pressed, we check - # whether the current value then differs from this saved value. In - # this way this is equivalent to clearing the value - session$userData$previous_fileInput_value[[code_name]] <- - session$input[[code_name]] - # hide file delete button - #message(glue("Hiding {element$delete_button}")) - shinyjs::hide(element$delete_button) - } - - if (hasArg(label)) { - label <- list(...)$label - session$sendCustomMessage(type = "fileInput-label", - message = list(id = code_name, - value = label)) - } - } -} - -# checks whether the list x (corresponding to a UI element) has a specified -# code name, and if yes, return it -# this function is used in app.R to find the element corresponding to a -# given code name when updating UI language -code_name_checker <- function(x, code_name) { - if (is.null(x$code_name)) { - return(NULL) - } - - if (x$code_name == code_name) { - return(x) - } else { - return(NULL) - } -} - - diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/fieldactivity.Rmd b/vignettes/fieldactivity.Rmd new file mode 100644 index 0000000..5159dbd --- /dev/null +++ b/vignettes/fieldactivity.Rmd @@ -0,0 +1,141 @@ +--- +title: "fieldactivity package for developers" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{fieldactivity} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +## Files: what is where + +### The root folder +- `DESCRIPTION`, `LICENCE`, `NAMESPACE`, `LICENSE.md` are metadata files related to R packages + +### `dev` +Contains files related to the development of the app. + +You should create: + +- a folder (e.g. `dev/dev_events`) for event files in the development phase. Change the call to `run_app` in `run_dev.R` to indicate the path to this folder +- a user database (you can use `create_user_db.R` for this). This too should be indicated in `run_dev.R` + +`01_start.R`, `02_dev.R` and `03_deploy.R` contain useful commands related to app development. These are files created by the Golem framework. `02_dev.R` is the most useful of these, it can be used to indicate dependencies to other packages, create new modules etc. + +run_dev.R is the script that `golem::run_dev()` runs (note, you should always use this command to run the app when developing it). It sets up the app for running it while developing the app. Here you can indicate whether you want the app to run in production or development mode. + +### `inst` + +- `golem-config.yml` is a configuration file related to Golem. Note, don't change the version number by hand here; see `dev/02_dev.R` instead. +- `inst/app/www/script.js` is a javascript file the app uses. It is added as a head tag to the app html. It is mostly related to the table and fileInput modules. + +#### `inst/extdata` + +This folder is home to three important files. + +##### `ui_structure.json` + +Contains the structure of each UI element. Each item in this file has at least +the following fields: + +- `code_name` is the name used to refer to the widget in the app +- `type` is the type of the widget. This is one of the following (listed under each type are the possible fields related to the type): + - `selectInput` + - `choices`: a list of choices, a category in `display_names.csv` or `"IGNORE"`. See the documentation for the function `get_selectInput_choices` defined in `fct_ui.R`. + - `multiple`: are multiple choices allowed? Defaults to `false`. + - `numericInput` + - `min`: The smallest acceptable value (inclusive) + - `max`: The largest acceptable value (inclusive) + - `step`: If set to 1, only integer values are allowed + - `sum_to`, `sum_of`: related to the calculation of yield sums in `harvest_crop_table` + - `fileInput` + - `filetype`: The type of files that should be accepeted. See Shiny documentation for the fileInput widget. This is not necessarily enforced. + - `textInput` + - `placeholder`: Code name of placeholder + - `textAreaInput` + - `placeholder`: Code name of placeholder + - `maxlength`: The maximum acceptable length (in characters) of the value + - `textOutput` + - `dynamic`: If defined, indicates how the text should be adjusted during the execution of app. See `form_title` for an illustrative (and only) example. + - `style`: `"label"` if the text should look like a widget label. + - `actionButton` + - `dateInput` + - `dateRangeInput` + - `dataTable` + - `columns`: The columns of the table in case it has a dynamic row group + - `rows`: A list of row groups. There are two types of row groups: dynamic and static. There can be at most one dynamic row group and it comes first. There can be multiple static row groups. For dynamic row groups the `row_variable` field indicates the widget which determines the rows of the dynamic row group. For static rows the variable names of the desired widgets are listed under `variables` and `hide_labels` can be used to hide the labels of these widgets (labels of the widgets in the dynamic row group are automatically hidden). The name of a static row can be defined in `name`. + +Other fields: + +- `label`: the code name of the label of the widget (this will be found from `display_names.csv`) +- `required`: is it compulsory to fill the widget before the event can be saved? Defaults to `false`. +- `hide_in_event_list`: should this variable be hidden in the event list (when viewing a specific activity type)? Defaults to `false`. +- `condition`: this isn't specified for single widgets but for groups of widgets. This is the condition (in javascript) which determines whether the widget group in question should be visible or not. This is given to a Shiny element called ConditionalPanel. + + +##### `display_names.csv` + +A csv file with four columns: `category`, `code_name`, `disp_name_eng` and `disp_name_fin`. Each row is a translation of a code name into the different languages. The category can be used to e.g. point a set of these names as the choices of a selectInput widget. + +##### `FOsites.csv` + +A csv file which contains the sites and their blocks. Note, the user names in the user database should match the names of these sites exactly (including case). + + +### `man`, `vignettes` + +`man` contains the function documentation generated by Roxygen2, `vignettes` contains this vignette. + +### `tests` + +All tests should be placed under `tests/testthat`. The testthat package is used. + +### `R` + +This is the folder which contains the actual bulk of the application. `run_app.R` defines the function which launches the app. `app_server.R` and `app_ui.R` define the server and UI functions of the main app. `fct_` and `utils_` files contain helper functions. Files starting with `mod_` are either modules or files directly related to modules. + +## The structure of the app + +The structure of the app can be summarised as follows: + +- the main app consists of `app_server.R` and `app_ui.R`. The UI includes (in order) + - the language and site selectors + - the title and introduction text + - **the event list module** (`mod_event_list.R`) + - the event list includes a table showing a list of events and selectors to filter which events are displayed + - buttons to create a new event and to clone an event + - **the form module** (`mod_form.R`) + - this contains all the widgets for entering information about an event and the save, cancel and delete event buttons + - the default widgets (block, activity, date and description) are hard-coded in the UI function of the module. The activity-specific widgets are created by calling the `create_ui` function (defined in `fct_ui.R`) in that same UI function. + - the widgets include standard Shiny widgets as well as **table modules** (`mod_table.R`) and **fileInput modules** (`mod_fileInput.R`). + +Modules are a tool to make Shiny apps more, well, modular. Each module includes a UI function, which creates user interface components, and a server function which defines how those components should behave. + +A module (more specifically, its server function) can be given input values which are usually reactives (reactive is a Shiny term. Reactive expressions can be thought of as functions which store their value and only recalculate it when it is no longer valid.). For example, the language chosen in the main app is passed on to other modules as a reactive expression -- when the language is changed by the user, that reactive can be used to access the latest language in the modules. Modules can also return values, and these values are usually reactive as well. For example, the form module returns the values of widgets to the main app server function, which goes on to edit or create a json file based on this information. + +### The startup process + +A few words about the process of starting the app, as that became a bit more complex recently. The app is started by a call to the `run_app` function, defined in `R/run_app.R`. The app can be started in two modes, production mode or developer mode. This is controlled by the option `golem.app.prod`: +```{r eval=FALSE, include=TRUE} +options(golem.app.prod = TRUE) # use production mode and hence user authentication +options(golem.app.prod = FALSE) # skip authentication +# run_app(...) +``` +It is in this `run_app.R` file where the app is "wrapped in shinymanager" to display the authentication UI if the app is in production mode. + +When the app starts, the `app_server` server function in `R\app_server.R` is initialised. It is here that the event list module server is initialised as well. However, calling the server function of the form module is delayed until a site is specified (either by logging in to a user account specific to a site or in admin mode where the site selector is visible). This is done to decrease the time it takes for the main app UI to be displayed. However, this causes a small delay in the loading of events in the event list. + +The form server is initialised by calling the function `initialise_form` defined within the `app_server` function. Furthermore, when the form server function is initialised, it does not yet initialise the server function of table or fileInput modules on the form. Instead, they are initialised the first time the form is shown. Their initialisation happens by sending an initialisation signal to the form through a reactive (`init_signal`), which is being listened to by the form server function. + +## Useful resources +- For Shiny: [Mastering Shiny](https://mastering-shiny.org) and [Shiny function reference](https://shiny.rstudio.com/reference/shiny/) +- For R packages: [R Packages](https://r-pkgs.org) and [R package primer](https://kbroman.org/pkg_primer/) +- For R: [Advanced R](https://adv-r.hadley.nz) +- For Golem and Shiny app development: [Engineering Production-Grade Shiny Apps](https://engineering-shiny.org) diff --git a/www/script.js b/www/script.js deleted file mode 100644 index 3cbe1f0..0000000 --- a/www/script.js +++ /dev/null @@ -1,23 +0,0 @@ -function do_selectize(table_id) { - return $('#'+table_id).find('select').selectize(); -} - -var renderCounter = 0; - -function rendering_done(rendered_id) { - renderCounter++; - Shiny.setInputValue(rendered_id, renderCounter); -} - -Shiny.addCustomMessageHandler('unbind-table', function(id) { - Shiny.unbindAll($('#'+id).find('.shiny-input-container')); -}); - -Shiny.addCustomMessageHandler('fileInput-value', function(message) { - var target = $('#'+message.id).parent().parent().parent().find('input[type=text]'); - target.val(message.value); -}); - -Shiny.addCustomMessageHandler('fileInput-label', function(message) { - $('#'+message.id+"-label").text(message.value); -}); \ No newline at end of file