R/levels.R

In knotion/PFSkit:

#' @title get_pflevels
#' Función que calcula Proficiency Levels de los valores plausibles
#' @details Calcula los niveles de proficiencia
#' @param data dataframe con la información de los indices y las pesos de replicación
#' @param pattern el patron de las columnas que contienen los valores plausibles
#' @export
#' @import dplyr

estimate_levels<-function(df,patt='pv'){
 vdums<-colnames(df%>%select(contains(patt)))
 domains<-gsub('[[:digit:]]+', '', vdums)
 domains<-gsub('pv', '', domains)
 domains<-gsub('\\.y', '', domains)
 print(domains)
 dfo<-make_levels(vdums,domains,df)
}

get_pflevels<-function(data,item,domain='math',levelspathf='data/Proficiency_levels.xlsx',id='stidstd'){
  plevels<-readxl::read_excel(levelspathf)%>%filter(Domain==domain)
  coln <- paste(item,'lev',sep='_')
   df<-data%>%select(c(item))%>%
     mutate(!!coln := case_when(
            . < plevels[['Level_1']] ~ 0,
            . < plevels[['Level_2']] ~ 1,
            . < plevels[['Level_3']] ~ 2,
            . < plevels[['Level_4']] ~ 3,
            . < plevels[['Level_5']] ~ 4,
            . < plevels[['Level_6']] ~ 5,
            . >= plevels[['Level_6']] ~ 6,
            TRUE ~ as.numeric(NA))
        )%>%select(-item)
  return(cbind('stidstd'=data[,id],df))
}

make_levels<-function(vdums,domain,df){
  dataw<-purrr::map2(vdums,domain,get_pflevels, data = df) %>%
    purrr::reduce(inner_join,by = 'stidstd')
}

#' @title get_readerpf
#' Función que calcula el Reader Profile
#' @details Calcula los Reader Profile por estudiante
#' @param data dataframe con las respuestas del cuestionario cognitivo
#' @export
#' @import dplyr
get_readerpf<-function(data){
   dfq<-get_09ST25_recoded(data)
   dfundrem<-get_UNDREM(data)
   dfmetasum<-get_METASUM(data)
   df<-dfq%>%inner_join(dfundrem)%>%
     inner_join(dfmetasum)
  return(df)
}

