8

I am in need of a function that extracts any type of bracket ie (), [], {} and the information in between. I created it and get it to do what I want but I get an annoying warning that I don't really know what it means. I want the annoying warning to go away either by fixing what's wrong with my code or suppressing the warning. I attempted this with suppressWarnings() but it didn't work because I don't think I used it correctly.

This function uses regmatches and requires R version 2.14 or higher

Here's the function below and an example to reproduce the warning. Thank you for the help.

################
# THE FUNCTION #
################
bracketXtract <- function(text, bracket = "all", include.bracket = TRUE) {

    bracketExtract <- if (include.bracket == FALSE) {
        function(Text, bracket) {
                  switch(bracket, 
                        square = lapply(Text, function(j) gsub("[\\[\\]]", "", 
                                 regmatches(j, gregexpr("\\[.*?\\]", j))[[1]], 
                                 perl = TRUE)), 
                        round =  lapply(Text, function(j) gsub("[\\(\\)]", "", 
                                 regmatches(j, gregexpr("\\(.*?\\)", j))[[1]])), 
                        curly =  lapply(Text, function(j) gsub("[\\{\\}]", "", 
                                 regmatches(j, gregexpr("\\{.*?\\}", j))[[1]])), 
                        all =    { P1 <- lapply(Text, function(j) gsub("[\\[\\]]", "", 
                                         regmatches(j, gregexpr("\\[.*?\\]", j))[[1]], 
                                         perl = TRUE))
                                   P2 <- lapply(Text, function(j) gsub("[\\(\\)]", "", 
                                         regmatches(j, gregexpr("\\(.*?\\)", j))[[1]]))
                                   P3 <- lapply(Text, function(j) gsub("[\\{\\}]", "", 
                                         regmatches(j, gregexpr("\\{.*?\\}", j))[[1]]))
                    apply(cbind(P1, P2, P3), 1, function(x) rbind(as.vector(unlist(x))))
                })
        }
    } else {
        function(Text, bracket) {
                  switch(bracket, 
                         square = lapply(Text, function(j) regmatches(j, 
                                  gregexpr("\\[.*?\\]", j))[[1]]), 
                         round =  lapply(Text, function(j) regmatches(j, 
                                  gregexpr("\\(.*?\\)", j))[[1]]), 
                         curly =  lapply(Text, function(j) regmatches(j, 
                                  gregexpr("\\{.*?\\}", j))[[1]]), 
                         all =    { P1 <- lapply(Text, function(j) regmatches(j, 
                                          gregexpr("\\[.*?\\]", j))[[1]])
                                    P2 <- lapply(Text, function(j) regmatches(j, 
                                          gregexpr("\\(.*?\\)", j))[[1]])
                                    P3 <- lapply(Text, function(j) regmatches(j, 
                                          gregexpr("\\{.*?\\}", j))[[1]])
                apply(cbind(P1, P2, P3), 1, function(x) rbind(as.vector(unlist(x))))
            })
        }
    }
    if (length(text) == 1) {
        unlist(lapply(text, function(x) bracketExtract(Text = text,
            bracket = bracket)))
    } else {
        sapply(text, function(x) bracketExtract(Text = text, 
            bracket = bracket))
    }
} 

##################
# TESTING IT OUT #
##################
j <- "What kind of cheese isn't your cheese? {wonder} Nacho cheese! [groan] (Laugh)"                                                          
bracketXtract(j, 'round')
bracketXtract(j, 'round', include.bracket = FALSE)

examp2<-data.frame(var1=1:4)                                                                                                                               
examp2$text<-as.character(c("I love chicken [unintelligible]!", "Me too! (laughter) It's so good.[interupting]", 
             "Yep it's awesome {reading}.", "Agreed."))

#=================================#
# HERE"S WHERE THE WARNINGS COME: #
#=================================#                                                                                                                                                            
examp2$text2<-bracketXtract(examp2$text, 'round')                                                                                                  
   examp2
examp2$text2<-bracketXtract(examp2$text, 'all')                                                                                                  
   examp2
0

4 Answers 4

8

Maybe this function is a little more straight-forward? Or at least more compact.

bracketXtract <-
    function(txt, br = c("(", "[", "{", "all"), with=FALSE)
{
    br <- match.arg(br)
    left <-        # what pattern are we looking for on the left?
        if ("all" == br) "\\(|\\{|\\["
        else sprintf("\\%s", br)
    map <-         # what's the corresponding pattern on the right?
        c(`\\(`="\\)", `\\[`="\\]", `\\{`="\\}",
          `\\(|\\{|\\[`="\\)|\\}|\\]")
    fmt <-         # create the appropriate regular expression
        if (with) "(%s).*?(%s)"
        else "(?<=%s).*?(?=%s)"
    re <- sprintf(fmt, left, map[left])
    regmatches(txt, gregexpr(re, txt, perl=TRUE))    # do it!
}

