1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
"sco.match" <- function(score1, score2, label = names(score1), clabel = 1, horizontal = TRUE, reverse = FALSE, pos.lab = 0.5, wmatch=3,pch = 20, cpoint = 1, boxes = TRUE, lim = NULL, grid = TRUE, cgrid = 1, include.origin = TRUE, origin = c(0,0), sub = "", csub = 1.25, possub = "bottomleft"){
if(!is.vector(score1))
stop("score1 should be a vector")
if(!is.vector(score2))
stop("score2 should be a vector")
nval <- length(score1)
if(nval != length(score2))
stop("length of 'score1' or 'score2' is not convenient")
if(is.null(label))
label <- 1:nval
if(nval != length(label))
stop("length of 'label' is not convenient")
if (pos.lab>1 | pos.lab<0)
stop("pos.lab should be between 0 and 1")
oldpar <- par(mar=rep(0.1, 4))
on.exit(par(oldpar))
res <- scatterutil.sco(score = c(score1,score2), lim = lim, grid = grid, cgrid = cgrid, include.origin = include.origin, origin = origin, sub = sub, csub = csub, horizontal = horizontal, reverse = reverse)
if(horizontal){
if(reverse) {
points(score1, rep(1- res[3], nval), pch = pch, cex = par("cex") * cpoint)
abline(h=1- wmatch*res[3])
points(score2, rep(1- wmatch*res[3], nval), pch = pch, cex = par("cex") * cpoint)
segments(score1,rep(1- res[3], nval),score2,rep(1- wmatch*res[3], nval))
} else {
points(score1, rep(res[3], nval), pch = pch, cex = par("cex") * cpoint)
abline(h=wmatch*res[3])
points(score2, rep(wmatch*res[3], nval), pch = pch, cex = par("cex") * cpoint)
segments(score1,rep(res[3], nval),score2,rep(wmatch*res[3], nval))
}
if(clabel>0){
if(is.null(pos.lab))
pos.lab <- 0.5
if(reverse){
pos.lab <- 1 - wmatch * res[3] - pos.lab * (1 - wmatch * res[3])
pos.elbow <- 1 - wmatch * res[3] - (1 - wmatch * res[3] - pos.lab)/5
} else {
pos.lab <- wmatch * res[3] + pos.lab * (1 - wmatch * res[3])
pos.elbow <- wmatch * res[3] + (pos.lab - wmatch * res[3])/5
}
for (i in 1:nval)
{
xh <- strwidth(paste(" ", label[order(score2)][i], " ", sep = ""), cex = par("cex") * clabel)
tmp <- scatterutil.convrot90(xh,0)
yh <- tmp[2]
yreg <- res[1] + (res[2] - res[1])/(nval + 1) * i
segments(score2[order(score2)][i],pos.elbow ,yreg, pos.lab)
if(reverse) {
segments(score2[order(score2)][i], 1 - wmatch * res[3], score2[order(score2)][i], pos.elbow)
scatterutil.eti(yreg, pos.lab - yh/2, label[order(score2)][i], clabel = clabel, boxes = boxes, horizontal = FALSE)
} else {
segments(score2[order(score2)][i], wmatch * res[3], score2[order(score2)][i], pos.elbow)
scatterutil.eti(yreg, pos.lab + yh/2, label[order(score2)][i], clabel = clabel, boxes = boxes, horizontal = FALSE)
}
}
}
} else {
if(reverse){
points(rep(1 - res[3], nval), score1, pch = pch, cex = par("cex") * cpoint)
abline(v=1- wmatch*res[3])
points(rep(1- wmatch*res[3], nval), score2, pch = pch, cex = par("cex") * cpoint)
segments(rep(1- res[3], nval),score1,rep(1- wmatch*res[3], nval), score2)
} else {
points(rep(res[3], nval), score1, pch = pch, cex = par("cex") * cpoint)
abline(v=wmatch*res[3])
points(rep(wmatch*res[3], nval), score2, pch = pch, cex = par("cex") * cpoint)
segments(rep(res[3], nval),score1,rep(wmatch*res[3], nval), score2)
}
if(clabel>0){
if(is.null(pos.lab))
pos.lab <- 0.5
if(reverse){
pos.lab <- 1 - wmatch * res[3] - pos.lab * (1 - wmatch * res[3])
pos.elbow <- 1- wmatch * res[3] - (1 - wmatch * res[3]- pos.lab)/5
} else {
pos.lab <- wmatch * res[3] + pos.lab * (1 - wmatch * res[3])
pos.elbow <- wmatch * res[3] + (pos.lab - wmatch * res[3])/5
}
for (i in 1:nval)
{
xh <- strwidth(paste(" ", label[order(score2)][i], " ", sep = ""), cex = par("cex") * clabel)
yreg <- res[1] + (res[2] - res[1])/(nval + 1) * i
segments(pos.elbow,score2[order(score2)][i],pos.lab ,yreg)
if(reverse) {
segments(1 - wmatch * res[3],score2[order(score2)][i], pos.elbow, score2[order(score2)][i])
scatterutil.eti(pos.lab - xh/2, yreg, label[order(score2)][i], clabel = clabel, boxes = boxes, horizontal = TRUE)
} else {
segments(wmatch * res[3],score2[order(score2)][i], pos.elbow, score2[order(score2)][i])
scatterutil.eti(pos.lab + xh/2, yreg, label[order(score2)][i], clabel = clabel, boxes = boxes, horizontal = TRUE)
}
}
}
}
invisible(match.call())
}
|
