/packages/archive/2010/04.2010/04.20.2010/spacodi/R/BOTHlabels.tim.R
R | 77 lines | 76 code | 1 blank | 0 comment | 33 complexity | ee3220ad260c476f040abdc79e647ffd MD5 | raw file
1BOTHlabels.tim <- 2function (text, sel, XX, YY, adj, frame, pch, thermo, pie, piecol, col, bg, border, ...) { 3 if (missing(text)) 4 text <- NULL 5 if (length(adj) == 1) 6 adj <- c(adj, 0.5) 7 if (is.null(text) && is.null(pch) && is.null(thermo) && is.null(pie)) 8 text <- as.character(sel) 9 frame <- match.arg(frame, c("rect", "circle", "none")) 10 args <- list(...) 11 CEX <- if ("cex" %in% names(args)) 12 args$cex 13 else par("cex") 14 if (frame != "none" && !is.null(text)) { 15 if (frame == "rect") { 16 width <- strwidth(text, units = "inches", cex = CEX) 17 height <- strheight(text, units = "inches", cex = CEX) 18 if ("srt" %in% names(args)) { 19 args$srt <- args$srt%%360 20 if (args$srt == 90 || args$srt == 270) { 21 tmp <- width 22 width <- height 23 height <- tmp 24 } 25 else if (args$srt != 0) 26 warning("only right angle rotation of frame is supported;\n try `frame = \"n\"' instead.\n") 27 } 28 width <- xinch(width) 29 height <- yinch(height) 30 xl <- XX - xinch(0.10) 31 xr <- XX + xinch(-0.01) 32 yb <- YY - yinch(0.02) 33 yt <- YY + yinch(0.02) 34 rect(xl, yb, xr, yt, col = bg, border = border) 35 } 36 if (frame == "circle") { 37 radii <- 0.8 * apply(cbind(strheight(text, units = "inches", 38 cex = CEX), strwidth(text, units = "inches", 39 cex = CEX)), 1, max) 40 symbols(XX, YY, circles = radii, inches = max(radii), add = TRUE, bg = bg) 41 } 42 } 43 if (!is.null(thermo)) { 44 parusr <- par("usr") 45 width <- CEX * (parusr[2] - parusr[1])/40 46 height <- CEX * (parusr[4] - parusr[3])/15 47 if (is.vector(thermo)) 48 thermo <- cbind(thermo, 1 - thermo) 49 thermo <- height * thermo 50 xl <- XX - width/2 51 xr <- xl + width 52 yb <- YY - height/2 53 if (is.null(piecol)) 54 piecol <- rainbow(ncol(thermo)) 55 rect(xl, yb, xr, yb + thermo[, 1], border = NA, col = piecol[1]) 56 for (i in 2:ncol(thermo)) rect(xl, yb + rowSums(thermo[, 57 1:(i - 1), drop = FALSE]), xr, yb + rowSums(thermo[, 58 1:i]), border = NA, col = piecol[i]) 59 rect(xl, yb, xr, yb + height, border = "black") 60 segments(xl, YY, xl - width/5, YY) 61 segments(xr, YY, xr + width/5, YY) 62 } 63 if (!is.null(pie)) { 64 if (is.vector(pie)) 65 pie <- cbind(pie, 1 - pie) 66 xrad <- CEX * diff(par("usr")[1:2])/50 67 xrad <- rep(xrad, length(sel)) 68 for (i in 1:length(sel)) floating.pie.asp(XX[i], YY[i], 69 pie[i, ], radius = xrad[i], col = piecol) 70 } 71 if (!is.null(text)) 72 text(XX, YY, text, adj = adj, col = col, ...) 73 if (!is.null(pch)) 74 points(XX + adj[1] - 0.5, YY + adj[2] - 0.5, pch = pch, 75 col = col, bg = bg, ...) 76} 77