Как я могу изменить текст на диагонали графиков рассеяния, созданных функцией «пар»?

Question

Я хочу изменить текст на диагоналях, созданных с помощью следующего кода в R (я хочу изменить текст, отображающий Sepal.Length, Sepal.Width, Petal.Length и Petal.Width).

Я пытался вставить что-то для аргумента diag.panel в функцию "pair", но с этим не повезло.

#Extracts the iris species column from the iris dataset
iris_class = iris$Species

#Change the class from characters to numerical values for indexing
# #1 = Iris-setosa
# #2 = Iris-versicolor
# #3 = Iris-virginica
class_to_number = as.numeric(factor(iris_class))


#A function to show the linear regression line in each graph
upper_panel_regression_line = function(x,y, ...){
  points(x,y,...)
  linear_regression = lm(y~x)
  linear_regression_line = abline(linear_regression)
}

#A function to calculate and show the R-squared value of each panel
lower_panel_r_squared = function(x, y, ...){
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 2, 0, 2))
  r = cor(x, y)
  r_squared = round(r^2, digits = 2)
  text_of_r_squared = paste0("R-squared = ", r_squared)
  text(1, 1, text_of_r_squared)
}


pairs(iris[1:4], main = "Predicting Iris Class", 
lower.panel=lower_panel_r_squared, upper.panel = 
        upper_panel_regression_line, col=c("red","blue","green") [class_to_number])

Answer 1

Это довольно близко к @Axeman, но я подумал, что поможет более программный способ назначения новых меток.

Во-первых, как всегда, вы можете просто изменить имена столбцов входящих данных с помощью colnames или setNames или просто names. Я предполагаю, что это не то решение, которое вам нужно.

Использование аргумента text.panel= немного хлопотно, так как он должен быть заранее определен, чтобы «знать», какими должны быть метки, либо сравнивая со старыми метками, либо зная положение. Вместо того, чтобы пытаться быть сверхъестественным, я предлагаю немного причудливый способ сделать это.

Как вы можете видеть в ответе @ Axeman (и в документации для ?pairs), обычно text.panel= и другие аргументы принимают функцию, но никакие аргументы этой функции не контролируются пользователем, поэтому мы определим функция, которая сначала берет новые метки для использования, а затем возвращает функцию, переданную pairs.

my.text.panel <- function(labels) {
  function(x, y, lbl, ...) {
    if (lbl %in% names(labels)) lbl <- labels[[lbl]]
    text(x, y, lbl, ...)
  }
}

pairs(iris[1:4], main = "Predicting Iris Class", 
      text.panel = my.text.panel(c(Sepal.Length="Slen", Sepal.Width="Swid",
                                   Petal.Length="Plen", Petal.Width="Pwid")),
      lower.panel = lower_panel_r_squared,
      upper.panel = upper_panel_regression_line,
      col=c("red","blue","green") [class_to_number])

С помощью этой функции вы можете указать все, некоторые или ни одну из меток; здесь по умолчанию используется предыдущая метка, если новое отображение не найдено, но это можно легко расширить в функции для управления другими методами.

Результат:

Изначально я сохранил mean(x) и тому подобное из ответа @ Axeman, но, поскольку в противном случае поведение по умолчанию (использующее внутреннюю функцию с именем textPanel), по-видимому, ожидает одиночные числа, а не векторы, я считаю, что mean ненужный (хотя и не проблемный).

Answer 2

diag_custom_labels <- function(x, y, labels, cex, font, ...) {
  if (!exists('i')) i <<- 1
  text(mean(x), mean(y), c('my', 'custom', 'diag', 'labels')[[i]], cex = cex)
  i <<- i + 1
}

pairs(iris[1:4], main = "Predicting Iris Class", 
      lower.panel=lower_panel_r_squared, upper.panel = upper_panel_regression_line, 
      text.panel = diag_custom_labels,
      col=c("red","blue","green") [class_to_number])