get_09ST25_recoded <- function(questionaire) {
  q_09ST25 <- questionaire %>% select(stidstd,contains('ST25Q0')) %>%
    rowwise() %>% #recoding
    mutate(
      magazine = case_when(
        `ST25Q01_9` == 4 | `ST25Q01_9` == 5 ~ 1,
        `ST25Q01_9` == 3 | `ST25Q01_9` == 2 | `ST25Q01_9` == 1 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      comic = case_when(
        `ST25Q02_9` == 4 | `ST25Q02_9` == 5 ~ 1,
        `ST25Q02_9` == 3 | `ST25Q02_9` == 2 | `ST25Q02_9` == 1 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      fiction = case_when(
        `ST25Q03_9` == 4 | `ST25Q03_9` == 5 ~ 1,
        `ST25Q03_9` == 3 | `ST25Q03_9` == 2 | `ST25Q03_9` == 1 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      nonfic = case_when(
        `ST25Q04_9` == 4 | `ST25Q04_9` == 5 ~ 1,
        `ST25Q04_9` == 3 | `ST25Q04_9` == 2 | `ST25Q04_9` == 1 ~ 0,
        TRUE ~ as.numeric(NA)
      ),
      news = case_when(
        `ST25Q05_9` == 4 | `ST25Q05_9` == 5 ~ 1,
        `ST25Q05_9` == 3 | `ST25Q05_9` == 2 | `ST25Q05_9` == 1 ~ 0,
        TRUE ~ as.numeric(NA)
      )
    ) %>%
    select(-contains('ST25Q0'))
  return(q_09ST25)
}
#Function to get UNDREM variable. Input: PFS CONTEXT Questionaire
get_UNDREM <- function(questionaire) {
  q_UNDREM <- questionaire %>%
    select(stidstd,contains('ST41Q0')) %>%
    mutate(`ST41Q01_9` = replace(`ST41Q01_9`, which(`ST41Q01_9`>90), NA),
           `ST41Q02_9` = replace(`ST41Q02_9`, which(`ST41Q02_9`>90), NA),
           `ST41Q03_9` = replace(`ST41Q03_9`, which(`ST41Q03_9`>90), NA),
           `ST41Q04_9` = replace(`ST41Q04_9`, which(`ST41Q04_9`>90), NA),
           `ST41Q05_9` = replace(`ST41Q05_9`, which(`ST41Q05_9`>90), NA),
           `ST41Q06_9` = replace(`ST41Q06_9`, which(`ST41Q06_9`>90), NA)) %>%
    rowwise() %>% #scoring 9 questions that form UNDREM
    mutate(
      score_1 = case_when(
        `ST41Q03_9` > `ST41Q01_9` ~ 1,
        `ST41Q03_9` <= `ST41Q01_9` ~ 0,
        is.na(`ST41Q03_9` > `ST41Q01_9`) ~ as.numeric(NA)
      ),
      score_2 = case_when(
        `ST41Q03_9` > `ST41Q02_9` ~ 1,
        `ST41Q03_9` <= `ST41Q02_9` ~ 0,
        is.na(`ST41Q03_9` > `ST41Q02_9`) ~ as.numeric(NA)
      ),
      score_3 = case_when(
        `ST41Q03_9` > `ST41Q06_9` ~ 1,
        `ST41Q03_9` <= `ST41Q06_9` ~ 0,
        is.na(`ST41Q03_9` > `ST41Q06_9`) ~ as.numeric(NA)
      ),
      score_4 = case_when(
        `ST41Q04_9` > `ST41Q01_9` ~ 1,
        `ST41Q04_9` <= `ST41Q01_9` ~ 0,
        is.na(`ST41Q04_9` > `ST41Q01_9`) ~ as.numeric(NA)
      ),
      score_5 = case_when(
        `ST41Q04_9` > `ST41Q02_9` ~ 1,
        `ST41Q04_9` <= `ST41Q02_9` ~ 0,
        is.na(`ST41Q04_9` > `ST41Q02_9`) ~ as.numeric(NA)
      ),
      score_6 = case_when(
        `ST41Q04_9` > `ST41Q06_9` ~ 1,
        `ST41Q04_9` <= `ST41Q06_9` ~ 0,
        is.na(`ST41Q04_9` > `ST41Q06_9`) ~ as.numeric(NA)
      ),
      score_7 = case_when(
        `ST41Q05_9` > `ST41Q01_9` ~ 1,
        `ST41Q05_9` <= `ST41Q01_9` ~ 0,
        is.na(`ST41Q05_9` > `ST41Q01_9`) ~ as.numeric(NA)
      ),
      score_8 = case_when(
        `ST41Q05_9` > `ST41Q02_9` ~ 1,
        `ST41Q05_9` <= `ST41Q02_9` ~ 0,
        is.na(`ST41Q05_9` > `ST41Q02_9`) ~ as.numeric(NA)
      ),
      score_9 = case_when(
        `ST41Q05_9` > `ST41Q06_9` ~ 1,
        `ST41Q05_9` <= `ST41Q06_9` ~ 0,

        is.na(`ST41Q05_9` > `ST41Q06_9`) ~ as.numeric(NA))) %>%
    select(-contains('ST41')) %>% #Calculating UNDREM
    mutate(UNDREM=((score_1+score_2+score_3+score_4+score_5+score_6+score_7+score_8+score_9)/9)) %>%
    select(-contains('score'))
  #Normalizing UNDREM
  q_UNDREM$UNDREM <-
    (q_UNDREM$UNDREM - mean(q_UNDREM$UNDREM, na.rm = TRUE)) / sd(q_UNDREM$UNDREM, na.rm =
                                                                   TRUE)
  return(q_UNDREM)
}

#Function to get METASUM variable. Input: PFS CONTEXT Questionaire
get_METASUM <- function(questionaire) {
  #METASUM
  q_METASUM <- questionaire %>%
    select(stidstd,contains('ST42Q0')) %>% #recoding NA values
    mutate(`ST42Q01_9` = replace(`ST42Q01_9`, which(`ST42Q01_9`>90), NA),
           `ST42Q02_9` = replace(`ST42Q02_9`, which(`ST42Q02_9`>90), NA),
           `ST42Q03_9` = replace(`ST42Q03_9`, which(`ST42Q03_9`>90), NA),
           `ST42Q04_9` = replace(`ST42Q04_9`, which(`ST42Q04_9`>90), NA),
           `ST42Q05_9` = replace(`ST42Q05_9`, which(`ST42Q05_9`>90), NA)) %>%
    rowwise() %>% #Recoding following rules from PFS techinical guide
    mutate(
      score_1 = case_when(
        `ST42Q04_9` > `ST42Q01_9` ~ 1,
        `ST42Q04_9` <= `ST42Q01_9` ~ 0,
        is.na(`ST42Q04_9` > `ST42Q01_9`) ~ as.numeric(NA)
      ),
      score_2 = case_when(
        `ST42Q04_9` > `ST42Q03_9` ~ 1,
        `ST42Q04_9` <= `ST42Q03_9` ~ 0,
        is.na(`ST42Q04_9` > `ST42Q03_9`) ~ as.numeric(NA)
      ),
      score_3 = case_when(
        `ST42Q04_9` > `ST42Q02_9` ~ 1,
        `ST42Q04_9` <= `ST42Q02_9` ~ 0,
        is.na(`ST42Q04_9` > `ST42Q02_9`) ~ as.numeric(NA)
      ),
      score_4 = case_when(
        `ST42Q05_9` > `ST42Q01_9` ~ 1,
        `ST42Q05_9` <= `ST42Q01_9` ~ 0,
        is.na(`ST42Q05_9` > `ST42Q01_9`) ~ as.numeric(NA)
      ),
      score_5 = case_when(
        `ST42Q05_9` > `ST42Q03_9` ~ 1,
        `ST42Q05_9` <= `ST42Q03_9` ~ 0,
        is.na(`ST42Q05_9` > `ST42Q03_9`) ~ as.numeric(NA)
      ),
      score_6 = case_when(
        `ST42Q05_9` > `ST42Q02_9` ~ 1,
        `ST42Q05_9` <= `ST42Q02_9` ~ 0,
        is.na(`ST42Q05_9` > `ST42Q02_9`) ~ as.numeric(NA)
      ),
      score_7 = case_when(
        `ST42Q01_9` > `ST42Q02_9` ~ 1,
        `ST42Q01_9` <= `ST42Q02_9` ~ 0,
        is.na(`ST42Q05_9` > `ST42Q03_9`) ~ as.numeric(NA)
      ),
      score_8 = case_when(
        `ST42Q03_9` > `ST42Q02_9` ~ 1,
        `ST42Q03_9` <= `ST42Q02_9` ~ 0,
        is.na(`ST42Q03_9` > `ST42Q02_9`) ~ as.numeric(NA))
    ) %>%
    select(-contains('ST42')) %>% #Calculating METASUM value
    mutate(METASUM=((score_1+score_2+score_3+score_4+score_5+score_6+score_7+score_8)/8)) %>%
    select(-contains('score'))
  #Normalizing METASUM
  q_METASUM$METASUM<-(q_METASUM$METASUM-mean(q_METASUM$METASUM,na.rm=TRUE))/sd(q_METASUM$METASUM,na.rm=TRUE)
  return(q_METASUM)
}