Как использовать легенду о взаимодействии?

Question

Я хочу построить годовой прирост грозди дубов в разных разрезах.Поэтому я измерил увеличение 2019, 2018 и 2017 года и хочу представить данные с графиком взаимодействия.Моя проблема в количестве деревьев, которые я исследовал.У меня 25 на трансект, проблема усугубляется, когда я пытаюсь объединить все 4 графика в одном кадре.

Я пытался использовать y.instersp, как вы можете использовать с обычной легендой.Но это создает предупреждение (y.intersp не является графическим параметром) и, похоже, не влияет на график.Есть ли альтернатива для взаимодействия. Сюжет?

Я сделал несколько образцов данных:

par(mfrow = c(2, 2),oma = c(0, 0, 2, 0)) # this worsens the problem, but it already exists without mfrow 
l2017 <- rnorm(1:25, 5)
l2018 <- rnorm(1:25, 8)
l2019 <- rnorm(1:25, 7)
TreeID <- sample(1:100, 25, replace=FALSE)
before.new <- data.frame(centimetre = l2017, Measurement = "2017", 
                         unit = TreeID)
middle.new <- data.frame(centimetre = l2018, Measurement = "2018", 
                         unit = TreeID)
after.new <- data.frame(centimetre = l2019, Measurement = "2019", 
                        unit = TreeID)
df.new <- rbind(before.new, middle.new, after.new)
#create plot
interaction.plot(df.new$Measurement, df.new$unit, df.new$centimetre, ylab = "Centimetre", xlab = "Measurement", 
                 col = df.new$unit, trace.label = "TreeID", xpd = T, lty=1, fixed = T, type ="b", leg.bty = T,
                 main = "Transect 1", pch = c(1:nrow(df.new)))

mtext("Oak increase 2017 - 2019", outer = TRUE, cex = 1.5)

Я хотел бы получить сжатую версию легенды.Если для взаимодействия.плота нет y.instersp, я открыт для альтернатив, чтобы сделать легенду или указать, какая линия принадлежит какому дереву.Спасибо вперед!

Answer 1

Ниже вы можете найти модифицированную версию interaction.plot, где добавлены некоторые новые параметры легенды (x.intersp, y.intersp, leg.pt.cex, leg.cex):

myinteraction.plot <- function (x.factor, trace.factor, response, fun = mean, 
    type = c("l", "p", "b", "o", "c"), legend = TRUE, 
    trace.label = deparse(substitute(trace.factor)), 
    fixed = FALSE, xlab = deparse(substitute(x.factor)), ylab = ylabel, 
    ylim = range(cells, na.rm = TRUE), lty = nc:1, col = 1, pch = c(1L:9, 
        0, letters), xpd = NULL, leg.bg = par("bg"), leg.bty = "n", 
    xtick = FALSE, xaxt = par("xaxt"), x.intersp = 1, y.intersp = 1, 
    leg.cex = 1, leg.pt.cex = leg.cex, axes = TRUE, ...) {
    ylabel <- paste(deparse(substitute(fun)), "of ", deparse(substitute(response)))
    type <- match.arg(type)
    cells <- tapply(response, list(x.factor, trace.factor), fun)
    nr <- nrow(cells)
    nc <- ncol(cells)
    xvals <- 1L:nr
    if (is.ordered(x.factor)) {
        wn <- getOption("warn")
        options(warn = -1)
        xnm <- as.numeric(levels(x.factor))
        options(warn = wn)
        if (!anyNA(xnm)) 
            xvals <- xnm
    }
    xlabs <- rownames(cells)
    ylabs <- colnames(cells)
    nch <- max(sapply(ylabs, nchar, type = "width"))
    if (is.null(xlabs)) 
        xlabs <- as.character(xvals)
    if (is.null(ylabs)) 
        ylabs <- as.character(1L:nc)
    xlim <- range(xvals)
    xleg <- xlim[2L] + 0.05 * diff(xlim)
    xlim <- xlim + c(-0.2/nr, if (legend) 0.2 + 0.02 * nch else 0.2/nr) * 
        diff(xlim)
    dev.hold()
    on.exit(dev.flush())
    matplot(xvals, cells, ..., type = type, xlim = xlim, ylim = ylim, 
        xlab = xlab, ylab = ylab, axes = axes, xaxt = "n", col = col, 
        lty = lty, pch = pch)
    if (axes && xaxt != "n") {
        axisInt <- function(x, main, sub, lwd, bg, log, asp, 
            ...) axis(1, x, ...)
        mgp. <- par("mgp")
        if (!xtick) 
            mgp.[2L] <- 0
        axisInt(1, at = xvals, labels = xlabs, tick = xtick, 
            mgp = mgp., xaxt = xaxt, ...)
    }
    if (legend) {
        yrng <- diff(ylim)
        yleg <- ylim[2L] - 0.1 * yrng
        if (!is.null(xpd) || {
            xpd. <- par("xpd")
            !is.na(xpd.) && !xpd. && (xpd <- TRUE)
        }) {
            op <- par(xpd = xpd)
            on.exit(par(op), add = TRUE)
        }
        text(xleg, ylim[2L] - 0.05 * yrng, paste("  ", trace.label), 
            adj = 0)
        if (!fixed) {
            ord <- sort.list(cells[nr, ], decreasing = TRUE)
            ylabs <- ylabs[ord]
            lty <- lty[1 + (ord - 1)%%length(lty)]
            col <- col[1 + (ord - 1)%%length(col)]
            pch <- pch[ord]
        }
        legend(xleg, yleg, legend = ylabs, col = col, pch = if (type %in% 
            c("p", "b")) 
            pch, lty = if (type %in% c("l", "b")) 
            lty, bty = leg.bty, bg = leg.bg, x.intersp=x.intersp, y.intersp=y.intersp, 
            cex=leg.cex, pt.cex=leg.pt.cex)
    }
    invisible()
}

Вы можетеиспользуйте myinteraction.plot внутри вашего кода:

par(mfrow = c(2, 2), oma = c(0, 0, 2, 0)) 
l2017 <- rnorm(1:25, 5)
l2018 <- rnorm(1:25, 8)
l2019 <- rnorm(1:25, 7)
TreeID <- sample(1:100, 25, replace=FALSE)
before.new <- data.frame(centimetre = l2017, Measurement = "2017", unit = TreeID)
middle.new <- data.frame(centimetre = l2018, Measurement = "2018", unit = TreeID)
after.new <- data.frame(centimetre = l2019, Measurement = "2019",  unit = TreeID)
df.new <- rbind(before.new, middle.new, after.new)

myinteraction.plot(df.new$Measurement, df.new$unit, df.new$centimetre, 
      ylab = "Centimetre", xlab = "Measurement",  col = df.new$unit, 
      trace.label = "TreeID", xpd = T, lty=1, fixed = T, type ="b", 
      leg.bty = T,  main = "Transect 1", pch = c(1:nrow(df.new)), 
      x.intersp=.6, y.intersp=.6, leg.pt.cex=.6, leg.cex=.6)

, и сгенерированный участок будет