Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit546c3c2

Browse files
authored
Added Tests for Untangle.R (#128)
* added test for collapse_with_pipes* added test for untangle.default* added test for flip_1_and_2* corrected test for untangle_step_rotate_both_side* corrected test for untangle_best_k_to_rotate_by_2side_backNforth* corrected test for untangle_step_rotate_1side* added test for untangle_labels* added test for untangle_DendSer* added test for ladderize* added test for untangle.dendlist* corrected test for untangle_step_rotate_2side* added test for untangle_random_search* corrected test for all_couple_rotations_at_k* formatting changed* added test for untangle_intercourse* added test for entanglement_return_best_brother* added test for untangle_evolution* changed untangle_intercourse* changed untangle_intercourse test* added test for untangle_evolution* corrected error in untangle_evolution test
1 parentf3a27a6 commit546c3c2

File tree

2 files changed

+294
-43
lines changed

2 files changed

+294
-43
lines changed

‎R/untangle.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1022,10 +1022,10 @@ untangle_step_rotate_both_side <- function(dend1, dend2, L = 1.5, max_n_iteratio
10221022
untangle_intercourse<-function(brother_1_dend1,brother_1_dend2,
10231023
sister_2_dend1,sister_2_dend2,L=1) {
10241024
# Gets two pairs of dend, and returns two childrens (inside a list)
1025-
children_1<- untangle_step_rotate_2side(brother_1_dend1,sister_2_dend2,L=L)
1026-
children_2<- untangle_step_rotate_2side(sister_2_dend1,brother_1_dend2,L=L)
1025+
children_1<- untangle_step_rotate_2side(brother_1_dend1,brother_1_dend2,L=L)
1026+
children_2<- untangle_step_rotate_2side(sister_2_dend1,sister_2_dend2,L=L)
10271027

1028-
dendlist(children_1,children_2)
1028+
list(children_1,children_2)
10291029
}
10301030

10311031
entanglement_return_best_brother<-function(brother_1_dend1,brother_1_dend2,

‎tests/testthat/test-untangle.R‎

Lines changed: 291 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,14 @@ test_that("all_couple_rotations_at_k work", {
4949
# tanglegram(dend1,dend2)
5050

5151
expect_identical(entanglement(dend1,dend2,L=2),0.5)
52+
53+
# returns original dend if k ==1
54+
dend2<- all_couple_rotations_at_k(dend1,k=1)
55+
expect_identical(dend1,dend2)
56+
# uses first element of k if k is a vector and raises a warning
57+
expect_warning(
58+
dend2<- all_couple_rotations_at_k(dend1,k= c(2,3))
59+
)
5260
})
5361

5462

@@ -66,12 +74,12 @@ test_that("untangle_step_rotate_1side work", {
6674
expect_identical(round(entanglement(dend1,dend2,L=2),2),0.47)
6775

6876
# Fixing the problem :)
69-
dend2_corrected<-untangle_step_rotate_1side(dend2,dend1)[[1]]
77+
dend2_corrected<-untangle.dendrogram(dend2,dend1,"step1side",leaves_matching_method="order")[[1]]
7078
# tanglegram(dend1,dend2_corrected) # FIXED.
7179
expect_identical(round(entanglement(dend1,dend2_corrected,L=2),2),0)
7280

7381
# the other direction may also work:
74-
dend2_corrected<-untangle_step_rotate_1side(dend2,dend1,direction="backward")[[1]]
82+
dend2_corrected<-untangle.dendrogram(dend2,dend1,"step1side",direction="backward")[[1]]
7583
# tanglegram(dend1,dend2_corrected) # FIXED.
7684
expect_identical(round(entanglement(dend1,dend2_corrected,L=2),2),0)
7785
})
@@ -80,48 +88,40 @@ test_that("untangle_step_rotate_1side work", {
8088

8189

8290
test_that("untangle_step_rotate_2side work", {
83-
suppressWarnings(RNGversion("3.5.0"))
84-
dend1<-USArrests[1:10, ] %>%
85-
dist() %>%
86-
hclust() %>%
87-
as.dendrogram()
88-
set.seed(3525645)
89-
dend2<-USArrests[1:10, ] %>%
90-
dist() %>%
91-
hclust(method="med") %>%
92-
as.dendrogram() %>%
93-
shuffle()
94-
# tanglegram(dend1,dend2)
95-
dend1<- sort(dend1)
96-
dend2<- sort(dend2)
97-
expect_identical(round(entanglement(dend1,dend2,L=2),2),0.21)
98-
99-
100-
# this is behaving different for R 3.3.3 and 3.4 - I'm not sure why...
101-
#
102-
# # Fixing the problem :)
103-
# dend12_corrected <- suppressWarnings(
104-
# untangle_step_rotate_2side(dend1, dend2, L = 2, print_times=FALSE, max_n_iterations = 20)
105-
# )
106-
#
107-
# # tanglegram(dend12_corrected[[1]],dend12_corrected[[2]]) # FIXED.
108-
# expect_identical(round(entanglement(dend12_corrected[[1]],dend12_corrected[[2]], L = 2),3) , 0.036)
109-
#
110-
#
91+
suppressWarnings(RNGversion("3.5.0"))
92+
set.seed(1)
93+
94+
dend1<-USArrests[1:20, ] %>%
95+
dist() %>%
96+
hclust() %>%
97+
as.dendrogram()
98+
noisy_USArrests=USArrests[1:20, ] %>% scale()+ rnorm(80)
99+
dend2<-noisy_USArrests %>%
100+
dist() %>%
101+
hclust(method="med") %>%
102+
as.dendrogram() %>%
103+
shuffle()
104+
105+
expect_identical(round(entanglement(dend1,dend2,L=2),2),0.24)
106+
107+
# enable print_times for test case but avoid cluttering output by capturing print statement
108+
# warnings suppressed as they were previously
109+
suppressWarnings(capture.output(
110+
# Fixing the problem :)
111+
dend12_corrected<- untangle_step_rotate_2side(dend1,dend2,L=2,print_times=T,max_n_iterations=20)
112+
))
113+
expect_identical(round(entanglement(dend12_corrected[[1]],dend12_corrected[[2]],L=2),3) ,0.059)
114+
111115
})
112116

113117

114118

115119
test_that("untangle_step_rotate_both_side work", {
116120
suppressWarnings(RNGversion("3.5.0"))
121+
set.seed(1)
117122
# Entanglement should be zero after applying algorithm, per Fig. 4 of 'Shuffle & untangle: novel untangle methods for solving the tanglegram layout problem' (Nguyen et al. 2022)
118123
example_labels<- c("Versicolor 90","Versicolor 54","Versicolor 81","Versicolor 63","Versicolor 72","Versicolor 99","Virginica 135","Virginica 117","Virginica 126","Virginica 108","Virginica 144","Setosa 27","Setosa 18","Setosa 36","Setosa 45","Setosa 9")
119-
# library(dplyr)
120-
# iris_modified <-
121-
# datasets::iris %>%
122-
# mutate(Row = row_number()) %>%
123-
# mutate(Label = paste(str_to_title(Species), Row)) %>%
124-
# dplyr::filter(Label %in% example_labels)
124+
125125
iris_modified<-datasets::iris
126126
iris_modified$Row<- seq_len(nrow(iris_modified))
127127
iris_modified$Label<- paste(tools::toTitleCase(as.character(iris_modified$Species)),iris_modified$Row)
@@ -132,7 +132,10 @@ test_that("untangle_step_rotate_both_side work", {
132132

133133
dend1<- as.dendrogram(hclust(dist(iris_numeric),method="single"))
134134
dend2<- as.dendrogram(hclust(dist(iris_numeric),method="complete"))
135-
result<- untangle_step_rotate_both_side(dend1,dend2)
135+
# enable print_times for test case but avoid cluttering output by capturing print statement
136+
capture.output(
137+
result<- untangle.dendrogram(dend1,dend2,"stepBothSides",print_times=T)
138+
)
136139
dend1<-result[[1]]
137140
dend2<-result[[2]]
138141
expect_identical(entanglement(dend1,dend2,L=2),0)
@@ -252,10 +255,258 @@ test_that("untangle_best_k_to_rotate_by_2side_backNforth works", {
252255
dend2<- shuffle(dend1)
253256
original_entanglement<- entanglement(dend1,dend2)
254257
expect_identical(round(original_entanglement,3),0.251)
255-
# resolve entanglement
256-
dends_corrected<- untangle_best_k_to_rotate_by_2side_backNforth(dend1,dend2,L=1,print_times=F)
258+
# enable print_times for test case but avoid cluttering output by capturing print statement
259+
capture.output(
260+
# resolve entanglement
261+
dends_corrected<- untangle_best_k_to_rotate_by_2side_backNforth(dend1,dend2,L=1,print_times=T)
262+
)
257263
corrected_entanglement<- entanglement(dends_corrected[[1]],dends_corrected[[2]])
258264

259265
# reduces entanglement from 0.251 to 0
260266
expect_identical(round(corrected_entanglement,3),0)
261-
})
267+
})
268+
269+
270+
271+
272+
test_that("collapse_with_pipes works", {
273+
x<- c("before pipe"," after pipe")
274+
collapsed_vector= collapse_with_pipes(x)
275+
expect_identical(collapsed_vector,"before pipe || after pipe")
276+
})
277+
278+
279+
280+
281+
test_that("untangle.default works", {
282+
suppressWarnings(RNGversion("3.5.0"))
283+
set.seed(1)
284+
285+
dend1<-USArrests[1:10, ] %>%
286+
dist() %>%
287+
hclust() %>%
288+
as.dendrogram()
289+
dend2<- shuffle(dend1)
290+
291+
expect_error(untangle.default(dend1,dend2))
292+
})
293+
294+
295+
296+
297+
test_that("flip_1_and_2 works", {
298+
x<- c(1,2,2,1)
299+
flipped<- flip_1_and_2(x)
300+
expect_identical(flipped, c(2,1,1,2))
301+
})
302+
303+
304+
305+
306+
test_that("untangle_labels works", {
307+
suppressWarnings(RNGversion("3.5.0"))
308+
set.seed(1)
309+
310+
# Create two example dendrograms with different label orders
311+
dend1<- as.dendrogram(hclust(dist(USArrests[1:5, ]),method="complete"))
312+
dend2<- as.dendrogram(hclust(dist(USArrests[5:1, ]),method="complete"))
313+
# use untangle_labels to reorder dend2 based on dend1
314+
result<- untangle.dendrogram(dend1,dend2,"labels")
315+
expect_identical(labels(result[[1]]), labels(result[[2]]))
316+
})
317+
318+
319+
320+
321+
test_that("untangle_DendSer works", {
322+
suppressWarnings(RNGversion("3.5.0"))
323+
set.seed(232)
324+
325+
ss<- sample(1:150,20)
326+
dend1<-iris[ss,-5] %>%
327+
dist() %>%
328+
hclust("com") %>%
329+
as.dendrogram()
330+
dend2<-iris[ss,-5] %>%
331+
dist() %>%
332+
hclust("sin") %>%
333+
as.dendrogram()
334+
dend12<- dendlist(dend1,dend2)
335+
336+
bad_entanglement=
337+
dend12 %>%
338+
untangle("step2") %>%
339+
entanglement()
340+
expect_identical(round(bad_entanglement,3),0.014)
341+
342+
best_entanglement=
343+
untangle.dendrogram(dend1,dend2,"DendSer") %>%
344+
untangle_DendSer() %>%
345+
untangle("step2") %>%
346+
entanglement()
347+
# reduces entanglement from 0.014 to 0
348+
expect_identical(best_entanglement,0)
349+
})
350+
351+
352+
353+
354+
test_that("ladderize works", {
355+
suppressWarnings(RNGversion("3.5.0"))
356+
set.seed(1)
357+
358+
dend1<- as.dendrogram(hclust(dist(mtcars[1:5, ]),method="average"))
359+
dend2<- as.dendrogram(hclust(dist(mtcars[6:10, ]),method="ward.D2"))
360+
361+
result<- untangle.dendrogram(dend1,dend2,"ladderize")
362+
363+
# check that both dendrograms were ladderized
364+
expect_false(identical(order.dendrogram(dend1), order.dendrogram(result[[1]])))
365+
expect_false(identical(order.dendrogram(dend2), order.dendrogram(result[[2]])))
366+
367+
# the first dendrogram should be ladderized, but the second should remain the same
368+
result_partial<- untangle.dendrogram(dend1,dend2,"ladderize",right=TRUE,which=1)
369+
expect_false(identical(order.dendrogram(dend1), order.dendrogram(result_partial[[1]])))
370+
expect_identical(order.dendrogram(dend2), order.dendrogram(result_partial[[2]]))
371+
372+
# check that the orders should differ after changing the 'right' argument
373+
result_right_true<- untangle.dendrogram(dend1,dend2,"ladderize",right=TRUE)
374+
result_right_false<- untangle.dendrogram(dend1,dend2,"ladderize",right=FALSE)
375+
expect_false(identical(order.dendrogram(result_right_true[[1]]), order.dendrogram(result_right_false[[1]])))
376+
expect_false(identical(order.dendrogram(result_right_true[[2]]), order.dendrogram(result_right_false[[2]])))
377+
})
378+
379+
380+
381+
382+
test_that("untangle.dendlist works", {
383+
suppressWarnings(RNGversion("3.5.0"))
384+
set.seed(1)
385+
386+
dend1<- as.dendrogram(hclust(dist(mtcars[6:10, ]),method="complete"))
387+
dend2<- as.dendrogram(hclust(dist(mtcars[6:10, ]),method="single"))
388+
dend3<- as.dendrogram(hclust(dist(mtcars[6:10, ]),method="average"))
389+
dend_list<- dendlist(dend1=dend1,dend2=dend2,dend3=dend3)
390+
391+
result<- untangle.dendlist(dend_list,method="step2side")
392+
393+
# entanglement improved from 0.522 to 0
394+
initial_entanglement<- entanglement(dend_list[[1]],dend_list[[2]])
395+
expect_identical(round(initial_entanglement,3),0.522)
396+
397+
final_entanglement<- entanglement(result[[1]],result[[2]])
398+
expect_identical(round(final_entanglement,3),0)
399+
})
400+
401+
402+
403+
404+
test_that("untangle_random_search works", {
405+
suppressWarnings(RNGversion("3.5.0"))
406+
set.seed(1)
407+
408+
dend1<- as.dendrogram(hclust(dist(iris[1:50,-5]),method="average"))
409+
dend2<- as.dendrogram(hclust(dist(iris[50:1,-5]),method="single"))
410+
411+
result<- untangle_random_search(dend1,dend2,R=10,leaves_matching_method="order")
412+
413+
# entanglement improved from 0.579 to 0.311
414+
initial_entanglement<- entanglement(dend1,dend2)
415+
expect_identical(round(initial_entanglement,3),0.579)
416+
417+
final_entanglement<- entanglement(result[[1]],result[[2]])
418+
expect_identical(round(final_entanglement,3),0.311)
419+
})
420+
421+
422+
423+
424+
test_that("untangle_intercourse works", {
425+
suppressWarnings(RNGversion("3.5.0"))
426+
set.seed(1)
427+
428+
brother_1_dend1<- as.dendrogram(hclust(dist(iris[1:10,-5]),method="complete"))
429+
brother_1_dend2<- as.dendrogram(hclust(dist(iris[10:1,-5]),method="single"))
430+
431+
sister_2_dend1<- as.dendrogram(hclust(dist(iris[11:20,-5]),method="average"))
432+
sister_2_dend2<- as.dendrogram(hclust(dist(iris[20:11,-5]),method="ward.D2"))
433+
434+
result<- untangle_intercourse(brother_1_dend1,brother_1_dend2,sister_2_dend1,sister_2_dend2,L=1)
435+
436+
# entanglement reduced from 0.866 to 0.045
437+
initial_entanglement_dend1<- entanglement(brother_1_dend1,brother_1_dend2)
438+
expect_identical(round(initial_entanglement_dend1,3),0.866)
439+
entanglement_child1<- entanglement(result[[1]][[1]],result[[1]][[2]])
440+
expect_identical(round(entanglement_child1,3),0.045)
441+
442+
# entanglement reduced from 0.391 to 0
443+
initial_entanglement_dend2<- entanglement(sister_2_dend1,sister_2_dend2)
444+
expect_identical(round(initial_entanglement_dend2,3),0.391)
445+
entanglement_child2<- entanglement(result[[2]][[1]],result[[2]][[2]])
446+
expect_identical(round(entanglement_child2,3),0)
447+
})
448+
449+
450+
451+
452+
test_that("entanglement_return_best_brother works", {
453+
suppressWarnings(RNGversion("3.5.0"))
454+
set.seed(1)
455+
456+
brother_1_dend1<- as.dendrogram(hclust(dist(iris[1:10,-5]),method="complete"))
457+
brother_1_dend2<- as.dendrogram(hclust(dist(iris[10:1,-5]),method="single"))
458+
459+
brother_2_dend1<- as.dendrogram(hclust(dist(iris[11:20,-5]),method="average"))
460+
brother_2_dend2<- as.dendrogram(hclust(dist(iris[20:11,-5]),method="ward.D2"))
461+
462+
result<- entanglement_return_best_brother(brother_1_dend1,brother_1_dend2,brother_2_dend1,brother_2_dend2,L=1)
463+
# brother_1 is more entangled, therefore we expect to get brother_2 in result
464+
expect_true(entanglement(brother_1_dend1,brother_1_dend2)> entanglement(brother_2_dend1,brother_2_dend2))
465+
expect_identical(result, dendlist(brother_2_dend1,brother_2_dend2))
466+
})
467+
468+
469+
470+
471+
test_that("untangle_intercourse_evolution works", {
472+
suppressWarnings(RNGversion("3.5.0"))
473+
set.seed(1)
474+
475+
brother_1_dend1<- as.dendrogram(hclust(dist(iris[1:10,-5]),method="complete"))
476+
brother_1_dend2<- as.dendrogram(hclust(dist(iris[10:1,-5]),method="single"))
477+
478+
brother_2_dend1<- as.dendrogram(hclust(dist(iris[11:20,-5]),method="average"))
479+
brother_2_dend2<- as.dendrogram(hclust(dist(iris[20:11,-5]),method="ward.D2"))
480+
481+
intercourse=list(dendlist(brother_1_dend1,brother_1_dend2), dendlist(brother_2_dend1,brother_2_dend2))
482+
result<- untangle_intercourse_evolution(intercourse,L=1)
483+
# brother_1 is more entangled, therefore we expect to get brother_2 in result
484+
expect_true(entanglement(brother_1_dend1,brother_1_dend2)> entanglement(brother_2_dend1,brother_2_dend2))
485+
expect_identical(result, dendlist(brother_2_dend1,brother_2_dend2))
486+
})
487+
488+
489+
490+
491+
test_that("untangle_evolution works", {
492+
suppressWarnings(RNGversion("3.5.0"))
493+
set.seed(1)
494+
495+
brother_1_dend1<- as.dendrogram(hclust(dist(iris[1:10,-5]),method="complete"))
496+
brother_1_dend2<- as.dendrogram(hclust(dist(iris[10:1,-5]),method="single"))
497+
498+
sister_2_dend1<- as.dendrogram(hclust(dist(iris[11:20,-5]),method="average"))
499+
sister_2_dend2<- as.dendrogram(hclust(dist(iris[20:11,-5]),method="ward.D2"))
500+
501+
# determine which set of dendrograms can be better untangled
502+
intercourse_result<- untangle_intercourse(brother_1_dend1,brother_1_dend2,sister_2_dend1,sister_2_dend2,L=1)
503+
entanglement_child1<- entanglement(intercourse_result[[1]][[1]],intercourse_result[[1]][[2]])
504+
entanglement_child2<- entanglement(intercourse_result[[2]][[1]],intercourse_result[[2]][[2]])
505+
expect_true(entanglement_child1>entanglement_child2)
506+
# the untangled version of the better dendrograms should be the result
507+
evolution_result<- untangle_evolution(brother_1_dend1,brother_1_dend2,brother_1_dend1,brother_1_dend2,L=1)
508+
expect_identical(evolution_result,intercourse_result[[1]])
509+
})
510+
511+
512+

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp