Justify text in R

后端 未结 2 605
醉话见心
醉话见心 2020-12-11 08:07

How do you justify text in R? By justify I mean that each line in a paragraph is exactly the same length (like when you justify in open office or excel). I have tried to f

相关标签:
2条回答
  • 2020-12-11 08:16

    @jenesaisquoi - great solution! But I found it does not work if there is a paragraph break with a space or if strs <- strwrap(string, width=width) returns one or fewer elements.

    So, I found an improved version that first splits string by paragraph/line breaks and then applies the same logic:

            justify = function(string, width = getOption('width'), 
                               fill = c('random', 'right', 'left')) {
    
                            # Split text into paragraphs and remove trailing and leading white space. 
                            paragraphs = gsub("^\\s+|\\s+$", "", 
                            unlist(strsplit(x = string, split = "\n", fixed = TRUE)))
    
                            # NOTE: Empty elements are paragraphs break. 
                            paragraphs = paragraphs[nchar(paragraphs) > 0] 
    
                            formatted_text = lapply(paragraphs, function(paragraph){
                                                    strs = strwrap(paragraph, width = width)
                                                    paste(fill_spaces(strs, width, fill), collapse = "\n")
                                             })
    
                            paste0(unlist(formatted_text, recursive = FALSE), collapse = "\n")
             }
    
            fill_spaces = function(lines, width, fill) {
    
              tokens = strsplit(lines, '\\s+')
    
              res = lapply(head(tokens, -1L), function(x) {
                nspace = length(x) - 1L
                extra = width - sum(nchar(x)) - nspace
                reps = extra %/% nspace
                extra = extra %% nspace
                times = rep.int(if (reps > 0) reps + 1L else 1L, nspace)
                if (extra > 0) {
                  if (fill == 'right') times[1:extra] = times[1:extra] + 1L
                  else if (fill == 'left') 
                    times[(nspace - extra + 1L):nspace] = times[(nspace - extra + 1L):nspace] + 1L
                  else times[inds] = times[(inds <- sample(nspace, extra))] + 1L
                }
                spaces <- c('', unlist(lapply(times, formatC, x = ' ', digits = NULL)))
                paste(c(rbind(spaces, x)), collapse = '')
              })
              c(res, paste(tail(tokens, 1L)[[1]], collapse = ' '))
            }
    
            nchar_per_line = 50
            string = "Colin\'s practice outfits have reached a new level recently. It's difficult to determine the effect they are having on his teammates - whether they serve more as a distraction or a nice bit of comice releif, but it is clear they fuel Colin's fire and act as a motivator to him. \n\n                                  On another note, Colin's high fives per 36 have been through the roof recently. It really seems like something he's been focusing on in practice lately, as well as putting extra reps in at the gym. \n\n                                  Keep an eye out for Colin, could be an interesting 10 day pickup down the line."
            cat(justify(string, width = nchar_per_line))
    
    
    
        # Colin's practice outfits have reached  a new level
        # recently. It's difficult  to determine the  effect
        # they are  having on his teammates  -  whether they
        # serve  more  as a  distraction  or  a nice bit  of
        # comice releif, but  it  is clear they fuel Colin's
        # fire and act as a motivator to him.
        # On another note, Colin's  high  fives per 36  have
        # been  through  the roof recently. It  really seems
        # like  something he's been focusing on in  practice
        # lately,  as well  as putting extra reps in at  the
        # gym.
        # Keep   an   eye   out   for  Colin,  could  be  an
        # interesting 10 day pickup down the line.
    
    0 讨论(0)
  • 2020-12-11 08:29

    Well, if there is no built-in way this works well enough for my purposes. Thanks for the comments above about how to use html styling as well.

    justify <- function(string, width=getOption('width'), 
                        fill=c('random', 'right', 'left')) {
        strs <- strwrap(string, width=width)
        paste(fill_spaces(strs, width, match.arg(fill)), collapse="\n")
    }
    
    fill_spaces <- function(lines, width, fill) {
        tokens <- strsplit(lines, '\\s+')
        res <- lapply(head(tokens, -1L), function(x) {
            nspace <- length(x)-1L
            extra <- width - sum(nchar(x)) - nspace
            reps <- extra %/% nspace
            extra <- extra %% nspace
            times <- rep.int(if (reps>0) reps+1L else 1L, nspace)
            if (extra > 0) {
                if (fill=='right') times[1:extra] <- times[1:extra]+1L
                else if (fill=='left') 
                    times[(nspace-extra+1L):nspace] <- times[(nspace-extra+1L):nspace]+1L
                else times[inds] <- times[(inds <- sample(nspace, extra))]+1L
            }
            spaces <- c('', unlist(lapply(times, formatC, x=' ', digits=NULL)))
            paste(c(rbind(spaces, x)), collapse='')
        })
        c(res, paste(tail(tokens, 1L)[[1]], collapse = ' '))
    }
    
    cat(justify(string, width=40))
    # Out  of the night  that covers me, Black
    # as  the pit from  pole to pole, I  thank
    # whatever   gods    may    be   For    my
    # unconquerable soul. In  the fell  clutch
    # of  circumstance I have  not  winced nor
    # cried  aloud. Under the  bludgeonings of
    # chance My  head  is bloody, but unbow'd.
    # Beyond this  place  of  wrath and  tears
    # Looms but  the Horror of the  shade, And
    # yet  the menace of the years  Finds  and
    # shall  find me unafraid. It  matters not
    # how strait  the  gate,  How charged with
    # punishments the scroll,  I am the master
    # of  my fate:  I  am  the  captain  of my
    # soul.
    
    0 讨论(0)
提交回复
热议问题