R：使用特定文本解析嵌套括号

我对R编程比较陌生，但有一个关于从语法解析的历史语言语料库中提取文本的具体问题。这个问题应该很容易解决，但我就是想不起来。我的问题基本上是这个问题的一个更具体的变体：

我想解析R中的嵌套括号。以下是一些数据的示例：

(sometext(NP-SBJ(D+N_THYSTORYE)(PP(P_OF)(NP(NPR_REYNARD)(NP-PRN(D_THE)(N_FOXE)))))sometext)

从这个字符串中，我想提取所有可能以NP开头的嵌套子字符串，因此结果应该是

(NP-SBJ(D+N_THYSTORYE)(PP(P_OF)(NP(NPR_REYNARD)(NP-PRN(D_THE)(N_FOXE)))))

(NP(NPR_REYNARD)(NP-PRN(D_THE)(N_FOXE)))

(NPR_REYNARD)

(NP-PRN(D_THE)(N_FOXE))

---

任何帮助都将不胜感激

这可能不是最有效的，但这里有一个函数可以提取匹配的父项之间的标记或字符串

find_tokens <- function(s) {
  stopifnot(length(s)==1)
  mm <- gregexpr("[)()]", s)
  stack <- numeric()
  starts <- numeric()
  stops <- numeric()
  Map(function(i, v) {
    if(v=="(") {
      stack <<- c(stack, i)
    } else if (v==")") {
      starts <<- c(starts, tail(stack, 1))
      stops <<- c(stops, i)
      stack <<- stack[-length(stack)]
    }
  }, mm[[1]], regmatches(s, mm)[[1]])
  rev(substring(s, starts, stops))
}

下面是另一个可能的find_令牌实现，它可能更有效，可以更好地支持多个字符串作为列表

find_tokens <- function(s) {
  mm <- gregexpr("[)()]", s)
  vv <- regmatches(s, mm)
  extr <- function(x, mm, vv) {
    open_i <- 0
    shut_i <- 0
    open <- numeric(length(vv)/2)
    shut <- numeric(length(vv)/2)
    close <- numeric(length(vv)/2)
    for(i in seq_along(mm)) {
      if (vv[i]=="(") {
        open_i <- open_i + 1
        shut_i <- shut_i + 1
        open[open_i] <- mm[i]
        shut[shut_i] <- open_i
      } else if (vv[i]==")") {
        close[shut[shut_i]] <- mm[i]
        shut_i <- shut_i - 1
      }
    }
    substring(x, open, close)
  }
  unname(Map(extr, s, mm, vv))
}

find_tokens <- function(s) {
  mm <- gregexpr("[)()]", s)
  vv <- regmatches(s, mm)
  extr <- function(x, mm, vv) {
    open_i <- 0
    shut_i <- 0
    open <- numeric(length(vv)/2)
    shut <- numeric(length(vv)/2)
    close <- numeric(length(vv)/2)
    for(i in seq_along(mm)) {
      if (vv[i]=="(") {
        open_i <- open_i + 1
        shut_i <- shut_i + 1
        open[open_i] <- mm[i]
        shut[shut_i] <- open_i
      } else if (vv[i]==")") {
        close[shut[shut_i]] <- mm[i]
        shut_i <- shut_i - 1
      }
    }
    substring(x, open, close)
  }
  unname(Map(extr, s, mm, vv))
}

lapply(find_tokens(s), function(x) grep("^\\(NP", x, value=TRUE))