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

   1 #* Copyright © - 2008-2013 ANR Textométrie - http://textometrie.ens-lyon.fr
   2 #*
   3 #* This file is part of the TXM platform.
   4 #*
   5 #* The TXM platform is free software: you can redistribute it and/or modif y
   6 #* it under the terms of the GNU General Public License as published by
   7 #* the Free Software Foundation, either version 3 of the License, or
   8 #* (at your option) any later version.
   9 #*
  10 #* The TXM platform is distributed in the hope that it will be useful,
  11 #* but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13 #* General Public License for more details.
  14 #*
  15 #* You should have received a copy of the GNU General Public License
  16 #* along with the TXM platform.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 `printrepartition` <-function(positions, names, colors, styles, widths, corpusname, Xmin, T, doCumulative, structurepositions, strutnames, graphtitle, bande) {
  19         options(scipen=1000)
  20
  21         linestyle = 1
  22         linewidth = 1
  23
  24                 if (length(positions) > length(colors)) stop("colors list size too small");
  25                 if (length(positions) > length(names)) stop("names list size too small");
  26                 if (length(positions) > length(styles)) stop("styles list size too small");
  27                 if (length(positions) > length(widths)) stop("widths list size too small");
  28
  29         # if (length(structurepositions) > length(strutnames)) stop("structure names list size too small");
  30
  31         doCumu <- (doCumulative == "true")
  32
  33         maxX = T
  34         maxY = 0
  35         draw = 0
  36
  37         # set maxX and maxY the ranges
  38         if(!doCumu)
  39         {
  40                 for(i in 1:length(names))
  41                 {
  42                         x = positions[[i]]
  43                         if(length(x) > 0)
  44                         {
  45                                 d = density(x, bw=bande)
  46                                 m = max(d[["y"]])
  47                                 if(maxY < m)
  48                                         maxY <- m
  49                         }
  50                 }
  51                 maxY=2*maxY
  52         }
  53         else
  54         {
  55                 for(i in 1:length(names))
  56                 {
  57                         my <- length(positions[[i]])
  58                         if(maxY < my)
  59                                 maxY <- my
  60                 }
  61         }
  62
  63         # draw curves
  64         for(i in 1:length(names))
  65         {
  66                 #line styles and width update
  67                 linestyle = linestyle + 1
  68                 if(linestyle >= 6)
  69                 {
  70                         linestyle = 1
  71                         linewidth = linewidth+ 1
  72                 }
  73                 x = positions[[i]]
  74                               if(length(x) > 0)
  75                               {
  76                                   y = 1:length(x)
  77
  78                                   y <- c( c(0), y , c(y[[length(x)]]) )
  79                                   x <- c( c(x[[1]]), x , c(maxX) )
  80
  81                                   if(draw == 0)# first draw
  82                                   {
  83                                           if(doCumu)
  84                                           {
  85
  86 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")
  87                                           }
  88                                           else
  89                                           {
  90 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")
  91                                           }
  92                                   }
  93                                   else #next draws
  94                                   {
  95                                           if(doCumu)
  96                                           {
  97 points(x, y, type="s", pch=15, col=colors[i], lty=styles[i], lwd=widths[i])
  98                                           }
  99                                           else
 100                                           {
 101 points(density(x, bw=bande), type="l", pch=15, col=colors[i], lty=styles[i], lwd=widths[i])
 102                                           }
 103                                   }
 104                                   rm(y)
 105                                   draw <- draw + 1
 106                               }
 107         }
 108
 109         # draw legend
 110         for(i in 1:length(names))
 111                 names[i] = paste(names[i], length(positions[[i]]))
 112
 113         if(draw > 0)
 114                 legend("topleft", names, inset = .02, col = colors, lty=styles, lwd=widths)
 115
 116         # draw hist of struct
 117         y = c()
 118         if(length(structurepositions) > 0)
 119         {
 120                 for(i in 1:length(structurepositions))
 121                 {
 122                         y[i] <- maxY
 123                         text(structurepositions[[i]], maxY*0.70, strutnames[[i]], cex = .8, srt=-90, adj = c(0,0))
 124                 }
 125                 points(structurepositions, y, type="h", ylim=c(0, maxY), xlim=c(Xmin, maxX))
 126         }
 127 }
 128