Skip to content
Snippets Groups Projects
Commit 0951323e authored by lq39quba's avatar lq39quba
Browse files

delete old

parent bbc4f5a4
Branches main
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 0 additions and 1106 deletions
ebv_metadata_app.R deleted 100644 → 0
+ 0
− 1106
View file @ bbc4f5a4
#install all packages if not yet installed
t <- tryCatch(
{find.package("shiny")},
error = function(e){
install.packages('shiny')
}
)
t <- tryCatch(
{find.package("stringr")},
error = function(e){
install.packages('stringr')
}
)
t <- tryCatch(
{find.package("checkmate")},
error = function(e){
install.packages('checkmate')
}
)
t <- tryCatch(
{find.package("withr")},
error = function(e){
install.packages('withr')
}
)
#load libraries
library(shiny)
library(stringr)
library(checkmate)
library(withr)
ui <- fluidPage(
#set style
#tags$style(type='text/css', '.selectize-label { font-size: 60px;}'),
#".selectize-input { font-size: 32px; line-height: 32px;} .selectize-dropdown { font-size: 28px; line-height: 28px; }"),
#tags$span(style="color:red", 'Summary*')
#set theme
theme = bslib::bs_theme(bootswatch = "flatly"),
#title
titlePanel("EBV netCDF Metadata - Terranova Atlas"),
#create several tabs
tabsetPanel(
#1. tab: general information----
tabPanel('General Information',
#2 cols
fluidRow(
#title
column(6,
textInput('title', tags$span(style="font-size: 18px; font-weight: bold", 'Title*'), width='80%',
placeholder='The title of the dataset.'),
#span(textOutput("title_desc"), style="font-size:14px")
),
#date of creation
column(6,
dateInput('date_created', tags$span(style="font-size: 18px; font-weight: bold", 'Date of creation*'), width='80%', max = Sys.Date())
)
),
#Summary
textAreaInput('summary', tags$span(style="font-size: 18px; font-weight: bold", 'Summary*'), width='90.5%',
placeholder = 'A paragraph describing the dataset. Allowed: 1500 characters'),
span(textOutput("summary_error"), style="color:red"),
#actionButton("summary_example", "Look at an example for a summary."),
#references
textAreaInput('references', tags$span(style="font-size: 18px; font-weight: bold", 'References'), width='90.5%',
placeholder = 'Provide the DOI URL of the dataset and/or associated publications. You can add several DOIs by seperating them by comma.'),
#Methods
textAreaInput('methods', tags$span(style="font-size: 18px; font-weight: bold", 'Methods*'), width='90.5%',
placeholder = 'The method of production of the original data. If it was model-generated, source should name the model and its version. If it is observational, source should characterize it.'),
#2 cols
#coverage content type
selectInput('coverage_content_type', tags$span(style="font-size: 18px; font-weight: bold", 'Coverage Content Type*'), width='90.5%',
c("Image" = "image",
"Thematic Classification" = "thematicClassification",
"Physical Measurement" = "physicalMeasurement",
"Auxiliary Information" = "auxiliaryInformation",
"Quality Information" = "qualityInformation",
"Reference Information" = "referenceInformation",
"Model Result" = "modelResult",
"Coordinate" = "coordinate"),
multiple = T
),
span(textOutput("cct_desc"), style="font-size:14px"),
#2 cols
fluidRow(
#project name
column(6,
textInput('project_name', tags$span(style="font-size: 18px; font-weight: bold", 'Project Name'), width='80%',
value = 'TERRANOVA - The European Landscape Learning Initiative',
placeholder='The name(s) of the Project principally responsible for originating this data. Several values should be separated by comma.'),
#span(textOutput("title_desc"), style="font-size:14px")
),
#project url
column(6,
textInput('project_url', tags$span(style="font-size: 18px; font-weight: bold", 'Project URL'), width='80%',
value = "https://www.terranova-itn.eu",
placeholder='The URL from the project(s) website. Several values should be separated by comma.')
)
),
#2 cols
fluidRow(
#Creator Name
column(6,
textInput('creator_name', tags$span(style="font-size: 18px; font-weight: bold", 'Creator Name*'), width='80%',
placeholder='The name of the person or other creator type principally responsible for creating this data.'),
),
#Creator Email
column(6,
textInput('creator_email', tags$span(style="font-size: 18px; font-weight: bold", 'Creator Email'), width='80%',
placeholder='The email of the person or other creator type principally responsible for creating this data.')
)
),
#Creator Institution
textAreaInput('creator_institution', tags$span(style="font-size: 18px; font-weight: bold", 'Creator Institution*'), width='90.5%',
placeholder = 'Name of the institution of the creator.'),
#2 cols
fluidRow(
#publisher Name
column(6,
textInput('publisher_name', tags$span(style="font-size: 18px; font-weight: bold", 'Publisher Name* (responsible PI)'), width='80%',
placeholder='The name of the person publishing the data. The publisher is also the contact person.'),
),
#publisher Email
column(6,
textInput('publisher_email', tags$span(style="font-size: 18px; font-weight: bold", 'Publisher Email*'), width='80%',
placeholder='The email of the person publishing the data. The publisher is also the contact person.')
)
),
#Publisher Institution
textAreaInput('publisher_institution', tags$span(style="font-size: 18px; font-weight: bold", 'Publisher Institution*'), width='90.5%',
placeholder = 'Name of the institution of the publisher.'),
#Co-creators
textAreaInput('contributor_names', tags$span(style="font-size: 18px; font-weight: bold", 'Co-creators '), width='90.5%',
placeholder = 'The names of the co-creators responsible for creating this data. Seperate several by comma.'),
#license
textAreaInput('license', tags$span(style="font-size: 18px; font-weight: bold", 'License*'), width='90.5%',
value = "https://creativecommons.org/licenses/by/4.0",
placeholder = 'Give the URL of a licence. Prefereble CC-License, e.g. https://creativecommons.org/licenses/by/4.0/'),
#add a text: link to CC licenses
tags$a(href="https://creativecommons.org/licenses/", "Link to CC licenses."),
#comment
textAreaInput('comment', tags$span(style="font-size: 18px; font-weight: bold", 'Comment'), width='90.5%',
placeholder = 'Miscellaneous information about the data, not captured elsewhere.'),
#end tabPanel 1
),
#2. tab: ebv attributes----
tabPanel('EBV Attributes',
#2 cols
fluidRow(
#EBV Class and EBV Name
column(6,
#EBV Class
selectInput("ebv_class", tags$span(style="font-size: 18px; font-weight: bold", "EBV Class"),
c("Genetic composition" = "Genetic composition",
"Species populations" = "Species populations",
"Species traits" = "Species traits",
"Community composition"="Community composition",
"Ecosystem functioning"="Ecosystem functioning",
"Ecosystem structure"="Ecosystem structure",
"None"="N/A"),
width='80%'),
#EBV Name - in server: create selectInput based on EBV Class
uiOutput('ebv_name'),
#environmental domain
selectInput('ebv_domain', tags$span(style="font-size: 18px; font-weight: bold", 'Environmental Domain*'), width='80%',
c("Terrestrial" = "Terrestrial",
"Marine" = "Marine",
"Freshwater" = "Freshwater",
"Other" = "Other",
"None" = "N/A"),
#selected = 'N/A',
multiple = T
),
#define other for environmental domain
uiOutput('ebv_domain_other'),
#terranova type (keywords)
selectInput('terranova_type', tags$span(style="font-size: 18px; font-weight: bold", 'Type of Data*'), width='80%',
c("Climate " = "climate",
"Biodiversity" = "biodiversity ",
'Anthropogenic activity'='anthropogenic activity ')
),
),
#Biological entity
column(6,
selectInput("biological_entity", tags$span(style="font-size: 18px; font-weight: bold", "Entity type"),
c( "None"="N/A",
"Species" = "Species",
"Communities" = "Communities",
"Ecosystems" = "Ecosystems",
"Other"="Other"
),
width='80%'),
uiOutput('entity_other'),
uiOutput('entity_scope'),
uiOutput('entity_classification_name'),
uiOutput('entity_classification_ref')
)
),
#2 cols
fluidRow(
#metric
column(6,
span(textOutput("metric_header"), style="font-size:21px; font-weight: bold"),
numericInput('metric_no', 'Please inicate the amount of Metrics. Minimum 1.', value = 1,
width = '80%',min = 1, max = 10),
span(textOutput("metric_desc"), style="font-size:14px"),
uiOutput('metric_container')
),
#scenario
column(6,
span(textOutput("scenario_header"), style="font-size:21px; font-weight: bold"),
numericInput('scenario_no', 'Please inicate the amount of Scenarios. None needed.', value = 0,
width = '80%', min = 0, max = 10),
span(textOutput("scenario_desc"), style="font-size:14px"),
uiOutput('scenario_container'),
)
)
#end 2. tab
),
#3. tab: spat. temp. attributes----
tabPanel('Spatial and temporal domain',
#2 cols
fluidRow(
#spatial domain
column(6,
#tags$b('Spatial Domain'),
#spatial scope
selectInput("spatial_scope", tags$span(style="font-size: 18px; font-weight: bold", "Spatial Scope*"),
c("Global" = "Global",
"Continental/Regional" = "Continental/Regional",
"National" = "National",
"Sub-national/Local"="Sub-national/Local"),
width='80%'),
#spatial description
uiOutput('spatial_desc'),
#spatial units
selectInput("spatial_units", tags$span(style="font-size: 18px; font-weight: bold", "Spatial Units*"),
c("degrees" = "degrees",
"meters" = "meters"),
width='80%'),
),
#temporal domain
column(6,
#tags$b('Temporal Domain'),
#temporal resoultion
selectInput("temporal_resolution", tags$span(style="font-size: 18px; font-weight: bold", "Temporal Resolution*"),
c("decadal" = "P0010-00-00",
"annually" = "P0001-00-00",
"monthly" = "P0000-01-00",
"weekly" = "P0000-00-07",
"daily" = "P0000-00-01",
'one timestep' = "P0000-00-00",
"irregular" = "Irregular",
"paleo" = "Paleo",
"other" = "other"),
width='80%'),
#other temporal resolution
uiOutput('temporal_resoultion_other'),
#irregular temporal resolution
uiOutput('temporal_resoultion_irregular'),
#temporal extent
uiOutput('temporal_extent'),
#tags$b('Temporal Extent'),
# dateInput('temp_start', tags$span(style="font-size: 18px; font-weight: bold",
# 'Start date of the dataset*'), width='80%',
# startview ='year'),
# dateInput('temp_end', tags$span(style="font-size: 18px; font-weight: bold",
# 'End date of the dataset*'), width='80%',
# startview ='year')
)
)
#end 3. tab
),
#4. tab: check and output generation----
tabPanel('Save metadata to file',
textInput('outputpath', tags$span(style="font-size: 18px; font-weight: bold", 'Outputpath*')), #value='C:\\Users\\lq39quba\\Desktop\\ebv_terranova\\bla.json'
actionButton('create_json', label = "Create JSON file.", class = "btn-lg btn-success"),
verbatimTextOutput("value")
)
)
)
server <- function(input, output) {
nodata <- 'N/A'
# #show summary example
# observeEvent(input$summary_example, {
# output$summary_error <- renderText({'jey'})
# showModal(modalDialog(
# title= "Summary Example",
# text = "Add a summary Example",
# type = 'info',
# closeOnClickOutside = T,
# easyClose = T
# ))
# })
#check summary length
summary_text <- reactive({input$summary})
output$summary_error <- renderText({
if(nchar(summary_text())>1500){
"Your summary is too long! Max. 1500 characters."
}
})
#add info to cct
output$cct_desc <- renderText({'The coverage content type indicates the source of the data. Several options may be selected.'})
#Get EBV Class to define EBV Names
output$ebv_name <- renderUI({
if(input$ebv_class=='Genetic composition'){
selectInput("ebv_name", tags$span(style="font-size: 18px; font-weight: bold", "EBV Name"),
c("Genetic diversity (richness and heterozygosity)" = "Genetic diversity",
"Genetic differentiation (number of genetic units and genetic distance)"="Genetic differentiation",
"Effective population size"="Effective population size",
"Inbreeding"="Inbreeding",
"None"="N/A"),
width='80%')
}else if(input$ebv_class=='Species populations'){
selectInput("ebv_name", "EBV Name",
c('Species distributions'='Species distributions',
'Species abundances'='Species abundances',
'None'='N/A'),
width='80%')
}else if(input$ebv_class=='Species traits'){
selectInput("ebv_name", "EBV Name",
c('Morphology'='Morphology',
'Physiology'='Physiology',
'Phenology'='Phenology',
'Movement'='Movement',
'None'='N/A'),
width='80%')
}else if(input$ebv_class=='Community composition'){
selectInput("ebv_name", "EBV Name",
c('Community abundance'='Community abundance',
'Taxonomic/phylogenetic diversity'='Taxonomic/phylogenetic diversity',
'Trait diversity'='Trait diversity',
'Interaction diversity'='Interaction diversity',
'None'='N/A'),
width='80%')
}else if(input$ebv_class=='Ecosystem functioning'){
selectInput("ebv_name", "EBV Name",
c('Primary productivity'='Primary productivity',
'Ecosystem phenology'='Ecosystem phenology',
'Ecosystem disturbances'='Ecosystem disturbances',
'None'='N/A'),
width='80%')
}else if(input$ebv_class=='Ecosystem structure'){
selectInput("ebv_name", "EBV Name",
c('Live cover fraction'='Live cover fraction',
'Ecosystem distribution'='Ecosystem distribution',
'Ecosystem Vertical Profile'='Ecosystem Vertical Profile',
'None'='N/A'),
width='80%')
}else if(input$ebv_class=='N/A'){
selectInput("ebv_name", "EBV Name",
c('None'='N/A'),
width='80%')
}
})
#add UI for ebv_domain
output$ebv_domain_other <- renderUI({
e <- tryCatch(
{
if('Other' %in% input$ebv_domain){
textInput('ebv_domain_other_txt', tags$span(style="font-weight: bold", 'Other environmental domain*'), width='80%',
placeholder = 'Name of other environmental domain here.')}
},
error = function(e){}
)
})
#add UI for biological entity
output$entity_other <- renderUI({
if(input$biological_entity=='Other'){
textAreaInput('entity_other_txt', 'Other', width='90.5%',
placeholder = 'Name of the other entity type.')
}
})
output$entity_scope <- renderUI({
if(input$biological_entity!='N/A'){
textAreaInput('entity_scope_txt', tags$span(style="font-weight: bold", 'Entity Scope'), width='90.5%',
placeholder = 'A description of the range of taxa or ecosystem types addressed in the dataset. E.g. "300 species of mammals”, “Forests”, etc..')
}
})
output$entity_classification_name <- renderUI({
if(input$biological_entity!='N/A'){
textInput('entity_classification_name_txt', tags$span(style="font-weight: bold", 'Classification System Name'), width='90.5%',
placeholder = 'E.g. Linnaean classification')
}
})
output$entity_classification_ref <- renderUI({
if(input$biological_entity!='N/A'){
textInput('entity_classification_ref_txt', tags$span(style="font-weight: bold", 'Classification System Reference'), width='90.5%',
placeholder = 'Reference of the classification system as a URL.')
}
})
#metric definition
output$metric_header <- renderText({'Metric*'})
output$metric_desc <- renderText({'Provide the name, description and units of the metric(s).'})
#create input fields for all metrics
output$metric_container <- renderUI({
out <- lapply(1:input$metric_no, function(i) {
#linebreak + header per metric
b <- tags$br()
h <- tags$b(tags$span(style="font-size: 17px", paste0('Metric ', i)))
#standard_name
sn <- textInput(paste0('metric_standard_name_',i), 'Name*', width='90.5%',
placeholder = paste0('Name of Metric ', i))
#description/long_name
ln <- textAreaInput(paste0('metric_long_name_',i), 'Description*', width='90.5%',
placeholder = paste0('Description of Metric ', i))
#units
u <- textInput(paste0('metric_units_',i), 'Units*', width='90.5%',
placeholder = paste0('Units of Metric ', i))
return(list(b, h, sn, ln, u))
})
})
#scenario definition
output$scenario_header <- renderText({'Scenario'})
output$scenario_desc <- renderText({
if(input$scenario_no>0){
"If applicable, name the scenario's classification system, the version and provide a URL to the reference."
}
})
#ask for scenario classification
output$scenario_container <- renderUI({
if(input$scenario_no>0){
#create input fields for all scenarios
out <- lapply(1:input$scenario_no, function(i) {
if(i==1){
scn <- textInput('scenario_classification_name', 'Classification Name', width='90.5%',
placeholder = 'Name of scenario classification system, e.g. SSP')
scv <- textInput('scenario_classification_version', 'Classification Version', width='90.5%',
placeholder = 'Version of scenario classification system, e.g. 1.0')
scu <- textInput('scenario_classification_url', 'Classification URL', width='90.5%',
placeholder = 'Reference of scenario classification system, e.g. https://www.aza.org/species-survival-plan-programs')
}
#linebreak + header per scenario
b <- tags$br()
h <- tags$b(tags$span(style="font-size: 17px", paste0('Scenario ', i)))
#standard_name
sn <- textInput(paste0('scenario_standard_name_',i), 'Name*', width='90.5%',
placeholder = paste0('Name of Scenario ', i))
#description/long_name
ln <- textAreaInput(paste0('scenario_long_name_',i), 'Description', width='90.5%',
placeholder = paste0('Description of Scenario ', i))
if(i==1){
return(list(scn, scv, scu, b, h, sn, ln))
}else{
return(list(b, h, sn, ln))
}
})
}
})
#spatial description
output$spatial_desc <- renderUI({
if(input$spatial_scope!='Global'){
textInput('spatial_desc_txt', tags$span(style="font-size: 18px; font-weight: bold", 'Spatial Description*'), width='80%',
placeholder='Name(s)/description of the continent/region/country/area')
}
})
#other temporal resoultion
output$temporal_resoultion_other <- renderUI({
if(input$temporal_resolution=='other'){
t <- renderText('Provide the definition of your temporal resoultion in the ISO 8601:2004 duration format P(YYYY)-(MM)-(DD).
Examples: decadal: P0010-00-00 and daily: P0000-00-01')
s <- textInput('temp_res_txt', '', width='80%', placeholder='P0000-00-00')
return(list(t,s))
}
})
output$temporal_resoultion_irregular <- renderUI({
if(input$temporal_resolution=='Irregular' | input$temporal_resolution=='Paleo'){
if(input$temporal_resolution=='Irregular'){
t <- renderText('Provide the definition of your timesteps as a comma-separated list in the format YYYY-MM-DD or short YYYY.')
s <- textInput('temp_res_irr', '', width='80%', placeholder='YYYY, YYYY, ...')
return(list(t,s))
}else{
t <- renderText('Provide the definition of your timesteps as a comma-separated list. The values will represent "kyr B.P.".')
s <- textInput('temp_res_irr', '', width='80%', placeholder='126, 125, ...')
return(list(t,s))
}
}
})
#check variables
to_do_list <- c()
create <- TRUE
#temporal extent----
output$temporal_extent <- renderUI({
if(input$temporal_resolution!='Irregular' & input$temporal_resolution!='Paleo'){
if(input$temporal_resolution=='other'){
#user defined temporal resolution
if(grepl('^P{1}\\d{4}-00-00', input$temp_res_txt)){
dateRangeInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Start and end date of the dataset*'),
format = "yyyy")
} else if(grepl('^P{1}\\d{4}-\\d{2}-00$', input$temp_res_txt)){
dateRangeInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Start and end date of the dataset*'),
format = "mm-yyyy")
} else if (grepl('^P{1}\\d{4}-\\d{2}-\\d{2}$', input$temp_res_txt)){
dateRangeInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Start and end date of the dataset*'),
format = "dd-mm-yyyy")
}else{
create <- FALSE
to_do_list <- c(to_do_list, 'Your temporal resolution does not match the ISO duration format.')
}
}else if(input$temporal_resolution=='P0000-00-00'){
#one timestep only
dateInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Date of the dataset*'), width='80%',
startview ='year')
}else if(grepl('^P{1}\\d{4}-00-00$', input$temporal_resolution)){
dateRangeInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Start and end date of the dataset*'),
format = "yyyy")
} else if(grepl('^P{1}\\d{4}-\\d{2}-00$', input$temporal_resolution)){
dateRangeInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Start and end date of the dataset*'),
format = "mm-yyyy")
} else {
dateRangeInput('temporal_extent_input', tags$span(style="font-size: 18px; font-weight: bold",
'Start and end date of the dataset*'),
format = "dd-mm-yyyy")
}
}
})
#submit button clicked -----
observeEvent(input$create_json,{
#start checks----
#check if outputpath is empty
if(input$outputpath==''){
output$value <- renderPrint({'You need to give an outputpath.'})
}else{
#check filepath
if (checkmate::checkCharacter(input$outputpath) != TRUE){
output$value <- renderPrint({'Outputpath must be of type character.'})
} else if(checkmate::checkDirectoryExists(dirname(input$outputpath)) != TRUE){
output$value <- renderPrint({paste0('Output directory does not exist.\n', dirname(input$outputpath))})
} else if(!endsWith(input$outputpath, '.json')){
output$value <- renderPrint({'Outputpath needs to end with *.json'})
} else {
#check title
if(nchar(input$title)==0){
to_do_list <- c('You must give a title.', to_do_list)
create <- FALSE
} else if(!is.na(suppressWarnings(as.numeric(input$title)))){
to_do_list <- c('You title must contain characters.', to_do_list)
create <- FALSE
}
#check summary
if(nchar(input$summary)==0){
to_do_list <- c('You must provide a summary.', to_do_list)
create <- FALSE
} else if(!is.na(suppressWarnings(as.numeric(input$summary)))){
to_do_list <- c('You summary must contain characters.', to_do_list)
create <- FALSE
}
if (nchar(input$summary)!=0 & nchar(input$summary)>1500){
to_do_list <- c('Your summary is too long. Max. 1500 characters.', to_do_list)
create <- FALSE
}
#check references - not mandatory
if(nchar(input$references)==0){
references <- nodata
}else{
references <- stringr::str_split(input$references, ',')[[1]]
references <- stringr::str_remove_all(references, ' ')
}
#check methods
if(nchar(input$methods)==0){
to_do_list <- c('You must provide a description of the method.', to_do_list)
create <- FALSE
} else if(!is.na(suppressWarnings(as.numeric(input$methods)))){
to_do_list <- c('You method must contain characters.', to_do_list)
create <- FALSE
}
#check content coverage type
if(!is.null(need(input$coverage_content_type != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to choose at least one value for the content coverage type.')
create <- FALSE
}
#check project_name
if(!is.null(need(input$project_name != '', TRUE))){
project_name <- 'TERRANOVA - The European Landscape Learning Initiative'
}else{
project_name <- 'TERRANOVA - The European Landscape Learning Initiative'
}
#check project_url
if(!is.null(need(input$project_url != '', TRUE))){
project_url <- 'https://www.terranova-itn.eu'
}else{
project_url <- 'https://www.terranova-itn.eu'
}
#check creator_name
if(!is.null(need(input$creator_name != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a creator name.')
create <- FALSE
}
#check creator_email
if(!is.null(need(input$creator_email != '', TRUE))){
creator_email <- nodata
}else{
creator_email <- input$creator_email
}
#check creator_institution
if(!is.null(need(input$creator_institution != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a creator institution.')
create <- FALSE
}
#check publisher_name
if(!is.null(need(input$publisher_name != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a publisher name.')
create <- FALSE
}
#check publisher_email
if(!is.null(need(input$publisher_email != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a publisher email.')
create <- FALSE
}
#check publisher_instiution
if(!is.null(need(input$publisher_institution != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a publisher institution.')
create <- FALSE
}
#check contributors_names
if(!is.null(need(input$contributor_names != '', TRUE))){
contributors_names <- nodata
}else{
contributors_names <- input$contributor_names
}
#check license
if(!is.null(need(input$license != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a license URL.')
create <- FALSE
}
#check comment
if(!is.null(need(input$comment != '', TRUE))){
comment <- nodata
}else{
comment <- input$comment
}
#check ebv_class
if(!is.null(need(input$ebv_class != '', TRUE))){
ebv_class <- nodata
}else{
ebv_class <- input$ebv_class
}
#check ebv_name
if(!is.null(need(input$ebv_name != '', TRUE))){
ebv_name <- nodata
}else{
ebv_name <- input$ebv_name
}
#check ebv_domain
if(!is.null(need(input$ebv_domain != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide an environmental domain.')
create <- FALSE
}else{
if('Other' %in% input$ebv_domain){
if(!is.null(need(input$ebv_domain_other_txt != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a description of the other environmental domain.')
create <- FALSE
}
#create ebv_domain value
ebv_domain_value <- c(input$ebv_domain[! input$ebv_domain %in% c('Other')], input$ebv_domain_other_txt)
}else{
#create ebv_domain value
ebv_domain_value <- c(input$ebv_domain)
}
}
#check biological_entity
if(!is.null(need(input$biological_entity != '', TRUE))){
biological_entity <- nodata
}else{
biological_entity <- input$biological_entity
}
#check entity_scope
if(biological_entity=='Other'){
if(!is.null(need(input$entity_other_txt != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a description of the entity type as you chose Other.')
create <- FALSE
}
} else{
#entity_other_txt
if(!is.null(need(input$entity_other_txt != '', TRUE))){
entity_other_txt <- nodata
}else{
entity_other_txt <- input$entity_other_txt
}
}
#entity_class_name
if(!is.null(need(input$entity_scope_txt != '', TRUE))){#HERE
entity_scope_txt <- nodata
}else{
entity_scope_txt <- input$entity_scope_txt
}
#entity_class_name
if(!is.null(need(input$entity_classification_name_txt != '', TRUE))){
entity_classification_name_txt <- nodata
}else{
entity_classification_name_txt <- input$entity_classification_name_txt
}
#entity_class_url
if(!is.null(need(input$entity_classification_ref_txt != '', TRUE))){
entity_classification_ref_txt <- nodata
}else{
entity_classification_ref_txt <- input$entity_classification_ref_txt
}
#check metric attributes
if(input$metric_no>0){
for(i in 1:input$metric_no){
if(!is.null(need(eval(parse(text = paste0('input$metric_standard_name_', i))) != '', TRUE))){
to_do_list <- c(to_do_list, paste0('The name for metric ',i,' is missing.'))
create <- FALSE
}
if(!is.null(need(eval(parse(text = paste0('input$metric_long_name_', i))) != '', TRUE))){
to_do_list <- c(to_do_list, paste0('The description for metric ',i,' is missing.'))
create <- FALSE
}
if(!is.null(need(eval(parse(text = paste0('input$metric_units_', i))) != '', TRUE))){
to_do_list <- c(to_do_list, paste0('The units for metric ',i,' are missing.'))
create <- FALSE
}
}
}
#check scenario attributes
if(input$scenario_no>0){
for(i in 1:input$scenario_no){
if(!is.null(need(eval(parse(text = paste0('input$scenario_standard_name_', i))) != '', TRUE))){
to_do_list <- c(to_do_list, paste0('The name for scenario ',i,' is missing.'))
create <- FALSE
}
# if(!is.null(need(eval(parse(text = paste0('input$scenario_long_name_', i))) != '', TRUE))){
# to_do_list <- c(to_do_list, paste0('The description for scenario ',i,' is missing.'))
# create <- FALSE
# }
}
#scenario_classification_name
if(!is.null(need(input$scenario_classification_name != '', TRUE))){
scenario_classification_name <- nodata
}else{
scenario_classification_name <- input$scenario_classification_name
}
#scenario_classification_version
if(!is.null(need(input$scenario_classification_version != '', TRUE))){
scenario_classification_version <- nodata
}else{
scenario_classification_version <- input$scenario_classification_version
}
#scenario_classification_url
if(!is.null(need(input$scenario_classification_url != '', TRUE))){
scenario_classification_url <- nodata
}else{
scenario_classification_url <- input$scenario_classification_url
}
}
#spatial scope
if(!is.null(need(input$spatial_scope != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a value for the spatial scope.')
create <- FALSE
}
#spatial description
if(input$spatial_scope != 'Global'){
if(!is.null(need(input$spatial_desc_txt != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a description of the spatial scope.')
create <- FALSE
}else{
spatial_desc_txt <- input$spatial_desc_txt
}
} else{
spatial_desc_txt <- nodata
}
#temporal resolution
if(input$temporal_resolution =='other'){
t_res <- input$temp_res_txt
if(!is.null(need(input$temp_res_txt != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to define the temporal resolution.')
create <- FALSE
}else{
if(!grepl('^P\\d{4}-\\d{2}-\\d{2}$', input$temp_res_txt)){
to_do_list <- c(to_do_list, 'The definition of the temporal resoultion is incorrect. Follow the format: PYYYY-MM-DD. Example: P0010-00-00.')
create <- FALSE
}
}
}else{
t_res <- input$temporal_resolution
}
#check the input of the irregulare timesteps
if(input$temporal_resolution=='Irregular'){
timestep_list <- stringr::str_split(input$temp_res_irr, ',')[[1]]
timestep_list <- gsub(' ', '', timestep_list) #remove whitespaces
print(timestep_list)
ts_irr_wrong <- FALSE
for(ts in timestep_list){
if(grepl('^\\d{4}-\\d{2}-\\d{2}$', ts) | grepl('^\\d{4}$', ts)){
#pass
}else{
ts_irr_wrong <- TRUE
}
}
if(ts_irr_wrong){
to_do_list <- c(to_do_list, 'You chose "Irregular" temporal resolution and the input you provided does not match the required form: comma-separated YYYY-MM-DD or comma-separated YYYY. Please check.')
create <- FALSE
}
}
if(input$temporal_resolution=='Paleo'){
timestep_list <- stringr::str_split(input$temp_res_irr, ',')[[1]]
for(ts in timestep_list){
if(is.na(suppressWarnings(as.numeric(ts)))){
to_do_list <- c(to_do_list, paste0('You chose "paleo" temporal resolution. The value "', ts, '" does not seem to be a numeric value. Please check.'))
create <- FALSE
}
}
}
#temporal extent
if(input$temporal_resolution=='Irregular'){
timestep_list <- stringr::str_split(input$temp_res_irr, ',')[[1]]
t_start <- min(timestep_list)
t_end <- max(timestep_list)
timesteps_irr <- paste0('"', paste0(timestep_list, collapse = '", "'), '"')
}else if(input$temporal_resolution=='Paleo'){
timestep_list <- as.numeric(stringr::str_split(input$temp_res_irr, ',')[[1]])
t_start <- max(timestep_list)
t_end <- min(timestep_list)
timesteps_irr <- paste0('"', paste0(timestep_list, collapse = '", "'), '"')
}else if(input$temporal_resolution=='P0000-00-00'){
t_start <-input$temporal_extent_input
t_end <- input$temporal_extent_input
}else{
t_start <- input$temporal_extent_input[1]
t_end <- input$temporal_extent_input[2]
}
if(input$temporal_resolution!='Irregular' & input$temporal_resolution!='Paleo'){
timesteps_irr <- '"N/A"'
}
#check terranova type
if(!is.null(need(input$terranova_type != '', TRUE))){
to_do_list <- c(to_do_list, 'You need to provide a value for the type of the data.')
create <- FALSE
}
#output errors for user ----
if(create==FALSE){
to_do_list <- c('Your metadata contains the following errors:', to_do_list)
output$value <- renderPrint({paste(to_do_list, sep='\n')})
}
#create json----
if(create){
#inform user
output$value <- renderPrint({'Creating Metadata file'})
#create metric
if(input$metric_no>0){
ebv_metric <- ''
for(i in 1:input$metric_no){
ebv_metric <- paste0(ebv_metric, '\n\t\t\t\t"ebv_metric_',i,'": {
":standard_name": "',eval(parse(text = paste0('input$metric_standard_name_', i))),'",
":long_name": "',eval(parse(text = paste0('input$metric_long_name_', i))),'",
":units": "',eval(parse(text = paste0('input$metric_units_', i))),'"\n\t\t\t\t}')
if(i != input$metric_no){
ebv_metric <- paste0(ebv_metric, ',')
}
}
}
#create scenario
if (input$scenario_no > 0){
ebv_scenario <- paste0('"ebv_scenario": {
"ebv_scenario_classification_name": "',scenario_classification_name,'",
"ebv_scenario_classification_version": "',scenario_classification_version,'",
"ebv_scenario_classification_url": "',scenario_classification_url,'",')
for(i in 1:input$scenario_no){
if(!is.null(need(eval(parse(text = paste0('input$scenario_long_name_', i))) != '', TRUE))){
long_name <- nodata
} else{
long_name <- eval(parse(text = paste0('input$scenario_long_name_', i)))
}
ebv_scenario <- paste0(ebv_scenario, '\n\t\t\t\t"ebv_scenario_',i,'": {
":standard_name": "',eval(parse(text = paste0('input$scenario_standard_name_', i))),'",
":long_name": "',long_name,'"
}')
if(i != input$scenario_no){
ebv_scenario <- paste0(ebv_scenario, ',')
}
}
ebv_scenario <- paste0(ebv_scenario, '\n\t\t\t},')
} else {
ebv_scenario <- '"ebv_scenario": "N/A",'
}
#create json
json <- paste0('{
"data": [
{
"id": "pending",
"naming_authority": "The German Centre for Integrative Biodiversity Research (iDiv) Halle-Jena-Leipzig",
"title": "', input$title ,'",
"date_created": "',input$date_created,'",
"summary": "',input$summary,'",
"references": [\n\t\t\t\t"',paste0(unlist(references), collapse='",\n\t\t\t\t"'),'"\n\t\t\t],
"source": "',input$methods,'",
"coverage_content_type": [\n\t\t\t\t"',paste0(input$coverage_content_type, collapse='",\n\t\t\t\t"'),'"\n\t\t\t],
"project": "',project_name,'",
"project_url": "',project_url,'",
"creator": {
"creator_name": "',input$creator_name,'",
"creator_email": "', creator_email,'",
"creator_institution": "',input$creator_institution,'"
},
"contributor_name": [\n\t\t\t\t"',paste0(stringr::str_remove_all(stringr::str_split(contributors_names, ',')[[1]], ' '), collapse='",\n\t\t\t\t"'),'"\n\t\t\t],
"license": "',input$license,'",
"publisher": {
"publisher_name": "',input$publisher_name,'",
"publisher_email": "',input$publisher_email,'",
"publisher_institution": "',input$publisher_institution,'"
},
"ebv": {
"ebv_class": "',ebv_class,'",
"ebv_name": "',ebv_name,'"
},
"ebv_entity": {
"ebv_entity_type": "',biological_entity,'",
"ebv_entity_scope": "', entity_scope_txt,'",
"ebv_entity_classification_name": "',entity_classification_name_txt,'",
"ebv_entity_classification_url": "',entity_classification_ref_txt,'"
},
"ebv_metric": {',
ebv_metric,
'\n\t\t\t},\n\t\t\t',
ebv_scenario,
'\n\t\t\t"ebv_geospatial": {
"ebv_geospatial_scope": "',input$spatial_scope,'",
"ebv_geospatial_description": "',spatial_desc_txt,'"
},
"geospatial_lat_units": "',input$spatial_units,'",
"geospatial_lon_units": "',input$spatial_units,'",
"time_coverage": {
"time_coverage_resolution": "',t_res,'",
"time_coverage_start": "',t_start,'",
"time_coverage_end": "',t_end,'"
},
"ebv_domain": [\n\t\t\t\t"', paste0(ebv_domain_value, collapse = '",\n\t\t\t\t"'),'"\n\t\t\t],
"comment": "',comment,'",
"terranova_type": "', input$terranova_type,'",
"timesteps": [\n\t\t\t\t', timesteps_irr, '\n\t\t\t]
}
]
}')
#write to file and set encoding
withr::with_options(list(encoding = "UTF-8"), write(json, input$outputpath))
}
}
}
})
}
shinyApp(ui, server)
#To Do
#pre-filled values for keywords: keywords:
#Anthropogenic activity / biodiversity / climate /
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment