/
messages.r
284 lines (266 loc) 路 12.1 KB
/
messages.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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
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
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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#
# This software was authored by Zhian N. Kamvar and Javier F. Tabima, graduate
# students at Oregon State University; Jonah C. Brooks, undergraduate student at
# Oregon State University; and Dr. Nik Gr眉nwald, an employee of USDA-ARS.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for educational, research and non-profit purposes, without fee,
# and without a written agreement is hereby granted, provided that the statement
# above is incorporated into the material, giving appropriate attribution to the
# authors.
#
# Permission to incorporate this software into commercial products may be
# obtained by contacting USDA ARS and OREGON STATE UNIVERSITY Office for
# Commercialization and Corporate Development.
#
# The software program and documentation are supplied "as is", without any
# accompanying services from the USDA or the University. USDA ARS or the
# University do not warrant that the operation of the program will be
# uninterrupted or error-free. The end-user understands that the program was
# developed for research purposes and is advised not to rely exclusively on the
# program for any reason.
#
# IN NO EVENT SHALL USDA ARS OR OREGON STATE UNIVERSITY BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, INCLUDING
# LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION,
# EVEN IF THE OREGON STATE UNIVERSITY HAS BEEN ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE. USDA ARS OR OREGON STATE UNIVERSITY SPECIFICALLY DISCLAIMS ANY
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE AND ANY STATUTORY
# WARRANTY OF NON-INFRINGEMENT. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
# BASIS, AND USDA ARS AND OREGON STATE UNIVERSITY HAVE NO OBLIGATIONS TO PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!#
#==============================================================================#
#==============================================================================#
# Message to print after running the poppr function
#
# Public functions utilizing this function:
# # poppr poppr.all
#
# Internal functions utilizing this function:
# # none
#==============================================================================#
poppr_message <- function(){
msg <- paste0(
"-------------------------------------------------------------------------|\n",
"Pop = Population name (Total == Pooled)\n",
"N = Census population size\n",
"MLG = Number of unique multilocus genotypes (MLG) observed\n",
"eMLG = Number of expected MLG based on rarefaction at smallest N >= 10\n",
"SE = Standard error of rarefaction analysis\n",
"H = Shannon-Wiener Index of MLG diversity\n",
"G = Stoddart and Taylor's Index of MLG diversity\n",
"lambda = Simpson's index\n",
"E.5 = Evenness\n",
"Hexp = Nei's 1978 expected heterozygosity\n",
"Ia = Index of association\n",
"rbarD = Standardized index of association\n",
"-------------------------------------------------------------------------|\n"
)
message(msg)
}
#==============================================================================#
# A function that will quit the function if a level in the hierarchy is not
# present in the given data frame.
#
# Public functions utilizing this function:
# # setPop strata poppr.amova
#
# Internal functions utilizing this function:
# # make_hierarchy make_ade_df
#==============================================================================#
hier_incompatible_warning <- function(levs, df){
msg <- paste("One or more levels in the given hierarchy is not present",
"in the data frame.",
"\nHierarchy:\t", paste(levs, collapse = ", "), "\nData:\t\t",
paste(names(df), collapse = ", "))
return(msg)
}
#==============================================================================#
# Warning message for when a distance matrix is non-euclidean and the user
# did not specify an appropriate correction.
#
# Public functions utilizing this function:
# # poppr.amova
#
# Internal functions utilizing this function:
# # none
#==============================================================================#
not_euclid_msg <- function(correction){
msg <- paste0("\nThe distance matrix generated is non-euclidean and a ",
"correction is needed.\n",
"You supplied: correction = '", correction, "'\nPlease change",
" it to one of the following:\n",
"\t'cailliez'\t'quasieuclid'\t'lingoes'")
return(msg)
}
#==============================================================================#
# Warning message for the function popsub.
# Public functions utilizing this function:
#
# # popsub
#
# Internal functions utilizing this function:
# # none
#==============================================================================#
unmatched_pops_warning <- function(pops, sublist){
msg <- paste("The sublist provided does not match any of the populations:\n",
"\tsublist.......", paste(sublist, collapse = " "), "\n",
"\tPopulations...", paste(pops, collapse = " "))
return(msg)
}
#==============================================================================#
# Warning messages for Bruvo's distance calculation.
# Public functions utilizing this function:
#
# # bruvo.dist bruvo.boot bruvo.msn
#
# Internal functions utilizing this function:
# # none
#==============================================================================#
repeat_length_warning <- function(replen){
msg <- paste("\n\nRepeat length vector for loci is not equal to the number",
"of loci represented.\nEstimating repeat lengths from data:\n",
paste0("c(", paste(replen, collapse = ", "),")"), "\n\n")
msg <- paste("\n\t--------------------------------------------------------------",
"\n\t !!! ALERT !!!",
"\n",
"\n\tThis warning will become an ERROR in future versions of poppr.",
"\n\tPlease define your repeat lengths to avoid this error.",
"\n\t--------------------------------------------------------------",
msg)
return(msg)
}
non_ssr_data_warning <- function(){
msg <- paste("\nThis dataset does not appear to be microsatellite data.",
"Bruvo's Distance can only be applied for true microsatellites.")
return(msg)
}
mismatched_repeat_length_warning <- function(replen, nloci){
paste0("length of repeats (", length(replen), ") does not equal",
" the number of loci (", nloci, ").")
}
trimmed_repeats_warning <- function(replen, loci){
keep <- names(replen) %in% loci
removed <- strwrap(paste(names(replen[!keep]), collapse = ", "))
removed <- paste(removed, sep = "\n")
paste0("There are more repeat lengths (", length(replen), ") than loci ",
"(", length(loci), "). The following repeat lengths will be removed:",
"\n ", removed)
}
unmatched_loci_warning <- function(replen, loci){
nr <- length(replen)
nl <- length(loci)
replen <- strwrap(paste(replen, collapse = ", "),
initial = "",
prefix = "\t ")
replen <- paste(replen, collapse = "\n")
loci <- strwrap(paste(loci, collapse = ", "),
initial = "",
prefix = "\t ")
loci <- paste(loci, collapse = "\n")
msg <- paste0("The following repeat lengths (", nr, ") do not match ",
"any of the loci (", nl, "):\n",
"\trepeat lengths... ", replen, "\n",
"\tloci............. ", loci)
return(msg)
}
#==============================================================================#
# Warning message for Neighbor-Joining trees.
# Public functions utilizing this function:
#
# # aboot bruvo.boot
#
# Internal functions utilizing this function:
# # none
#==============================================================================#
negative_branch_warning <- function(){
msg <- paste("Some branch lengths of the tree are negative.",
"Normalizing branches according to Kuhner and Felsenstein",
"(1994)")
return(msg)
}
#==============================================================================#
# Warning message for mlg.crosspop with the flag mlgsub.
# Public functions utilizing this function:
#
# # mlg.crosspop
#
# Internal functions utilizing this function:
# # none
#==============================================================================#
mlg_sub_warning <- function(mlgs){
msg <- paste0("The following multilocus genotypes are not defined in this ",
"dataset: ", paste(mlgs, collapse = ", "))
return(msg)
}
#==============================================================================#
# create a message about missing data
#
# param things a character vector of names that are removed
# param type a vector of length two giving the singular and plural of things
# param nremoved the number of removed items
# param cutoff the cutoff at which items were removed
#
# Public functions utilizing this function:
# ## missingno
#
# Internal functions utilizing this function:
# ## none
#==============================================================================#
missing_messenger <- function(things, type = c("locus", "loci"), nremoved = 1,
cutoff = 0.05){
type <- ifelse(length(things) == 1, type[1], type[2])
cutoff <- cutoff*100
n_things <- length(things)
things_no_more <- paste(c("Removing", n_things, paste0(type, ":"),
paste0(things[-n_things], ", "), things[n_things]),
collapse = " ")
msg <- paste0("\nFound ", nremoved, " missing values.\n\n", n_things, " ",
type, " contained missing values greater than ", cutoff, "%\n\n",
paste(strwrap(things_no_more), collapse = "\n"))
message(msg)
}
uninformative_loci_message <- function(pop, glocivals, alocivals, locivals,
min_ind, ind, MAF){
glocsum <- sum(!glocivals)
alocsum <- sum(!alocivals)
locsum <- sum(!locivals)
lnames <- locNames(pop)
cutoff <- paste(lnames[!glocivals], collapse = ", ")
MAFloc <- paste(lnames[!alocivals], collapse = ", ")
fmsg <- paste("Found", locsum, "uninformative",
ifelse(locsum != 1, "loci", "locus"), "\n",
"============================")
gmsg <- paste(glocsum,
ifelse(glocsum != 1, "loci", "locus"), "found with",
"a cutoff of", min_ind, ind,
ifelse(glocsum == 0, "", ":\n"),
paste(strwrap(cutoff), collapse = "\n"))
amsg <- paste(alocsum,
ifelse(alocsum != 1, "loci", "locus"),
"found with MAF <", signif(MAF, 3),
ifelse(alocsum == 0, "", ":\n"),
paste(strwrap(MAFloc), collapse = "\n"))
msg <- paste("\n", fmsg, "\n", gmsg, "\n", amsg)
return(msg)
}
option_deprecated <- function(the_call, option, replacement, version, extra) {
names(the_call)[names(the_call) == option] <- replacement
CALL <- as.character(deparse(the_call))
msg <- paste("the option", option, "is deprecated as of poppr version")
msg <- paste(msg, version, extra)
msg <- paste(msg, "\n\nPlease use this as a replacement:\n ", CALL, "\n")
msg
}