adapted tia names to new dexter

.Rbuildignore

@@ -8,3 +8,4 @@
 ^example
 ^cran-comments\.md$
 ^inno
+LICENSE

DESCRIPTION

@@ -2,14 +2,14 @@ Package: dextergui
 Type: Package
 Title: A Graphical User Interface for Dexter
 Version: 0.2.4
-Authors@R: c(person("jesse","koops", role = c("aut", "cre"), email="[email protected]"),
+Authors@R: c(person("Jesse","Koops", role = c("aut", "cre"), email="[email protected]"),
               person("Eva","de Schipper", role = c("aut")),
               person("Ivailo","Partchev", role = c("aut", "ctb")),
 	            person("Gunter", "Maris", role = c("aut", "ctb")),
 	            person("Timo", "Bechger", role = c("aut", "ctb")),
 	            person("Gareth", "Watts", role = c("cph"), comment = "author of jquery.sparkline"),
 	            person("Hakim", "El Hattab", role = c("cph"), comment = "author of zoom.js"))
-Maintainer: jesse koops <[email protected]>
+Maintainer: Jesse Koops <[email protected]>
 Description: Classical Test and Item analysis, 
   Item Response analysis and data management for educational and psychological tests.
 License: GPL-3

NEWS.md

@@ -1,5 +1,10 @@
 # dextergui 0.2.3
 
+* minor corrections to GUI behavior
+* updates for dexter 1.1.5
+
+# dextergui 0.2.3
+
 * suggest knitr in description at request of cran
 
 # dextergui 0.2.2

R/misc.R

@@ -137,25 +137,35 @@ im_is_connected = function(im)
   return(all(visited))
 }
 
-ctt_items_table = function(itemStats, averaged)
+combined_var = function(means,vars,n)
+{
+  if(length(vars)<=1L)
+    return(vars)
+  q = (n-1)*vars + n*means^2
+  (sum(q) - sum(n)* weighted.mean(means,n)^2)/(sum(n)-1)
+}
+
+ctt_items_table = function(items, averaged)
 {
   if(averaged)
   {
-    itemStats = itemStats %>% 
+    items = items %>% 
       group_by(.data$item_id) %>% 
-      summarise(nBooklets = n(), 
-                meanScore = weighted.mean(.data$meanScore, w = .data$n, na.rm = TRUE), 
-                sdScore = weighted.mean(.data$sdScore, w = .data$n, na.rm = TRUE), 
-                maxScore = max(.data$maxScore), 
-                pvalue = weighted.mean(.data$pvalue, w = .data$n, na.rm = TRUE), 
-                rit = weighted.mean(.data$rit, w = .data$n, na.rm = TRUE), 
-                rir = weighted.mean(.data$rir, w = .data$n, na.rm = TRUE), n = sum(.data$n, na.rm = TRUE))
+      summarise(n_booklets = n(), 
+                w_mean_score = weighted.mean(.data$mean_score, w = .data$n_persons, na.rm = TRUE), 
+                sd_score = sqrt(combined_var(.data$mean_score, .data$sd_score^2, .data$n_persons)),
+                max_score = max(.data$max_score), 
+                pvalue = weighted.mean(.data$pvalue, w = .data$n_persons, na.rm = TRUE), 
+                rit = weighted.mean(.data$rit, w = .data$n_persons, na.rm = TRUE), 
+                rir = weighted.mean(.data$rir, w = .data$n_persons, na.rm = TRUE), 
+                n_persons = sum(.data$n_persons)) %>%
+      ungroup() %>%
+      rename(mean_score = .data$w_mean_score)
   }
 
-  # do some rounding and aesthetic renaming
-  itemStats %>%
+  items %>%
     mutate(pvalue = round(.data$pvalue,3), rit = round(.data$rit,3), rir = round(.data$rir,3),
-          meanScore = round(.data$meanScore,2), sdScore = round(.data$sdScore,2))
+          mean_score = round(.data$mean_score,2), sd_score = round(.data$sd_score,2))
 
 }
 

R/serve.R

@@ -134,16 +134,14 @@ group_by(.data$booklet_id) %>%
 summarise(test_score = sparkbox_vals(.data$booklet_score)) %>%
 ungroup() %>%
 mutate(booklet_id = as.character(.data$booklet_id))
-tia$testStats = tia$testStats %>%
-mutate(alpha = round(.data$alpha,3), meanP = round(.data$meanP,3), meanRit = round(.data$meanRit,3), meanRir = round(.data$meanRir,3)) %>%
+tia$booklets = tia$booklets %>%
+mutate_if(is.double, round, digits=3) %>% 
 inner_join(sparks, by='booklet_id')
