/
helpers.R
147 lines (114 loc) · 4.8 KB
/
helpers.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
# helpers.R
footer <- function() {
tags$div(
class = "panel-footer",
style = "text-align:center",
tags$div(
class = "foot-inner",
list(
# hr(),
"ideal is a project developed by Federico Marini in the Bioinformatics division of the ",
tags$a(href = "http://www.unimedizin-mainz.de/imbei", "IMBEI"),
"- Institute for Medical Biostatistics, Epidemiology and Informatics", br(),
"License: ", tags$a(href = "https://opensource.org/licenses/MIT", "MIT"), br(),
"Development of the ideal package is on ",
tags$a(href = "https://github.com/federicomarini/ideal", "GitHub")
)
)
)
}
############################# helper funcs #################################
#' Make an educated guess on the separator character
#'
#' This function tries to guess which separator was used in a text delimited file
#'
#' @param file The name of the file which the data are to be read from
#' @param sep_list A vector containing the candidates for being identified as
#' separators. Defaults to \code{c(",", "\t", ";"," ")}
#'
#' @return A character value, corresponding to the guessed separator. One of ","
#' (comma), "\\t" (tab), ";" (semicolon)," " (whitespace)
#' @export
#'
#' @examples
#' sepguesser(system.file("extdata/design_commas.txt", package = "ideal"))
#' sepguesser(system.file("extdata/design_semicolons.txt", package = "ideal"))
#' sepguesser(system.file("extdata/design_spaces.txt", package = "ideal"))
#' mysep <- sepguesser(system.file("extdata/design_tabs.txt", package = "ideal"))
#'
#' # to be used for reading in the same file, without having to specify the sep
sepguesser <- function(file, sep_list = c(",", "\t", ";", " ")) {
separators_list <- sep_list
rl <- readLines(file, warn = FALSE)
rl <- rl[rl != ""] # allow last line to be empty
sephits_min <- sapply(separators_list, function(x) min(stringr::str_count(rl, x))) # minimal number of separators on all lines
sep <- separators_list[which.max(sephits_min)]
sep
}
sepguesser2 <- function(file, sep_list = c(",", "\t", ";", " ")) {
separators_list <- sep_list
rl <- readLines(file, warn = FALSE)
rl <- rl[rl != ""] # allow last line to be empty
sephits_min <- sapply(separators_list, function(x) min(stringr::str_count(rl, x))) # minimal number of separators on all lines
counts <- sapply(separators_list, function(x) min(count.fields(textConnection(rl), sep = x)))
sep <- separators_list[which.max(counts)]
# sep = separators_list[which.max(sephits_min)]
sep
}
shake_topGOtableResult <- function(obj,
p_value_column = "p.value_elim") {
if(!all(c("GO.ID", "Term", "Annotated", "Significant", "Expected", "p.value_classic") %in%
colnames(obj))) {
stop("The provided object must be of in the format specified by the `pcaExplorer::topGOtable` function")
}
if(!p_value_column %in% colnames(obj)) {
stop("You specified a column for the p-value which is not contained in the provided object. \n",
"Please check the colnames of your object in advance.")
}
if(!"genes" %in% colnames(obj)) {
stop("The column `genes` is not present in the provided object and is required for properly running GeneTonic.",
"\nMaybe you did set `addGeneToTerms` to FALSE in the call to `pcaExplorer::topGOtable`?")
}
# Thought: store somewhere the ontology if possible - in an extra column?
message("Found ", nrow(obj), " gene sets in `topGOtableResult` object.")
message("Converting for usage in GeneTonic...")
fullresults <- obj
mydf <- data.frame(
gs_id = fullresults$GO.ID,
gs_description = fullresults$Term,
gs_pvalue = fullresults[[p_value_column]],
gs_genes = fullresults$genes,
gs_de_count = fullresults$Significant,
gs_bg_count = fullresults$Annotated,
Expected = fullresults$Expected,
stringsAsFactors = FALSE
)
rownames(mydf) <- mydf$gs_id
return(mydf)
}
# combineTogether <- function(normCounts,resuTable,anns) {
# combinedCountsAndRes <- inner_join(resuTable,normCounts,by="id")
# anns2 <- anns[match(combinedCountsAndRes$id, anns[, 1]), ]
# combinedCountsAndRes$Description <- anns2$description
# return(combinedCountsAndRes)
# }
#
#
# combine_resucounts <- function(normCounts,resuTable) {
# combinedCountsAndRes <- inner_join(resuTable,normCounts,by="id")
# # anns2 <- anns[match(combinedCountsAndRes$id, anns[, 1]), ]
# # combinedCountsAndRes$Description <- anns2$description
# return(combinedCountsAndRes)
# }
#
# getGeneInfos <- function(obj, annopkg, idtype) {
# # obj is a dds object...
# ids <- rownames(obj)
#
# mydf <- mapIds(eval(parse(text=annopkg)),keys=ids,column = "GENENAME",keytype = idtype)
# mydf_2 <- AnnotationDbi::select(eval(parse(text=annopkg)),keys=ids,column = "GENENAME",keytype = idtype)
#
# return(mydf_2)
# }
#
#