格子内の条件付き軸R

Question

ここで問題になります。ターゲットは、変数 "Z"がより高い/より低いsdであるという条件の下で、ドットプロット内のy軸にフォーマット（太字/正則）を与えることである。私は既にフォーマットを導入することができたので、今私は論理テストの導入方法に苦しんでいます。

#dataframe 
d<-data.frame(a=LETTERS[1:26],b=rnorm(26,50,10),c=rnorm(26,50,1)) 
#dotplot 
dotplot(a~b,d,col="blue",pch=16, 
     #simple plot comparing two vectors 
     panel = function(x,col,y,...){ 
    panel.dotplot(x,col="blue",y,...) 
    panel.xyplot(x=d$c,col="darkblue",y,...) 
    mins=NULL 
    maxs=NULL 
    #a line showing the difference between "measures" 
    for(i in 1:nrow(d)){ 
    mins[i]<-min(d$c[i],d$b[i]) 
    maxs[i]<-max(d$c[i],d$b[i]) 
    } 
    panel.segments(x0=mins,y0=as.numeric(y), 
       x1=maxs,y1=as.numeric(y),col="red") 
}, 
#the challenge of the conditional Y-axis 
yscale.components = function(...){ 
    temp <- yscale.components.default(...) 
    loc <- temp$left$labels$at 
    print(temp$left$labels$labels <- 
      sapply(temp$left$labels$labels, 
        function(x) if(a> x){ 
        as.expression(bquote(bold(.(x)))) 
        }else{ 
        as.expression(bquote(.(x)))})) 
    temp }, 
#a legend 
key = list(columns=2, 
      points=list(pch=16,col=c("blue","darkblue")), 
      text=list(c("measure","fitted")))) 

私はこれをアドバンスコードと考えていますので、あなたの考えを聞かせてください！

Answer 1

sapply（）で主にコードを変更してロジックテストを導入しました。 abs（b - c）> sd（b - c）のときには太字を使用します（abs（b-c）は各行の値ですがsd（b-c）は共通の値です）。 sapply（）はラベルを順番に並べ、部分集合（）でラベルを付けた行を選ぶことができます（d [d $ a == x]などの他の方法があります）。今度は、サブセット（〜）は1つの行を意味します。 if（）でこれを使うと、いくつかの論理テストを行うことができます。
[編集]他の変更部分はpanel.segments（より簡単に書くことができます）と "loc"（使用しないため削除）です。

#dataframe 
d<-data.frame(a=LETTERS[1:26],b=rnorm(26,50,10),c=rnorm(26,50,1)) 
# calculate sd 
b_sd <- with(d, sd(b-c)) 
#dotplot 
dotplot(a~b,d,col="blue",pch=16, 
     #simple plot comparing two vectors 
     panel = function(x,col,y,...){ 
      panel.dotplot(x,col="blue",y,...) 
      panel.xyplot(x=d$c,col="darkblue",y,...) 
## can draw the difference lines more simply 
      panel.segments(x, as.numeric(y), d$c, as.numeric(y), col="red") 
     }, 
## the conditional Y-axis (if abs(b - c) > sd, use "bold") 
     yscale.components = function(...){ 
      temp <- yscale.components.default(...) 
      print(temp$left$labels$labels <- 
        sapply(temp$left$labels$labels, 
## sapply() gives a label in sequence and we can pick one row having the lavel out by subset(). 
          function(x) { 
          sub <- subset(d, d$a == x) 
          if(abs(sub$b - sub$c) > b_sd) 
          { 
           as.expression(bquote(bold(.(x)))) 
          } else { 
           as.expression(bquote(.(x))) 
          } 
          })) 
      temp }, 
     #a legend 
     key = list(columns=2, 
        points=list(pch=16,col=c("blue","darkblue")), 
        text=list(c("measure","fitted"))))