R/plotQuote.R

In stm: Estimation of the Structural Topic Model

#' Plots strings
#' 
#' Plots strings to a blank canvas.  Used primarily for plotting quotes
#' generated by \code{\link{findThoughts}}.
#' 
#' A simple function which wraps sentences at \code{width} characters per line
#' and plots the results.
#' 
#' @param sentences Vector of sentence to plot.
#' @param width Number of characters in each line.
#' @param text.cex Sets the size of the text
#' @param maxwidth Sets the maximum character width of the plotted responses
#' rounding to the nearest word.  Note that this may perform somewhat
#' unexpectedly for very small numbers.
#' @param main Title of plot.
#' @param xlab Sets an x-axis label
#' @param ylab Set a y-axis label
#' @param xlim Sets the x-range of the plot.
#' @param ylim Sets the y-range of the plot
#' @param ...  Other parameters passed to the plot function
#' @seealso \code{\link{findThoughts}}
#' @examples
#' \donttest{
#' 
#' thoughts <- findThoughts(gadarianFit,texts=gadarian$open.ended.response,
#' topics=c(1), n=3)$docs[[1]]
#' plotQuote(thoughts)
#' }
#' @export
plotQuote <- function(sentences, width=30, text.cex=1, maxwidth=NULL,
                      main=NULL, xlab="", ylab="", xlim=NULL, ylim=NULL, ...) {
  xaxt <- "n"
  yaxt <- "n"
  numlines <- c()
  out <- list()

  for(j in 1:length(sentences)){
    sentence <- sentences[j]
    if(!is.null(maxwidth)) {
      sentence <- strwrap(sentence, width=maxwidth)[1]
    }
    out[[j]] <- stringr::str_wrap(sentence, width)
    numlines[j] <- length(strsplit(out[[j]], "\n")[[1]])
  }
  
  if(is.null(xlim)) xlim <- c(0, 5)
  if(is.null(ylim)) ylim<-c(0,.5*sum(numlines))
  plot(c(0,0),type="n", xlim=xlim, ylim=ylim, xaxt=xaxt, yaxt=yaxt, xlab=xlab, ylab=ylab, main=main, ...)
  numlines <- c(0, rev(numlines))
  out <- rev(out)
  start <- 0
  for(j in 2:(length(out)+1)){
    text(2.5, start + numlines[j-1]/4 + numlines[j]/4, out[[j-1]], cex=text.cex)
    start <- start + numlines[j-1]/4 + numlines[j]/4 
    if(j!=1 & j!=(length(out)+1)) lines(c(0,5), c(sum(numlines[1:j-1])/2 + numlines[j]/2, sum(numlines[1:j-1])/2 + numlines[j]/2), lty=2)
  }
}