HEADmaster

3 files changed, 0 insertions, 324 deletions

diff --git a/admin/survey/modules/mod_kakovost/R/calc.usability.R b/admin/survey/modules/mod_kakovost/R/calc.usability.R
deleted file mode 100644
index 4e4bb0c..0000000
--- a/admin/survey/modules/mod_kakovost/R/calc.usability.R
+++ /dev/null
@@ -1,72 +0,0 @@
-calc.usability <- function(m.all, return.type){

-  # return.type:

-  #   1: return only absolute

-  #   2: return only %

-  #   3: return both (even rows: absolute, odd rows: %)

-  

-  ## calculations

-  m.all[, Prekinitve:=v3]

-  m.all[, Neodgovori:=v1]

-  m.all[, Nevsebinski:=v96+v97+v98+v99]

-  m.all[, Izpostavljen:=allqs-(v2+v3+v4+v5)]

-  setnames(m.all, "va", "Veljavni")

-  

-  m.all[, UNL:=Neodgovori/Izpostavljen]

-  m.all[is.na(UNL)==T, UNL:=0]

-  m.all[, UML:=(v3/allqs)+(1-(v3/allqs))*UNL]

-  m.all[, UCL:=1-UML]

-  m.all[, UIL:=v2/(v2+Izpostavljen)]

-  m.all[is.na(UIL)==T, UIL:=0]

-  m.all[, UAQ:=v4/allqs]

-  

-  m.all[, Uporabnost:=1-UML]

-  

-  #tidy up

-  setcolorder(m.all, c("recnum", "allqs", "Veljavni", "Nevsebinski", "Neodgovori", 

-                       "Izpostavljen", "Prekinitve", "Uporabnost",

-                       "v1", "v2", "v3", "v4", "v5", "v96", "v97", "v98", "v99",

-                       "UNL", "UML", "UCL", "UIL", "UAQ"))

-  

-  if(return.type==1){

-    return(m.all)

-  }else{

-    m.all.p <- copy(m.all)

-    

-    m.all.p[, (c("Veljavni", "Nevsebinski", "Neodgovori")) := lapply(.SD, "/", m.all.p$Izpostavljen), .SDcols=c("Veljavni", "Nevsebinski", "Neodgovori")]

-    m.all.p[, (c("Prekinitve", "v1", "v2", "v3", "v4", "v5", "v96", "v97", "v98", "v99")) := lapply(.SD, "/", m.all.p$allqs), .SDcols=c("Prekinitve", "v1", "v2", "v3", "v4", "v5", "v96", "v97", "v98", "v99")]

-    m.all.p[, Izpostavljen:=1]

-    

-    if(return.type==2){

-      return(m.all.p)

-    }else{

-      m.all[, Uporabnost:=Veljavni]

-      m.all[, c("UNL", "UML", "UCL", "UIL", "UAQ"):=NA]

-      m.all <- m.all[, lapply(.SD, as.character)]

-      

-      m.all.p[, allqs:=NA]

-      m.all.p[, allqs:=as.character(allqs)]

-      

-      change.cols <- c("Veljavni", "Nevsebinski", "Neodgovori", "Izpostavljen", "Prekinitve", "Uporabnost",

-                       "v1", "v2", "v3", "v4", "v5", "v96", "v97", "v98", "v99",

-                       "UNL", "UML", "UCL", "UIL", "UAQ")

-      m.all.p[, (change.cols):=lapply(.SD, function(x){paste0(round(x*100, 0), "%")}), .SD=change.cols]

-      

-      m.1ka <- data.table(matrix("", nrow=nrow(m.all)*2, ncol=ncol(m.all)))

-      

-      a.rows <- as.integer(seq(1, nrow(m.1ka), by=2))

-      p.rows <- as.integer(seq(2, nrow(m.1ka), by=2))

-      

-      set(m.1ka, a.rows, 1:ncol(m.1ka), value=m.all)

-      suppressWarnings(set(m.1ka, p.rows, 1:ncol(m.1ka), value=m.all.p))

-      

-      setnames(m.1ka, colnames(m.all))

-      m.1ka[, Status:=NA_character_]

-      setcolorder(m.1ka, c("recnum", "allqs", "Veljavni", "Nevsebinski", "Neodgovori", 

-                           "Izpostavljen", "Prekinitve", "Uporabnost", "Status",

-                           "v1", "v2", "v3", "v4", "v5", "v96", "v97", "v98", "v99",

-                           "UNL", "UML", "UCL", "UIL", "UAQ"))

-      

-      return(m.1ka)

-    }

-  }

-}
\ No newline at end of file
diff --git a/admin/survey/modules/mod_kakovost/R/gen.survey.str.R b/admin/survey/modules/mod_kakovost/R/gen.survey.str.R
deleted file mode 100644
index 32e1f57..0000000
--- a/admin/survey/modules/mod_kakovost/R/gen.survey.str.R
+++ /dev/null
@@ -1,71 +0,0 @@
-gen.survey.str <- function(colnames.dsa, questions.file, items.file){

-  #import questions file

-  questions <- fread(questions.file, skip=1, header=F,

-                     select=c(2, 5, 6, 8, 9, 10),

-                     col.names=c("question.id", "variable", "tip", "size", "visible", "params"))

-  

-  #create variable list from survey data file

-  #remove "recnum" and "_text" fields

-  var.data <- colnames.dsa[sapply(colnames.dsa, function(x){substr(x, nchar(x)-4, nchar(x))})!="_text"]

-  

-  #create variable list from questions file

-  var.questions <- questions$variable

-  

-  #generate data.table from var.data list

-  survey.str <- data.table(variable = var.data)

-  

-  setkey(questions, "variable")

-  setkey(survey.str, "variable")

-  

-  #if all var.data in var.questions, do the simple merge and return file

-  if(all(var.data %in% var.questions)){

-    survey.str <- questions[survey.str,]

-    return(survey.str)

-  }else{   #if not, import items file and do additional merge with it...

-    #import items file

-    items <- fread(items.file, skip=1, header=F,

-                   select=c(2, 3, 4),

-                   col.names=c("question.id", "item.id", "variable"))

-    

-    setkey(items, "question.id")

-    setkey(questions, "question.id")

-

-    #bind variables from questions and items (for the later, only take instances with no match in the questions file...)

-    survey.str.qi <- rbindlist(list(questions[var.questions %in% var.data,],

-                                    items[questions[!(var.questions %in% var.data), -"variable", with=F], nomatch=0L]), 

-                               fill=T)

-

-    #merge questions+items with survey data...

-    setkey(survey.str.qi, "variable")

-    setkey(survey.str, "variable")

-    survey.str <- survey.str.qi[survey.str,]

-    

-    #if all var.data is now matched, return the survey.str

-    if(!(any(is.na(survey.str)))){

-      return(survey.str)

-    }else{  #if not, do additional merging...

-      #create index of all NA instaces from survey.str...

-      index <- apply(cbind(survey.str[, is.na(tip)], 

-                           (sapply(survey.str[, variable], function(x){

-                             substr(x, 1, regexpr("\\_[^\\_]*$", x)-1)

-                           }) %in% survey.str.qi$variable)

-      ), 

-      1, all)

-      

-      #... using regex to find matches among unmatched instances from survey.str.qi

-      add <- merge(survey.str[index, list(variable, substr(variable, 1, regexpr("\\_[^\\_]*$", variable)-1))], 

-                   survey.str.qi[!(variable %in% survey.str$variable),], 

-                   by.x="V2", by.y="variable", all.y=F)[, list(question.id, item.id, tip, visible, size, params)]

-

-      #update survey.str with new values

-      survey.str[index, c("question.id", "item.id", "tip", "visible", "size", "params") := as.list(add)]

-

-      #if there is no NAs left, return survey.str, else return msg

-      if(!(any(is.na(survey.str$tip)))){

-        return(survey.str)

-      }else{

-        return(paste("No match found for: ", survey.str[is.na(tip), variable]))

-      }

-    }

-  }

-}