-if(all(grepl('^\\d+$',tia$testStats$booklet_id))){
-tia$testStats = tia$testStats %>%
-arrange(as.integer(.data$booklet_id))
-tia$itemStats =  tia$itemStats %>%
-arrange(.data$item_id, as.integer(.data$booklet_id))}
-values$ctt_items = tia$itemStats
-values$ctt_booklets = tia$testStats}
+if(all(grepl('^\\d+$',tia$booklets$booklet_id))){
+tia$tbooklets = arrange(tia$booklets, as.integer(.data$booklet_id))
+tia$items = arrange(tia$items, .data$item_id, as.integer(.data$booklet_id))}
+values$ctt_items = tia$items
+values$ctt_booklets = tia$booklets}
 set_js_vars(db, session)
 lapply(c('project_load_icon','oplm_inputs','example_datasets'), hide)
 show('proj_rules_frm')
@@ -651,12 +649,12 @@ cdef = list(list(targets = ncol(values$ctt_booklets)-1,
 render = JS("function(data, type, full){ return '<span class=\"sparkbox\">' + data + '</span>' }")),
 list(className = "numeric", targets = list(7)),
 list(className = "dec-3", targets = list(2,3,4,5)))
-drawcallback = init_sparks(.box = list(chartRangeMin = 0, chartRangeMax = max(values$ctt_booklets$maxTestScore)),
+drawcallback = init_sparks(.box = list(chartRangeMin = 0, chartRangeMax = max(values$ctt_booklets$max_booklet_score)),
 add_js='dt_numcol(settings);')
 selected = 1
 isolate({
 if(!is.null(values$inter_booklet)){
-selected = min(which(values$ctt_booklets == values$inter_booklet))}})
+selected = min(which(values$ctt_booklets$booklet_id == values$inter_booklet))}})
 datatable({ values$ctt_booklets}, 
 rownames = FALSE, selection = list(mode = 'single', selected = selected), 
 class='compact', extensions = 'Buttons',
@@ -686,7 +684,7 @@ output$inter_current_booklet = renderUI(tags$b(paste('Booklet:', values$inter_bo
 observe({
 req(values$inter_booklet, values$inter_plot_items)
 stats = filter(values$ctt_booklets, .data$booklet_id==values$inter_booklet)
-if(stats$N <= stats$nItems){
+if(stats$n_persons <= stats$n_items){
 updateSlider(session, 'interslider', 
 error='Cannot compute the interaction model because the number of responses is smaller than the number of items')
 return(NULL);}
@@ -799,7 +797,7 @@ booklet = pull(ctt_item, booklet_id)
 lgnd = distractor_plot(db, predicate={booklet_id==booklet}, item_id = item_id,main='pos. $item_position in $booklet_id',sub=NULL,legend=FALSE)} else{
 isolate({
 booklets = values$ctt_items %>% 
-filter(.data$item_id==!!item_id & .data$n>1) %>%
+filter(.data$item_id==!!item_id & .data$n_persons>1) %>%
 pull(.data$booklet_id)})
 ly = matrix_layout(length(booklets)) 
 if(ncol(ly)<=3){
@@ -844,7 +842,7 @@ tags$tfoot(tags$tr(tags$td(),
 tags$td(),
 tags$td('sum: ', style='text-align: right;'), 
 tags$td(tags$div(sum(df$n), style="background-color:lightgrey;width:100%;height:100%;text-align:center;")),
-tags$td(paste('avg: ',ctt_item$meanScore), style='text-align: right;'),
+tags$td(paste('avg: ',ctt_item$mean_score), style='text-align: right;'),
 tags$td()),
 style="font-style:italic;"))
 df$n = paste(df$n, sum(df$n),sep=',')

README.md

@@ -1,6 +1,6 @@
 # Dextergui
 
-Dextergui is a graphical user interface for the main functionality of [dexter](https://cran.r-project.org/package=dexter) for use in educational and psychological measurement. It offers Classical Test Analysis, Item Response Theory and Data management.
+Dextergui is a graphical user interface for the main functionality of [dexter](https://dexter-psychometrics.github.io/dexter/) for use in educational and psychological measurement. It offers Classical Test Analysis, Item Response Theory and Data management.
 
 ## Installation
 

server/ctt.R

@@ -8,14 +8,14 @@ output$inter_booklets = renderDataTable({
               list(className = "numeric", targets = list(7)),
               list(className = "dec-3", targets = list(2,3,4,5)))
 
-  drawcallback = init_sparks(.box = list(chartRangeMin = 0, chartRangeMax = max(values$ctt_booklets$maxTestScore)),
+  drawcallback = init_sparks(.box = list(chartRangeMin = 0, chartRangeMax = max(values$ctt_booklets$max_booklet_score)),
                              add_js='dt_numcol(settings);')
 
   selected = 1
   isolate({
     if(!is.null(values$inter_booklet))
     {
-      selected = min(which(values$ctt_booklets == values$inter_booklet))
+      selected = min(which(values$ctt_booklets$booklet_id == values$inter_booklet))
     }
   })
 
@@ -30,6 +30,7 @@ output$inter_booklets = renderDataTable({
 
 })
 
+#write minus the spark column
 output$inter_booklets_xl_download = downloadHandler(
     filename = function(){paste0(gsub('\\.\\w+$','',basename(values$project_name), perl=TRUE),'_ctt_booklets.xlsx')},
     content = function(file) {
@@ -60,7 +61,7 @@ observe({
   req(values$inter_booklet, values$inter_plot_items)
   stats = filter(values$ctt_booklets, .data$booklet_id==values$inter_booklet)
 
-  if(stats$N <= stats$nItems)
+  if(stats$n_persons <= stats$n_items)
   {
     updateSlider(session, 'interslider', 
                  error='Cannot compute the interaction model because the number of responses is smaller than the number of items')
@@ -244,7 +245,7 @@ distr_plot = function(update_legend=TRUE)
   {
     isolate({
       booklets = values$ctt_items %>% 
-        filter(.data$item_id==!!item_id & .data$n>1) %>%
+        filter(.data$item_id==!!item_id & .data$n_persons>1) %>%
         pull(.data$booklet_id)
      })
 
@@ -325,7 +326,7 @@ output$item_rules = renderDataTable({
                            tags$td(),
                            tags$td('sum: ', style='text-align: right;'), 
                            tags$td(tags$div(sum(df$n), style="background-color:lightgrey;width:100%;height:100%;text-align:center;")),
-                           tags$td(paste('avg: ',ctt_item$meanScore), style='text-align: right;'),
+                           tags$td(paste('avg: ',ctt_item$mean_score), style='text-align: right;'),
                            tags$td()),
                    style="font-style:italic;"))
 

server/init.R

@@ -62,23 +62,18 @@ init_project = function()
       ungroup() %>%
       mutate(booklet_id = as.character(.data$booklet_id))
 
-    tia$testStats = tia$testStats %>%
-      mutate(alpha = round(.data$alpha,3), meanP = round(.data$meanP,3), meanRit = round(.data$meanRit,3), meanRir = round(.data$meanRir,3)) %>%
+    tia$booklets = tia$booklets %>%
+      mutate_if(is.double, round, digits=3) %>% 
       inner_join(sparks, by='booklet_id')
 
-    if(all(grepl('^\\d+$',tia$testStats$booklet_id)))
+    if(all(grepl('^\\d+$',tia$booklets$booklet_id)))
     {
-      tia$testStats = tia$testStats %>%
-        arrange(as.integer(.data$booklet_id))
-
-      tia$itemStats =  tia$itemStats %>%
-        arrange(.data$item_id, as.integer(.data$booklet_id))
+      tia$tbooklets = arrange(tia$booklets, as.integer(.data$booklet_id))
+      tia$items = arrange(tia$items, .data$item_id, as.integer(.data$booklet_id))
     }
 
-    values$ctt_items = tia$itemStats
-
-    values$ctt_booklets = tia$testStats
-
+    values$ctt_items = tia$items
+    values$ctt_booklets = tia$booklets
   }
 
   set_js_vars(db, session)

vignettes/dextergui.Rmd

@@ -142,7 +142,7 @@ tia=tia_tables(db)
 ```
 
 ```{r}
-tia$testStats %>%
+tia$booklets %>%
   mutate_if(is.double, round, digits=3) %>%
   kable()
 ```
@@ -163,7 +163,7 @@ The Rasch model fits this item very well, so the two curves practically coincide
 The items tab shows classical statistics for the items on the left, including RiT, RiR and pvalue.
 
 ```{r}
-tia$itemStats %>%
+tia$items %>%
   slice(1:10) %>%
   mutate_if(is.double, round, digits=3) %>%
   kable()