Não foi possível enviar o arquivo. Será algum problema com as permissões?
Diferenças
Aqui você vê as diferenças entre duas revisões dessa página.
Ambos lados da revisão anterior Revisão anterior Próxima revisão | Revisão anterior | ||
pessoais:jcfaria [2007/03/02 18:51] jcfaria |
pessoais:jcfaria [2012/08/01 19:25] (atual) jcfaria |
||
---|---|---|---|
Linha 9: | Linha 9: | ||
**1. Quem sou** | **1. Quem sou** | ||
- | - Engenheiro Agrônomo; | + | - Engenheiro Agrônomo |
- | + | - Mestrado e Doutorado em Produção Vegetal pela Universidade Federal de Viçosa - UFV/MG | |
- | - 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) |
Linha 18: | Linha 18: | ||
- Professor de estatística e pesquisador da Universidade Estadual de Santa Cruz - UESC/BA; | - Professor de estatística e pesquisador da Universidade Estadual de Santa Cruz - UESC/BA; | ||
- | - Coordenador e desenvolvedor do projeto Tinn-R (GUI/editor para o ambiente R). | + | - 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** | **3. Sobre o R** | ||
- | - Gostaria de tê-lo encontrado desde o início de minha carreira na área de estatística computacional. | + | - Gostaria de tê-lo encontrado desde o início de minha carreira na área de estatística computacional! |
Linha 29: | Linha 38: | ||
- Desejo aprofundar os conhecimentos em análise multivariada de dados no ambiente R; | - Desejo aprofundar os conhecimentos em análise multivariada de dados no ambiente R; | ||
- | |||
- | - Aprimorar o Tinn-R e disponibilizá-lo também para a plataforma Linux; | ||
- Trocar experiências com pessoas e equipes envolvidas nestas áreas. | - Trocar experiências com pessoas e equipes envolvidas nestas áreas. | ||
Linha 592: | Linha 599: | ||
==== Funções úteis ==== | ==== Funções úteis ==== | ||
- | === Tabelas e histogramas === | ||
- | == Função tb.table == | ||
- | |||
- | Função simples, flexível mas poderosa para descrever, via tabela de distribuição de freqüências e histogramas, vetores e data.frames. | ||
- | |||
- | <code> | ||
- | #=============================================================================== | ||
- | # Name : tb.table | ||
- | # Original author: José Cláudio Faria, Gabor Gothendievisk and Enio Jelihovschi | ||
- | # Date (dd/mm/yy): 1/3/07 11:06:02 | ||
- | # Version : v24 | ||
- | # Aim : To make tables of frequency distribution and associated | ||
- | # histogram | ||
- | #=============================================================================== | ||
- | # Arguments: | ||
- | # breaks : Method to determine number of classes= c('Sturges', 'Scott', 'FD') | ||
- | # by : Variable to group | ||
- | # end : Last class (high value) | ||
- | # h : Classes extent | ||
- | # k : Class number | ||
- | # right : Intervals right open (default = FALSE) | ||
- | # start : First class (small value) | ||
- | # x : A R object (vector or data.frame) | ||
- | # histogram : Plot histogram (default = TRUE) | ||
- | # title.histogram: Title of histogram c('auto', 'none') | ||
- | #=============================================================================== | ||
- | |||
- | # Common functions | ||
- | tb.make.table.I <- function(x, | ||
- | start, | ||
- | end, | ||
- | h, | ||
- | right, | ||
- | histogram, | ||
- | titleH) | ||
- | { | ||
- | f <- table(cut(x, br=seq(start, end, h), right=right)) # Absolut freq | ||
- | fr <- f/length(x) # Relative freq | ||
- | frP <- 100*(f/length(x)) # Relative freq, % | ||
- | fac <- cumsum(f) # Cumulative freq | ||
- | facP <- 100*(cumsum(f/length(x))) # Cumulative freq, % | ||
- | fi <- round(f, 2) | ||
- | fr <- round(as.numeric(fr), 2) | ||
- | frP <- round(as.numeric(frP), 2) | ||
- | fac <- round(as.numeric(fac), 2) | ||
- | facP <- round(as.numeric(facP),2) | ||
- | res <- data.frame(fi, fr, frP, fac, facP) # Make final table | ||
- | names(res) <- c('Class limits', 'fi', 'fr', 'fr(%)', 'fac', 'fac(%)') | ||
- | |||
- | # Making the histogram: With Benilton suggestions | ||
- | if (histogram) { | ||
- | hist(x, | ||
- | breaks = seq(start, end, h), | ||
- | freq = T, | ||
- | right = right, | ||
- | xlab = 'Class limits', ylab='Frequency', | ||
- | col = 'LightYellow', | ||
- | main = titleH, | ||
- | xlim = c(start, end), ylim=c(0, max(fi)), | ||
- | las = 1, | ||
- | xaxt = 'n') | ||
- | axis(1, at=round(seq(start, end, h), 2)) | ||
- | } | ||
- | 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 { | ||
- | tmp <- range(x) | ||
- | start <- tmp[1] - abs(tmp[2])/100 | ||
- | end <- tmp[2] + abs(tmp[2])/100 | ||
- | R <- end-start | ||
- | 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!) | ||
- | tb.table <- function(x, ...) UseMethod("tb.table") | ||
- | |||
- | # Table form vectors | ||
- | tb.table.default <- function(x, | ||
- | k, | ||
- | start, | ||
- | end, | ||
- | h, | ||
- | breaks=c('Sturges', 'Scott', 'FD'), | ||
- | right=FALSE, | ||
- | histogram=TRUE, | ||
- | title.histogram=c('auto', 'none')) | ||
- | { | ||
- | # User defines nothing or not 'x' isn't numeric -> stop | ||
- | stopifnot(is.numeric(x)) | ||
- | x <- na.omit(x) | ||
- | |||
- | # User defines only 'x' | ||
- | # (x, {k, start, end, h}, [breaks, right]) | ||
- | 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 (missing(by)) { | ||
- | logCol <- sapply(df, is.numeric) | ||
- | nHist <- length(logCol[logCol]) | ||
- | if (histogram) { | ||
- | count = 0 | ||
- | if (nHist > 1) { | ||
- | x11() | ||
- | par(mfrow=c(4, 1)) | ||
- | } | ||
- | } | ||
- | for (i in 1:ncol(df)) { | ||
- | if (logCol[i]) { | ||
- | count <- (count + 1) | ||
- | if (count == 5) { | ||
- | x11() | ||
- | par(mfrow=c(4, 1)) | ||
- | count <- 1 | ||
- | } | ||
- | 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) | ||
- | } | ||
- | |||
- | # User defines one factor | ||
- | else { | ||
- | namesdf <- names(df) | ||
- | pos <- which(namesdf == by) | ||
- | stopifnot(is.factor((df[[pos]]))) | ||
- | 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) | ||
- | } | ||
- | </code> | ||
- | |||
- | == Testar função tb.table == | ||
- | O script abaixo possibilita testar e aprender a usar a função tb.table. | ||
- | |||
- | <code> | ||
- | #=============================================================================== | ||
- | # Name : tb.table_test | ||
- | # Original author: Jose Cláudio Faria | ||
- | # Date (dd/mm/yy): 1/3/07 11:06:02 | ||
- | # Version : v24 | ||
- | # Aim : To learn how to use the function tb.table | ||
- | #=============================================================================== | ||
- | # 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') | ||
- | |||
- | tb.table(iris, k=5) | ||
- | |||
- | tb.table(iris, k=10) | ||
- | |||
- | levels(iris$Species) | ||
- | tbl=tb.table(iris, k=5, by='Species') | ||
- | length(tbl) | ||
- | names(tbl) | ||
- | tbl | ||
- | |||
- | tb.table(iris, k=5, by='Species', right=T) | ||
- | |||
- | tb.table(iris, breaks='FD', by='Species') | ||
- | |||
- | library(MASS) | ||
- | levels(Cars93$Origin) | ||
- | tbl=tb.table(Cars93, k=5, by='Origin') | ||
- | names(tbl) | ||
- | tbl | ||
- | |||
- | tb.table(Cars93, breaks='FD', by='Origin') | ||
- | </code> | ||
- | |||
=== Superfície de resposta === | === Superfície de resposta === | ||
== Função plotlm3d == | == Função plotlm3d == | ||
Linha 1209: | Linha 796: | ||
</code> | </code> | ||
- | == Testar função plotlm3d == | + | == Usando a função plotlm3d == |
<code> | <code> | ||
#=============================================================================== | #=============================================================================== | ||
# Name : Script to test plotlm3d | # Name : Script to test plotlm3d | ||
# Author : Jose Claudio Faria and Duncan Murdoch | # Author : Jose Claudio Faria and Duncan Murdoch | ||
- | # Date (dd/mm/yy): 23/7/06 07:21:23 | + | # Date (dd/mm/yy): 2012/07/01 |
- | # Version : v17 | + | # Version : v18 |
# Aim : To plot 3d scatter, an or, surfaces with rgl package | # Aim : To plot 3d scatter, an or, surfaces with rgl package | ||
#=============================================================================== | #=============================================================================== | ||
Linha 1229: | Linha 816: | ||
groups = Species, | groups = Species, | ||
xlab = 'SL', | xlab = 'SL', | ||
- | ylab = 'PL', | + | ylab = 'SW', |
- | zlab = 'SW', | + | zlab = 'PL', |
grid = F, | grid = F, | ||
sphere.factor = 1)) | sphere.factor = 1)) | ||
Linha 1245: | Linha 832: | ||
box = T, | box = T, | ||
xlab = 'SL', | xlab = 'SL', | ||
- | ylab = 'PL', | + | ylab = 'SW', |
- | zlab = 'SW', | + | zlab = 'PL', |
grid = F, | grid = F, | ||
sphere.factor = 1)) | sphere.factor = 1)) | ||
Linha 1258: | Linha 845: | ||
surface = T, | surface = T, | ||
xlab = 'SL', | xlab = 'SL', | ||
- | ylab = 'PL', | + | ylab = 'SW', |
- | zlab = 'SW', | + | zlab = 'PL', |
grid = F, | grid = F, | ||
sphere.factor = 1)) | sphere.factor = 1)) | ||
Linha 1275: | Linha 862: | ||
box = F, | box = F, | ||
xlab = 'SL', | xlab = 'SL', | ||
- | ylab = 'PL', | + | ylab = 'SW', |
- | zlab = 'SW', | + | zlab = 'PL', |
grid = F, | grid = F, | ||
sphere.factor = 1)) | sphere.factor = 1)) |