Você está aqui: start » pessoais » jcfaria

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 anteriorRevisão anterior
Próxima revisão		Revisão anterior
pessoais:jcfaria [2007/03/01 11:47] – jcfariapessoais: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 2007) refletindo profundamente sobre o R!!!+Eu na Praia do Sul de Ilhéus/BA, em janeiro de 2007, refletindo 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 (default, 26) forming 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(start, end, h), +    complete.cases(x, y, z, groups) 
-         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(0, max(fi)), +  if (!is.null(groups)) 
-         las    = 1, +    groups <- groups[valid] 
-         xaxt   = 'n') +  
-    axis(1, at=round(seq(start, end, h), 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.col, radius = size) 
 +    else 
 +      points3d(x, y, z, color = 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(1, 1, 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 = xvals, y = 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(mod, newdata = dat), grid.lines, grid.lines) 
-  # (x, {k, start, end, h}, [breaks, right]) +        surface3d(xvals, yvals, zhat, color = 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' +
-  # (x, k, {start, end, 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(xvals, yvals, zhat, color = grid.col, alpha = 0.5, 
-    logCol <-  sapply(df, is.numeric) +            lit = F, front = 'lines', back = 'lines')
-    nHist  <- length(logCol[logCol]) +
-    if (histogram) { +
-      count = 0 +
-      if (nHist > 1) { +
-        x11() +
-        par(mfrow=c(4, 1))+
       }       }
-    } +      else { # groups is not NULL 
-    for (i in 1:ncol(df)) { +        if (!model.by.group) { 
-      if (logCol[i]) { +          for (j 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(4, 1)) +              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(startMatrix, theta, 0, 0, 1))
-    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(x, k, breaks, right, 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=5, by='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(iris, breaks='FD', by='Species')+# Example 5: Netter 
 +x = c( 274,  180,  375,  205,   86,  265,   98,  330,  195,   53, 
 +       430,  372,  236,  157,  370) 
 +y = c(2450, 3254, 3802, 2838, 2347, 3782, 3008, 2450, 2137, 2560, 
 +      4020, 4427, 2660, 2088, 2605) 
 +z = 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(Cars93, k=5, by='Origin') +zpred = predict(mreg, newdata = ndata, se.fit = F)
-names(tbl) +
-tbl+
  
-tb.table(Cars93, breaks='FD', by='Origin')+open3d() 
 +rgl.bringtotop(stay = T) 
 +plotlm3d(x, y, 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)