Точечный график включает в себя вертикальную линию и точки разных цветов - PullRequest
Новая
       18

Точечный график включает в себя вертикальную линию и точки разных цветов

0 голосов
/ 24 марта 2020

Мне нужно было включить в приведенный ниже код вертикальную линию, например, в положение x = 5 и чтобы все точки, меньшие 5, имели другой цвет, например синий.

Значения переменной можно прочитать с оси x, а на оси y показан порядок наблюдений в переменной (снизу вверх). Отдельные точки на дальних концах и по обеим сторонам графика указывают на потенциальные выбросы

Спасибо 

library(dplyr)
library(lattice)
n = 1000
df <- tibble(
  xx1 = runif(n, min = 3, max = 10),
  xx2 = runif(n, min = 3, max = 10),
  xx3 = runif(n, min = 3, max = 10)
  )

MyVar <- c("xx1","xx2","xx3")

MydotplotBR <- function(DataSelected){

  P <- dotplot(as.matrix(as.matrix(DataSelected)),
               groups=FALSE,
               strip = strip.custom(bg = 'white',
                                    par.strip.text = list(cex = 1.2)),
               scales = list(x = list(relation = "same",tck = 1,
                                      draw = TRUE, at=seq(0,10,1)),x=list(at=seq),
                             y = list(relation = "free", draw = FALSE),
                             auto.key = list(x =1)), 
               col=10, 
               axes = FALSE,
               cex  = 0.4, pch = 5,   
               xlim=c(0,10),  
               xlab = list(label = "Variable Value", cex = 1.5),
               ylab = list(label = "Order of data in the file", cex = 1.5))

  print(P)

}
(tempoi <- Sys.time())
Vertemp <- MydotplotBR(df[,MyVar])
(tempof <- Sys.time()-tempoi)

1 Ответ

0 голосов
/ 25 марта 2020

Я нахожу странным, что вы хотите, чтобы цвет зависел только от оси X, когда значения также используются на оси Y других графиков. Тем не менее, вот самодельная функция pairs_cutoff(), которая делает то, что вы хотите. 

pairs_cutoff <- function(data, cutoff, cols = c("red", "blue"),
                         only.lower = F, ...){
  data <- as.data.frame(data)
  cns <- colnames(data)
  nc <- ncol(data)

  layout(matrix(seq_len(nc^2), ncol = nc))

  invisible(
  sapply(seq_len(nc), function(i){
    sapply(seq_len(nc), function(j){
      if(i == j){
        plot.new()
        legend("center", bty = "n", title = cns[i], cex = 1.5, text.font = 2, legend = "")
      } else {
        if(j < i & only.lower)
          plot.new()
        else{
          if(is.null(cutoff))
            cols <- cols[1]
          plot(data[,i], data[,j], col = cols[(data[,i] < cutoff) + 1], 
               xlab = cns[i], ylab = cns[j], ...)
        }
      }


    })
  })
  )
}

Используя предложенные вами данные: 

n = 1000
dat <- tibble(
  xx1 = runif(n, min = 3, max = 10),
  xx2 = runif(n, min = 3, max = 10),
  xx3 = runif(n, min = 3, max = 10)
)

pairs_cutoff(dat, cutoff = 5, only.lower = T)

выводит следующий график: enter image description here

Вы можете указать дополнительные параметры для функции построения графика (например, pch) непосредственно для pairs_cutoff. Также, если вам нужна полная симметрия c сетка графиков, установите only.lower = F.

...