# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  word chops.r                                                                           #
  #           Last Updated Funclist  :  19 Feb 2015, 12:52 PM (Thursday)                                                       #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   chopAfterWord      ( string, words, maxLength=120, after.word=TRUE, ignore.case=FALSE, verbose=FALSE                     #
  #                        , split.lines=FALSE, C=NULL )                                                                       #
  #   chop               ( DT, vec, simplify=FALSE, add.nrow=TRUE )                                                            #
  #   chopLine           ( line, collapse="\n", width=88L, flex=15L, padding=0L, maxNumberOfBreaks=2L                          #
  #                        , dotsBeyondMax=FALSE, padToSecondSpace=FALSE, trimSpace=TRUE, showWarnings=TRUE                    #
  #                        , splitOn="\\s+", dropTrimmedSpace=TRUE )                                                           #
  #   cordl              ( ..., length=NULL, justSize=FALSE, crop=TRUE, chop=TRUE )                                            #
  #   paraLineChop       ( so, length=NULL, lines=NULL, justSize=FALSE )                                                       #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #


## chopAfterWord is the newer function
## The other functions are older.  May be good. not sure

chopAfterWord <- function(string, words, maxLength=120, after.word=TRUE, ignore.case=FALSE, verbose=FALSE, split.lines=FALSE, C=NULL) {
## split.lines :: if TRUE, first splits on "\n" 
## C :: if any value other than NULL, pasteC(..., C=C) will be called on the return value right before returning

  if (is.list(string))
    stop ("sting cannot be a list")

  ## if no string, or if it is less than 90% of the max, or if it is all blanks, return it as is
  if (!length(string) || (length(string) == 1 && nchar(string) < maxLength*.9) || all(nchar(string) == 0))
    return(string)

  ## if we are splitting lines, we do not want to accidentally paste them again, thus, we need some funky sign
  pat.endl <- "\\$\\^$" ## a very unlikely pattern that also will not add too much length.
  if (split.lines) {
    string <- gsub("\\n", "$^\\\n", string)
    string <- unlist(strsplit(string, "\\n"))
  }

  chopOn <- "@@@%%@@@"

  words <- words[sapply(words, function(x) any(grepl(x, string)), USE.NAMES=FALSE)]

  string.mod <- string
  for (word in words) {
    
    ## If we are chopping on punctuation, handle a little differently
    if (grepl("\\b", word)) {
      pat <- word
      repl <- ifelse(after.word, paste0(word, chopOn), paste0(chopOn, word))
    } else {
      pat  <- sprintf("(\\b)(%s)(\\b)", word)
      if (after.word)
        repl <- sprintf("\\1\\2%s\\3", chopOn)
      else 
        repl <- sprintf("\\1%s\\2\\3", chopOn)
    }

    string.mod <- gsub(pat, repl, string.mod, ignore.case=ignore.case)

    splat <- unlist(strsplit(string.mod, chopOn), use.names=FALSE)
    orig.splat <- splat
    for (j in c(2.5, 1.6, 1.2, 1)) {
      i <- 1
      while (i < length(splat)) {
        # verboseMsg(verbose, sprintf("j:%2.3f    i:% 3i   nchar(splat) = %-51s", j, i, pasteC(nchar(splat), C=",")), time=TRUE)
        if (sum(nchar(splat[c(i, i + 1)])) < maxLength/j && !grepl(pat.endl, splat[[i]]))
          splat <- 
                c(
                splat[0:max(0, (i-1))]
                , pasteC(splat[c(i, i + 1)], C="")
                , removeNA(splat[(i + 2):max(length(splat), i+2)])
                )
        else 
          i <- i + 1
      } # // for i
    } # // for j
    string.mod <- splat
  } # // for word


  ## Remove the funky pattern
  string.mod <- gsub(pat.endl, "", string.mod)

  ## if a value was given for 'C', then call pasteC on the return value, 
  ## However, first check that C is a valid string
  if (!is.null(C)) {
    if (!is.character(C))
      warning ("'C' should be a character -- will *NOT* pastteC() the results")
    else 
      string.mod <- pasteC(string.mod, C=C)
  }

  return(string.mod)
}


## THESE ARE OLDER FUNCTIONS


chop <- function(DT, vec, simplify=FALSE, add.nrow=TRUE) {
#  takes the results from makeIntervals(vec) and uses it to  
#   chop DT into a list of tables

  if (add.nrow)
    if (!(nrow(DT) %in% vec))
      vec <- c(vec, nrow(DT))

  indecies <- makeIntervals(vec, final=NULL)

  ret <- lapply(indecies, function(ind) DT[ind, ])

  if (simplify)
      return(rbindlist(ret))
  return(ret)
}


