R语⾔中⽤pairs作图时标出各个分图中的所要显⽰的点对R语⾔源码中的graphics包中的pairs.R⽂件修改如下：
pairs.default <-
function (x, labels, panel = points, ...,
lower.panel = panel, upper.panel = panel,
diag.panel = NULL, text.panel = textPanel,
label.pos = 0.5 + has.diag/3, line.main = 3,
cex.labels = NULL, font.labels = 1,
row1attop = TRUE, gap = 1, log = "")
{
if(doText <- missing(text.panel) || is.function(text.panel))
textPanel <-
function(x = 0.5, y = 0.5, txt, cex, font)
前十装修公司text(x, y, txt, cex = cex, font = font)
localAxis <- function(side, x, y, xpd, bg, col=NULL, main, oma, ...) {
复读高三## Explicitly ignore any color argument pasd in as
## it was most likely meant for the data points and
## not for the axis.
xpd <- NA
if(side %% 2L == 1L && xl[j]) xpd <- FALSE
if(side %% 2L == 0L && yl[i]) xpd <- FALSE李贺简介
if(side %% 2L == 1L) Axis(x, side = side, xpd = xpd, ...)
el Axis(y, side = side, xpd = xpd, ...)
}
localPlot <- function(..., main, oma, font.main, cex.main) plot(...)
localLowerPanel <- function(..., main, oma, font.main, cex.main)
lower.panel(...)
顽石点头
localUpperPanel <- function(..., main, oma, font.main, cex.main)
upper.panel(...)
localDiagPanel <- function(..., main, oma, font.main, cex.main)
20年后的世界
diag.panel(...)
dots <- list(...); nmdots <- names(dots)
if (!is.matrix(x)) {
x <- as.data.frame(x)
段干木for(i in q_along(names(x))) {
if(is.factor(x[[i]]) || is.logical(x[[i]]))
x[[i]] <- as.numeric(x[[i]])
if(!is.numeric(unclass(x[[i]])))
stop("non-numeric argument to 'pairs'")
}
} el if (!is.numeric(x)) stop("non-numeric argument to 'pairs'")
panel <- match.fun(panel)
if((has.lower <- !is.null(lower.panel)) && !missing(lower.panel))
lower.panel <- match.fun(lower.panel)
if((has.upper <- !is.null(upper.panel)) && !missing(upper.panel))
upper.panel <- match.fun(upper.panel)
if((has.diag <- !is.null( diag.panel)) && !missing( diag.panel))
diag.panel <- match.fun( diag.panel)
excel美化
if(row1attop) {
伶仃是什么意思tmp <- lower.panel; lower.panel <- upper.panel; upper.panel <- tmp
tmp <- has.lower; has.lower <- has.upper; has.upper <- tmp
}
nc <- ncol(x)
if (nc < 2) stop("only one column in the argument to 'pairs'")
if(doText) {
if (missing(labels)) {
labels <- colnames(x)
if (is.null(labels)) labels <- paste("var", 1L:nc)
}
el if(is.null(labels)) doText <- FALSE
}
oma <- if("oma" %in% nmdots) dots$oma
main <- if("main" %in% nmdots) dots$main
if (is.null(oma))
oma <- c(4, 4, if(!is.null(main)) 6 el 4, 4)
opar <- par(mfrow = c(nc, nc), mar = rep.int(gap/2, 4), oma = oma)
dev.hold(); on.exit(dev.flush(), add = TRUE)
xl <- yl <- logical(nc)
if (is.numeric(log)) xl[log] <- yl[log] <- TRUE
el {xl[] <- grepl("x", log); yl[] <- grepl("y", log)}
for (i in if(row1attop) 1L:nc el nc:1L)
for (j in 1L:nc) {
l <- paste0(ifel(xl[j], "x", ""), ifel(yl[i], "y", ""))
localPlot(x[, j], x[, i], xlab = "", ylab = "",
axes = FALSE, type = "n", ..., log = l)
if(i == j || (i < j && has.lower) || (i > j && has.upper) ) {
box()
if(i == 1 && (!(j %% 2L) || !has.upper || !has.lower ))
localAxis(1L + 2L*row1attop, x[, j], x[, i], ...)
if(i == nc && ( j %% 2L || !has.upper || !has.lower ))
localAxis(3L - 2L*row1attop, x[, j], x[, i], ...)
if(j == 1 && (!(i %% 2L) || !has.upper || !has.lower ))
localAxis(2L, x[, j], x[, i], ...)
if(j == nc && ( i %% 2L || !has.upper || !has.lower ))
localAxis(4L, x[, j], x[, i], ...)
mfg <- par("mfg")
if(i == j) {
if (has.diag) localDiagPanel(as.vector(x[, i]), ...)
if (doText) {
par(usr = c(0, 1, 0, 1))
if(is.null(cex.labels)) {
l.wid <- strwidth(labels, "ur")
cex.labels <- max(0.8, min(2, .9 / max(l.wid)))
}
xlp <- if(xl[i]) 10^0.5 el 0.5
ylp <- if(yl[j]) 10^label.pos el label.pos
text.panel(xlp, ylp, labels[i],
cex = cex.labels, font = font.labels)
}
} el if(i < j){
localLowerPanel(as.vector(x[, j]), as.vector(x[, i]), ...)
points(x[150,j],x[150,i],pch='o',cex=3) #此处添加这句话，这⾥x的坐标为所需突出点的坐标，可按需相应修改 }
el{
localUpperPanel(as.vector(x[, j]), as.vector(x[, i]), ...)
points(x[150,j],x[150,i],pch='o',cex=3) #此处添加这句话，这⾥x的坐标为所需突出点的坐标，可按需相应修改 }
if (any(par("mfg") != mfg))
stop("the 'panel' function made a new plot")
} el par(new = FALSE)
}
if (!is.null(main)) {
font.main <- if("font.main" %in% nmdots) dots$font.main el par("font.main")
cex.main <- if("cex.main" %in% nmdots) dots$cex.main el par("cex.main")
mtext(main, 3, line.main, outer=TRUE, at = 0.5, cex = cex.main, font = font.main)
}
invisible(NULL)
}
iris2=iris[,-5]
kmeans<- it(iris2),3)
pairs(iris2, main="煤炭企业聚类分析", pch=21, bg = c("red", "green3", "blue")[unclass(kmeans$cluster)])
