Skip to content

Commit 8fbe359

Browse files
RichardBruskiewichRichardBruskiewich
committed
Implemented the possibility of NOT giving either a min or max for trait filterin (bounds default to actual min or max of given trait)
1 parent d8dcecb commit 8fbe359

2 files changed

Lines changed: 220 additions & 120 deletions

File tree

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: explora
2-
Version: 0.5-1
3-
Date: 2014-11-4
2+
Version: 0.6-0
3+
Date: 2014-11-17
44
Title: Bioversity Seed4Needs Explora Germplasm Selection Tool
55
Authors@R: c( person(given="Maarten", family = "van Zonneveld", role = c("aut",
66
"cre", "cph"), email = "m.vanzonneveld@cgiar.org", comment = "Explora

‎R/dialogs.r‎

Lines changed: 218 additions & 118 deletions
Original file line numberDiff line numberDiff line change
@@ -81,8 +81,11 @@ DialogSelectThresholds <- function( win, notebook ){
8181
object.thresholds <- object.thresholds[,1:ncon]
8282

8383
min.values <- matrix(round(as.table(sapply( object.thresholds, min, na.rm=TRUE )),3), ncol = 1)
84+
names(min.values) <- names(object.thresholds)
85+
8486
max.values <- matrix(round(as.table(sapply( object.thresholds, max, na.rm=TRUE )),3), ncol = 1)
85-
87+
names(max.values) <- names(object.thresholds)
88+
8689
names.thresholds <- paste(names(object.thresholds),":(","Min = ", min.values," ; ","Max = ",
8790
max.values, ")", sep = "")
8891

@@ -137,125 +140,222 @@ DialogSelectThresholds <- function( win, notebook ){
137140

138141
# Exit button here!
139142
# Local saveTraitThresholds() function and variables visible by closure?
140-
tpl[14,1:10] <- gbutton(
141-
"Save Thresholds",
142-
container = tpl,
143-
handler = function(h,...) {
144-
var1 <- svalue(var1); var2 <- svalue(var2); var3 <- svalue(var3); var4 <- svalue(var4); var5 <- svalue(var5)
145-
var6 <- svalue(var6); var7 <- svalue(var7); var8 <- svalue(var8); var9 <- svalue(var9); var10 <- svalue(var10)
146-
147-
min.var1 <- as.numeric(svalue(min.var1)); min.var2 <- as.numeric(svalue(min.var2))
148-
min.var3 <- as.numeric(svalue(min.var3)); min.var4 <- as.numeric(svalue(min.var4))
149-
min.var5 <- as.numeric(svalue(min.var5)); min.var6 <- as.numeric(svalue(min.var6))
150-
min.var7 <- as.numeric(svalue(min.var7)); min.var8 <- as.numeric(svalue(min.var8))
151-
min.var9 <- as.numeric(svalue(min.var9)); min.var10 <- as.numeric(svalue(min.var10))
152-
153-
max.var1 <- as.numeric(svalue(max.var1)); max.var2 <- as.numeric(svalue(max.var2))
154-
max.var3 <- as.numeric(svalue(max.var3)); max.var4 <- as.numeric(svalue(max.var4))
155-
max.var5 <- as.numeric(svalue(max.var5)); max.var6 <- as.numeric(svalue(max.var6))
156-
max.var7 <- as.numeric(svalue(max.var7)); max.var8 <- as.numeric(svalue(max.var8))
157-
max.var9 <- as.numeric(svalue(max.var9)); max.var10 <- as.numeric(svalue(max.var10))
158-
159-
vars <- c(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10)
160-
if(all(vars=="NA")) {
161-
svalue(notebook) <- 3
162-
return(list())
163-
}
164-
165-
if(var1!="NA"){var1 <- unlist(strsplit(var1, ":"))[1]};if(var2!="NA"){var2 <-unlist(strsplit(var2, ":"))[1]}
166-
if(var3!="NA"){var3 <- unlist(strsplit(var3, ":"))[1]};if(var4!="NA"){var4 <-unlist(strsplit(var4, ":"))[1]}
167-
if(var5!="NA"){var5 <- unlist(strsplit(var5, ":"))[1]};if(var6!="NA"){var6 <-unlist(strsplit(var6, ":"))[1]}
168-
if(var7!="NA"){var7 <- unlist(strsplit(var7, ":"))[1]};if(var8!="NA"){var8 <-unlist(strsplit(var8, ":"))[1]}
169-
if(var9!="NA"){var9 <- unlist(strsplit(var9, ":"))[1]};if(var10!="NA"){var10 <-unlist(strsplit(var10, ":"))[1]}
170-
171-
var.thresholds <- c(var1, var2, var3, var4, var5,
172-
var6, var7, var8, var9, var10)
173-
174-
var.thresholds <- var.thresholds[var.thresholds!="NA"]
175-
var.thresholds <- unique(var.thresholds)
176-
177-
min.val <- c(min.var1,min.var2,min.var3,min.var4,min.var5,
178-
min.var6,min.var7,min.var8,min.var9,min.var10)
179-
180-
min.val <- min.val[!is.na(min.val)]
181-
182-
max.val <- c(max.var1,max.var2,max.var3,max.var4,max.var5,
183-
max.var6,max.var7,max.var8,max.var9,max.var10)
184-
185-
max.val <- max.val[!is.na(max.val)]
186-
187-
matrix.thresholds <- matrix(NA, nrow=length(var.thresholds), ncol=3)
188-
matrix.thresholds <- cbind(var.thresholds, min.val, max.val)
189-
matrix.thresholds <- as.data.frame(matrix.thresholds, class = c("character","numeric","numeric"))
190-
colnames(matrix.thresholds) <- c("Variable", "Min", "Max")
191-
matrix.thresholds <- na.omit(matrix.thresholds)
192-
193-
val.min <- character(dim(matrix.thresholds)[1])
194-
val.max <- character(dim(matrix.thresholds)[1])
195-
196-
for(i in 1:dim(matrix.thresholds)[1]){
197-
198-
if(as.numeric(as.matrix(matrix.thresholds)[i,2]) < min(theDataSet[colnames(theDataSet) == as.character(matrix.thresholds[i,1])])){
199-
val.min[i] <- as.character(matrix.thresholds[i,1])
200-
}
201-
if(as.numeric(as.matrix(matrix.thresholds)[i,3]) > max(theDataSet[colnames(theDataSet) == as.character(matrix.thresholds[i,1])])){
202-
val.max[i] <- as.character(matrix.thresholds[i,1])
203-
}
204-
}
205-
206-
val.min <- val.min[val.min!=""]
207-
val.max <- val.max[val.max!=""]
208-
209-
if(length(val.min) == 0 & length(val.max) == 0){
210-
211-
## Extract subset of data base from thresholds
212-
data.var.thresholds <- as.data.frame(theDataSet[,is.element(colnames(theDataSet), matrix.thresholds$Variable)])
213-
rownames(data.var.thresholds) <- object.complete$accession
214-
accession_subset <- matrix(NA, nrow = dim(theDataSet)[1], ncol = length(var.thresholds))
215-
colnames(accession_subset) <- as.character(matrix.thresholds[,1])
216-
217-
w<-1
218-
219-
while(w <= dim(matrix.thresholds)[1]){
220-
sub <- subset(data.var.thresholds,data.var.thresholds[,w] >= as.numeric(as.character(matrix.thresholds[w,2])) & data.var.thresholds[,w] <= as.numeric(as.character(matrix.thresholds[w,3])))
221-
data.var.thresholds <- subset(data.var.thresholds,data.var.thresholds[,w] >= as.numeric(as.character(matrix.thresholds[w,2])) & data.var.thresholds[,w] <= as.numeric(as.character(matrix.thresholds[w,3])))
222-
accession_subset[1:length(rownames(sub)),w] <- rownames(sub)
223-
w <- w +1
224-
}
225-
226-
accession_subset <- as.numeric(na.omit(accession_subset[,dim(matrix.thresholds)[1]]))
227-
data.var.thresholds.final <- object.complete[is.element(object.complete$accession, accession_subset),]
228-
thresholdFilteredDataSubset <- data.var.thresholds.final
229-
data.var.thresholds.final <- data.var.thresholds.final[,-1]
230-
data.var.thresholds.final <- data.var.thresholds.final[,1:7]
231-
d.thresholds = sapply(data.var.thresholds.final, des.continuous)
232-
row.names(d.thresholds) <- c("n","Min","Max","Average","Variance","Est.Desv","Median","CV %","NA","NA %")
233-
d.thresholds = as.table(d.thresholds)
234-
names(dimnames(d.thresholds)) <- c(" ", paste("Variable thresholds", svalue( datasetSelector(analysis) )))
235-
236-
saveProjectFile( d.thresholds, "ResultsDescriptiveAnalysisThresholds" )
237-
saveProjectFile( thresholdFilteredDataSubset, "ThresholdFilteredDataSubset", row.names = FALSE )
238-
239-
print(d.thresholds)
240-
241-
output <- list("Threshold.Values" = matrix.thresholds, "Descript.Thresholds" = d.thresholds)
242-
243-
cat("\n")
244-
cat("\n")
245-
cat(paste("Process completed................."))
246-
cat("\n")
247-
248-
# Send the user back to the original notebook panel...
249-
svalue(notebook) <- 3
250-
251-
return(output)
252-
}
253-
254-
var1; var2; var3; var4; var5; var6; var7; var8; var9; var10
255-
min.var1; min.var2; min.var3; min.var4; min.var5; min.var6; min.var7; min.var8; min.var9; min.var10
256-
max.var1; max.var2; max.var3; max.var4; max.var5; max.var6; max.var7; max.var8; max.var9; max.var10
143+
144+
saveThresholds <- function(h,...) {
145+
146+
var1 <- svalue(var1); var2 <- svalue(var2); var3 <- svalue(var3); var4 <- svalue(var4); var5 <- svalue(var5)
147+
var6 <- svalue(var6); var7 <- svalue(var7); var8 <- svalue(var8); var9 <- svalue(var9); var10 <- svalue(var10)
148+
149+
min.var1 <- as.numeric(svalue(min.var1)); min.var2 <- as.numeric(svalue(min.var2))
150+
min.var3 <- as.numeric(svalue(min.var3)); min.var4 <- as.numeric(svalue(min.var4))
151+
min.var5 <- as.numeric(svalue(min.var5)); min.var6 <- as.numeric(svalue(min.var6))
152+
min.var7 <- as.numeric(svalue(min.var7)); min.var8 <- as.numeric(svalue(min.var8))
153+
min.var9 <- as.numeric(svalue(min.var9)); min.var10 <- as.numeric(svalue(min.var10))
154+
155+
max.var1 <- as.numeric(svalue(max.var1)); max.var2 <- as.numeric(svalue(max.var2))
156+
max.var3 <- as.numeric(svalue(max.var3)); max.var4 <- as.numeric(svalue(max.var4))
157+
max.var5 <- as.numeric(svalue(max.var5)); max.var6 <- as.numeric(svalue(max.var6))
158+
max.var7 <- as.numeric(svalue(max.var7)); max.var8 <- as.numeric(svalue(max.var8))
159+
max.var9 <- as.numeric(svalue(max.var9)); max.var10 <- as.numeric(svalue(max.var10))
257160

161+
vars <- c(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10)
162+
if(all(vars=="NA")) {
163+
svalue(notebook) <- 3
164+
return(list())
165+
}
166+
167+
if(var1!="NA"){
168+
var1 <- unlist(strsplit(var1, ":"))[1]
169+
if(is.na(min.var1)) {
170+
min.var1 <- min.values[var1]
171+
}
172+
if(is.na(max.var1)) {
173+
max.var1 <- max.values[var1]
174+
}
175+
}
176+
if(var2!="NA"){
177+
var2 <-unlist(strsplit(var2, ":"))[1]
178+
if(is.na(min.var2)) {
179+
min.var2 <- min.values[var2]
180+
}
181+
if(is.na(max.var2)) {
182+
max.var2 <- max.values[var2]
183+
}
184+
}
185+
if(var3!="NA"){
186+
var3 <- unlist(strsplit(var3, ":"))[1]
187+
if(is.na(min.var3)) {
188+
min.var3 <- min.values[var3]
189+
}
190+
if(is.na(max.var3)) {
191+
max.var3 <- max.values[var3]
192+
}
193+
194+
}
195+
if(var4!="NA"){
196+
var4 <-unlist(strsplit(var4, ":"))[1]
197+
if(is.na(min.var4)) {
198+
min.var4 <- min.values[var4]
199+
}
200+
if(is.na(max.var4)) {
201+
max.var4 <- max.values[var4]
202+
}
203+
204+
}
205+
if(var5!="NA"){
206+
var5 <- unlist(strsplit(var5, ":"))[1]
207+
if(is.na(min.var5)) {
208+
min.var5 <- min.values[var5]
209+
}
210+
if(is.na(max.var5)) {
211+
max.var5 <- max.values[var5]
212+
}
213+
258214
}
215+
if(var6!="NA"){
216+
var6 <-unlist(strsplit(var6, ":"))[1]
217+
if(is.na(min.var6)) {
218+
min.var6 <- min.values[var6]
219+
}
220+
if(is.na(max.var6)) {
221+
max.var6 <- max.values[var6]
222+
}
223+
224+
}
225+
if(var7!="NA"){
226+
var7 <- unlist(strsplit(var7, ":"))[1]
227+
if(is.na(min.var7)) {
228+
min.var7 <- min.values[var7]
229+
}
230+
if(is.na(max.var7)) {
231+
max.var7 <- max.values[var7]
232+
}
233+
234+
}
235+
if(var8!="NA"){
236+
var8 <-unlist(strsplit(var8, ":"))[1]
237+
if(is.na(min.var8)) {
238+
min.var8 <- min.values[var8]
239+
}
240+
if(is.na(max.var8)) {
241+
max.var8 <- max.values[var8]
242+
}
243+
244+
}
245+
if(var9!="NA"){
246+
var9 <- unlist(strsplit(var9, ":"))[1]
247+
if(is.na(min.var9)) {
248+
min.var9 <- min.values[var9]
249+
}
250+
if(is.na(max.var9)) {
251+
max.var9 <- max.values[var9]
252+
}
253+
254+
}
255+
if(var10!="NA"){
256+
var10 <-unlist(strsplit(var10, ":"))[1]
257+
if(is.na(min.var10)) {
258+
min.var10 <- min.values[var10]
259+
}
260+
if(is.na(max.var10)) {
261+
max.var10 <- max.values[var10]
262+
}
263+
264+
}
265+
266+
var.thresholds <- c(var1, var2, var3, var4, var5,
267+
var6, var7, var8, var9, var10)
268+
269+
var.thresholds <- var.thresholds[var.thresholds!="NA"]
270+
var.thresholds <- unique(var.thresholds)
271+
272+
min.val <- c(min.var1,min.var2,min.var3,min.var4,min.var5,
273+
min.var6,min.var7,min.var8,min.var9,min.var10)
274+
275+
min.val <- min.val[!is.na(min.val)]
276+
277+
max.val <- c(max.var1,max.var2,max.var3,max.var4,max.var5,
278+
max.var6,max.var7,max.var8,max.var9,max.var10)
279+
280+
max.val <- max.val[!is.na(max.val)]
281+
282+
matrix.thresholds <- matrix(NA, nrow=length(var.thresholds), ncol=3)
283+
matrix.thresholds <- cbind(var.thresholds, min.val, max.val)
284+
matrix.thresholds <- as.data.frame(matrix.thresholds, class = c("character","numeric","numeric"))
285+
colnames(matrix.thresholds) <- c("Variable", "Min", "Max")
286+
matrix.thresholds <- na.omit(matrix.thresholds)
287+
288+
val.min <- character(dim(matrix.thresholds)[1])
289+
val.max <- character(dim(matrix.thresholds)[1])
290+
291+
for(i in 1:dim(matrix.thresholds)[1]){
292+
293+
if(as.numeric(as.matrix(matrix.thresholds)[i,2]) < min(theDataSet[colnames(theDataSet) == as.character(matrix.thresholds[i,1])])){
294+
val.min[i] <- as.character(matrix.thresholds[i,1])
295+
}
296+
if(as.numeric(as.matrix(matrix.thresholds)[i,3]) > max(theDataSet[colnames(theDataSet) == as.character(matrix.thresholds[i,1])])){
297+
val.max[i] <- as.character(matrix.thresholds[i,1])
298+
}
299+
}
300+
301+
val.min <- val.min[val.min!=""]
302+
val.max <- val.max[val.max!=""]
303+
304+
if(length(val.min) == 0 & length(val.max) == 0){
305+
306+
## Extract subset of data base from thresholds
307+
data.var.thresholds <- as.data.frame(theDataSet[,is.element(colnames(theDataSet), matrix.thresholds$Variable)])
308+
rownames(data.var.thresholds) <- object.complete$accession
309+
accession_subset <- matrix(NA, nrow = dim(theDataSet)[1], ncol = length(var.thresholds))
310+
colnames(accession_subset) <- as.character(matrix.thresholds[,1])
311+
312+
w<-1
313+
314+
while(w <= dim(matrix.thresholds)[1]){
315+
sub <- subset(data.var.thresholds,data.var.thresholds[,w] >= as.numeric(as.character(matrix.thresholds[w,2])) & data.var.thresholds[,w] <= as.numeric(as.character(matrix.thresholds[w,3])))
316+
data.var.thresholds <- subset(data.var.thresholds,data.var.thresholds[,w] >= as.numeric(as.character(matrix.thresholds[w,2])) & data.var.thresholds[,w] <= as.numeric(as.character(matrix.thresholds[w,3])))
317+
accession_subset[1:length(rownames(sub)),w] <- rownames(sub)
318+
w <- w +1
319+
}
320+
321+
accession_subset <- as.numeric(na.omit(accession_subset[,dim(matrix.thresholds)[1]]))
322+
data.var.thresholds.final <- object.complete[is.element(object.complete$accession, accession_subset),]
323+
thresholdFilteredDataSubset <- data.var.thresholds.final
324+
data.var.thresholds.final <- data.var.thresholds.final[,-1]
325+
data.var.thresholds.final <- data.var.thresholds.final[,1:7]
326+
d.thresholds = sapply(data.var.thresholds.final, des.continuous)
327+
row.names(d.thresholds) <- c("n","Min","Max","Average","Variance","Est.Desv","Median","CV %","NA","NA %")
328+
d.thresholds = as.table(d.thresholds)
329+
names(dimnames(d.thresholds)) <- c(" ", paste("Variable thresholds", svalue( datasetSelector(analysis) )))
330+
331+
saveProjectFile( d.thresholds, "ResultsDescriptiveAnalysisThresholds" )
332+
saveProjectFile( thresholdFilteredDataSubset, "ThresholdFilteredDataSubset", row.names = FALSE )
333+
334+
print(d.thresholds)
335+
336+
output <- list("Threshold.Values" = matrix.thresholds, "Descript.Thresholds" = d.thresholds)
337+
338+
cat("\n")
339+
cat("\n")
340+
cat(paste("Process completed................."))
341+
cat("\n")
342+
343+
# Send the user back to the original notebook panel...
344+
svalue(notebook) <- 3
345+
346+
return(output)
347+
}
348+
349+
var1; var2; var3; var4; var5; var6; var7; var8; var9; var10
350+
min.var1; min.var2; min.var3; min.var4; min.var5; min.var6; min.var7; min.var8; min.var9; min.var10
351+
max.var1; max.var2; max.var3; max.var4; max.var5; max.var6; max.var7; max.var8; max.var9; max.var10
352+
353+
}
354+
355+
tpl[14,1:10] <- gbutton(
356+
"Save Thresholds",
357+
container = tpl,
358+
handler = saveThresholds
259359
)
260360

261361
visible(win) <- TRUE

0 commit comments

Comments
 (0)