iramuteq.org Git - iramuteq/blob - Rlib/textometrieR/R/repartition.R

   1 `printrepartition` <-function(positions, names, colors, styles, widths, corpusname, Xmin, T, doCumulative, structurepositions, strutnames, graphtitle, bande) {
   2         options(scipen=1000)
   3
   4         linestyle = 1
   5         linewidth = 1
   6
   7                 if (length(positions) > length(colors)) stop("colors list size too small");
   8                 if (length(positions) > length(names)) stop("names list size too small");
   9                 if (length(positions) > length(styles)) stop("styles list size too small");
  10                 if (length(positions) > length(widths)) stop("widths list size too small");
  11
  12         # if (length(structurepositions) > length(strutnames)) stop("structure names list size too small");
  13
  14         doCumu <- (doCumulative == "true")
  15
  16         maxX = T
  17         maxY = 0
  18         draw = 0
  19
  20         # set maxX and maxY the ranges
  21         if(!doCumu)
  22         {
  23                 for(i in 1:length(names))
  24                 {
  25                         x = positions[[i]]
  26                                       if(length(x) > 0)
  27                                       {
  28                                           d = density(x, bw=bande)
  29                                           m = max(d[["y"]])
  30                                           if(maxY < m)
  31                                                   maxY <- m
  32                                       }
  33                 }
  34                 maxY=2*maxY
  35         }
  36         else
  37         {
  38                 for(i in 1:length(names))
  39                 {
  40                         my <- length(positions[[i]])
  41                         if(maxY < my)
  42                                 maxY <- my
  43                 }
  44         }
  45
  46         # draw curves
  47         for(i in 1:length(names))
  48         {
  49                 #line styles and width update
  50                 linestyle = linestyle + 1
  51                 if(linestyle >= 6)
  52                 {
  53                         linestyle = 1
  54                         linewidth = linewidth+ 1
  55                 }
  56                 x = positions[[i]]
  57                               if(length(x) > 0)
  58                               {
  59                                   y = 1:length(x)
  60
  61                                   y <- c( c(0), y , c(y[[length(x)]]) )
  62                                   x <- c( c(x[[1]]), x , c(maxX) )
  63
  64                                   if(draw == 0)# first draw
  65                                   {
  66                                           if(doCumu)
  67                                           {
  68
  69 plot(x, y, type="s", xlab=paste("T = ", maxX), main = graphtitle, ylab="Occurrences", ylim=c(0, maxY), xlim=c(Xmin, maxX), pch=15, col=colors[i], lty=styles[i], lwd=widths[i], xaxs="i", yaxs="i")
  70                                           }
  71                                           else
  72                                           {
  73 plot(density(x, bw=bande), type="l", xlab=paste("T = ", maxX), graphtitle, ylab="Density", ylim=c(0, maxY), xlim=c(Xmin, maxX), pch=15, col=colors[i], lty=styles[i], lwd=widths[i], xaxs="i", yaxs="i")
  74                                           }
  75                                   }
  76                                   else #next draws
  77                                   {
  78                                           if(doCumu)
  79                                           {
  80 points(x, y, type="s", pch=15, col=colors[i], lty=styles[i], lwd=widths[i])
  81                                           }
  82                                           else
  83                                           {
  84 points(density(x, bw=bande), type="l", pch=15, col=colors[i], lty=styles[i], lwd=widths[i])
  85                                           }
  86                                   }
  87                                   rm(y)
  88                                   draw <- draw + 1
  89                               }
  90         }
  91
  92         # draw legend
  93         for(i in 1:length(names))
  94                 names[i] = paste(names[i], length(positions[[i]]))
  95
  96         if(draw > 0)
  97                 legend("topleft", names, inset = .02, col = colors, lty=styles, lwd=widths)
  98
  99         # draw hist of struct
 100         y = c()
 101         if(length(structurepositions) > 0)
 102         {
 103                 for(i in 1:length(structurepositions))
 104                 {
 105                         y[i] <- maxY
 106                         text(structurepositions[[i]], maxY*0.70, strutnames[[i]], cex = .8, srt=-90, adj = c(0,0))
 107                 }
 108                 points(structurepositions, y, type="h", ylim=c(0, maxY), xlim=c(Xmin, maxX))
 109         }
 110 }
 111