R/AllMethods.R

In utubun/keggr: KEGG API

# Methods for .KeggListOrganism class

setMethod(
  'KeggListOrganisms',
  '.KeggListOrganisms',
  function(x) {
    resp <- .kegg_list(database = 'organism')
    x@data     <- readr::read_tsv(
      httr::content(resp, as = 'text', encoding = 'utf-8'), # TODO take encoding from header
      col_names = FALSE
    ) |>
    setNames(nm = c('taxa', 'kid', 'name', 'phylo'))
    return(x)
  }
)


setMethod(
    'get_compounds',
    'KGML',
    function(x,...) {
        xml <- xml2::read_xml(x)
        ent <- xml2::xml_find_all(xml, './entry')
        ent <- ent[xml2::xml_attr(ent, 'type') == 'compound']

        data.table::rbindlist(lapply(ent, \(node) {
            as.list(xml2::xml_attrs(node))
        })
      )
    }
)

setMethod(
    'get_genes',
    'KGML',
    function(x,...) {
        xml <- xml2::read_xml(x)
        ent <- xml2::xml_find_all(xml, './entry')
        ent <- ent[xml2::xml_attr(ent, 'type') == 'gene']

        data.table::rbindlist(lapply(ent, \(node) {
            as.list(xml2::xml_attrs(node))
            })
        ) |>
        dplyr::mutate(name = stringr::str_split(name, '\\s+'))
    }
)

setMethod(
    'get_reactions',
    'KGML',
    function(x,...) {

        xml <- xml2::read_xml(x)

        rct <- xml2::xml_find_all(xml, './reaction')

        sbs <- lapply(
            rct,
            \(node) {
                ids <- xml2::xml_attr(node, 'id')
                lst <- xml2::xml_attrs(xml2::xml_find_all(node, 'substrate'))
                lst <- lapply(lst, as.list)
                lst <- data.table::rbindlist(lst)
                lst$reaction_id = ids
                lst
            }
        ) |>
        data.table::rbindlist(fill = TRUE)

        prd <- lapply(
            rct,
            \(node) {
                ids <- xml2::xml_attr(node, 'id')
                lst <- xml2::xml_attrs(xml2::xml_find_all(node, 'product'))
                lst <- lapply(lst, as.list)
                lst <- data.table::rbindlist(lst)
                lst$reaction_id = ids
                lst
            }
        ) |>
        data.table::rbindlist(fill = TRUE)

        rct <- data.table::rbindlist(lapply(rct, \(node) {
            as.list(xml2::xml_attrs(node))
            })
        )

        return(
            list(reaction = rct, substrate = sbs, product = prd)
        )
    }
)


setMethod(
    'get_relations',
    'KGML',
    function(x,...) {
        xml <- xml2::read_xml(x)
        ent <- xml2::xml_find_all(xml, './relation')
        #ent <- ent[xml2::xml_attr(ent, 'type') != 'maplink']

        data.table::rbindlist(lapply(ent, \(node) {
            as.list(xml2::xml_attrs(node))
        })
      ) |>
      setNames(c('from', 'to', 'type'))
    }
)

setMethod(
  'get_maps',
  'KGML',
  function(x,...) {
    xml <- xml2::read_xml(x)
    ent <- xml2::xml_find_all(xml, './entry')
    ent <- ent[xml2::xml_attr(ent, 'type') == 'map']

    data.table::rbindlist(lapply(ent, \(node) {
      as.list(xml2::xml_attrs(node))
    })
    )
  }
)

setMethod(
  'get_map_id',
  'KGML',
  function(x,...) {
    get_relations(x) |>
      dplyr::filter(type == 'maplink') |>
      dplyr::pull(to)
    }
)

setMethod(
  'expand_maps',
  'KGML',
  function(x,...) {

    URL = 'http://rest.kegg.jp/get/%s/kgml'

    ids <- get_maps(x) |>
      dplyr::pull('name') |>
      unique()

    ids <- gsub('path:', '', ids)

    lapply(ids, \(id) {httr::GET(sprintf(URL, id))})
  }
)

setMethod(
    'get_vertex_id',
    'KeggVertex',
    function(x, ...) {
        return(x@id)
    }
)

setMethod(
    'get_vertex_id',
    'KeggVertex',
    function(x, ...) {
        return(x@id)
    }
)

setMethod(
    'get_vertices',
    'KeggGraph',
    function(x, ...) {
        return(x@vertices)
    }
)

setMethod(
    'get_edges',
    'KeggGraph',
    function(x, ...) {
        return(x@edges)
    }
)

setMethod(
    'adjacency_matrix',
    'KeggGraph',
    function(x) {
        vertices_ids <- sapply(get_vertices(x), get_vertex_id)
        graph_edges  <-
        mat <- matrix(
            data = 0,
            ncol = length(vertices_ids),
            nrow = length(vertices_ids),
            dimnames = list(vertices_ids, vertices_ids)
        )
        return(mat)
    }
)