Skip to content

Commit bd7c55d

Browse files
eblondeleblondel
committed
enrichWithDataSubjects global option
1 parent 17e4bd7 commit bd7c55d

File tree

3 files changed

+59
-53
lines changed

3 files changed

+59
-53
lines changed

‎R/executeWorkflowJob.R

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -24,13 +24,15 @@ executeWorkflowJob <- function(config, jobdir = NULL, queue = NULL, monitor = NU
2424

2525
#options
2626
skipDataDownload = FALSE
27-
if(!is.null(config$profile$options$skipFileDownload)){
27+
if(!is.null(config$profile$options[["skipFileDownload"]])){
2828
config$logger.warn("Global option 'skipFileDownload' is deprecated, use 'skipDataDownload instead!")
29-
skipDataDownload = config$profile$options$skipFileDownload
29+
skipDataDownload = config$profile$options[["skipDataDownload"]]
3030
}
31-
skipDataDownload <- if(!is.null(config$profile$options$skipDataDownload)) config$profile$options$skipDataDownload else FALSE
32-
skipEnrichWithDatatypes <- if(!is.null(config$profile$options$skipEnrichWithDatatypes)) config$profile$options$skipEnrichWithDatatypes else FALSE
33-
skipEnrichWithData = if(!is.null(config$profile$options$skipEnrichWithData)) config$profile$options$skipEnrichWithData else FALSE
31+
skipDataDownload <- if(!is.null(config$profile$options[["skipDataDownload"]])) config$profile$options[["skipDataDownload"]] else FALSE
32+
skipEnrichWithDatatypes <- if(!is.null(config$profile$options[["skipEnrichWithDatatypes"]])) config$profile$options[["skipEnrichWithDatatypes"]] else FALSE
33+
skipEnrichWithData = if(!is.null(config$profile$options[["skipEnrichWithData"]])) config$profile$options[["skipEnrichWithData"]] else FALSE
34+
skipEnrichWithDataSubjects = if(!is.null(config$profile$options[["skipEnrichWithDataSubjects"]])) config$profile$options[["skipEnrichWithDataSubjects"]] else FALSE
35+
dataSubjectsToExclude = if(!is.null(config$profile$options[["dataSubjectsToExclude"]])) config$profile$options[["dataSubjectsToExclude"]] else c()
3436

3537
#Actions onstart
3638
config$log_separator("-")
@@ -170,7 +172,7 @@ executeWorkflowJob <- function(config, jobdir = NULL, queue = NULL, monitor = NU
170172
entity$enrichWithFormats(config)
171173

172174
#data subjects
173-
entity$enrichWithSubjects(config)
175+
if(!skipEnrichWithDataSubjects) entity$enrichWithSubjects(config, exclusions = dataSubjectsToExclude)
174176
}
175177

176178
#enrich entities with metadata (other properties)

‎R/geoflow_entity.R

Lines changed: 50 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -1868,7 +1868,8 @@ geoflow_entity <- R6Class("geoflow_entity",
18681868
#'@description Enrichs the entity with subjects. If no subject specify in Subjects,
18691869
#'automatically add keyword from dictionary to 'theme' category
18701870
#'@param config geoflow config object
1871-
enrichWithSubjects = function(config){
1871+
#'@param exclusions exclusions
1872+
enrichWithSubjects = function(config, exclusions = c()){
18721873

18731874
data_objects <- self$data
18741875
if(is(data_objects, "geoflow_data")) data_objects <- list(self$data)
@@ -1880,51 +1881,54 @@ geoflow_entity <- R6Class("geoflow_entity",
18801881
#List all columns of data features
18811882
columns <- colnames(data_object$features)
18821883
for(featureAttrName in columns){
1883-
#Check if correspond column exist in dictionary
1884-
fat_attr <- NULL
1885-
fto <- data_object$featureTypeObj
1886-
if(!is.null(fto)) fat_attr <- fto$getMemberById(featureAttrName)
1887-
if(!is.null(fat_attr)){
1888-
#Check if register is link
1889-
registerId <- fat_attr$registerId
1890-
1891-
if(!is.null(registerId)) if(!is.na(registerId)){
1892-
registers <- config$registers
1893-
if(length(registers)>0) {
1894-
registers <- registers[sapply(registers, function(x){x$id == registerId})]
1895-
fat_attr_register <- registers[[1]]
1896-
1897-
#Check if values of column are in register
1898-
dataAttrValues <- unique(data_object$features[featureAttrName])
1899-
featureAttrValues <- switch(class(data_object$features)[1],
1900-
"sf" = data_object$features[,featureAttrName][[1]],
1901-
"data.frame" = data_object$features[,featureAttrName]
1902-
)
1903-
featureAttrValues <- unique(featureAttrValues)
1904-
matchAttrValues <- subset(fat_attr_register$data, code %in% featureAttrValues)
1905-
1906-
if (nrow(matchAttrValues)>0){
1907-
defSource <- fat_attr$defSource
1908-
if(is.na(defSource)){desc_name<-paste0("[",fat_attr$name,"]")}else{
1909-
desc_name<-paste0("[",defSource[1],"]")
1910-
if(!is.null(attr(defSource,"description"))) desc_name<-paste0("[",attr(defSource,"description"),"]")
1911-
if(!is.null(attr(defSource,"uri"))) desc_name<-paste0(desc_name,"@",attr(defSource,"uri"))
1912-
}
1913-
subject_obj <- geoflow_subject$new()
1914-
subject_obj$setKey("theme")
1915-
subject_obj$setName(desc_name)
1916-
for(i in 1:nrow(matchAttrValues)){
1917-
subject_obj$addKeyword(
1918-
keyword = paste0(matchAttrValues$label[i]," [",matchAttrValues$code[i],"]"),
1919-
uri = if(!is.na(matchAttrValues$uri[i])) matchAttrValues$uri[i] else NULL
1920-
)
1921-
}
1922-
self$addSubject(subject_obj)
1923-
1924-
}
1925-
}
1926-
}
1927-
}
1884+
1885+
if(featureAttrName %in% exclusions) next
1886+
1887+
#Check if correspond column exist in dictionary
1888+
fat_attr <- NULL
1889+
fto <- data_object$featureTypeObj
1890+
if(!is.null(fto)) fat_attr <- fto$getMemberById(featureAttrName)
1891+
if(!is.null(fat_attr)){
1892+
#Check if register is link
1893+
registerId <- fat_attr$registerId
1894+
1895+
if(!is.null(registerId)) if(!is.na(registerId)){
1896+
registers <- config$registers
1897+
if(length(registers)>0) {
1898+
registers <- registers[sapply(registers, function(x){x$id == registerId})]
1899+
fat_attr_register <- registers[[1]]
1900+
1901+
#Check if values of column are in register
1902+
dataAttrValues <- unique(data_object$features[featureAttrName])
1903+
featureAttrValues <- switch(class(data_object$features)[1],
1904+
"sf" = data_object$features[,featureAttrName][[1]],
1905+
"data.frame" = data_object$features[,featureAttrName]
1906+
)
1907+
featureAttrValues <- unique(featureAttrValues)
1908+
matchAttrValues <- subset(fat_attr_register$data, code %in% featureAttrValues)
1909+
1910+
if (nrow(matchAttrValues)>0){
1911+
defSource <- fat_attr$defSource
1912+
if(is.na(defSource)){desc_name<-paste0("[",fat_attr$name,"]")}else{
1913+
desc_name<-paste0("[",defSource[1],"]")
1914+
if(!is.null(attr(defSource,"description"))) desc_name<-paste0("[",attr(defSource,"description"),"]")
1915+
if(!is.null(attr(defSource,"uri"))) desc_name<-paste0(desc_name,"@",attr(defSource,"uri"))
1916+
}
1917+
subject_obj <- geoflow_subject$new()
1918+
subject_obj$setKey("theme")
1919+
subject_obj$setName(desc_name)
1920+
for(i in 1:nrow(matchAttrValues)){
1921+
subject_obj$addKeyword(
1922+
keyword = paste0(matchAttrValues$label[i]," [",matchAttrValues$code[i],"]"),
1923+
uri = if(!is.na(matchAttrValues$uri[i])) matchAttrValues$uri[i] else NULL
1924+
)
1925+
}
1926+
self$addSubject(subject_obj)
1927+
1928+
}
1929+
}
1930+
}
1931+
}
19281932
}
19291933
}
19301934

‎inst/actions/geometa_create_iso_19110.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ function(action, entity, config){
66

77
ISOMetadataNamespace$GML$uri <- "http://www.opengis.net/gml/3.2"
88

9-
skipEnrichWithData = if(!is.null(config$profile$options$skipEnrichWithData)) config$profile$options$skipEnrichWithData else FALSE
9+
skipEnrichWithData = if(!is.null(config$profile$options[["skipEnrichWithData"]])) config$profile$options[["skipEnrichWithData"]] else FALSE
1010

1111
#manage multiple sources (supposes a common data structure to expose as ISO 19110)
1212
data_objects <- list()

0 commit comments

Comments
 (0)