No need to lapply; the regular expression functions are vectorized in that way. This fails with nested parentheses; likely regular expressions won't be a good solution if that's important. Here we are in action:

> txt <- c("I love chicken [unintelligible]!",
+          "Me too! (laughter) It's so good.[interupting]",
+          "Yep it's awesome {reading}.",
+          "Agreed.")
> bracketXtract(txt, "all")
[[1]]
[1] "unintelligible"

[[2]]
[1] "laughter"    "interupting"

[[3]]
[1] "reading"

[[4]]
character(0)

This fits without trouble into a data.frame.

> examp2 <- data.frame(var1=1:4)
> examp2$text <- c("I love chicken [unintelligible]!",
+                  "Me too! (laughter) It's so good.[interupting]",
+                  "Yep it's awesome {reading}.", "Agreed.")
> examp2$text2<-bracketXtract(examp2$text, 'all')
> examp2
  var1                                          text                 text2
1    1              I love chicken [unintelligible]!        unintelligible
2    2 Me too! (laughter) It's so good.[interupting] laughter, interupting
3    3                   Yep it's awesome {reading}.               reading
4    4                                       Agreed.                      

The warning you were seeing has to do with trying to stick a matrix into a data frame. I think the answer is "don't do that".

> df = data.frame(x=1:2)
> df$y = matrix(list(), 2, 2)
> df
  x    y
1 1 NULL
2 2 NULL
Warning message:
In format.data.frame(x, digits = digits, na.encode = FALSE) :
  corrupt data frame: columns will be truncated or padded with NAs
4
  • Thanks for the response. I'm away from my computer right now but am eager to try out your solution when I get home. Is there a way to apply it to a data frame and suppress the warning without wrapping the functikn? Commented Dec 24, 2011 at 0:38
  • Very Nice Martin. This looks great I think you just forgot one thing: the if(with==TRUE) you just have if(with). Am I correct that this was your intention? Commented Dec 24, 2011 at 2:35
  • 1
    Tyler if(with) is a lot nicer of a notation since with is just boolean anyway.
    – Dason
    Commented Dec 24, 2011 at 3:19
  • Didn't know you could do that. Commented Dec 24, 2011 at 16:03
4

My thought had been to make 6 (implicitly vectorized) helper functions, but I will be studying Martin's code instead, since he is much better at this than I:

rm.curlybkt.no <-function(x) gsub("(\\{).*(\\})", "\\1\\2", x, perl=TRUE)
rm.rndbkt.no <-  function(x) gsub("(\\().*(\\))", "\\1\\2", x, perl=TRUE)
rm.sqrbkt.no <-  function(x) gsub("(\\[).*(\\])", "\\1\\2", x, perl=TRUE)

rm.rndbkt.in <- function(x) gsub("\\(.*\\)", "", x)
rm.curlybkt.in <- function(x) gsub("\\{.*\\}", "", x)
rm.sqrbkt.in   <- function(x) gsub("\\[.*\\]", "", x)
1
  • thanks for your input. I think , as you point out, Martin's idea is a bit more straight forward. Commented Dec 24, 2011 at 2:37
3

Suppose that brackets are not nested and that we have this test data:

x <- c("a (bb) [ccc]{d}e", "x[a]y")

Then using strapply in gsubfn we have this two-line solution which first translates all parentheses and square brackets to brace brackets and then processes that:

library(gsubfn)    

xx <- chartr("[]()", "{}{}", x)
s <- strapply(xx, "{([^}]*)}", c)

The result of the above is the following list:

> s
[[1]]
[1] "bb"  "ccc" "d"  

[[2]]
[1] "a"
0

Give this a shot. I prefer the stringr package! :)

bracketXtract <- function(string, bracket = "all", include.bracket = TRUE){
  # Load stringr package
  require(stringr)

  # Regular expressions for your brackets
  rgx = list(square = "\\[\\w*\\]", curly  = "\\{\\w*\\}", round  = "\\(\\w*\\)")
  rgx['all'] = sprintf('(%s)|(%s)|(%s)', rgx$square, rgx$curly, rgx$round)

  # Ensure you have the correct bracket name
  stopifnot(bracket %in% names(rgx))

  # Find your matches
  matches = str_extract_all(string, pattern = rgx[[bracket]])[[1]]

  # Remove brackets from results if needed
  if(!include.bracket) 
    matches = sapply(matches, function(m) substr(m, 2, nchar(m)-1))

  unname(matches)
}



j <- "What kind of cheese isn't your cheese? {wonder} Nacho cheese! [groan] (Laugh)"  
bracketXtract(j)
# [1] "{wonder}" "[groan]"  "(Laugh)" 
bracketXtract(j, bracket = "square")
# [1] "[groan]"
bracketXtract(j, include.bracket = F)
# [1] "wonder" "groan"  "Laugh" 

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.