Dev: All good to send for an Update

DESCRIPTION

@@ -26,7 +26,10 @@ Imports:
     tidyselect,
     lavaan,
     mirt,
-    ggplot2
+    ggplot2,
+    plotly,
+    kutils,
+    tidyr
 Suggests: 
     rmarkdown,
     knitr,

NAMESPACE

@@ -9,8 +9,11 @@ export(fac.tab)
 export(ggicc)
 export(ggiteminfo)
 export(ggreliability)
+export(ggreliability_plotly)
 export(ggtestinfo)
 export(ggtestinfo_se)
+export(ggtestinfo_se_ploty)
+export(gt_tab)
 export(normality.loop)
 importFrom(MOTE,apa)
 importFrom(dplyr,across)
@@ -20,10 +23,16 @@ importFrom(ggplot2,labs)
 importFrom(ggplot2,xlab)
 importFrom(ggplot2,ylab)
 importFrom(ggplot2,ylim)
+importFrom(kutils,likert)
 importFrom(lavaan,fitmeasures)
 importFrom(magrittr,"%>%")
 importFrom(mirt,extract.item)
 importFrom(mirt,iteminfo)
+importFrom(plotly,ggplotly)
+importFrom(stats,median)
 importFrom(stats,reshape)
+importFrom(stats,sd)
 importFrom(stats,time)
+importFrom(tibble,rownames_to_column)
+importFrom(tidyr,gather)
 importFrom(tidyselect,vars_select_helpers)

R/des.tab.R

@@ -6,24 +6,30 @@
 #'data <- tabledown::Rotter[, 11:31]
 #'table <- des.tab(data)
 #' @param df A data frame.
+#' @param reverse If TRUE, will provide indicate which items had a negative correlation and reverse them
+#'
 #'@return
 #'Returns a summary table of descriptives in a data frame structure.
 
 #' @export
-des.tab <- function(df){
+des.tab <- function(df, reverse = FALSE){
+
   Descriptives <- psych::describe(df)
   Mean <-MOTE::apa(Descriptives$mean,2,TRUE)
   SD <-MOTE::apa(Descriptives$sd,2,TRUE)
   Skew <-MOTE::apa(Descriptives$skew,2,TRUE)
   Kurtosis <- MOTE::apa(Descriptives$kurtosis,2,TRUE)
+  ifelse(reverse==TRUE,{
   alpha <- psych::alpha(df,check.keys=TRUE)
+  },
+  {alpha <- psych::alpha(df,check.keys=FALSE)})
   Items <- rownames(alpha$item.stats)
   Corrected.item.total.correlation <- MOTE::apa(alpha$item.stats$r.cor,2,TRUE)
 normality.test <-normality.loop(df)
  statistics <-MOTE::apa(normality.test$statistic,2,TRUE)
  sig <-(normality.test$significance)
  Normality <- paste(statistics, sig, sep = "" )
  des.tab <-as.data.frame((cbind(Items, Mean, SD, Skew,Kurtosis,  Normality,Corrected.item.total.correlation)))
- des.tab
+ des.tab}
+
 
-  }

R/ggreliability_plotly.R

@@ -0,0 +1,43 @@
+#' A Function for Creating   Item Response Theory based reliability plot based on plotly.
+#'
+#' This function will create  Item Response Theory based based reliability plot with standard error using ggplot2 and plotly from objects created from
+#' mirt pack.
+#' Using ggplot2 will enable the user to modify the Item plot.
+#'
+#' @param  dataframe your data.
+#' @param  model A mirt package fitted object.
+#'@examples
+#'data <- tabledown::Rotter[, 11:31]
+#'model <- mirt::mirt(data, model = 1, itemtype = '2PL')
+#'
+#'plot <- ggreliability_plotly(data, model)
+#'@return
+#'A publication quality reliability plot (dashed line). Output object is a ggplot object.
+
+
+#'@importFrom mirt extract.item iteminfo
+#'
+#'@importFrom plotly ggplotly
+#'
+#'@importFrom ggplot2 geom_line labs ylim xlab ylab
+#'
+#' @export
+#'
+ggreliability_plotly <- function(dataframe,model){
+  Theta <- matrix(seq(-6,6, by = .1))
+  T1 <- 0
+  se <- 0
+  reliability <- 0
+  for(i in 1:ncol(dataframe)){
+    T1 <- T1 + mirt::iteminfo(extract.item(model, i), Theta)
+    reliability <- T1/(T1+1)
+  }
+
+  data <- as.data.frame(cbind(Theta, T1,  reliability))
+  p1 <-  ggplot2::ggplot(data, ggplot2::aes(x=Theta, y=reliability)) +ylim(0,1)+
+    ggplot2::geom_line() + ggplot2::labs(y="rxx", x= "Theta")
+p2 <- plotly::ggplotly(p1)
+  return(p2)
+}
+
+

R/ggtestinfo_se_plotly.R