chopLine <- function(line, collapse="\n", width=88L, flex=15L
                              , padding=0L, maxNumberOfBreaks=2L, dotsBeyondMax=FALSE
                              , padToSecondSpace=FALSE
                              , trimSpace=TRUE
                              , showWarnings=TRUE
                              , splitOn="\\s+", dropTrimmedSpace=TRUE) {
## Takes a line of text and breaks it up into width
  if (!is.atomic(line) || length(line) > 1)
    stop ("`line` should be an atomic vector of length exactly 1.")

  if (!length(line) || nchar(line) < width)
    return(line)

  ## if the split value is not present within the range, return the original value
  if (!grepl(splitOn, substr(line, width-flex, width+flex))) {
    if (showWarnings) {
      warning("Could not find pattern '", splitOn, "' within the designated character range (", width , " +/- ", flex," chars)\n")
    }
    return(line)
  }

  if (padToSecondSpace) {
    if (is.character(padding)) {
          warning("`padding` given explicitly as a string, but `padToSecondSpace` is set to TRUE.\nThis will overwrite `padding`.")
          padding <- 0
      }
      # find the first letter of the second word. Then go back one space from there. (We want the END of the second space)
      secondspace <- attr(regexpr("(\\s*)([^\\s]+)(\\s+)([^\\s])", line, perl=TRUE), "match.length")[[1]] - 1
      padding <- max(secondspace, padding)
  }

  if (is.numeric(padding))
    padding <- pasteR(" ", padding)

  ## NOTE dont pre allocate. Otherwise would then need to check for blank lines.
  ret <- line

  # dont chop if maxNumberOfBreaks==0
  if (maxNumberOfBreaks)
    for (i in seq.int(maxNumberOfBreaks)) {
      ## only continue if enough chars
      if (nchar(ret[[i]]) < width + (.6*flex))
        break

      spaces <- findCharBetween(ret[[i]], char.to.find=splitOn, from=width-(3*flex), to=width+(4*flex))
      if (!length(spaces))
        bk <- width
      else 
        bk <- spaces[which.min(abs(spaces - width))]
      current <- substr(ret[[i]], 1, bk-1)
      pushIt   <- ifelse(dropTrimmedSpace && splitOn=="\\s+", 1, 0)  # if not splitting on space, do not remove it
      new     <- substr(ret[[i]], bk+pushIt, nchar(ret[[i]]))

      # add a hyphen if mid-work break
      if (!length(spaces))
        current <- paste0(current, "-")

      # clean whitespace
      if (trimSpace)
        new <- gsub("^\\s+", "", new)

      ret[[i]]   <- current
      ret[[i+1]] <- paste0(padding, new)
    }

  ## add dots
  L <- length(ret)
  if (dotsBeyondMax && nchar(ret[[L]]) > width) {
    ret[[L]] <- paste0(substr(ret[[L]], 1, width-3), " ...")
  }

  return(paste(ret, collapse=collapse))
}


### ----------------- paraLineChop & cordl --------------------------- #####

cordl <- function(..., length=NULL, justSize=FALSE, crop=TRUE, chop=TRUE)  {
  # Capture Output, Remove Duplicate Lines, wrapper function.
  # Will run paraLineChop unless either of crop or chop are FALSE 
  #  crop and chop serve the same purpose.  Allowing for synonyms 
  #  for forgetful programmers. 

  ret <- rmDupLines(capture.output(eval(substitute(...))))

  if (!crop)
    return(ret)

  return(paraLineChop(ret, length=length, justSize=justSize))
}


paraLineChop <- function(so, length=NULL, lines=NULL, justSize=FALSE) {
# chops up the lines in a capture.ouput paragraph to length
# so is some output from capture.output
#
# if justSize, then will output value of chop and how many lines will be chopped

    # if user provided a length, use that. Else calculate it as a weighted average
    if (!is.null(length)) {
        chop <- length
        feather <- 0
    } else {
        feather <- 5
        lngs <- sort(nchar(so))
        lngs <- lngs[!lngs == 0]
        
        # we want to trim, but only if there is something to tirm
        L <- length(lngs)
        trm <- ceiling(max(1, .15*L, .08*L))

        weigtd <- mean(lngs[-(1:trm)])
        chop <- round(mean(c(lngs[L-trm], mean(lngs[-(1:trm)])))) + 6
    }

    # if no value for chop determined
    if (is.na(chop)) {
        warning("couldnt chop")
        return(so)
    }

    # determine which lines need cropping
    lines <- nchar(so) > chop 

    if (justSize)
        return (c(lines=sum(lines), chop=chop))

    # if there are no lines to crop, return the thing now
    if(!any(lines))
        return(so)

    matches <- regexpr(" ", substr(so[lines], chop-11, chop+feather))
    
    # TODO:  Deal with NA by chopping at chop-1, then adding a hyphon
    matches[matches<0] <- NA

    # Mark the specific spot in each line where the chop will happen    
    markers <- chop-11 + matches

    # 2nd Halfs
    sublines <- substr(so[lines], markers, nchar(so[lines]))

    # add some tabs
    sublines[nchar(sublines) < (chop - 8)] <- paste0(tbs(2), sublines[nchar(sublines) < (chop - 8)])
    sublines[nchar(sublines) < (chop - 4)] <- paste0(tbs(1), sublines[nchar(sublines) < (chop - 4)])

    # 1st Halfs
    so[lines] <- substr(so[lines], 1, markers-1)

    numbLines <- length(sublines)
    for (j in seq(numbLines)) {

        antij <- numbLines - j +1
        i <- which(lines)[[antij]]
        tail <- seq(i+1, length(so))

        # error prevention for the last line, so that we dont have leng:(leng+1)
        if (i == length(so))
            tail <- i

        so[tail+1] <- so[tail]
        so[i+1]    <- sublines[[antij]] 
    }

    # if any long lines remain, recurse
    if (any(nchar(so) > chop))
        return(paraLineChop(so, length=chop))
    
    return(so)
}