Update functions florabank

.zenodo.json

@@ -1,6 +1,6 @@
 {
   "title": "inbodb: Connect to and Retrieve Data from Databases on the INBO Server",
-  "version": "0.0.6",
+  "version": "0.0.7",
   "license": "GPL-3.0",
   "upload_type": "software",
   "description": "<p>A bundle of functions to connect to and retrieve data from databases on the INBO server, with dedicated functions to query some of these databases.<\/p>",

CITATION.cff

@@ -44,4 +44,4 @@ abstract: "A bundle of functions to connect to and retrieve data from databases
 identifiers:
 - type: url
   value: https://inbo.github.io/inbodb/
-version: 0.0.6
+version: 0.0.7

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: inbodb
 Title: Connect to and Retrieve Data from Databases on the INBO Server
-Version: 0.0.6
+Version: 0.0.7
 Authors@R: c(
     person("Els", "Lommelen", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-3481-5684", affiliation = "Research Institute for Nature and Forest (INBO)")),

NAMESPACE

@@ -35,7 +35,6 @@ importFrom(dplyr,collect)
 importFrom(dplyr,distinct)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
-importFrom(dplyr,inner_join)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n)

NEWS.md

@@ -1,3 +1,10 @@
+# inbodb 0.0.7
+
+* update functions `get_florabank_observations()`,  
+  `get_florabank_taxon_ifbl_year()` and
+  `get_florabank_traits()` (database 'D0021_00_userFlora' is deprecated and 
+  replaced with 'D0152_00_Flora')
+
 # inbodb 0.0.6
 
 * new functions `get_taxonlijsten_lists()`, `get_taxonlijsten_features()` and

R/connect_inbo_dbase.R

@@ -6,7 +6,7 @@
 #' The function can only be used from within the INBO network.
 #'
 #' For more information, refer to
-#' \href{https://inbo.github.io/tutorials/tutorials/r_database_access/}{this
+#' \href{https://tutorials.inbo.be/tutorials/r_database_access/}{this
 #' tutorial}.
 #'
 #' @param database_name char Name of the INBO database you want to connect

R/get_florabank_observations.R

@@ -28,18 +28,19 @@
 #' @return A dataframe with the following variables:
 #' `NaamNederlands`,
 #' `NaamWetenschappelijk`,
+#' `AcceptedNaamWetenschappelijk`,
 #' `Bron`,
 #' `BeginDatum`,
 #' `EindDatum`,
-#' `hok`,
+#' `Hok`,
 #' `Toponiem`,
-#' `CommentaarTaxon`,
-#' `CommentaarHabitat`,
-#' `WaarnemingID`,
+#' `CommentaarEvent`,
+#' `CommentaarWaarneming`,
+#' `EventID`,
+#' `X_event`,
+#' `Y_event`,
 #' `X_waarneming`,
-#' `Y_waarneming`,
-#' `X_meting`,
-#' `Y_meting`
+#' `Y_waarneming`
 #'
 #' @importFrom glue glue_sql
 #' @importFrom assertthat assert_that
@@ -55,7 +56,7 @@
 #' # code can only be run if a connection to the database is possible
 #' library(inbodb)
 #' # connect to florabank
-#' db_connectie <- connect_inbo_dbase("D0021_00_userFlora")
+#' db_connectie <- connect_inbo_dbase("D0152_00_Flora")
 #'
 #' # query and collect the data using scientific name
 #' succprat1 <-	get_florabank_observations(db_connectie,
@@ -100,67 +101,91 @@
 #' }
 
 get_florabank_observations <- function(connection, names, fixed = FALSE,
-                                   collect = FALSE) {
+                                       collect = FALSE) {
 
   assert_that(inherits(connection, what = "Microsoft SQL Server"),
               msg = "Not a connection object to database.")
-  assert_that(connection@info$dbname == "D0021_00_userFlora")
+  assert_that(connection@info$dbname == "D0152_00_Flora")
 
   if (missing(names)) {
     stop("Please provide names.")
   }
 
-  sql_statement <- "SELECT DISTINCT
-  tblTaxon.NaamNederlands
-  , tblTaxon.NaamWetenschappelijk
-  , cdeBron.Omschrijving AS Bron
-  , tblWaarneming.BeginDatum
-  , tblWaarneming.EindDatum
-  , tblIFBLHok.Code AS hok
-  , tblWaarneming.Opmerking AS Toponiem
-  , tblMeting.CommentaarTaxon
-  , tblMeting.CommentaarHabitat
-  , tblWaarneming.ID AS WaarnemingID
-  , tblWaarneming.Cor_X AS X_waarneming
-  , tblWaarneming.Cor_Y AS Y_waarneming
-  , tblMeting.Cor_X AS X_meting
-  , tblMeting.Cor_Y AS Y_meting
-  FROM dbo.tblWaarneming
-  INNER JOIN dbo.tblMeting ON tblWaarneming.ID = tblMeting.WaarnemingID
-  INNER JOIN dbo.relTaxonTaxon ON relTaxonTaxon.TaxonIDChild = tblMeting.TaxonID
-  INNER JOIN dbo.tblTaxon ON tblTaxon.ID = relTaxonTaxon.TaxonIDParent
-  LEFT JOIN dbo.tblIFBLHok ON tblIFBLHok.ID = tblWaarneming.IFBLHokID
-  INNER JOIN dbo.cdeBron ON cdeBron.Code = tblWaarneming.BronCode
-  WHERE 1=1
-  AND (tblMeting.MetingStatusCode='GDGA' OR tblMeting.MetingStatusCode='GDGK')
+  sql_statement <- "SELECT DISTINCT COALESCE(cte.ParentNaamNederlands
+  , cte.NaamNederlands) as NaamNederlands
+	, cte.NaamWetenschappelijk
+	, cte.ParentNaamWetenschappelijk AS AcceptedNaamWetenschappelijk
+	, b.Beschrijving AS Bron
+	, e.BeginDatum
+	, e.EindDatum
+	, h.Code AS Hok
+	, e.Toponiem
+	, e.Opmerking AS CommentaarEvent
+	, w.Commentaar AS CommentaarWaarneming
+	, e.id AS EventID
+	, e.CorX AS X_event
+	, e.CorY AS Y_event
+	, w.CorX AS X_waarneming
+	, w.CorY AS Y_waarneming
+FROM [event] e
+	INNER JOIN Bron b ON b.ID = e.BronID
+	INNER JOIN Waarneming w ON w.EventID = e.ID
+	INNER JOIN waarnemingstatus ws ON ws.id = w.WaarnemingStatusID
+	INNER JOIN Hok h ON h.ID = e.HokID
+	INNER JOIN (SELECT t.id AS taxonid
+					, t.code AS taxoncode
+					, t.NaamNederlands
+					, t.NaamWetenschappelijk
+					, CASE WHEN t.ParentTaxonID IS NULL OR t.TaxonRelatieTypeID = 1
+					THEN t.id ELSE t.ParentTaxonID END AS ParentTaxonID
+					, CASE WHEN t.ParentTaxonID IS NULL OR t.TaxonRelatieTypeID = 1
+					THEN t.code ELSE tp.code END AS ParentTaxoncode
+					, CASE WHEN t.ParentTaxonID IS NULL OR t.TaxonRelatieTypeID = 1
+					THEN t.NaamNederlands ELSE tp.NaamNederlands
+					END AS ParentNaamNederlands
+					, CASE WHEN t.ParentTaxonID IS NULL OR t.TaxonRelatieTypeID = 1
+					THEN t.NaamWetenschappelijk ELSE tp.NaamWetenschappelijk
+					END AS ParentNaamWetenschappelijk
+				FROM Taxon t
+					LEFT JOIN Taxon tp ON tp.id = t.ParentTaxonID)cte
+					ON cte.taxonid = w.TaxonID
+WHERE 1=1
+	AND ws.Code in ('GDGA','GDGK')
   "
 
   if (!fixed) {
     like_string <-
-      paste0("AND (",
+      paste0("AND cte.ParentTaxonID in
+		(SELECT DISTINCT CASE WHEN t.ParentTaxonID IS NULL
+		OR t.TaxonRelatieTypeID = 1 THEN t.id ELSE t.ParentTaxonID
+		END AS ParentTaxonID
+		 FROM Taxon t
+			LEFT JOIN Taxon tp ON tp.id = t.ParentTaxonID
+		 WHERE 1=1
+		 	AND (",
              paste0(
-               c(paste0("tblTaxon.NaamNederlands", " LIKE ", "'%", names, "%'"),
-                 paste0("tblTaxon.NaamWetenschappelijk", " LIKE ", "'%", names,
+               c(paste0("cte.NaamNederlands", " LIKE ", "'%", names, "%'"),
+                 paste0("cte.NaamWetenschappelijk", " LIKE ", "'%", names,
                         "%'")),
                collapse = " OR "),
-             ")")
+             "))")
     sql_statement <- glue_sql(
       sql_statement,
       like_string,
       .con = connection)
   } else {
     sql_statement <- glue_sql(
       sql_statement,
-      "AND (tblTaxon.NaamWetenschappelijk IN ({names*}) OR
-             tblTaxon.NaamNederlands IN ({names*}))
+      "AND (cte.NaamWetenschappelijk IN ({names*}) OR
+             cte.NaamNederlands IN ({names*}))
              ",
       names = names,
       .con = connection)
   }
 
   sql_statement <- glue_sql(
     sql_statement,
-    "ORDER BY tblWaarneming.BeginDatum DESC OFFSET 0 ROWS",
+    "ORDER BY e.BeginDatum DESC OFFSET 0 ROWS",
     .con = connection)
 
   sql_statement <- iconv(sql_statement, from =  "UTF-8", to = "latin1")