Não foi possível enviar o arquivo. Será algum problema com as permissões?
Diferenças

Diferenças

Aqui você vê as diferenças entre duas revisões dessa página.

Link para esta página de comparações

Ambos lados da revisão anterior Revisão anterior
Próxima revisão
Revisão anterior
pessoais:jcfaria [2007/03/01 11:47]
jcfaria
pessoais:jcfaria [2012/08/01 19:25] (atual)
jcfaria
Linha 1: Linha 1:
-====== ​Página WIKI de José Cláudio Faria ======+====== José Cláudio Faria ======
  
-{{pessoais:​i_in_the_beach_2007.png|125X210}}+{{  pessoais:​i_in_the_beach_2007.png}}
  
-Na Praia do Sul de Ilhéus/Bahia (janeiro de 2007refletindo profundamente sobre o R!!!+Eu na Praia do Sul de Ilhéus/BA, em janeiro de 2007refletindo profundamente sobre estatística computacional e o R!!! 
 + 
 +Brincadeiras a parte... 
 + 
 +**1. Quem sou** 
 + 
 +- Engenheiro Agrônomo 
 +- Mestrado e Doutorado em Produção Vegetal pela Universidade Federal de Viçosa - UFV/MG 
 +- Pós-doc em estatística e experimentação agronômica (ESALQ) 
 + 
 + 
 +**2. O que tenho feito profissionalmente** 
 + 
 +- Professor de estatística e pesquisador da Universidade Estadual de Santa Cruz - UESC/BA; 
 + 
 +- Tenho estado desenvolvendo algumas soluções computacionais voltadas para o ambiente R: 
 +  - Editores: 
 +    - Tinn-R ([[http://​sourceforge.net/​projects/​tinn-r/​]]) 
 +    - Vim-R-plugin ([[http://​www.vim.org/​scripts/​script.php?​script_id=2628]]) 
 +  - Pacotes: 
 +    - bpca ([[http://​cran.r-project.org/​web/​packages/​bpca/​index.html]]) 
 +    - TinnR ([[http://​cran.r-project.org/​web/​packages/​TinnR/​index.html]]) 
 +    - fdth ([[http://​cran.r-project.org/​web/​packages/​fdth/​index.html]]) 
 +    - ScottKnott ([[http://​cran.r-project.org/​web/​packages/​ScottKnott/​index.html]]) 
 +    - TukeyC ([[http://​cran.r-project.org/​web/​packages/​TukeyC/​index.html]]) 
 + 
 + 
 +**3. Sobre o R** 
 + 
 +- Gostaria de tê-lo encontrado desde o início de minha carreira na área de estatística computacional! 
 + 
 + 
 +**4. Sobre o futuro** 
 + 
 +- Desejo aprofundar os conhecimentos em análise multivariada de dados no ambiente R; 
 + 
 +- Trocar experiências com pessoas e equipes envolvidas nestas áreas.
  
 ===== Tinn-R ===== ===== Tinn-R =====
Linha 563: Linha 599:
  
 ==== Funções úteis ==== ==== Funções úteis ====
-=== Tabelas e histogramas ​=== +=== Superfície de resposta ​=== 
-== Função ​tb.table ​==+== Função ​plotlm3d ​== 
 +The simple, power and very flexible function **plotlm3d** enables you to plot 3d points and/or surfaces obtained from linear methods. It was adapted from scatter3d [[http://​socserv.socsci.mcmaster.ca/​jfox/​Misc/​Rcmdr/​index.html | Rcmdr package]] of John Fox and some [[ http://​www.stat.wisc.edu/​~deepayan | Deepayan Sarkar]] ideas.
  
-Função simples, flexível mas poderosa para descrever, via tabela de distribuição de freqüências e histogramas,​ vetores e data.frames.+It requires the **rgl** package that you can download from [[http://​cran.r-project.org|CRAN]].
  
 <​code>​ <​code>​
 #​=============================================================================== #​===============================================================================
-# Name           : ​tb.table +# Name           : ​plotlm3d 
-# Original author: ​José Cláudio ​Faria, Gabor Gothendievisk ​and Enio Jelihovschi +# Original author: ​John Fox (scatter3d from package Rcmdr) 
-# Date (dd/​mm/​yy): ​1/3/07 11:06:02 +# Changes ​       : Jose Claudio ​Faria and Duncan Murdoch 
-# Version ​       : v24 +# Date (dd/​mm/​yy): ​12/8/06 19:44:37 
-# Aim            : To make tables of frequency distribution and associated +# Version ​       : v18 
-#                  histogram+# Aim            : To plot 3d scatter, an or, surfaces with rgl package
 #​=============================================================================== #​===============================================================================
 + 
 # Arguments: # Arguments:
-breaks ​        : Method to determine number ​of classes= c('​Sturges',​ '​Scott',​ '​FD'​+x                 ​variable for horizontal axis. 
-by             ​: Variable ​to group +# y                 ​variable for out-of-screen axis. 
-end            : Last class (high value+# z                 ​variable for vertical axis (response). 
-h              : Classes extent +surface ​          plot surface(s) (TRUE or FALSE). 
-k              : Class number +# model             ​one or more linear model to fit ('z ~ x + y' is the default). 
-right          : Intervals right open (default = FALSE) +groups ​           if NULL (the default), no groups are defined; if a factor, 
-start          : First class (small value+                  a different surface or set of surfaces is plotted for each 
-x              : A R object ​(vector ​or data.frame+                  level of the factor; in this event, the colours in plane.col 
-histogram ​     : Plot histogram ​(default = TRUE) +                  are used successively for the points and surfaces. 
-title.histogram: Title of histogram c('​auto'​'​none'​+# model.by.group ​   if TRUE the function will adjust one model for each level 
-#​=============================================================================== +#                   of groups; the order of the models must be the same of the 
- +#                   level of the. 
-# Common functions +# model.summary ​    print summary or summaries of the model(s) fit (TRUE or FALSE). 
-tb.make.table.I <- function(x+simple.axes ​      ​whether to draw sinple axes (TRUE or FALSE). 
-                            start+box               ​whether to draw a box (TRUE or FALSE). 
-                            end+# xlab,            
-                            h+# ylab,            
-                            right+# zlab              axis labels. 
-                            ​histogram+# surface.col ​      ​vector of colours for regression planes, used in the order 
-                            ​titleH)+#                   ​specified by fit. 
 +# point.col ​        ​colour of points. 
 +# grid.col ​         colour of grid lines on the regression surface(s). 
 +grid             plot grid lines on the regression surface(s) ​(TRUE or FALSE). 
 +grid.lines        number ​of lines (default26forming the grid, in each of 
 +                  the x and z directions. 
 +# sphere.factor ​    ​relative size factor of spheres representing points; the 
 +#                   ​default size is dependent on the scale of observations. 
 +# threshold ​        if the actual size of the spheres is less than the threshold,​ 
 +#                   ​points are plotted instead. 
 +# speed             ​revolutions of the plot per second. 
 +# revolutions ​      ​number of full revolutions of the display. 
 +  
 +plotlm3d <- function (x, y, z, 
 +                      surface ​       ​T, 
 +                      model          ​'z ~ x + y', 
 +                      groups ​        NULL, 
 +                      model.by.group ​F, 
 +                      model.summary  ​F, 
 +                      simple.axes ​   ​T, 
 +                      box            ​F, 
 +                      xlab           deparse(substitute(x)),​ 
 +                      ylab           deparse(substitute(y)),​ 
 +                      zlab           deparse(substitute(z)),​ 
 +                      surface.col ​   ​c('​blue',​ '​orange',​ '​red',​ '​green',​ 
 +                                         '​magenta',​ '​cyan',​ '​yellow',​ '​gray',​ '​brown'​),​ 
 +                      ​point.col ​     = '​yellow',​ 
 +                      grid.col       = material3d("​color"​)
 +                      ​grid ​          = T
 +                      ​grid.lines ​    = 26
 +                      ​sphere.factor ​ = 1
 +                      ​threshold ​     = 0.01
 +                      ​speed ​         = 0.5
 +                      ​revolutions ​   = 0)
 { {
-  ​f    <- table(cut(x,​ br=seq(start, end, h), right=right)) # Absolut freq +  ​require(rgl
-  ​fr   <- f/length(x                                      # Relative freq +  ​require(mgcv
-  ​frP  ​<- 100*(f/​length(x))                                 # Relative freq, % +  ​summaries ​<- list() 
-  ​fac  <- cumsum(f                                        # Cumulative freq +  
-  facP <- 100*(cumsum(f/length(x)))                         # Cumulative freq, % +  ​if ((!is.null(groups)) && model.by.group
-  ​fi ​  <- round(f, 2+    ​if ​(!nlevels(groups) == length(model)) 
-  ​fr   <- round(as.numeric(fr), 2) +      stop('Model number is different of the number of groups'​) 
-  frP  <- round(as.numeric(frP), 2) +  
-  fac  <- round(as.numeric(fac), 2+  ​if ((!is.null(groups)) && ​(nlevels(groups> length(surface.col))
-  ​facP <- round(as.numeric(facP),2) +    stop('​Number of groups exceeds number of colors'​) 
-  res  <- data.frame(fi, fr, frP, fac, facP               # Make final table +  
-  ​names(res) <- c('Class limits',​ '​fi',​ '​fr',​ '​fr(%)',​ '​fac',​ '​fac(%)')+  ​if ((!is.null(groups)) && (!is.factor(groups))
 +    stop('groups variable must be a factor.') 
 +  
 +  xlab; ylab; zlab
  
-  ​# Making the histogram: With Benilton suggestions +  ​valid <- if (is.null(groups)
-  ​if (histogram{ +    ​complete.cases(x, y, z) 
-    ​hist(x, +  ​else 
-         breaks = seq(startendh)+    complete.cases(xyzgroups) 
-         freq   = T, +  
-         right  = right, +  ​x <- x[valid] 
-         xlab   = 'Class limits',​ ylab='​Frequency',​ +  y <- y[valid] 
-         col    = '​LightYellow',​ +  z <- z[valid] 
-         main   = titleH, +   
-         xlim   = c(start, end), ylim=c(0max(fi)), +  if (!is.null(groups)) 
-         las    ​= ​1, +    ​groups <- groups[valid] 
-         ​xaxt ​  '​n'​+  
-    ​axis(1at=round(seq(startendh), 2))+  levs <- levels(groups) 
 +  size <- max(c(x,y,z))/100 * sphere.factor 
 +  
 +  if (is.null(groups)) { 
 +    ​if (size > threshold) 
 +      spheres3d(x,​ y, z, color point.colradius ​size
 +    ​else 
 +      points3d(xyzcolor = point.col)
   }   }
-  return(res) 
-} 
- 
-tb.make.table.II <- function (x, 
-                              k, 
-                              breaks=c('​Sturges',​ '​Scott',​ '​FD'​),​ 
-                              right=FALSE,​ 
-                              histogram, 
-                              titleH) 
-{ 
-  x <- na.omit(x) 
- 
-  # User defines only x and/or '​breaks'​ 
-  # (x, {k,​}[breaks,​ right]) 
-  if (missing(k)) { 
-    brk   <- match.arg(breaks) 
-    switch(brk, 
-           ​Sturges = k <- nclass.Sturges(x),​ 
-           ​Scott ​  = k <- nclass.scott(x),​ 
-           ​FD ​     = k <- nclass.FD(x)) 
-    tmp   <- range(x) 
-    start <- tmp[1] - abs(tmp[2])/​100 
-    end   <- tmp[2] + abs(tmp[2])/​100 
-    R     <- end-start 
-    h     <- R/k 
-  } 
- 
-  # User defines '​x'​ and '​k'​ 
-  # (x, k,[breaks, right]) 
   else {   else {
-    ​tmp   <- range(x+    ​if (size > threshold
-    start <- tmp[1] - abs(tmp[2])/100 +      ​spheres3d(x,​ y, z, color = surface.col[as.numeric(groups)], radius = size
-    ​end   <- tmp[2] + abs(tmp[2])/100 +    ​else 
-    R     <- end-start +      points3d(x, y, z, color = surface.col[as.numeric(groups)])
-    h     <- R/abs(k)+
   }   }
-  tbl     <- tb.make.table.I(x,​ start, end, h, right, histogram, titleH) 
-  return(tbl) 
-} 
  
-# With Gabor Grotendieck suggestions ​(thanks Gabor, very much!) +  aspect3d(c(11, 1))
-tb.table <- function(x...UseMethod("​tb.table"​)+
  
-# Table form vectors +  if (surface) { 
-tb.table.default ​<- function(x, +    ​xvals ​<- seq(min(x)max(x)length ​grid.lines) 
-                             k, +    yvals <- seq(min(y)max(y), length ​grid.lines) 
-                             ​start,​ +     
-                             ​end,​ +    ​dat ​ <- expand.grid(x = xvalsy = yvals
-                             h, +  
-                             ​breaks=c('​Sturges'​'​Scott',​ '​FD'​), +    for (i in 1:​length(model)) ​
-                             right=FALSE, +      ​if ​(is.null(groups)) { 
-                             histogram=TRUE,​ +        ​mod ​<- lm(formula(model[i])) 
-                             title.histogram=c('​auto'​'​none'​)+  
-+        if (model.summary) 
-  # User defines nothing or not '​x'​ isn't numeric -> stop +          summaries[[model[i]]] <- summary(mod)
-  stopifnot(is.numeric(x)) +
-  ​x ​<- na.omit(x)+
  
-  # User defines only '​x'​ +        zhat <- matrix(predict(modnewdata ​dat), grid.linesgrid.lines
-  # (x, {k, start, end, h}, [breaks, right]) +        ​surface3d(xvalsyvalszhatcolor surface.col[i], alpha 0.5, lit F)
-  if (missing(k) && missing(start) && missing(end) && missing(h) ) { +
-    brk   <- match.arg(breaks) +
-    switch(brk, +
-           ​Sturges ​k <- nclass.Sturges(x), +
-           ​Scott ​  = k <- nclass.scott(x), +
-           ​FD ​     = k <- nclass.FD(x)+
-    ​tmp ​  <- range(x) +
-    start <- tmp[1] - abs(tmp[2])/​100 +
-    end   <- tmp[2] + abs(tmp[2])/​100 +
-    R     <- end-start +
-    h     <- R/k +
-  } +
- +
-  # User defines '​x'​ and '​k'​ +
-  # (xk{startend, h}, [breaks, right]) +
-  else if (missing(start) && missing(end) && missing(h)) { +
-    stopifnot(length(k) >1) +
-    tmp   <- range(x) +
-    start <- tmp[1- abs(tmp[2])/​100 +
-    end   <- tmp[2] + abs(tmp[2])/​100 +
-    R     <- end-start +
-    h     <- R/abs(k) +
-  } +
- +
-  # User defines '​x'​'​start'​ and '​end'​ +
-  # (x, {k,} start, end, {h,} [breaks, right]) +
-  else if (missing(k) && missing(h)) { +
-    stopifnot(length(start) >1, length(end) >=1) +
-    tmp <- range(x) +
-    R   <- end-start +
-    k   <- sqrt(abs(R)) +
-    if (k < 5)  k <- 5 # min value of k +
-    h   <- R/k +
-  } +
- +
-  # User defines '​x'​'​start',​ '​end'​ and '​h'​ +
-  # (x, {k,} start, end, h, [breaks, right]) +
-  else if (missing(k)) { +
-    stopifnot(length(start) >1, length(end) >= 1, length(h) >= 1) +
-  } +
- +
-  else stop('​Please,​ see the function sintax!'​) +
- +
-  if (histogram) { +
-    x11() +
-    par(mfrow=c(1,​ 1)) +
-    title.histogram <- match.arg(title.histogram) +
-    switch(title.histogram,​ +
-           auto = titleH <- '​x',​ +
-           none = titleH <- ''​) +
-  } +
-  tbl <- tb.make.table.I(x,​ start, end, h, right, histogram, titleH) +
-  return(tbl) +
-+
- +
-# Table form data.frames +
-tb.table.data.frame <- function(df,​ +
-                                k, +
-                                by, +
-                                breaks=c('​Sturges',​ '​Scott',​ '​FD'​),​ +
-                                right=FALSE,​ +
-                                histogram=TRUE,​ +
-                                title.histogram=c('​auto',​ '​none'​)) +
-+
-  stopifnot(is.data.frame(df)) +
-  tmpList <- list() +
-  nameF   <- character() +
-  nameY   <- character()+
  
-  # User didn't defines a factor +        ​if (grid
-  ​if (missing(by){ +          ​surface3d(xvalsyvals, zhat, color = grid.col, alpha = 0.5, 
-    ​logCol <-  sapply(dfis.numeric) +            ​lit ​Ffront = '​lines',​ back = '​lines'​)
-    nHist  <- length(logCol[logCol]) +
-    if (histogram) { +
-      count = 0 +
-      if (nHist > 1) { +
-        x11() +
-        par(mfrow=c(41))+
       }       }
-    } +      else { # groups is not NULL 
-    for (in 1:ncol(df)) { +        if (!model.by.group) { 
-      if (logCol[i]) { +          ​for (in 1:length(levs)) { 
-        ​count  ​<- (count + 1+            mod <- lm(formula(model[i]),​ subset = (groups == levs[j])) 
-        if (count == 5) { +  
-          ​x11() +            ​if (model.summary) 
-          ​par(mfrow=c(41)) +              summaries[[paste(model[i], '​.',​ levs[j], sep = ''​)]] <- summary(mod
-          ​count <- 1+  
 +            zhat <- matrix(predict(mod,​ newdata = dat), grid.lines, grid.lines
 +            ​surface3d(xvals,​ yvals, zhat, color = surface.col[j],​ alpha = 0.5, lit = F) 
 +  
 +            ​if (grid) 
 +             ​surface3d(xvals,​ yvals, zhat, color grid.col, alpha 0.5
 +                lit = F, front = '​lines',​ back = '​lines'​) 
 +  
 +            texts3d(min(x),​ min(y), predict(mod,​ newdata = data.frame(x = min(x), y = min(y), 
 +              groups = levs[j])), paste(levs[j],​ ' '), adj = 1, color = surface.col[j]) 
 +          } 
 +        } 
 +        else # model.by.group is TRUE 
 +          ​mod <- lm(formula(model[i]),​ subset = (groups == levs[i])) 
 +  
 +          ​if (model.summary) 
 +            summaries[[paste(model[i]'​.',​ levs[i], sep = ''​)]] <- summary(mod) 
 +  
 +          ​zhat <- matrix(predict(mod,​ newdata = dat), grid.lines, grid.lines) 
 +  
 +          surface3d(xvals,​ yvals, zhat, color = surface.col[i],​ alpha = 0.5, lit = F) 
 +  
 +          if (grid) 
 +            surface3d(xvals,​ yvals, zhat, color = grid.col, alpha = 0.5, 
 +              lit = F, front = '​lines',​ back = '​lines'​) 
 +  
 +          texts3d(min(x),​ min(y), predict(mod,​ newdata = data.frame(x = min(x), y = min(y), 
 +            groups = levs[i])), paste(levs[i],​ ' '), adj = 1, color = surface.col[i])
         }         }
-        title.histogram <- match.arg(title.histogram) 
-        switch(title.histogram,​ 
-               auto = titleH <- names(logCol[i]),​ 
-               none = titleH <- ''​) 
-        x       <- as.matrix(df[ ,i]) 
-        tbl     <- tb.make.table.II(x,​ k, breaks, right, histogram, titleH) 
-        tmpList <- c(tmpList, list(tbl)) 
       }       }
     }     }
-    valCol <- logCol[logCol] 
-    names(tmpList) <- names(valCol) 
-    return(tmpList) 
   }   }
 +  if(simple.axes) {
 +    axes3d(c('​x',​ '​y',​ '​z'​))
 +    title3d(xlab = xlab, ylab = ylab, zlab = zlab)
 +  }
 +  else
 +    decorate3d(xlab = xlab, ylab = ylab, zlab = zlab, box = box)
  
-  ​# User defines one factor +  ​if (revolutions > 0{ 
-  else { +    ​start <- proc.time()[3
-    namesdf ​  <- names(df+    ​startMatrix ​<- par3d("​userMatrix"​
-    ​pos       <- which(namesdf == by) +    ​while ((theta ​<- speed*(proc.time()[3] - start))/2/pi revolutions) { 
-    stopifnot(is.factor((df[[pos]]))) +      rgl.viewpoint(userMatrix ​rotate3d(startMatrixtheta001))
-    nF        <- table(df[[pos]]) +
-    ​logCol ​   ​<- sapply(df, is.numeric+
-    ​nHist     <- length(logCol[logCol]) +
-    nDisGraph ​<- round((length(nF) ​nHist) / 12)  # 12 is the maximum easily visible +
-    if (histogram) { +
-      count <- 0 +
-      x11() +
-      par(mfrow=c(4, ​3)) +
-    } +
-    for(i in 1:​length(nF)) { +
-      tmpdf  <- subset(df, df[[pos]] == names(nF[i])) +
-      logCol <sapply(tmpdf,​ is.numeric) +
-      for (j in 1:​ncol(tmpdf)) { +
-        if (logCol[j]) { +
-          count  ​<- (count + 1) +
-          if (count == 13) { +
-            ​x11() +
-            par(mfrow=c(4,​ 3)) +
-            count <- 1 +
-          } +
-          nameF  <- names(nF[i]) +
-          nameY  <- names(logCol[j]) +
-          nameFY <- paste(nameF,'​.', nameY, sep=""​) +
-          title.histogram <- match.arg(title.histogram) +
-          switch(title.histogram,​ +
-                 ​auto ​titleH <- nameFY, +
-                 none = titleH <- ''​) +
-          x            <- as.matrix(tmpdf[ ​,j]) +
-          tbl          <- tb.make.table.II(xkbreaksright, histogram, titleH) +
-          newFY        <- list(tbl) +
-          names(newFY) <- sub(' +$', '',​ nameFY) +
-          tmpList ​     <- c(tmpList, newFY) +
-        } +
-      }+
     }     }
   }   }
-  return(tmpList)+  ​if (model.summary) 
 +    ​return(summaries) 
 +  else 
 +    return(invisible(NULL))
 } }
 </​code>​ </​code>​
  
-== Testar ​função ​tb.table ​== +== Usando a função ​plotlm3d ​==
-O script abaixo possibilita testar e aprender a usar a função tb.table. +
 <​code>​ <​code>​
 #​=============================================================================== #​===============================================================================
-# Name           : ​tb.table_test +# Name           : ​Script to test plotlm3d 
-Original author: Jose Cláudio ​Faria +Author ​        : Jose Claudio ​Faria and Duncan Murdoch 
-# Date (dd/​mm/​yy): ​1/3/07 11:06:02 +# Date (dd/​mm/​yy): ​2012/07/01 
-# Version ​       : v24 +# Version ​       : v18 
-# Aim            : To learn how to use the function tb.table+# Aim            : To plot 3d scatter, an or, surfaces with rgl package
 #​=============================================================================== #​===============================================================================
-# Observation ​   : Test it line by line 
-#​=============================================================================== 
-# 1.Tables 
-# 1.1. Tables from vectors 
-#​=============================================================================== 
- 
-## To debug 
-# mtrace.off() 
-# mtrace(tb.make.table.I) 
-# mtrace(tb.make.table.II) 
-# mtrace(tb.table.default) 
-# mtrace(tb.table.data.frame) 
- 
-# Make a vector 
-set.seed(1) 
-x=rnorm(150,​ 5, 1) 
- 
-tb.table(x, his=F) 
-tb.table(x) 
-tb.table(x, title.his='​none'​) 
-tb.table(x, k=10, his=T) 
- 
-#Title 
-tb.table(x, title.his='​teste'​) #error! 
-tb.table(x, title.his='​none'​) 
-tb.table(x, title.his='​auto'​) 
- 
-# Equal to above 
-tb.table(x, breaks='​Sturges'​) 
- 
-# Equal to above 
-tb.table(x, breaks='​St'​) 
- 
-tb.table(x, breaks='​Scott'​) 
- 
-# Equal to above 
-tb.table(x, b='​Sc'​) 
- 
-tb.table(x, breaks='​FD'​) 
- 
-# Equal to above 
-tb.table(x, breaks='​F'​) 
- 
-tb.table(x, breaks='​F',​ right=T) 
- 
-# Will make a error! 
-tb.table(x, breaks='​S'​) #​('​S'​turges) and ('​S'​cott) 
- 
-tb.table(x, k=4) 
- 
-tb.table(x, k=20) 
- 
-# Partial 
-tb.table(x, start=4, end=6) # Will make error! 
-tb.table(x, start=4, end=6, his=F) 
- 
-# Equal to above 
-tb.table(x, s=4, e=6, his=F) 
- 
-# Partial 
-tb.table(x, start=4.5, end=5.5, his=F) 
- 
-# Partial 
-tb.table(x, start=5, end=6, h=.5, his=F) 
- 
-# Nonsense 
-tb.table(x, start=0, end=10, h=.5) 
- 
-# First and last class forced (fi=0) 
-tb.table(x, start=1, end=9, h=1) 
- 
-tb.table(x, start=1, end=10, h=2) 
- 
- 
-#​=============================================================================== 
-# 1.2. Tables from data.frames 
-#​=============================================================================== 
-# Make a data.frame 
-mdf=data.frame(X1 =rep(LETTERS[1:​4],​ 25), 
-               X2 =as.factor(rep(1:​10,​ 10)), 
-               Y1 =c(NA, NA, rnorm(96, 10, 1), NA, NA), 
-               Y2 =rnorm(100, 60, 4), 
-               Y3 =rnorm(100, 50, 4), 
-               Y4 =rnorm(100, 40, 4)) 
- 
-tb.table(mdf) 
- 
-tb.table(mdf,​ title.his='​none'​) 
- 
-# Equal to above 
-tb.table(mdf,​ breaks='​Sturges'​) 
- 
-# Equal to above 
-tb.table(mdf,​ breaks='​St'​) 
- 
-tb.table(mdf,​ breaks='​Scott'​) 
- 
-tb.table(mdf,​ breaks='​FD'​) 
- 
-tb.table(mdf,​ k=4) 
- 
-tb.table(mdf,​ k=10) 
- 
-levels(mdf$X1) 
-tbl = tb.table(mdf,​ k=5, by='​X1'​) 
-length(tbl) 
-names(tbl) 
-tbl 
- 
-tb.table(mdf,​ breaks='​FD',​ by='​X1'​) 
- 
-# A '​big'​ result: X2 is a factor with 10 levels! 
-tb.table(mdf,​ breaks='​FD',​ by='​X2'​) 
  
-tb.table(mdf, breaks='​FD',​ k=5, by='​X2'​)+# mtrace(plotlm3d) 
 +# mtrace.off
  
-tb.table(iris, ​k=5)+# Example 1 
 +open3d() 
 +rgl.bringtotop(stay = T) 
 +with(iris, ​plotlm3d(Sepal.Length,​ Sepal.Width,​ Petal.Length,​ 
 +                    surface ​      = F, 
 +                    groups ​       = Species, 
 +                    xlab          = '​SL',​ 
 +                    ylab          = '​SW',​ 
 +                    zlab          = '​PL',​ 
 +                    grid          = F, 
 +                    sphere.factor ​1))
  
-tb.table(iris, ​k=10)+# Example 2 
 +open3d() 
 +rgl.bringtotop(stay = T) 
 +with(iris, ​plotlm3d(Sepal.Length,​Sepal.Width,​ Petal.Length,​ 
 +                    model         = c('z ~ x + y', 
 +                                      'z ~ x + y + I(x^2) + I(y^2) + I(x*y)'​),​ 
 +                    surface ​      = T, 
 +                    groups ​       = Species, 
 +                    simple.axes ​  = F, 
 +                    box           = T, 
 +                    xlab          = '​SL',​ 
 +                    ylab          = '​SW',​ 
 +                    zlab          = '​PL',​ 
 +                    grid          = F, 
 +                    sphere.factor ​1))
  
-levels(iris$Species+# Example 3 
-tbl=tb.table(iris, ​k=5by='Species') +open3d() 
-length(tbl) +rgl.bringtotop(stay = T) 
-names(tbl+with(iris, ​plotlm3d(Sepal.Length,Sepal.Width,​ Petal.Length,​ 
-tbl+                    model         c('z ~ x + y', 
 +                                      '​z ~ x + y + I(x^2+ I(y^2+ I(x*y)'​),​ 
 +                    ​surface ​      = T, 
 +                    xlab          = '​SL',​ 
 +                    ylab          = '​SW',​ 
 +                    zlab          = '​PL',​ 
 +                    grid          = F, 
 +                    sphere.factor = 1))
  
-tb.table(iris, ​k=5, by='Species', ​right=T)+ # Example 4 
 + ​open3d() 
 + rgl.bringtotop(stay = T) 
 + with(iris, ​plotlm3d(Sepal.Length,​ Sepal.Width,​ Petal.Length,​ 
 +                     ​model ​         ​c('z ~ x + y'                           # to setosa 
 +                                        'z ~ x + y + I(x^2) + I(y^2) + I(x*y)',​ # to versicolor 
 +                                        'z ~ I(x^3) + I(y^3)'​), ​                # to virginica 
 +                     ​groups ​        = Species, 
 +                     ​model.by.group = T, 
 +                     ​simple.axes ​   = F, 
 +                     ​box ​           = F, 
 +                     ​xlab ​          = 'SL', 
 +                     ​ylab ​          '​SW',​ 
 +                     ​zlab ​          = '​PL',​ 
 +                     ​grid ​          = F, 
 +                     ​sphere.factor ​ = 1))
  
-tb.table(irisbreaks='​FD'​by='​Species'​)+# Example 5: Netter 
 +x = c274 ​180, ​ 375,  205,   ​86, ​ 265,   ​98, ​ 330,  195,   53, 
 +       ​430, ​ 372,  236,  157,  370) 
 +c(24503254, 3802, 2838, 2347, 3782, 3008, 2450, 2137, 2560, 
 +      4020, 4427, 2660, 2088, 2605) 
 +c( 162,  120,  223,  131,   ​67, ​ 169,   ​81, ​ 192,  116,   55, 
 +       ​252, ​ 232,  144,  103,  212)
  
-library(MASS+mreg  = lm(z ~ x + y
-levels(Cars93$Origin+ndata = data.frame(x = c(150, 274, 220, 370), y = c(4000, 2800, 3500, 3100)
-tbl=tb.table(Cars93k=5by='​Origin'​) +zpred predict(mregnewdata ​ndatase.fit ​F)
-names(tbl) +
-tbl+
  
-tb.table(Cars93breaks='FD', ​by='Origin')+open3d() 
 +rgl.bringtotop(stay = T) 
 +plotlm3d(xy, z, 
 +         ​surface = T, 
 +         ​model ​  = 'z ~ x + y', 
 +         ​xlab ​   ​= 'x'
 +         ​ylab ​   = '​y',​ 
 +         ​zlab ​   = '​z'​) 
 +spheres3d(x = c(150, 274, 220, 370), y = c(4000, 2800, 3500, 3100), zpred, 
 +          col = '​red',​ radius = 60)
 </​code>​ </​code>​
  

QR Code
QR Code pessoais:jcfaria (generated for current page)