Trabajo Individual Estadistica

Instrucciones:

Esta tarea se debe presentar máximo hasta las 23:55 del martes 18 de julio de 2023, exclusivamente a través del recurso creado en el aula virtual para el efecto. En caso de no entregar en la fecha indicada o usando algún otro recurso (correo electrónico, Teams, etc. . . ) la tarea no tendrá validez.
Se debe presentar únicamente un pdf con la solución de los ejercicios propuestos.
El pdf que se presente debe ser elaborado exclusivamente usando el recurso R-Markdown, caso contrario no tendrá validez.
En el pdf se debe visualizar tanto el texto, como el código y los resultados. Si solo se evidencian los resultados, no tendrá validez.
Si se observa dos o más trabajos con alto nivel de similitud, se dividirá la nota para el número de personas que presenten este particular.

Tomando en cuenta la siguiente base de datos:

library(knitr)

sexo<-c("Mujer","Hombre","Hombre","Hombre","Hombre","Mujer","Hombre","Mujer",
        "Mujer","Mujer","Hombre","Mujer","Mujer" ,"Mujer","Hombre" ,"Hombre",
        "Hombre" ,"Mujer" ,"Mujer" ,"Mujer")
talla<-c(49,48,47,43,49,48,50,51,50,46,49,48,49,50,50,50,51 ,50,49,49)
peso<-c(3.150,2.030,2.200,3.000,2.770,2.550,3.855,3.997,3.100,2.550,
        3.350,2.616,3.118,3.750,2.800,3.340,3.320,NA,3.050,2.860)
     
datos<-data.frame(sexo,talla,peso)   
kable(datos)

sexo	talla	peso
Mujer	49	3.150
Hombre	48	2.030
Hombre	47	2.200
Hombre	43	3.000
Hombre	49	2.770
Mujer	48	2.550
Hombre	50	3.855
Mujer	51	3.997
Mujer	50	3.100
Mujer	46	2.550
Hombre	49	3.350
Mujer	48	2.616
Mujer	49	3.118
Mujer	50	3.750
Hombre	50	2.800
Hombre	50	3.340
Hombre	51	3.320
Mujer	50	NA
Mujer	49	3.050
Mujer	49	2.860

Pregunta 1:

Construya una función propia de R llamada descriptivos, la cual, a partir de un conjunto de datos cuantitativos le permita:

Visualizar en una sola gráfica el boxplot y el histograma de la variable que ingresemos.
Visualizar los resúmenes numéricos: media, mediana, moda, varianza, desviación estándar, coeficiente de variación, cuartil 1, cuartil 2, cuartil 3, número de atípicos, coeficiente de asimentría y coeficiente de curtosis

Para el caso de la varianza, desviación estándar y coeficiente de variación, se deberán calcular los resúmenes numéricos originales, es decir, aquellos que están divididos para “n”, en lugar de para “n - 1”

IMPORTANTE:

Aplique esta función en las variables cuantitativas de la base de datos propuesta. Tome en cuenta que existe una variable con NA. Los resultados deberían ser los siguientes:

Descriptivos<-function(vari,na.rm=FALSE){
  ifelse(na.rm == TRUE ,
         vari <- as.vector(na.omit(vari)), 
         vari <- vari)
  n<-length(vari)
  Media<-sum(vari)/n
  Mediana<-median(vari)
  Moda<-function(vari){
  if(length((names(table(vari)[table(vari)==max(table(vari))])))==1){
    ((names(table(vari)[table(vari)==max(table(vari))])))}else{NA}}
  Varianza <- sum((vari - Media)^2) / n
  Desv.esta <- sqrt(Varianza)
  Coef.Vari. <- Desv.esta  / Media
  est<-boxplot(vari, plot = FALSE)
  n.atipicos<-length(est$out)
  Q1<-est$stats[2,1]
  Q3<-est$stats[4,1]
  par(mfrow = c(1, 2))
 
  boxplot(vari,main= "boxplot",col= 2)
  hist(vari , main= "histograma",col=2)
  
  estadisticos<-c("media"=Media,
                  "mediana"=Mediana,
                  "moda"=Moda(vari),
                  "varianza"=Varianza,
                  "D.est."=Desv.esta ,
                  "c.v"=Coef.Vari.,
                  "Q1"=Q1,
                  "Q3"=Q3,
                  "n.atip"=n.atipicos,
                  "asimetria"=psych::skew(vari,type = 2,na.rm=FALSE),
                  "curtosis"=(psych::kurtosi(vari, type = 2,na.rm=FALSE)));kable(estadisticos)}

