filters.R 4.72 KB
Newer Older
Matija Obreza's avatar
Matija Obreza committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
# Copyright 2018 Global Crop Diversity Trust
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

Nora Castaneda-Alvarez's avatar
Nora Castaneda-Alvarez committed
15
16
17
18
19

MCPD <- list(
  SAMPSTAT = list("Wild" = list(100, "Natural" = 110, "Semi-natural/wild"=120, "Semi-natural/sown"=130),
                  "Weedy" = 200, 
                  "Traditional cultivar/landrace" = 300,
Matija Obreza's avatar
Matija Obreza committed
20
                  "Breeding/research material"= list(400, "Breeder's line"=410,"Synthetic population"=411,"Hybrid"=412,"Founder stock/base population"=413,"Inbred line (parent of hybrid cultivar)"=414,"Segregating population"=415,"Clonal selection"=416,"Genetic stock"=420,"Mutant (e.g. induced/insertion mutant, tilling population)"=421,"Cytogenetic stock (e.g. chromosome addition/substitution, aneuploids, amphiploids)"=422,"Other genetic stocks (e.g. mapping populations)"=423),
Nora Castaneda-Alvarez's avatar
Nora Castaneda-Alvarez committed
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
                  "Advanced or improved cultivar (conventional breeding methods)"=500,
                  "GMO (by genetic engineering)"=600,
                  "Other (elaborate in REMARKS field)"=999),
  STORAGE = list("Seed collection"=list(10,"Short term"=11,"Medium term"=12,"Long term"=13),
                 "Field collection"=20,
                 "In vitro collection"=30,
                 "Cryopreserved collection"=40,
                 "DNA collection"=50,
                 "Other (elaborate in REMARKS field)"=99),
  COLLSRC = list("Wild habitat"=list(10,"Forest or woodland"=11,"Shrubland"=12,"Grassland"=13,"Desert or tundra"=14,"Aquatic habitat"=15),
                 "Farm or cultivated habitat"=list(20,"Field"=21,"Orchard"=22,"Backyard, kitchen or home garden (urban, peri-urban or rural)"=23,"Fallow land"=24,"Pasture"=25,"Farm store"=26,"Threshing floor"=27,"Park"=28),
                 "Market or shop"=30,
                 "Institute, Experimental station, Research organization, Genebank"=40,
                 "Seed company"=50,
                 "Weedy, disturbed or ruderal habitat"=list(60,"Roadside"=61,"Field margin"=62),
                 "Other (Elaborate in REMARKS field)"=99)
)

Matija Obreza's avatar
Matija Obreza committed
39
40
41
42
43
#' Make or adjust filter using MCPD terminology
#'
#' See FAO/Bioversity Multi-Crop Passport Descriptors.
#'
#' @param filter Existing filters (or blank list if not provided)
Matija Obreza's avatar
Matija Obreza committed
44
#' @param DOI Accession DOI
Matija Obreza's avatar
Matija Obreza committed
45
46
#' @param ORIGCTY Country of origin
#' @param SAMPSTAT Biological status of sample
Matija Obreza's avatar
Matija Obreza committed
47
48
#' @param GENUS List of genera
#' @param SPECIES List of specific epithets (within specified genera)
Matija Obreza's avatar
Matija Obreza committed
49
50
51
52
53
54
55
#'
#' @examples
#'  # Filter accessions from Mexico and Slovenia
#'  mcpd_filter(ORIGCTY = c("MEX", "SVN"))
#'
#'
#' @export
Matija Obreza's avatar
Matija Obreza committed
56
mcpd_filter <- function(filter = list(), DOI = NULL, ORIGCTY = NULL, SAMPSTAT = NULL, GENUS = NULL, SPECIES = NULL) {
Matija Obreza's avatar
Matija Obreza committed
57
58
59
60
61
  f <- c(filter)

  f <- filter_DOI(f, DOI)
  f <- filter_ORIGCTY(f, ORIGCTY)
  f <- filter_SAMPSTAT(f, SAMPSTAT)
Matija Obreza's avatar
Matija Obreza committed
62
63
64
  f <- filter_GENUS(f, GENUS)
  f <- filter_SPECIES(f, SPECIES)
  
Matija Obreza's avatar
Matija Obreza committed
65
66
67
68
  f
}

#' Add filter on accession DOI
Matija Obreza's avatar
Matija Obreza committed
69
70
#' @param filter Existing filters (or blank list if not provided)
#' @param DOI Accession DOI
Matija Obreza's avatar
Matija Obreza committed
71
72
73
74
75
76
77
78
79
80
#' @export
filter_DOI <- function(filter = list(), DOI) {
  f <- c(filter)
  if (!is.null(DOI)) {
    f$doi = c(f$doi, DOI)
  }
  f
}

#' Add filter on Country of origin of material
Matija Obreza's avatar
Matija Obreza committed
81
82
#' @param filter Existing filters (or blank list if not provided)
#' @param ORIGCTY Country of origin
Matija Obreza's avatar
Matija Obreza committed
83
84
85
86
#' @export
filter_ORIGCTY <- function(filter = list(), ORIGCTY) {
  f <- c(filter)
  if (!is.null(ORIGCTY)) {
Matija Obreza's avatar
Matija Obreza committed
87
    f$countryOfOrigin$iso3 = c(f$countryOfOrigin$iso3, ORIGCTY)
Matija Obreza's avatar
Matija Obreza committed
88
89
90
91
92
  }
  f
}

#' Add filter on Biological status of sample
Matija Obreza's avatar
Matija Obreza committed
93
94
#' @param filter Existing filters (or blank list if not provided)
#' @param SAMPSTAT Biological status of sample
Matija Obreza's avatar
Matija Obreza committed
95
96
97
98
99
100
101
102
#' @export
filter_SAMPSTAT <- function(filter = list(), SAMPSTAT) {
  f <- c(filter)
  if (!is.null(SAMPSTAT)) {
    f$sampStat = c(f$sampStat, SAMPSTAT)
  }
  f
}
Matija Obreza's avatar
Matija Obreza committed
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128


#' Add filter by genus
#' @param filter Existing filters (or blank list if not provided)
#' @param GENUS List of genera
#' @export
filter_GENUS <- function(filter = list(), GENUS) {
  f <- c(filter)
  if (!is.null(GENUS)) {
    f$taxonomy$genus = c(f$taxonomy$genus, GENUS)
  }
  f
}


#' Add filter on specific epithet
#' @param filter Existing filters (or blank list if not provided)
#' @param SPECIES List of specific epithets
#' @export
filter_SPECIES <- function(filter = list(), SPECIES) {
  f <- c(filter)
  if (!is.null(SPECIES)) {
    f$taxonomy$species = c(f$taxonomy$species, SPECIES)
  }
  f
}