R/deb_proj.R

In adrienPAv/Projet_lib_R: What the Package Does (One Line, Title Case)

#############################
#---------Librairies
#############################
install.packages("questionr")
library(questionr)
install.packages(c("FactoMineR", "factoextra"))
library("FactoMineR")
library("factoextra")
install.packages('rmarkdown')
library('rmarkdown')
usethis::use_vignette("comment-utiliser-mon-package")


data<- read.table("C:/Users/adrien/Downloads/temperat.csv", sep = ";",header = 1,row.names = 1)
#data<- read.table("C:/Users/adrien/Downloads/ford.csv", sep = ",",header = 1)
#data = data[1:500,]
#dataqua = data[,c(2,3,5,7:9)]

dataqua = data[,1:14]

########################
#------partie CAH (au pr?alable)
#########################
#on centre et on r?duit
data.cr<-scale(dataqua, center = T, scale=T)
d.data <- dist(data.cr)


cah.ward <- hclust(d.data,method="ward.D2")
#dendrogramme avec mat?rialisation des groupes
plot(cah.ward)
rect.hclust(cah.ward,k=5)
#d?coupage en 4 groupes
groupes.cah <- cutree(cah.ward,k=5)
#liste des groupes
print(sort(groupes.cah))
data['groupe'] = groupes.cah
data[["groupe"]] = as.factor(data[["groupe"]])
data[["R?gion"]] = as.factor(data[["R?gion"]])
data[["vraigroupe"]] = as.factor(data[["groupe"]])
data[1,19] = "2"
data[9,19] ="1"
data[13,9] ="4"
#############Fonction#########################
#----------unilat?ral
##############################################
etude_quali <- function(data,varqual1, vargroupe){
  #contr?le - data.frame
  ok <- is.data.frame(data)
  if (!ok){
    stop("Ce n'est pas un data frame")
  }
  tableau <- table(data[[varqual1]],data[[vargroupe]])
  nli = nrow(tableau)
  nco = ncol(tableau)
  eff = addmargins(tableau)
  pourc = addmargins(prop.table(addmargins(tableau,1),1),2)
  tab_vtest <- table(data[[varqual1]],data[[vargroupe]])
  for (i in 1:nli){
    for (j in 1:nco){
      v = (sqrt(eff[i,nco+1]))*((pourc[i,j] - pourc[nli+1,j])/(sqrt(((eff[nli+1,nco+1]-eff[i,nco+1])/(eff[nli+1,nco+1] - 1))*pourc[i,j]* (1-pourc[i,j]))))
      tab_vtest[i,j] <- v
    }
  }
  print("ci dessous tableau des valeurs tests")
  print(tab_vtest)
  tab_taille <- table(data[[varqual1]],data[[vargroupe]])
  for (i in 1:nli){
    for (j in 1:nco){
      taille = eff[i,j]/eff[i,nco+1]
      tab_taille[i,j] <- taille
    }

  }
  print(" ci dessous le tableau des tailles")
  print(tab_taille)
  #r?alisation des profils ligne et colonne
  lprop(tableau, digits=1)#la distribution de la r?gion parmis ceux heureux || 4 profils lignes
  #ensemnle = profil moyen
  cprop(tableau, digits=2)
  #on s'uppose la d?pendance car les profils sont distincts
  # on test l'ind?pendance
  chisq = chisq.test(tableau)
  print(chisq)
  #aphiques
  colors <- c("chartreuse4", "chartreuse1", "orange","green")
  barplot(tableau, col=colors, main = "heureux par libert? sur internet", ylab="nombre ")
  mosaicplot(tableau, col = colors)
  res.ca <- CA(tableau, graph = TRUE)
  #print(res.ca)

}


etude_quali(data,"R?gion","groupe")



#------------bilat?ral
##############################################
print(data)
etude_quali_bila <- function(data, vargroupe){
  ind.qual = sapply(data,is.factor)
  data.qual <- data[ ,ind.qual]
  print(data.qual)
  res.mca <- MCA (data.qual,graph = FALSE)  #calcul de l'ACM, r???sultats mis dans une variable
  #print(res.mca) #Variable resultat contient tous les elements suivants

  fviz_mca_var(res.mca, repel = TRUE,col.var = "contrib",
               ggtheme= theme_minimal())
}


#data[["transmission"]] = as.factor(data[["transmission"]])
#data[["model"]] = as.factor(data[["model"]])
#typeof(data[['goupe']])
etude_quali_bila(data,"groupe")





comparaison(data, "groupe","vraigroupe")

sprintf("Il y a une pr?diction de %i dans la classe",str(colnames(matrice_conf,1)))






nli = nrow(tableau)
rep(0,nli)
data.frame(modalit?s = row.names(tableau),plg=rep(0,nli), pl = rep(0,nli))

tableau <- table(data$R?gion,data$groupe)
eff = addmargins(tableau)
pourc = addmargins(prop.table(addmargins(tableau,1),1),2)

#pourc[2,5]
#vtNord_5 = (sqrt(eff[2,6]))*((pourc[2,5] - pourc[5,5])/(sqrt(((eff[5,6]-eff[2,6])/(eff[5,6] - 1))*pourc[2,5]* (1-pourc[2,5]))))
#vtNord_5


# tab_vtest <- table(data$R?gion,data$groupe)
# for (i in 1:4){
#   for (j in 1:5){
#     v = (sqrt(eff[i,6]))*((pourc[i,j] - pourc[5,j])/(sqrt(((eff[5,6]-eff[i,6])/(eff[5,6] - 1))*pourc[i,j]* (1-pourc[i,j]))))
#     tab_vtest[i,j] <- v
#   }
# }
# print(tab_vtest)

print(data[data$groupe == 1,])

#sur-repr?sentivit? de sud dans le groupe 2
tableau <- table(data$groupe,data$R?gion)
eff = addmargins(tableau)
print(eff)
plg = eff[2,4]/eff[2,5]
pl = eff[6,4]/eff[6,5]
pla = (eff[6,4]-eff[2,4])/(eff[6,5]-eff[2,5])

khi = chisq.test(tableau)

print(c(plg,pl,pla))

data[["groupe"]] = as.character(data[["groupe"]])
head(data)
cat <- sapply(dataqual, is.factor)
data.qual =  data[,colnames(data)[grepl('character',sapply(data,class))]]
data.qual = data.qual[,-which(names(data.qual) %in% c("Region"))]
print(data.qual)
























library(gridExtra)


names(data) <- c("modalit?",
                 expression(plg),
                 expression(pl))
tt <- ttheme_default(colhead=list(fg_params = list(parse=TRUE)))
tbl <- tableGrob(data, rows=NULL, theme=tt)
# Plot chart and table into one object
grid.arrange(tbl,
             nrow=2,
             as.table=TRUE,
             heights=c(3,1))