R/get_percent.R

In knotion/PFSkit:

#' @title get_all
#' Función que calcula todo
#' @details Función que calcula todo
#' @export
#' @import dplyr
get_all<-function(){
    qtx<-read.csv("data/input_pfs_context_mex_2018.csv")
    qcog<-read.csv("data/input_pfs_cognitive_mex_2018.csv")
    p<-get_goldDatasetStd(qtx,qcog)
    d<-estimate_percents(p)
    d2<-estimate_media(p)
    d3<-estimate_score(p)
    df<-inner_join(d,d2)%>%
      inner_join(d3)
    return(list("student"=p,"school"=df))
}

#' @title get_percent
#' Función que calcula porcentaje de una categoria para un item (categorico) de un dataframe
#' @details Calcula el porcentaje y el error asociado a una categoria de un item dado
#'  usando pesos de replicación
#' @param data dataframe con la información de los items y las pesos de replicación
#' @param item string con el id (columna) del item de interes
#' @param group string con el nombre de la columna por la que se va agrupar
#' @export
#' @import dplyr

estimate_percents<-function(data,indices=c('DISCLIMA','DISCLIM','STUDREL','INSTMOT','INSTSCIE','MATHEFF','SCIEEFF')){
  p<-get_params(indices)
  l1<-paste(p[[indices[1]]]$items,p[[indices[1]]]$PISA%%100,sep= ifelse(p[[indices[1]]]$PISA%%100 >10,'_' ,'_0' ))
  l2<-paste(p[[indices[2]]]$items,p[[indices[2]]]$PISA%%100,sep= ifelse(p[[indices[2]]]$PISA%%100 >10,'_' ,'_0' ))
  lvars0<-c(l1,l2)
  df0<-make_percents(lvars0,data,flag = -1)
  lvars<-paste(p[[indices[3]]]$items,p[[indices[3]]]$PISA%%100,sep= ifelse(p[[indices[3]]]$PISA%%100 >10,'_' ,'_0' ))
  for(id in indices[4:length(indices)]){
    lv<-paste(p[[id]]$items,p[[id]]$PISA%%100,sep='_')
    lvars<-c(lvars,lv)
  }
  df<-make_percents(lvars,data)
  return(inner_join(df0,df))
}


#' @title get_media
#' Función que calcula la media de un indice de un dataframe
#' @details Calcula la media y el error asociado de un indice dado
#'  usando pesos de replicación
#' @param data dataframe con la información de los indices y las pesos de replicación
#' @param indices lista  con los id (columna) del indice de interes
#' @export
#' @import dplyr
estimate_media<-function(data,indices=c('ESCS','DISCLIMA','DISCLIM','STUDREL','INSTMOT','INSTSCIE','MATHEFF','SCIEEFF')){
  lvars<-indices
  df<-make_media(lvars,data)
  return(df)
}

#' @title get_scores
#' Función que calcula la media de un indice de un dataframe
#' @details Calcula la media y el error asociado de un indice dado
#'  usando pesos de replicación
#' @param data dataframe con la información de los indices y las pesos de replicación
#' @param indices lista  con los id (columna) del indice de interes
#' @export
#' @import dplyr
estimate_score<-function(data,domain=c('read','math','scie')){
  lvars<-domain
  #average scores
  dfav<-make_score(lvars,df=data)
  #average score by gender
  dff<-make_score_cat(lvars,df=data)#female
  dfm<-make_score_cat(lvars,df=data,cat=2)#male
  df<-dfav%>%
    inner_join(dff,by='stidsch',suffix = c("", "_f"))%>%
    inner_join(dfm,by='stidsch',suffix = c("", "_m"))
  return(df)
}




make_percents<-function(vdums,df,flag=1){
  dataw<-purrr::map(vdums,get_percent, data = df,flag=flag) %>%
    purrr::reduce(inner_join,by = 'stidsch')
}

