[R-br] Alterar a função codebook

Daniel Marcelino dmsilva.br em gmail.com
Terça Maio 31 14:32:18 BRT 2011


Caros, esta função codebook tem uma saída para valores characters e
factors diferente do que eu preciso para montar um livro de códigos.
No código abaixo, quando a coluna é string a única informação que
mostra é:   "A character vector". O que eu preciso é que a saída me
mostre pelo menos uns 3 exemplos de strings. Alguém sabe como alterar
isso?

Daniel


function (dataFrame = .data)
{
    cat("\n", attr(dataFrame, "datalabel"), "\n", "\n")
    x1 <- dataFrame[1, ]
    for (i in 1:ncol(dataFrame)) {
        cat(paste(names(dataFrame)[i], "\t", ":", "\t", attr(dataFrame,
            "var.labels")[i]), "\n")
        if (all(is.na(dataFrame[, i]))) {
            cat(paste("All elements of ", names(dataFrame)[i],
                " have a missing value", "\n"))
        }
        else {
            if (any(class(x1) == "data.frame")) {
                x2 <- x1[, i]
            }
            else {
                x2 <- x1
            }
            if (any(class(x2) == "character") | any(class(x2) ==
                "AsIs")) {
                cat("A character vector", "\n")
            }
            else {
                if (any(class(x2) == "difftime")) {
                  print(summary(x2))
                }
                else {
                  if (is.logical(x2))
                    x2 <- as.factor(x2)
                  if (any(class(x2) == "factor")) {
                    table1 <- (t(t(table(dataFrame[, i]))))
                    table1 <- cbind(table1, format(table1/sum(table1) *
                      100, digits = 3))
                    colnames(table1) <- c(.frequency1, .percent)
                    if (is.null(attr(dataFrame, "val.labels")[i])) {
                      print.noquote(table1, right = TRUE)
                    }
                    else {
                      if (any(is.na(attr(dataFrame, "label.table")))) {
                        print.noquote(table1, right = TRUE)
                      }
                      else {
                        attr(dataFrame,
"label.table")[which(is.na(attr(attr(dataFrame,
                          "label.table"), "names")))] <- ""
                        index <- attr(attr(dataFrame, "label.table"),
                          "names") == attr(dataFrame, "val.labels")[i]
                        index <- na.omit(index)
                        if
(suppressWarnings(!all(rownames(as.data.frame(attr(dataFrame,
                          "label.table")[index])) == levels(x2)))) {
                          print.noquote(table1, right = TRUE)
                        }
                        else {
                          table2 <- data.frame(attr(dataFrame,
                            "label.table")[index], table1)
                          colnames(table2) <- c("code", colnames(table1))
                          cat("Label table:", attr(dataFrame,
                            "val.labels")[i], "\n")
                          print.noquote(table2, right = TRUE)
                        }
                      }
                    }
                  }
                  else {
                    print(summ(dataFrame[, i], graph = FALSE))
                  }
                }
            }
        }
        cat("\n", "==================", "\n")
    }
}

-- 
Daniel Marcelino
http://danielmarcelino.zip.net
Skype: d_marcelino


Mais detalhes sobre a lista de discussão R-br