View | Details | Raw Unified | Return to bug 15215 | Differences between
and this patch

Collapse All | Expand All

(-)dendrogram.R (-3 / +32 lines)
Lines 1-7 Link Here
1
#  File src/library/stats/R/dendrogram.R
1
#  File src/library/stats/R/dendrogram.R
2
#  Part of the R package, http://www.R-project.org
2
#  Part of the R package, http://www.R-project.org
3
#
3
#
4
#  Copyright (C) 1995-2014 The R Core Team
4
#  Copyright (C) 1995-2015 The R Core Team
5
#
5
#
6
#  This program is free software; you can redistribute it and/or modify
6
#  This program is free software; you can redistribute it and/or modify
7
#  it under the terms of the GNU General Public License as published by
7
#  it under the terms of the GNU General Public License as published by
Lines 346-355 Link Here
346
    function(x1, x2, subtree, type, center, leaflab, dLeaf,
346
    function(x1, x2, subtree, type, center, leaflab, dLeaf,
347
	     nodePar, edgePar, horiz = FALSE)
347
	     nodePar, edgePar, horiz = FALSE)
348
{
348
{
349
    wholetree <- subtree
350
    depth <- 0
351
    llimit <- list()
352
    KK <- integer()
353
    kk <- integer()
354
    
355
    repeat {
349
    inner <- !is.leaf(subtree) && x1 != x2
356
    inner <- !is.leaf(subtree) && x1 != x2
350
    yTop <- attr(subtree, "height")
357
    yTop <- attr(subtree, "height")
351
    bx <- plotNodeLimit(x1, x2, subtree, center)
358
    bx <- plotNodeLimit(x1, x2, subtree, center)
352
    xTop <- bx$x
359
    xTop <- bx$x
360
    depth <- depth + 1
361
    llimit[[depth]] <- bx$limit
353
362
354
    ## handle node specific parameters in "nodePar":
363
    ## handle node specific parameters in "nodePar":
355
    hasP <- !is.null(nPar <- attr(subtree, "nodePar"))
364
    hasP <- !is.null(nPar <- attr(subtree, "nodePar"))
Lines 401-406 Link Here
401
	    text(X, Y, nodeText, xpd = lab.xpd, srt = srt, adj = adj,
410
	    text(X, Y, nodeText, xpd = lab.xpd, srt = srt, adj = adj,
402
                 cex = lab.cex, col = lab.col, font = lab.font)
411
                 cex = lab.cex, col = lab.col, font = lab.font)
403
	}
412
	}
413
	repeat {
414
            depth <- depth - 1
415
            if (!depth || kk[depth] < KK[depth]) break
416
	}
417
	if (!depth) break
418
	length(kk) <- depth
419
	kk[depth] <- kk[depth] + 1L
420
	k <- kk[depth]
421
	x1 <- llimit[[depth]][k]; x2 <- llimit[[depth]][k + 1L]
422
	subtree <- wholetree[[kk]]
404
    }
423
    }
405
    else if (inner) {
424
    else if (inner) {
406
	segmentsHV <- function(x0, y0, x1, y1) {
425
	segmentsHV <- function(x0, y0, x1, y1) {
Lines 489-497 Link Here
489
                         font = t.font)
508
                         font = t.font)
490
                }
509
                }
491
	    }
510
	    }
492
	    plotNode(bx$limit[k], bx$limit[k + 1], subtree = child,
493
		     type, center, leaflab, dLeaf, nodePar, edgePar, horiz)
494
	}
511
	}
512
	if (!length(subtree)) break
513
        KK[depth] <- length(subtree)
514
        if (storage.mode(kk) != storage.mode(KK))
515
            storage.mode(kk) <- storage.mode(KK)
516
517
        ## go to first child
518
        kk[depth] <- 1L
519
        x1 <- bx$limit[1L]; x2 <- bx$limit[2L]
520
        subtree <- subtree[[1L]]
521
    }
522
    else
523
        break
495
    }
524
    }
496
    invisible()
525
    invisible()
497
}
526
}

Return to bug 15215