Add files via upload

_old/modules/Fill/buildGuideline.R

@@ -0,0 +1,92 @@
+### buildGuidelines.R ###
+rm(list=ls())
+start.time <- Sys.time()
+setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
+
+
+
+### libraries ###
+library(xml2)
+library(data.tree)
+
+
+
+### imports ###
+source("xsdExplorer.R")
+source("../utils/multiApply.R")
+
+
+
+### set vars ###
+{
+  cat("Setting variables : ")
+  files = dir(path = "xsdFiles",pattern="eml",full.names = TRUE)
+  focus = c("element"
+            , "simpleType"
+            , "attribute"
+            , "group"
+            , "complexType"
+            , "R-Attributes"
+            , "simpleContent"
+            , "extension")
+  filter = c("simpleType:"
+             , "complexType:"
+             , "simpleContent:"
+             , "element:"
+             , "group:[a-zA-Z0-9]{4,}"
+             , gsub("xsdFiles/","", gsub("\\.xsd","",files))
+             )
+  cat(round(Sys.time() - start.time, 1),"s.\n"); start.time = Sys.time()
+}
+
+
+
+### Guidelines production ###
+# Only lists are saved (as it is a more usual format)
+cat("Producing the guidelines:\n")
+
+{
+  ## system guideline ##
+  if(!file.exists( "../resources/systemGuideline.RData"))
+  {
+    cat("* System guideline: ")
+    systemList = buildSystemList(files, focus)
+    saveRDS(systemList, "../resources/systemGuideline.RData")
+    cat(round(Sys.time() - start.time, 1),"s.\n"); start.time = Sys.time()
+  }
+  else systemList <- readRDS("../resources/systemGuideline.RData")
+
+  ## Backbone guideline ##
+  if(!file.exists( "../resources/backboneGuideline.RData"))
+  {
+    cat("* Backbone guideline: ")
+    backboneList <- buildBackboneList(li = systemList, focus=focus)
+    saveRDS(backboneList, "../resources/backboneGuideline.RData")
+    cat(round(Sys.time() - start.time, 1),"s.\n")
+  }
+  else backboneList <- readRDS("../resources/systemGuideline.RData")
+
+  ## Doc guideline ##
+  if(!file.exists( "../resources/docGuideline.RData"))
+  {
+    cat("* Doc guideline: ")
+    docList <- buildDocList(li = backboneList, filter = filter)
+    saveRDS(docList, "../resources/docGuideline.RData")
+    cat(round(Sys.time() - start.time, 1),"s.\n"); start.time = Sys.time()
+  }
+  else docList <- readRDS("../resources/systemGuideline.RData")
+
+  ## Fill guideline ##
+  {
+    cat("* Fill guideline: ")
+    fillList <- buildFillList(li = backboneList, 
+                              focus=focus, 
+                              filter = filter[-which(filter %in% c("simpleType:","simpleContent:","element:"))])
+    saveRDS(fillList, "../resources/fillGuideline.RData")
+    minFillList <- buildMinFillList(fillList, systemList)
+    write.table(minFillList, "../resources/minFillGuideline.tsv", row.names = TRUE)
+    cat(round(Sys.time() - start.time, 1),"s.\n")
+  }
+}
+
+rm(list = ls())

_old/modules/Fill/fill.R

@@ -0,0 +1,62 @@
+# fill.R
+
+### IMPORTS ###
+source("modules/fill/fill_functions.R")
+library("data.table")
+
+cat("* Loading Fill Guidelines: \n")
+fillGuideline = as.list(readRDS("resources/fillGuideline.RData"))
+cat("** Fill Guideline successfully loaded !\n")
+minFillGuideline = as.data.frame(read.table("resources/minFillGuideline.tsv" ))
+cat("** Minimized Fill Guideline successfully loaded !\n")
+
+### UI ###
+fillUI <- function(id, IM){
+  ns <- NS(id)
+
+  div(
+    fluidRow(
+      box(column(4,
+                 selectInput(ns("item"),
+                             "Select an item to fill:",
+                             minFillGuideline$abrev,
+                             selectize = FALSE)),
+          column(8,
+                 htmlOutput(ns("location")),
+                 style="max-height: 10%;"),
+          width = 12)
+    ),
+    fluidRow(
+      uiOutput(ns("gui"))
+    )
+  )
+}
+
+
+
+### SERVER ###
+fill <- function(input, output, session, IM){
+  # This commented part is useful to get str() applied on a list
+  # output$accessedPath <- reactive({gsub("((\\.\\. *)*\\$ )","\n\\1",
+  #                                       gsub(" +"," ",
+  #                                            capture.output(str(followPath(systemGuideline,input$item)))))})
+
+  output$location <- renderText({ 
+    row <- which(minFillGuideline[,2] == input$item)
+    return(HTML(paste0("<b>SystemGuideline Location: </b>", as.character(minFillGuideline[row,1]))))
+  })
+
+  output$gui <- renderUI({
+    row <- which(minFillGuideline[,2] == input$item)
+    accessed <- followPath(systemGuideline, as.character(minFillGuideline[row,1]))
+
+    ## processing
+    rendered <- fillExplore(li = accessed, 
+                            id = accessed$`R-Attributes`$XSDPATH,
+                            lastName = input$item)
+    # [additional processes]
+    # browser()
+
+    return(rendered)
+  })
+}

