Fixes - version 1.1 release

Descendant and self of and ancestor and self of fixed

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: SnoLyze
-Version: 1.0
+Version: 1.1
 Date: 2017-05-23
 Title: SNOMED CT Expression Constraint Language (ECL) Execution Engine
 Author: Sander Laverman [aut, cre],
@@ -11,4 +11,4 @@ Imports: data.table, bit64, V8
 License: BSD 3-Clause License
 Description: Support data analytics over SNOMED CT enabled data.
 NeedsCompilation: no
-Packaged: 2017-05-23 14:07:15 UTC; Sander
+Packaged: 2017-06-06 17:56:37 UTC; Sander

R/eclFunctions.R

@@ -1,132 +1,116 @@
 self <- function(sctid) # INPUT MUST BE A STRING OTHERWISE 999480561000087100 WILL BECOME 999480561000087040
 {
-    return(as.integer64(sctid))
+    self <- as.integer64(sctid)
+    if(self %in% any())
+    {
+      return(self)
+    }
+    else
+    {
+      return(emptyVector())
+    }
 }
 
 descendantOrSelfOf <- function(sctid)
 {
-  if(as.character(sctid) == "*")
+  if(length(sctid) == 0)
+  {
+    return(sctid)
+  }
+  else if(as.character(sctid) == "*")
   {
     return(any())
   }
   else
   {
-    descendants <- transitiveclosure[supertypeId == sctid]$subtypeId
-    if(length(descendants) == 0) # check if sctid is a concept
-    {
-      return(emptyVector())
-    }
-    else
-    {
-      return(c.integer64(sctid,descendants))
-    }
+    return(c.integer64(sctid,transitiveclosure[supertypeId == sctid]$subtypeId))
   }
 }
 
 descendantOf <- function(sctid)
 {
-  if(as.character(sctid) == "*")
+  if(length(sctid) == 0)
+  {
+    return(sctid)
+  }
+  else if(as.character(sctid) == "*")
   {
     return(anyExceptRoot())
   }
   else
   {
-    descendants <- transitiveclosure[supertypeId == sctid]$subtypeId
-    if(length(descendants) == 0)
-    {
-      return(emptyVector())
-    }
-    else
-    {
-      return(descendants)
-    }
+    return(transitiveclosure[supertypeId == sctid]$subtypeId)
   }
 }
 
 ancestorOf <- function(sctid)
 {
-  if(as.character(sctid) == "*")
+  if(length(sctid) == 0)
+  {
+    return(sctid)
+  }
+  else if(as.character(sctid) == "*")
   {
     return(nonLeafConcepts())
   }
   else
   {
-    ancestors <- transitiveclosure[subtypeId == sctid]$supertypeId
-    if(length(ancestors) == 0)
-    {
-      return(emptyVector())
-    }
-    else
-    {
-      return(ancestors)
-    }
+    return(transitiveclosure[subtypeId == sctid]$supertypeId)
   }
 }
 
 ancestorOrSelfOf <- function(sctid)
 {
-  if(as.character(sctid) == "*")
+  if(length(sctid) == 0)
+  {
+    return(sctid)
+  }
+  else if(as.character(sctid) == "*")
   {
     return(any())
   }
   else
   {
-    ancestors <- transitiveclosure[subtypeId == sctid]$supertypeId
-    if(length(ancestors) == 0)
-    {
-      return(emptyVector())
-    }
-    else
-    {
-      return(c.integer64(sctid, ancestors))
-    }
+    return(c.integer64(sctid, transitiveclosure[subtypeId == sctid]$supertypeId))
   }
 }
 
 parentOf <- function(sctid)
 {
-  if(as.character(sctid) == "*")
+  if(length(sctid) == 0)
+  {
+    return(sctid)
+  }
+  else if(as.character(sctid) == "*")
   {
     return(nonLeafConcepts())
   }
   else
   {
-    parents <- isa[sourceId == sctid]$destinationId
-    if(length(parents) == 0)
-    {
-      return(emptyVector())
-    }
-    else
-    {
-      return(parents)
-    }
+    return(isa[sourceId == sctid]$destinationId)
   }
 }
 
 childOf <- function(sctid)
 {
-  if(as.character(sctid) == "*")
+  if(length(sctid) == 0)
+  {
+    return(sctid)
+  }
+  else if(as.character(sctid) == "*")
   {
     return(anyExceptRoot())
   }
   else
   {
-    children <- isa[destinationId == sctid]$sourceId
-    if(length(children) == 0)
-    {
-      return(emptyVector())
-    }
-    else
-    {
-      return(children)
-    }
+    return(isa[destinationId == sctid]$sourceId)
   }
 }
 
 # wildCard functions,for << *, > *, ... faster than selecting unique values in transitiveclosure
 any <- function()
 {
-  return(c.integer64(rootconcept,unique(isa$sourceId)))
+  return(all$sctid)
 }
 anyExceptRoot <- function()
 {
@@ -287,7 +271,6 @@ cardinalityHandler <- function(group, min, max, att, reverseFlag, grouped = FALS
     {
       ex_spec_att <- exclusion(con, att$sourceId) # all concepts that have attribute(s), but not the specified attribute
     }
-    #no_att <- exclusion(any(), con) # all concepts without attributes
     no_spec_att <- disjunction(ex_spec_att, no_att) # evertything that has not the specified attribute
     return(disjunction(no_spec_att, spec_att))
   }

R/eclParser.R

@@ -41,7 +41,6 @@ createParser <- function()
               parser.ast.callbacks[\"memberOf\"] = true;
               parser.ast.callbacks[\"conceptReference\"] = true;
               parser.ast.callbacks[\"conceptId\"] = true;
-              parser.ast.callbacks[\"term\"] = true;
               parser.ast.callbacks[\"wildCard\"] = true;
               parser.ast.callbacks[\"constraintOperator\"] = true;
               parser.ast.callbacks[\"descendantOf\"] = true;

R/read.R

@@ -10,7 +10,7 @@ readRel <- function(source)
   rel$typeId <- as.integer64(rel$typeId)
   rel$destinationId <- as.integer64(rel$destinationId)
   rel$characteristicTypeId <- as.integer64(rel$characteristicTypeId)
-  setkey(rel, sourceId, typeId, destinationId, relationshipGroup)
+  setkey(rel, typeId)
   return(rel)
 }
 
@@ -35,6 +35,6 @@ readTrans <- function(source)
   trans <- fread(source, colClasses = trans_cols, showProgress = FALSE)
   trans$subtypeId <- as.integer64(trans$subtypeId)
   trans$supertypeId <- as.integer64(trans$supertypeId)
-  setkey(trans, subtypeId, supertypeId)
+  setkey(trans, supertypeId, subtypeId)
   return(trans)
 }

R/snolyze.R

@@ -12,6 +12,7 @@ packagename <- "SnoLyze"
 # Speed up cardinality with minValue 0
 no_att <- NULL # concepts without attributs for 0 cardinality 25% faster
 con <- NULL # all unique concepts with attributes
+all <- NULL
 
 #' @export
 launch <- function(sourceRel, sourceTrans = NULL)
@@ -28,10 +29,11 @@ launch <- function(sourceRel, sourceTrans = NULL)
   unlockBinding("isa", env)
   unlockBinding("no_att", env)
   unlockBinding("con", env)
+  unlockBinding("all", env)
 
   rel <- tryCatch(readRel(sourceRel), error = function(e){stop("Relationship file is not RF2")})
   isa <<- typeRel(rel, FALSE)
-  setkey(isa, sourceId, destinationId)
+  setkey(isa, destinationId, sourceId)
 
   if(!is.null(sourceTrans))
   {
@@ -42,6 +44,9 @@ launch <- function(sourceRel, sourceTrans = NULL)
     transitiveclosure <<- createTC(copy(isa))
   }
   rel <<- typeRel(rel, TRUE)
+  all <<- data.table(c.integer64(rootconcept,unique(isa$sourceId)))
+  setnames(all, old = "V1", new = "sctid")
+  setkey(all, sctid)
   parser <<- createParser()
   con <<- unique(rel$sourceId)
   no_att <<- exclusion(any(), con)
@@ -52,6 +57,7 @@ launch <- function(sourceRel, sourceTrans = NULL)
   lockBinding("isa", env)
   lockBinding("con", env)
   lockBinding("no_att", env)
+  lockBinding("all", env)
 }
 
 #' @export
@@ -63,22 +69,8 @@ execute <- function(query)
   }
   if(validate(query))
   {
-    result <- eval(parse(text = getRcode()))
-    if(length(result) == 1) # check if concept exists, instead of checking it everytime in self()
-    {
-      if(result %in% transitiveclosure$subtypeId | result == rootconcept)
-      {
-        return(result)
-      }
-      else
-      {
-        return(emptyVector())
-      }
-    }
-    else
-    {
-      return(result)
-    }
+    return(eval(parse(text = getRcode())))
+
   }
   else
   {

R/transitiveClosure.R

@@ -24,6 +24,6 @@ createTC <- function(rel)
     setkey(dt, supertypeId)
     i <- nrow(a)
   }
-  setkey(dt, subtypeId, supertypeId, pathlength)
+  setkey(dt, supertypeId, subtypeId)
   return(unique(dt[,1:2]))
 }