R/autism_details.R

In vjcitn/ontoProc: processing of ontologies of anatomy, cell lines, and so on

#ex = "Stereotyped_Restricted_and_Repetitive_Behavior"
#ex2 = "Stereotyped_Restricted"

munge = function(z) {
  pda = function(x) paste(x, collapse=" ")
  if (length(z)>3) return(paste(pda(z[1:3]), "\\n", pda(z[-c(1:3)]), collapse="", sep=""))
  if (length(z)==1) return(z)
  paste(z[1], "\\n", z[-1], collapse="", sep="")
}

munge2 = function(z) {
  pda = function(x) paste(x, collapse=" ")
  if (length(z)>3) return(paste(pda(z[1:3]), " ", pda(z[-c(1:3)]), collapse="", sep=""))
  if (length(z)==1) return(z)
  paste(z[1], " ", z[-1], collapse="", sep="")
}

schk = function(x) {
  ss = strsplit(x, "_")
  unlist(lapply(ss, munge))
}

schk2 = function(x) {
  ss = strsplit(x, "_")
  unlist(lapply(ss, munge2))
}

#schk(c(ex, ex2))
# autism_details.R -- operations to work conveniently with an NCBO autism ontology called autism-merged.

# convert autism-rules.owl to json using robot
#library(jsonlite)
#library(graph)
#library(Rgraphviz)

#' extract class relationship graph from JSON representation of OWL
#' @importFrom jsonlite fromJSON
#' @import graph
#' @param jsonpath character(1) path to JSON, typically generated by java robot applied to owl
#' @param dropstrings character(), strings to be excised from class names
#' @return graphNEL with edgemode 'directed'
#' @examples
#' if (!requireNamespace("graph")) stop("install graph package from Bioconductor to use this function")
#' jpath = system.file("json", "aut.json.gz", package="ontoProc")
#' cg = jowl2classgraph(jpath,
#'   dropstrings = "http://purl.org/autism-ontology/1.0/autism-rules.owl#")
#' head(graph::nodes(cg))
#' @export
jowl2classgraph = function(jsonpath,
  dropstrings = c("http://www.ifomis.org/bfo/1.1/snap#", "http://purl.org/autism-ontology/1.0/autism-rules.owl#")) {
 aut1 = fromJSON(jsonpath)
 # extract class hierarchy
 nodedf  = (aut1[[1]]$nodes[[1]])  # this has lbl values for AUTISMC tags
 #iscl = which(nodedf$type == "CLASS")
# build map for AUTISMC entries
 needslab = grep("AUTISMC", nodedf$id)
 labmap = nodedf$lbl[needslab]
 names(labmap) = nodedf$id[needslab]
# end build
 edgedf  = (aut1[[1]]$edges[[1]])
 isas = which(edgedf$pred == "is_a")
 iedges = edgedf[isas,]
# remap AUTISMC entries
 edmc_sub = grep("AUTISMC", iedges$sub)
 iedges$sub[edmc_sub] = labmap[iedges$sub[edmc_sub]]
 edmc_obj = grep("AUTISMC", iedges$obj)
 iedges$obj[edmc_obj] = labmap[iedges$obj[edmc_obj]]
# end remap
 utoks = unique(c(iedges$sub, iedges$obj))
 # remove undesirable namespace prefixes (would be nice to stash them... when we design an object)
 cl = force  # default is to do nothing if no dropstrings given
 if (length(dropstrings)>0) {
     cl = function(x, dropstrings) {
       for (i in seq_len(length(dropstrings)))
          x = gsub(dropstrings[i], "", x)
       x
       }
    }
 # drop strings when used ... could be moved up in workstream
# following lines try to break long tags but fail 14 june 2025
 #autg = new("graphNEL", nodes=schk(cl(utoks, dropstrings)), edgemode="directed")
 #addEdge(schk(cl(iedges$obj, dropstrings)), schk(cl(iedges$sub, dropstrings)), autg)
 autg = new("graphNEL", nodes=schk2(cl(utoks, dropstrings)), edgemode="directed")
 addEdge(schk2(cl(iedges$obj, dropstrings)), schk2(cl(iedges$sub, dropstrings)), autg)
}

#debug(jowl2classgraph)

#cg = jowl2classgraph("aut.json",
#   dropstrings = "http://purl.org/autism-ontology/1.0/autism-rules.owl#")
#plot(cg)


pad2 = function (x, targ = 13) 
{
    ans = rep(NA_character_, targ)
    ans[seq_len(length(x))] = x
    ans
}


#evec = grep("span\\#|snap\\#", nodes(cg), value=TRUE)

#' produce list of vectors of (shortest) paths from root to all nodes in gr
#' @importFrom RBGL sp.between
#' @param gr graphNEL (package graph) instance representing an ontology
#' @param root character(1) node from which to produce paths
#' @param excise character() or NULL, path steps to exclude
#' @examples
#' if (!requireNamespace("graph")) stop("install graph package from Bioconductor to use this function")
#' jpath = system.file("json", "aut.json.gz", package="ontoProc")
#' cg = jowl2classgraph(jpath,
#'   dropstrings = "http://purl.org/autism-ontology/1.0/autism-rules.owl#")
#' evec = grep("span\\#|snap\\#", graph::nodes(cg), value=TRUE)
#' paths = graph2paths(cg, excise=evec)
#' tail(paths)
#' @export
graph2paths = function(gr, root="http://www.ifomis.org/bfo/1.1#Entity",
   excise=NULL) {
   op = lapply(graph::nodes(gr), function(x) RBGL::sp.between(gr, root, x)[[1]]$path_detail)
   if (!is.null(excise))
     op = lapply(op, function(x) setdiff(x, excise))
   op
}

#op = lapply(nodes(cg), function(x) sp.between(cg, "http://www.ifomis.org/bfo/1.1#Entity", x)[[1]]$path_detail)
 
#op = graph2paths(cg, excise=evec)

#zzz = op
#
#library(d3Tree)
#
#
#do.call(rbind, lapply(zzz, pad2)) -> padded
#ddd = as.data.frame(padded)
#
#
#  d3tree(list(
#        root = (abc <<- df2tree(
#                 rootname = 'lit',
#                 struct = ddd)),
#        layout = 'collapse'), width="100%"
#      )
#