JoeToolFunctions.R 7.48 KB
Newer Older
Jalbert, Joe's avatar
Jalbert, Joe committed
1
2
3
4
#' Standard Error
#'
#' @param data The vector or dataset over which the standard error is calculated
#'
5
#' @return The calculated Standard Error
Jalbert, Joe's avatar
Jalbert, Joe committed
6
7
8
9
10
11
12
13
14
15
#' @importFrom stats sd
#' @export
#'
#' @examples
#' x=c(10, 20, 30, 40, 50)
#' se(x)
se=function(data){
  return(sd(data, na.rm=T)/sqrt(sum(!is.na(data))))
}

16
17
18
19
20
21
22
23
24
#' Simplifying Reports
#'
#' @param input 
#'
#' @return Simplified interacton reports
#' @import tidyverse
#' @export
#'
#' @examples
25
simplifyAppend <- function(input) {
26
27
28
29
30
31
32
33
  x=match("Signif",colnames(input))+1
  y=as.numeric(ncol(input))
  df=input%>%
    filter(!is.nan(Diff))%>%
    mutate(across(x:y,~cut(.,breaks=c( 0,.001,.01,.05, .1,.999,1), labels=c("***" ,"**","*",".","NS","1" ))))%>%
    select(1:x-1,where(~sum((.%in%c("***" ,"**","*",".")))>0))
}

Jalbert, Joe's avatar
Jalbert, Joe committed
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
#' Flexible Workbook Creation Function
#'
#' @param df The dataframe to be saved
#' @param filename Name of the file, including the xlsx extension
#' @param sheetBy Option to create sheets based on the values in a particular column of the dataframe
#' @param keepNames The function automatically renames the column names with \code{\link[stringr:case]{stringr::str_to_sentence()}}. Setting this to TRUE will leave your column names unaltered
#'
#' @return Creates a Excel workbook from the supplied dataframe
#' @import tidyverse
#' @import xlsx
#' @import lazyeval
#' @export
#'
#' @examples
#' library(datasets)
#' library(tidyverse)
#' library(xlsx)
#' data(iris)
#' wbsave(iris, "Iris report.xlsx")
#' wbsave(iris, "Iris report - by Species.xlsx", sheetBy="Species", keepNames=TRUE)
wbsave=function(df,filename,sheetBy=NULL,keepNames=FALSE){
  if(keepNames==FALSE) {names(df)=str_to_sentence(names(df))}
  if(!is.null(sheetBy)) {sheetBy=str_to_sentence(sheetBy)}
  wb=createWorkbook()
Jalbert, Joe's avatar
Jalbert, Joe committed
58
  df=as.data.frame(df)
Jalbert, Joe's avatar
Jalbert, Joe committed
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
  TABLE_COLNAMES_STYLE <- CellStyle(wb)+ Font(wb,  heightInPoints=11, color="#44546A", isBold=TRUE)+
    Border(color = "#8EA9DB", position = "BOTTOM", pen="BORDER_THICK")
  sheetAll=createSheet(wb,sheetName = "All")
  wbdata=NULL
  wbAll=NULL
  if(!is.null(sheetBy)) {l=levels(as.factor(df[[sheetBy]]))}
  if(!is.null(sheetBy)) {for (i in l){
    filter_criteria <- interp(~y == x, .values=list(y = as.name(sheetBy), x = i))
    wbdata=df%>%
      filter_(filter_criteria)
    wbAll[[i]]=wbdata
    sheet=createSheet(wb,sheetName = i)
    addDataFrame(wbdata,sheet, colnamesStyle = TABLE_COLNAMES_STYLE)
    autoSizeColumn(sheet, colIndex = 1:ncol(df)+1)
  }}
  addDataFrame(df,sheetAll, colnamesStyle = TABLE_COLNAMES_STYLE)
  autoSizeColumn(sheetAll, colIndex = 1:ncol(df)+1)
  saveWorkbook(wb, filename)
}

#' Creates a Report with t-tests for a Vector of Outcomes
#'
#' @param df Dataframe to use for the report
#' @param Measures A vector of string names for columns to take means for. Order will be used to make the report.
#' @param Factor A binary factor which will be used for comparisons.  Must be 1 (Treatment) or 0 (No_Treatment)
#' @param paired Options for running t-test.  "Yes" forces paired, t-tests, "No" assumes no pairing, and "Try" will try a paired t-test, and follow up with a unpaired t-test if it fails to run.
#'
#' @return
#' @import tidyverse
#' @export
#'
#'
#' @examples