make_media<-function(vdums,df){
  dataw<-purrr::map(vdums,get_mean, data = df) %>%
    purrr::reduce(inner_join,by = 'stidsch')
}

make_score<-function(vdums,df){
  dataw<-purrr::map(vdums,get_score, data = df) %>%
    purrr::reduce(inner_join,by = 'stidsch')
}

make_score_cat<-function(vdums,df,qu='ST004Q01_15',cat=1){
  df<-df%>%filter(eval(as.symbol(qu))==cat)
  dataw<-purrr::map(vdums,get_score, data = df) %>%
    purrr::reduce(inner_join,by = 'stidsch')
}


get_percent<-function(data,item,flag=1,agrupar='stidsch'){
   schools<-unique(data[,agrupar])
   interitem<-dplyr::select(data,item)
   interitem[interitem==99]<-NA
   interitem[interitem>4]<-NA
   if (flag==1){
    interitem[interitem<=2]<-1
   }else{
     interitem[interitem<=2]<- -1
     interitem[interitem > 2]<- 1
   }
   data[[item]]<-interitem[,item]
   datapos<-as.data.frame(data[complete.cases(data[[item]]),])
   datapos$W_FSTUWT<-1
   df<-datapos%>%filter(stidsch==schools[1])
   df<-estima.prop(dat = df,medida = item)
   percents <- data.frame(matrix(unlist(df), nrow=length(df)/2, byrow=T))
   percents<-percents[1,]
   for(s in schools[2:length(schools)]){
     df<-datapos%>%filter(stidsch==s)
     df<-estima.prop(dat = df,medida = item)
     p <- data.frame(matrix(unlist(df), nrow=length(df)/2, byrow=T))
     p<-p[1,]
     percents <- rbind(percents,p)
   }
   dfo<-cbind(stidsch=schools,percents)
   colnames(dfo)<-c(agrupar,item,paste(item,'se',sep = '_'))
   return(dfo)
   #return(datapos)
 }


get_mean<-function(data,item,flag=1,agrupar='stidsch'){
  schools<-unique(data[,agrupar])
  datapos<-as.data.frame(data[complete.cases(data[[item]]),])
  #datapos<-data
  datapos$W_FSTUWT<-1
  df<-datapos%>%filter(stidsch==schools[1])
  df<-estima.media(dat = df,medida = item)
  percents <- data.frame(matrix(unlist(df), nrow=length(df)/2, byrow=T))
  percents<-percents[1,]
  for(s in schools[2:length(schools)]){
    df<-datapos%>%filter(stidsch==s)
    df<-estima.media(dat = df,medida = item)
    p <- data.frame(matrix(unlist(df), nrow=length(df)/2, byrow=T))
    p<-p[1,]
    percents <- rbind(percents,p)
  }
  dfo<-cbind(stidsch=schools,percents)
  colnames(dfo)<-c(agrupar,item,paste(item,'se',sep = '_'))
  return(dfo)
}


get_score<-function(data,item,flag=1,agrupar='stidsch'){
  schools<-unique(data[,agrupar])
  #<-as.data.frame(data[complete.cases(data[[item]]),])
  datapos<-data
  datapos$W_FSTUWT<-1
  df<-datapos%>%filter(stidsch==schools[1])
  df<-estima.vp.media(dat = df,medida = item)
  percents <- data.frame(matrix(unlist(df), nrow=length(df)/2, byrow=T))
  percents<-percents[1,]
  for(s in schools[2:length(schools)]){
    df<-datapos%>%filter(stidsch==s)
    df<-estima.vp.media(dat = df,medida = item)
    p <- data.frame(matrix(unlist(df), nrow=length(df)/2, byrow=T))
    p<-p[1,]
    percents <- rbind(percents,p)
  }
  dfo<-cbind(stidsch=schools,percents)
  colnames(dfo)<-c(agrupar,item,paste(item,'se',sep = '_'))
  return(dfo)
}