根据R中数据帧的列号着色树形图的末端分支（或叶子）

Question

从数据框data.main，我能够生成hclust树状图，

aa1<- c(2,4,6,8)
bb1<- c(1,3,7,11)
aa2<-c(3,6,9,12)
bb2<-c(3,5,7,9)
data.main<- data.frame(aa1,bb1,aa2,bb2)
d1<-dist(t(data.main))
hcl1<- hclust(d1)
plot(hcl1)

此外，我知道有一些方法可以使用树木截断来为树枝或树叶上色。但是，是否可以根据部分列名称或列号对它们进行着色（例如，我希望与aa1对应的分支，aa2为红色，bb1和bb2为蓝色）？

我已检查过R包dendextend，但我仍然无法找到直接/简单的方法来获得所需的结果。

Answer 1

更改树形图的颜色比使用hclust对象更容易，但转换非常简单。你可以做到

drg1 <- dendrapply(as.dendrogram(hcl1, hang=.1), function(n){
  if(is.leaf(n)){
    labelCol <- c(a="red", b="blue")[substr(attr(n,"label"),1,1)];
    attr(n, "nodePar") <- list(pch = NA, lab.col = labelCol);
    attr(n, "edgePar") <- list(col = labelCol); # to color branch as well
  }
  n;
});
plot(drg1)

将绘制

Answer 2

更新

我只留下我的答案，因为 有效且有人可能会发现OOMPA有用。但是，在看到solution of using dendrapply as suggested by MrFlick后，我推荐它。您可能会发现OOMPA软件包的其他功能很有用，但我不会仅为核心R中已存在的功能安装它。

原始答案

安装OOMPA（面向对象的微阵列和蛋白质组学分析包）：

plotColoredClusters

然后使用库ClassDiscovery中的library(ClassDiscovery) aa1<- c(2,4,6,8) bb1<- c(1,3,7,11) aa2<-c(3,6,9,12) bb2<-c(3,5,7,9) data.main<- data.frame(aa1,bb1,aa2,bb2) d1<-dist(t(data.main)) hcl1<- hclust(d1) #identify the labels labels=hcl1[4]$labels # Choose which ones are in the "aa" group aa_present <- grepl("aa", labels) colors <- ifelse(aa_present, "red", "blue") plotColoredClusters(hcl1,labs=labels,cols=colors) 函数：

<?xml version="1.0" encoding="UTF-8"?>
<xp:view xmlns:xp="http://www.ibm.com/xsp/core"
    xmlns:xe="http://www.ibm.com/xsp/coreex">
    <script src="jquery-1.11.2.min.js"></script>
    <xp:this.data>
        <xp:dominoView var="view3" viewName="vwSomeData"></xp:dominoView>
    </xp:this.data>

    <xe:jsonRpcService id="jsonRpcService1" serviceName="myRPC">
        <xe:this.methods>
            <xe:remoteMethod name="setRows"
                script="sessionScope.put('numRows', rows)">
                <xe:this.arguments>
                    <xe:remoteMethodArg name="rows" type="boolean"></xe:remoteMethodArg>
                </xe:this.arguments>
            </xe:remoteMethod>
        </xe:this.methods>
    </xe:jsonRpcService>


    <xp:panel styleClass="viewWrapper" id="viewWrapper">
        <xp:viewPanel value="#{view3}" id="viewPanel1">
            <xp:this.facets>
                <xp:pager partialRefresh="true"
                    layout="Previous Group Next" xp:key="headerPager" id="pager1"
                    rendered="false">
                </xp:pager>
            </xp:this.facets>
            <xp:this.rows><![CDATA[#{javascript:
                var temp = sessionScope.get("numRows");
                print (temp)
                //if no sessionScope value assume 10
                return (temp || 10)
                }]]>
            </xp:this.rows>
            <xp:viewColumn columnName="Record_ID" id="viewColumn1">
                <xp:this.facets>
                    <xp:viewColumnHeader value="Record_ i d"
                        xp:key="header" id="viewColumnHeader1">
                    </xp:viewColumnHeader>
                </xp:this.facets>
            </xp:viewColumn>
            <xp:viewColumn columnName="departdate" id="viewColumn2">
                <xp:this.facets>
                    <xp:viewColumnHeader value="D e p a r t d a t e"
                        xp:key="header" id="viewColumnHeader2">
                    </xp:viewColumnHeader>
                </xp:this.facets>
            </xp:viewColumn>
            <xp:viewColumn columnName="returndate" id="viewColumn3">
                <xp:this.facets>
                    <xp:viewColumnHeader value="R e t u r n d a t e"
                        xp:key="header" id="viewColumnHeader3">
                    </xp:viewColumnHeader>
                </xp:this.facets>
            </xp:viewColumn>
        </xp:viewPanel>
    </xp:panel>

    <xp:scriptBlock id="scriptBlock1">
        <xp:this.value><![CDATA[
        $(document).ready(function(){

            //This is only rendered if there is no sessionScope variable
            var rowFactor = parseInt($(window).height()/32);
            console.log(rowFactor)

            $.when(myRPC.setRows(rowFactor))
            .then(function(){
                var temp = $('.viewWrapper').attr("id");

                XSP.partialRefreshGet(temp, {})
            })

        })
        ]]>
        </xp:this.value>
        <xp:this.rendered><![CDATA[#{javascript:
            var temp1 = !sessionScope.get('numRows'); 
            print (temp1); 
            return temp1;
            }]]></xp:this.rendered>
    </xp:scriptBlock>
</xp:view>

结果：

Answer 3

ice，dendextend包允许使用assign_values_to_leaves_edgePar函数执行此操作。

以下是如何使用它：

aa1 <- c(2,4,6,8)
bb1 <- c(1,3,7,11)
aa2 <- c(3,6,9,12)
bb2 <- c(3,5,7,9)
data.main <- data.frame(aa1,bb1,aa2,bb2)
d1 <- dist(t(data.main))
hcl1 <- hclust(d1)
# plot(hcl1)

dend <- as.dendrogram(hcl1)
col_aa_red <- ifelse(grepl("aa", labels(dend)), "red", "blue")
dend2 <- assign_values_to_leaves_edgePar(dend=dend, value = col_aa_red, edgePar = "col")
plot(dend2)

结果：