93
report=function(df, Measures, Factor, paired=c("Try","Yes", "No")){
Jalbert, Joe's avatar
Jalbert, Joe committed
94
95
96
97
98
  output=df%>%
    group_by(.data[[Factor]])%>%
    summarise_at(vars(Measures), mean,na.rm=T)%>%
    mutate(Levels =ifelse(.data[[Factor]]==1, "Treatment", "No_Treatment"))%>%
    select(-.data[[Factor]])%>%
Jalbert, Joe's avatar
Jalbert, Joe committed
99
    pivot_longer(cols=Measures, names_to = "Measure")%>%
Jalbert, Joe's avatar
Jalbert, Joe committed
100
101
102
103
104
105
106
    pivot_wider(names_from = "Levels", values_from = "value")%>%
    mutate(Diff=Treatment-No_Treatment)%>%
    mutate(Measure=factor(.data$Measure,levels=Measures))%>%
    arrange(Measure)


  reportpvaluecount=0
Jalbert, Joe's avatar
Jalbert, Joe committed
107
  p=NULL
Jalbert, Joe's avatar
Jalbert, Joe committed
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
  for(i in Measures){
    reportpvaluecount=reportpvaluecount+1
    form=paste0(i, "~",Factor)
    if(paired=="Yes"){p[reportpvaluecount]=as.numeric(try(t.test(formula=as.formula(form), data=df, paired=T)$p.value))}
    else if (paired=="No"){p[reportpvaluecount]=as.numeric(try(t.test(formula=as.formula(form), data=df)$p.value))}
    else {p[reportpvaluecount]=tryCatch(as.numeric(t.test(formula=as.formula(form), data=df, paired=T)$p.value), error=function(err)
      p[reportpvaluecount]=as.numeric(try(t.test(formula=as.formula(form), data=df)$p.value)), finally = NA)}

  }

  output$p_value=p

  output=output%>%
    mutate(Signif=ifelse(p_value<.001, "***",ifelse(p_value<.01, "**",
                                                    ifelse(p_value<.05, "*", ifelse(p_value<.1, ".", "")))))
}
Jalbert, Joe's avatar
Jalbert, Joe committed
124
125
126
127
128


#' Appends Interactions to a \code{\link[JoeTools:report]{report()}} Output Dataframe
#'
#' @param report The report dataframe that is being appended
129
130
#' @param df The original dataframe used for the report
#' @param Measures A vector of string names for the dependent variable. Order must be the same as the repor
Jalbert, Joe's avatar
Jalbert, Joe committed
131
132
133
134
135
136
137
138
#' @param Factor A binary factor (as a string) which will be used for comparisons.  Must be 1 (Treatment) or 0 (No_Treatment)
#' @param Interaction A factor column name (as a string) that will be used as an interacting independant variable.
#'
#' @return
#' @import tidyverse
#' @export
#'
#' @examples
139
appendInteraction=function(report,df, Measures,Factor,Interaction, Simplify=T){
Jalbert, Joe's avatar
Jalbert, Joe committed
140
  p=NULL
141
142
  anova=NULL
  aov_factors=as.vector(Interaction)
Jalbert, Joe's avatar
Jalbert, Joe committed
143
  for(i in Measures){
144
145
146
147
148
149
150
151
152
153
154
155
156
157
    form=paste0(i, "~",Factor,"*",paste(aov_factors, collapse="*"))
    anova[[i]]=NULL
    if(!is.na(tryCatch(summary(aov(as.formula(form),data=df)), error=function(err) NA))){
      
    
    anova[[i]]=summary(aov(as.formula(form),data=df))[[1]]%>%
      rownames_to_column("Interactions")%>%
      filter(grepl(paste0(Factor,":"), Interactions))%>%
      mutate(Interactions=str_remove(Interactions,paste0(Factor,":")))%>%
      mutate(Interactions=str_remove_all(Interactions, " "))%>%
      select(Interactions,pvalue=`Pr(>F)` )%>%
      pivot_wider(names_from = Interactions, values_from = "pvalue")%>%
      mutate(Measure=i)
    } 
Jalbert, Joe's avatar
Jalbert, Joe committed
158
  }
159
160
161
162
163
  anova=bind_rows(anova)
  if(nrow(anova)>0){
    output=report%>%
    left_join(anova, by="Measure")
    if(Simplify==T){
164
      output=simplifyAppend(output)
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    }
  } else  {
    warning("Error in ANOVA, No comparison added.")
    output=report
  }
}

#' Plotting more than one plot together
#'
#' @param ... Name of each plot
#' @param plotlist A vector with plot names
#' @param file 
#' @param cols How many columns of plots you want in your chart
#' @param layout A matrix specifying the layout. If present, 'cols' is ignored.
#'
#' @return
#' @import grid
#' @export
#'
#' @examples
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  library(grid)
  
  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  
  numPlots = length(plots)
Jalbert, Joe's avatar
Jalbert, Joe committed
192
  
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }
  
  if (numPlots==1) {
    print(plots[[1]])
    
  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
    
    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
      
      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
Jalbert, Joe's avatar
Jalbert, Joe committed
219
}