Descriptivos(datos$talla)

	x
media	48.8000000
mediana	49.0000000
moda	NA
varianza	3.2600000
D.est.	1.8055470
c.v	0.0369989
Q1	48.0000000
Q3	50.0000000
n.atip	1.0000000
asimetria	-1.7729222
curtosis	4.2158025

Descriptivos(datos$peso)

	x
media	NA
mediana	NA
moda	2.55
varianza	NA
D.est.	NA
c.v	NA
Q1	2.693
Q3	3.33
n.atip	0
asimetria	NA
curtosis	NA

Descriptivos(datos$peso,na.rm=TRUE)

	x
media	3.02136842105263
mediana	3.05
moda	2.55
varianza	0.258638864265928
D.est.	0.508565496535036
c.v	0.16832290064045
Q1	2.693
Q3	3.33
n.atip	0
asimetria	0.0684931228159632
curtosis	-0.183933301650606

Pregunta 2.

Considere las siguientes tablas de frecuencia: Construya una función propia de R llamada “agrupcentral”, que le permita calcular la media, mediana y moda de estos datos. La función deberá admitir únicamente como input los intervalos y las frecuencias absolutas de las tablas.

Int	Fr. Abs
[42,44)	1
[44,46)	0
[46,48)	2
[48,50)	9
[50,52)	8

Int	Fr. Abs
[3, 7)	20
[7, 11)	25
[11,15)	30
[15,19)	15

agrupados<-function(intervalos,frecuencias.abs){
  pm<-intervalos[-length(intervalos)]+
    diff(intervalos)/2
  mean<-sum(frecuencias.abs*pm)/(sum(frecuencias.abs))
  Ene<-sum(frecuencias.abs)
  F.acumulada<-cumsum(frecuencias.abs)
  med<-if (Ene%%2==0){
    Ene/2
  }else{
    (Ene+1)/2}
  inter<-which((F.acumulada-med)>0)
  a<-min(inter)
  ss<-(which.max(frecuencias.abs)+1)
  superior<-frecuencias.abs[ss]
  ii<-(which.max(frecuencias.abs)-1)
  inferior<-frecuencias.abs[ii]
  ancho<-min(intervalos[which.min(intervalos)+1])-min(intervalos)
  m<-intervalos[a]+
    ((max(frecuencias.abs)-inferior)/((max(frecuencias.abs)-inferior)+
                                        (max(frecuencias.abs)-superior)))*ancho
    median<-if(sum((F.acumulada-med)==0) !=0){
    intervalos[which((F.acumulada-med)==0)+1]
  }else{
    inin<-min(which((F.acumulada-med)>0),intervalos[which((F.acumulada-med)==0)+1])
    intervalos[inin]+((((Ene/2)-F.acumulada[inin-1])/(F.acumulada[inin]))*(diff(intervalos)[1]))
  }
  mode<-data.frame("Media"=mean,"Mediana"=median,"Moda"=m)
  kable(mode)
  
}

agrupados(intervalos=seq(42, 52, by=2),frecuencias.abs=c(1,0,2,9,8))

Media	Mediana	Moda
49.3	49.16667	49.75

agrupados(intervalos=seq(3, 19, by=4),frecuencias.abs=c(20,25,30,15))

Media	Mediana	Moda
10.77778	11	12

Trabajo Individual Estadistica

Paola Alexandra Chacasaguay

2023-07-16

Pregunta 1:

IMPORTANTE:

Pregunta 2.