@@ -0,0 +1,40 @@
+#' A Function for Creating  Item Response Theory based test information plot with standard error with plotly.
+#'
+#' This function will create Item Response Theory based Test information plot with standard error using ggplot2 and plotly from objects created from
+#' mirt pack.
+#' Using ggplot2 will enable the user to modify the Item plot.
+#'
+#' @param  dataframe your data.
+#' @param  model A mirt package fitted object.
+#'@examples
+#'data <- tabledown::Rotter[, 11:31]
+#'model <- mirt::mirt(data, model = 1, itemtype = '2PL')
+#'plot <- ggtestinfo_se_ploty(data, model)
+#'@return
+#'A publication quality Test information plot with standard error (dashed line). Output object is a ggplot object.
+
+
+#'@importFrom mirt extract.item iteminfo
+#'
+#'@importFrom plotly ggplotly
+
+#' @export
+ggtestinfo_se_ploty <- function(dataframe,model){
+  Theta <- matrix(seq(-6,6, by = .1))
+  T1 <- 0
+  se <- 0
+  for(i in 1:ncol(dataframe)){
+    T1 <- T1 + mirt::iteminfo(extract.item(model, i), Theta)
+    se <- 1/(sqrt(T1))
+
+  }
+
+  data <- as.data.frame(cbind(Theta, T1, se))
+  p1 <-  ggplot2::ggplot(data, ggplot2::aes(x=Theta, y=T1)) +
+    ggplot2::geom_line() + ggplot2::labs(y="Test Information")+
+    geom_line(data = data,linetype = "dashed",color = "red", ggplot2::aes(x=Theta, y=se))
+
+  p2 <- plotly::ggplotly(p1)
+  return(p2)
+}
+

R/global.functions.R

@@ -1,2 +1,2 @@
 globalVariables(c("where"))
-
+globalVariables(c("."))

R/gttab.R

@@ -0,0 +1,81 @@
+#' A Function for gtExtra package friendly data summary.
+#'
+#' This function will gtExtra package friendly data summary using the datafrmae provided
+#' psych pack.
+
+#' @param  dataframe Dataframe with all items.
+#' @param  recode_code Recode key
+#'@examples
+#'data <- tabledown::FFMQ.CFA[, c(9,10,12,14)]
+#'recode_code <- c( "1" = "Never or very rarely true", "2" = "Rarely true",
+#'"3"= "Sometimes true","4" = "Often true","5" = "Very often or always true")
+#'sample_tab <- gt_tab(data,recode_code)
+#'@return
+#'A publication ready descriptive summary table in png format.
+
+
+#' @importFrom magrittr  %>%
+#'@importFrom stats median sd
+#'@importFrom tidyselect vars_select_helpers
+#'@importFrom tidyr gather
+#'@importFrom kutils likert
+#'@importFrom tibble rownames_to_column
+
+#' @export
+gt_tab <- function(dataframe, recode_code){
+Items <- 0
+value <- 0
+  longtab <- as.data.frame(tidyr::gather(dataframe, Items, value))
+  longtab$value <- as.numeric(as.character(longtab$value))
+
+  ##Summarizing and creating gt object
+
+  summary_tab <- longtab %>%
+    dplyr::group_by(Items) %>%
+    # calculate summary stats & create data for the histogram and density plot
+    dplyr::summarise(
+      nr = dplyr::n(),
+      mean = mean(value, na.rm = TRUE),
+      med = median(value, na.rm = TRUE),
+      sd = sd(value, na.rm = TRUE),
+      hist_data = list(value),
+      dens_data = list(value),
+      .groups = "drop"
+    )
+
+
+  descriptive_tab <- tabledown::des.tab(dataframe)
+  summary_tab_2 <- dplyr::inner_join(summary_tab, descriptive_tab, by = "Items")
+  data_likert_1 <- dataframe
+  data_likert_2 <-  dplyr::mutate(data_likert_1, dplyr::across(dplyr::starts_with(c("item")), ~unname(recode_code[.])))
+  data_Factor_1 = as.data.frame(lapply(data_likert_2,factor, ordered = T))
+
+  #get the items name
+  items <- names(data_Factor_1)
+  #Calculate percentage
+  percentage_1 <- kutils::likert(data_Factor_1, vlist = items )
+
+  percentage_2 <- percentage_1$table %>%
+    as.data.frame(.)
+  #data wrangling
+
+  labels<- tibble::rownames_to_column(percentage_2, "Items")
+
+  full_percentage_1<- as.data.frame(t(labels )) #transpose
+  full_percentage_2 <- full_percentage_1[,-6] #removing 1st row and total column
+  full_percentage_3 <- tibble::rownames_to_column(full_percentage_2, "Items")
+  col_names <- full_percentage_3[1,]
+  full_percentage_4 <-full_percentage_3[-1,]
+  full_percentage_5 <- as.data.frame(full_percentage_4)
+
+  colnames(full_percentage_5) <- (col_names)
+
+  full.table <-  dplyr::inner_join( summary_tab_2, full_percentage_5, by = "Items")
+
+  return(full.table )
+}
+
+
+
+
+