R/linlogplot.R

In TIMP: Fitting Separable Nonlinear Models in Spectroscopy and Microscopy

"linlogplot" <- function (x, y, mu, alpha, xlim, ...) 
{
    maxorigx <- max(x)
    minorigx <- min(x)
    for (i in 1:length(x)) {
        if ((x[i] - mu)/alpha >= 1) 
            x[i] <- alpha + (alpha * log10((x[i] - mu)/alpha))
        else if ((x[i] - mu)/alpha < -1) 
            x[i] <- -alpha - (alpha * log10((mu - x[i])/alpha))
        else x[i] <- x[i] - mu
    }
    for (i in 1:length(xlim)) {
        if ((xlim[i] - mu)/alpha >= 1) 
            xlim[i] <- alpha + (alpha * log10((xlim[i] - mu)/alpha))
        else if ((xlim[i] - mu)/alpha < -1) 
            xlim[i] <- -alpha - (alpha * log10((mu - xlim[i])/alpha))
        else xlim[i] <- xlim[i] - mu
    }

    ticsl <- c(-alpha)
    tics <- c(-alpha)
    cntmin <- -alpha
    while (cntmin > minorigx) {
        cntmin <- cntmin * 10
        ticsl <- append(ticsl, cntmin)
        tics <- append(tics, -alpha - (alpha * log10(-cntmin/alpha)))
    }
    ticsl <- append(sort(ticsl), c(0, alpha))
    tics <- append(sort(tics), c(0, alpha))
    cntmax <- alpha
    while (cntmax < maxorigx) {
        cntmax <- cntmax * 10
        ticsl <- append(ticsl, cntmax)
        tics <- append(tics, alpha + (alpha * log10(cntmax/alpha)))
    }
    plot(x, y, xaxt = "n", xlim = xlim, ...)
    axis(side = 1, at = tics, labels = ticsl)
}