_old/modules/Fill/fill_functions.R

@@ -0,0 +1,122 @@
+# fill_functions.R
+
+# root input
+fillExplore <- function(li,              # currently examined list
+                        id = "none",     # vector of id, built for each input UI element
+                        depth = 0,       # the current depth - e.g. number of times fillExplore() was applied
+                        sequence = NULL, # the depth of the last entered sequence 
+                        choice = NULL,   # the depth of the last entered choice
+                        lastName         # if no name is precised at a level, which was the last name to remember?
+                        ){
+  ui <- lapply(li[!grepl("annotation|R-Attributes", attr(li,"names"))],
+               function(ll){
+                 # set variables
+                 ind <- unname(which(unlist(lapply(li, identical, ll))))
+                 llName <- attr(li,"names")[ind]
+                 arguments <- as.list(parent.env(environment()))
+                 arguments$li <- ll
+                 arguments$id <- arguments$li$`R-Attributes`$XSDPATH # unique for each element
+                 arguments$depth <- arguments$depth+1
+
+                 # go for non direct recursion
+                 # NOTA: the following is obviously not optimized but at least is LEGIBLE
+                 # thanks me later ;)
+                 # sequence
+                 if(grepl("sequence",llName)){
+                   arguments$sequence <- arguments$depth
+                   return(do.call(sequenceUI, arguments))
+                 }
+                 # choice
+                 if(grepl("choice",llName)){
+                   arguments$choice <- arguments$depth
+                   return(do.call(choiceUI, arguments))
+                 }
+                 # element
+                 if(grepl("element:",llName)){
+                   return(do.call(elementUI, arguments))
+                 }
+                 # union
+                 if(grepl("union",llName)){
+                   return(do.call(unionUI, arguments))
+                 }
+                 # simpleType, simpleContent, extension
+                 if(grepl("simpleType|simpleContent|extension",llName)){
+                   return(do.call(simpleTypeUI, arguments))
+                 }
+                 # restriction
+                 if(grepl("restriction",llName)){
+                   return(do.call(restrictionUI, arguments))
+                 }
+                 # complexType, complexContent
+                 if(grepl("complexType|complexContent",llName)){
+                   return(do.call(complexTypeUI, arguments))
+                 }
+                 # attributes
+                 if(grepl("attribute",llName)){
+                   # browser()
+                   return("attribute")
+                 }
+
+                 return(tags$u(llName))
+               })
+
+  return(ui)
+}
+
+# sequence input
+sequenceUI <- function(li, id, depth, sequence, choice, lastName){
+  content <- do.call(fillExplore, as.list(environment()))
+  return(box(content, title = lastName, width = 12))
+}
+
+# choice
+choiceUI <- function(li, id, depth, sequence, choice, lastName){
+  content <- do.call(fillExplore, as.list(environment()))
+  return(lapply(content, box, width=12, status = "warning"))
+}
+
+# element input
+elementUI <- function(li, id, depth, sequence, choice, lastName){
+  arguments <- as.list(environment())
+  if(!is.null(li$`R-Attributes`$NAME))
+    name <- li$`R-Attributes`$NAME 
+  else{
+    name <- "element"
+  }
+  if(length(li[!grepl("annotation|R-Attributes",attr(li,"names"))]) > 0){
+    arguments$lastName <- name
+    content <- do.call(fillExplore, arguments)
+  }
+  else{
+    content <- textInput(id, name)
+  }
+  return(content)
+}
+
+# union
+unionUI <- function(li, id, depth, sequence, choice, lastName){
+  return(do.call(fillExplore, as.list(environment())))
+}
+
+# simpleType
+simpleTypeUI <- function(li, id, depth, sequence, choice, lastName){
+  return(do.call(fillExplore, as.list(environment())))
+}
+
+# restriction
+restrictionUI <- function(li, id, depth, sequence, choice, lastName){
+  values <- lapply(li[!grepl("annotation|R-Attributes", attr(li,"names"))],
+                   function(sub)
+                     return(sub$`R-Attributes`$VALUE)
+                   )
+  if(length(values) == 0)
+    return()
+  return(selectInput(id, lastName, values))
+}
+
+# complexType
+complexTypeUI  <- function(li, id, depth, sequence, choice, lastName){
+  return(do.call(fillExplore, as.list(environment())))
+}
+
+#_UI <- function(li, id, depth, sequence, choice, lastName)