diff --git a/admin/survey/modules/mod_kakovost/R/gen.usability.matrix.R b/admin/survey/modules/mod_kakovost/R/gen.usability.matrix.R
deleted file mode 100644
index a2b1465..0000000
--- a/admin/survey/modules/mod_kakovost/R/gen.usability.matrix.R
+++ /dev/null
@@ -1,181 +0,0 @@
-gen.usability.matrix <- function(dsa, survey.str){

-  #define special values to detect

-  #order of this values is important: 

-  #  in case of conflicts @ chk.t types of questions the order sets the priporty of which values to keep

-  special.v <- c(-1, -3, -5, -96, -97, -98, -99, -4, -2)

-  

-  #define which variables belong to checkbox-like* questions

-  #(* i.e.: check for special values @ ANY variable per question/item ID)

-  # 2: normal checkbox

-  # 16: multicheckbox

-  # 17: ranking

-  chkbox.t <- c(2, 16, 17)

-  

-  ##all other variables belong to normal** questions

-  #(** i.e.: check for special values @ each variable per question/item ID)

-  #if there are no normal questions, create 0 matrix, otherwise...

-  if(nrow(survey.str[!(tip %in% chkbox.t),])==0){

-    m.n <- matrix(0, nrow = nrow(dsa), ncol=length(special.v)+1)

-  }else{

-    #create list of all normal questions

-    c.n <- colnames(dsa)[which(colnames(dsa) %in% survey.str[!(tip %in% chkbox.t), variable])]

-    

-    #...count all non-special values for each variable

-    #... + count each special value for each variable

-    m.n <- cbind(rowSums(sapply(dsa[, c.n, with=FALSE], function(x){!(x %in% special.v)})),

-                 sapply(special.v, function(x){as.integer(rowSums(dsa[, c.n, with=FALSE]==x, na.rm=TRUE))}))

-  }

-  

-  ##procedure for tip:2

-  #only run if there is an at least one tip:2 variable

-  if(survey.str[, any(tip==2)]){

-    #get list of all unique tip:2 question ids

-    q.2 <- unique(survey.str[tip==2, question.id])

-    #get list of all corresponding variables for each q.2 id

-    c.2 <- lapply(q.2, function(x){colnames(dsa)[which(colnames(dsa) %in% survey.str[question.id==x & tip==2, variable])]})

-    

-    #(do this for each instance in c.2):

-    #for each set of variables:

-    # check if any variable contains at least one non-special value

-    # + (for each special value) check if any variable contains at least special value 

-    m.2 <- lapply(c.2, function(x){

-      cbind(apply(dsa[, x, with=FALSE], 1, function(q){any(!(q %in% special.v))}),

-            sapply(special.v, function(y){

-              apply(dsa[, x, with=FALSE], 1, function(q){any(q==y)})

-            })

-      )

-    })

-    

-    # (do this for each instance in c.2)

-    # if multiple special values per respondent exist, keep only the first one

-    m.2 <- lapply(m.2, function(x){

-      if(any(rowSums(x)>1)){

-        p <- x[rowSums(x)>1,]

-        for(i in 1:nrow(p)){

-          a <- p[i,]

-          f <- TRUE

-          for(j in 1:length(a)){

-            print(j)

-            if(a[j] & f){

-              f <- FALSE

-            }else if(a[j] & !f){

-              a[j] <- FALSE

-            }

-          }

-          p[i,] <- a

-        }

-        x[rowSums(x)>1,] <- p

-      }else{x}

-    })

-    

-    

-    #add to m.n

-    m.n <- m.n + Reduce('+', m.2) 

-  }

-  

-  ##procedure for tip:16

-  #only run if there is an at least one tip:16 variable

-  if(survey.str[, any(tip==16)]){

-    #get list of all unique tip:16 item ids

-    q.16 <- unique(survey.str[tip==16, item.id])

-    

-    #get list of all corresponding variables for each q.16 id

-    c.16 <- lapply(q.16, function(x){colnames(dsa)[which(colnames(dsa) %in% survey.str[item.id==x & tip==16, variable])]})

-    #(do this for each special value):

-    #for each set of variables, check if any variable contains at least one special value

-    # m.16 <- sapply(special.v, function(x){

-    #   rowSums(sapply(c.16, function(y){

-    #     apply(dsa[, y, with=FALSE], 1, function(q){any(q==x)})

-    #   }))

-    # })

-    

-    #(do this for each instance in c.16):

-    #for each set of variables:

-    # check if any variable contains at least one non-special value

-    # + (for each special value) check if any variable contains at least special value 

-    m.16 <- lapply(c.16, function(x){

-      cbind(apply(dsa[, x, with=FALSE], 1, function(q){any(!(q %in% special.v))}),

-            sapply(special.v, function(y){

-              apply(dsa[, x, with=FALSE], 1, function(q){any(q==y)})

-            })

-      )

-    })

-    

-    # (do this for each instance in c.16)

-    # if multiple special values per respondent exist, keep only the first one

-    m.16 <- lapply(m.16, function(x){

-      if(any(rowSums(x)>1)){

-        p <- x[rowSums(x)>1,]

-        for(i in 1:nrow(p)){

-          a <- p[i,]

-          f <- TRUE

-          for(j in 1:length(a)){

-            print(j)

-            if(a[j] & f){

-              f <- FALSE

-            }else if(a[j] & !f){

-              a[j] <- FALSE

-            }

-          }

-          p[i,] <- a

-        }

-        x[rowSums(x)>1,] <- p

-      }else{x}

-    })

-    

-    m.n <- m.n + Reduce('+', m.16)

-  }

-  

-  ##procedure for tip:17

-  #only run if there is an at least one tip:17 variable

-  if(survey.str[, any(tip==17)]){

-    #get list of all unique tip:17 question ids

-    q.17 <- unique(survey.str[tip==17, question.id])

-    

-    #get list of all corresponding variables for each q.17 id

-    c.17 <- lapply(q.17, function(x){colnames(dsa)[which(colnames(dsa) %in% survey.str[question.id==x & tip==17, variable])]})

-    

-    #similiar procedure as for tip:2 and tip:16....

-    m.17 <- lapply(c.17, function(x){

-      cbind(apply(dsa[, x, with=FALSE], 1, function(q){any(!(q %in% special.v))}),

-            sapply(special.v, function(y){

-              apply(dsa[, x, with=FALSE], 1, function(q){any(q==y)})

-            })

-      )

-    })

-    

-    #... the only difference is that we are checking for all rowsums > 0, not > 1

-    m.17 <- lapply(m.17, function(x){

-      if(any(rowSums(x)>1)){

-        p <- x[rowSums(x)>0,]

-        for(i in 1:nrow(p)){

-          a <- p[i,]

-          f <- TRUE

-          for(j in 1:length(a)){

-            if(a[j] & f){

-              f <- FALSE

-            }else if(a[j] & !f){

-              a[j] <- FALSE

-            }

-          }

-          p[i,] <- a

-        }

-        x[rowSums(x)>0,] <- p

-      }else{x}

-    })

-    

-    m.n <- m.n + Reduce('+', m.17)

-  } 

-  

-  m.n <- cbind(m.n, rowSums(m.n))

-  

-  if(all(m.n[, ncol(m.n)][1]==m.n[, ncol(m.n)])){

-    m.n <- as.data.table(m.n)

-    m.n[, recnum:=dsa$recnum]

-    setnames(m.n, colnames(m.n)[-length(colnames(m.n))], c("va", "v1", "v3", "v5", "v96", "v97", "v98", "v99", "v4", "v2", "allqs"))

-    setcolorder(m.n, c("recnum", colnames(m.n)[-length(colnames(m.n))]))

-    return(m.n)

-  }else{

-    print("not all rowsums equal!") 

-  }

-}
\ No newline at end of file