Nothing
#' @title Tabla de frecuencias.
#'
#' @description Esta función presenta la distribución de frecuencias de una variable cuantitativa o cualitativa.
#'
#' Lee el código QR para video-tutorial sobre el uso de la función con un ejemplo.
#'
#' \if{html}{\figure{qrtablafrecuencias.png}{options: width="25\%" alt="Figure: qricvarianza.png"}}
#' \if{latex}{\figure{qrtablafrecuencias.png}{options: width=3cm}}
#'
#' @usage tabla.frecuencias(x,
#' eliminar.na = TRUE,
#' grafico = FALSE,
#' exportar = FALSE)
#'
#' @param x Conjunto de datos. Puede ser un vector (numérico o factor) o un dataframe. Si el dataframe tiene más de una variable, solicitará al usuario que idenfique el nombre de la variable para la que se quiere calcular la tabla de frecuencias.
#' @param eliminar.na Valor lógico. Por defecto \code{eliminar.na = TRUE}. Si se quiere obtener la tabla de frecuencias con NAs, cambiar el argumento a \code{eliminar.na = FALSE}.
#' @param grafico Si \code{grafico = TRUE}, representa el histograma o el gráfico de barras de la variable seleccionada.
#' @param exportar Para exportar los resultados a una hoja de cálculo Excel (\code{exportar = TRUE}).
#'
#' @return Devuelve la tabla de frecuencias como una \code{tibble}. Si \code{grafico = TRUE}, se devuelve en una lista la tabla de frecuencias y su representación gráfica.
#'
#' @author
#' \strong{Vicente Coll-Serrano}.
#' \emph{Métodos Cuantitativos para la Medición de la Cultura (MC2). Economía Aplicada.}
#'
#' \strong{Rosario Martínez Verdú}.
#' \emph{Economía Aplicada.}
#'
#' Facultad de Economía. Universidad de Valencia (España)
#'
#' @references
#' Esteban García, J. y otros. (2005). Estadística descriptiva y nociones de probabilidad. Paraninfo. ISBN: 9788497323741
#'
#' Newbold, P, Carlson, W. y Thorne, B. (2019). Statistics for Business and Economics, Global Edition. Pearson. ISBN: 9781292315034
#'
#' Murgui, J.S. y otros. (2002). Ejercicios de estadística Economía y Ciencias sociales. tirant lo blanch. ISBN: 9788484424673
#'
#' @importFrom tidyr pivot_longer drop_na
#' @import dplyr
#'
#' @export
tabla.frecuencias <- function(x,
eliminar.na = TRUE,
grafico = FALSE,
exportar = FALSE){
x <- as.data.frame(x)
varnames <- colnames(x)
if(length(x) > 1 ) {
variable <- readline(prompt = "Intoduce el nombre de la variable: ")
} else{
variable <- varnames
}
if(is.character(variable)){
if(variable %in% varnames){
variable = which(varnames == variable)
} else {
stop("El nombre de la variable no es v\u00e1lido")
}
}
x <- as.data.frame(x) %>%
dplyr::select(all_of(variable))
y <- varnames[variable] # nombre de la variable seleccionada
clase <- sapply(x, class)
if (!clase %in% c("numeric","integer","factor","logic")) {
stop("No puede construirse la tabla de frecuencias, la variable que has\n
seleccionado es car\u00e1cter")
}
if(length(x) > 1){
stop("Esta funci\u00f3n solo puede contruir la tabla de frecuencias de una variable")
print("Para obtener la tabla de frecuencias de mas de una variable utiliza la funci\u00f3n apply")
}
valores_distintos <- nrow(unique(x))
valores_ordenados <- unique(x)
valores_ordenados <- valores_ordenados[,1]
if(valores_distintos >= 20){
# tabla de frecuencias de valores agrupados
print("La variable presenta muchos valores distintos (20 o mas)")
agrupar <- as.numeric(readline('\u00bfQuieres agrupar los valores en intervalos?: \n 1. "S\u00ed, agrupar en intervalos." \n 2. "No, usar los valores sin agrupar." \n'))
if(agrupar == 1){
clase <- sapply(x, class)
x <- na.omit(x)
if(clase %in% c("factor","character","logic")){
stop("La variable no es cuantitativa, no puede representarse el histograma")
}
if(nrow(x)<=100){
intervalos <- ceiling(sqrt(nrow(x)))
} else {
intervalos <- ceiling(log(nrow(x))/log(2) + 1)
}
amplitud <- (max(x,na.rm=TRUE)-min(x,na.rm=TRUE))/intervalos
x$cut <- cut(x[,1], seq(min(x[,1],na.rm=TRUE),max(x[,1],na.rm=TRUE),amplitud),
include.lowest = TRUE,
dig.lab = 8)
x <- x[2]
names(x) <- y
} else{
print("Has decidido no agrupar los valores, puede que el diagrama de barras no represente adecuadamente la distribuci\u00f3n de la variable")
agrupar = 0
}
} else{
print("Has decidido no agrupar los valores.")
agrupar = 0
}
# tabla de frecuencias
# ordena de menor a mayor los valores
tabla <- x %>% dplyr::arrange(x) %>%
dplyr::group_by_at(y) %>% # en lugar de group_by(.dots=y)
dplyr::count() %>%
dplyr::ungroup()
names(tabla) <- c(y,"ni") # nombres de las columnas de tabla
# calcula las frecuencias
tabla <- tabla %>%
dplyr::mutate(Ni = cumsum(ni),
fi = ni / sum(ni),
Fi = cumsum(fi))
if(eliminar.na == TRUE){
x <- drop_na(x)
tabla <- x %>% dplyr::arrange(x) %>%
dplyr::group_by_at(y) %>%
dplyr::count() %>%
dplyr::ungroup()
names(tabla) <- c(y,"ni")
tabla <- tabla %>%
dplyr::mutate(Ni = cumsum(ni),
fi = ni / sum(ni),
Fi = cumsum(fi))
} else {
tabla <- x %>% dplyr::arrange(x) %>%
dplyr::group_by_at(y) %>%
dplyr::count() %>%
dplyr::ungroup()
names(tabla) <- c(y,"ni")
tabla <- tabla %>%
dplyr::mutate(Ni = cumsum(ni),
fi = ni / sum(ni),
Fi = cumsum(fi))
}
if (exportar) {
filename <- paste("Tabla de frecuencias de ", y, " (", Sys.time(), ").xlsx", sep = "")
filename <- gsub(" ", "_", filename)
filename <- gsub(":", ".", filename)
rio::export(tabla, file = filename)
}
if(grafico){
df <- cbind(tabla[1],tabla[2],tabla[4],tabla[3],tabla[5])
if(agrupar == 1){
marca_clase <- function(cut_label) {
mean(as.numeric(unlist(strsplit(gsub("\\(|\\)|\\[|\\]", "", as.character(cut_label)), ","))))
}
df$marca <- sapply(df[,1], marca_clase)
variables <- names(df)
print("Los valores han sido agrupados en intervalos y se representar\u00e1n mediante un histograma")
plot <- ggplot(df, aes_string(x=variables[1], y = variables[2])) +
geom_bar(stat = "identity", width = 1,
color = "white", fill = "orange") +
geom_text(aes_string(label=variables[2]), vjust=1.5, size = 2.5) +
geom_text(aes(label=paste("(",round(df[,3]*100,2),"%)",sep="")), vjust=2.5, size = 2.5, color = "darkgreen" ) +
labs(title = paste("Histograma de ",variables[1],sep=""),
x = variables[1],
y = "") +
theme(
panel.background = element_rect(fill = "transparent"), # bg of the panel
plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
panel.grid.major = element_blank(), # get rid of major grid
panel.grid.minor = element_blank(), # get rid of minor grid
legend.background = element_blank(), # get rid of legend bg
legend.box.background = element_blank(), # get rid of legend panel bg
legend.key = element_blank(), # get rid of key legend fill, and of the surrounding
axis.ticks.x=element_blank(),
axis.line.y = element_blank(),
axis.ticks.y=element_blank(),
axis.text.x=element_text(size=6,angle=30),
axis.text.y=element_blank(),
legend.title = element_blank()
)
} else {
variables <- names(df)
if(clase == "factor"){
x_string <- df[,1]
} else{
x_string <- as.factor(round(df[,1],2))
}
if(valores_distintos > 10){
print("El diagrama de barras puede no ser una buena representaci\u00f3n gr\u00e1fica si la variable presenta muchos distintos valores (aconsejable como m\u00e1ximo 10-15)")
plot <- ggplot(df, aes_string(x=x_string,y=variables[2])) +
geom_bar(stat = "identity", fill = "orange") +
geom_text(aes_string(label=variables[2]), vjust=1.5, size = 2.5) +
geom_text(aes(label=paste("(",round(df[,3]*100,2),"%)",sep="")), vjust=2.65, size = 2.5, color = "blue" ) +
labs(title = paste("Diagrama de barras de ", variables[1], sep=""),
x = variables[1],
y = "") +
theme(
panel.background = element_rect(fill = "transparent"), # bg of the panel
plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
panel.grid.major = element_blank(), # get rid of major grid
panel.grid.minor = element_blank(), # get rid of minor grid
legend.background = element_blank(), # get rid of legend bg
legend.box.background = element_blank(), # get rid of legend panel bg
legend.key = element_blank(), # get rid of key legend fill, and of the surrounding
axis.ticks.x=element_blank(),
axis.line.y = element_blank(),
axis.ticks.y=element_blank(),
axis.text.x=element_text(size=6,angle=90),
axis.text.y=element_blank(),
legend.title = element_blank()
)
} else {
plot <- ggplot(df, aes_string(x=x_string,y=variables[2])) +
geom_bar(stat = "identity", width = 0.5, fill = "orange") +
geom_text(aes_string(label=variables[2]), vjust=1.5, size = 2.5) +
geom_text(aes(label=paste("(",round(df[,3]*100,2),"%)",sep="")), vjust=2.65, size = 2.5, color = "blue" ) +
labs(title = paste("Diagrama de barras de ", variables[1], sep=""),
x = variables[1],
y = "") +
scale_x_discrete(breaks = valores_ordenados) +
theme(
panel.background = element_rect(fill = "transparent"), # bg of the panel
plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
panel.grid.major = element_blank(), # get rid of major grid
panel.grid.minor = element_blank(), # get rid of minor grid
legend.background = element_blank(), # get rid of legend bg
legend.box.background = element_blank(), # get rid of legend panel bg
legend.key = element_blank(), # get rid of key legend fill, and of the surrounding
axis.ticks.x=element_blank(),
axis.line.y = element_blank(),
axis.ticks.y=element_blank(),
axis.text.y=element_blank(),
legend.title = element_blank()
)
}
}
} # cierra grafico
if(grafico){
return(list(tabla,plot))
} else{
return(tabla)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.