R/crispify.R

In widals: Weighting by Inverse Distance with Adaptive Least Squares

crispify <-
function (locs1, locs2, Z.delta, z.lags.vec, geodesic, alpha, 
    flatten, self.refs, lags, stnd.d = FALSE, log10cutoff = -16) 
{
    n1 <- nrow(locs1)
    n2 <- nrow(locs2)
    tau <- nrow(Z.delta)
    n.Zd <- ncol(Z.delta)
    Z.out <- rep(0, tau * n1)
    z.rep.in <- rep(0:(n.Zd - 1), length.out = n2)
    t.start <- max(0, -min(lags))
    t.stop <- min(tau, tau - max(lags))
    t.s.s <- c(t.start, t.stop)
    if (geodesic) {
        rlocs1 <- pi * locs1[, 1:2]/180
        rlocs2 <- pi * locs2[, 1:2]/180
        Z.out <- .C("crispify", as.double(cos(rlocs1[, 1]) * 
            cos(rlocs1[, 2])), as.double(cos(rlocs1[, 1]) * sin(rlocs1[, 
            2])), as.double(sin(rlocs1[, 1])), as.double(locs1[, 
            3]), as.double(cos(rlocs2[, 1]) * cos(rlocs2[, 2])), 
            as.double(cos(rlocs2[, 1]) * sin(rlocs2[, 2])), as.double(sin(rlocs2[, 
                1])), as.double(locs2[, 3]), as.double(as.vector(Z.delta)), 
            as.double(Z.out), as.double(alpha), as.double(flatten), 
            as.integer(self.refs), as.integer(length(self.refs)), 
            as.integer(z.lags.vec), as.integer(z.rep.in), as.integer(n.Zd), 
            as.integer(n1), as.integer(n2), as.integer(tau), 
            as.integer(stnd.d), as.integer(t.s.s), as.integer(geodesic), 
            as.double(log10cutoff))[[10]]
    }
    else {
        Z.out <- .C("crispify", as.double(locs1[, 1]), as.double(locs1[, 
            2]), as.double(0), as.double(locs1[, 3]), as.double(locs2[, 
            1]), as.double(locs2[, 2]), as.double(0), as.double(locs2[, 
            3]), as.double(as.vector(Z.delta)), as.double(Z.out), 
            as.double(alpha), as.double(flatten), as.integer(self.refs), 
            as.integer(length(self.refs)), as.integer(z.lags.vec), 
            as.integer(z.rep.in), as.integer(n.Zd), as.integer(n1), 
            as.integer(n2), as.integer(tau), as.integer(stnd.d), 
            as.integer(t.s.s), as.integer(geodesic), as.double(log10cutoff))[[10]]
    }
    dim(Z.out) <- c(tau, n1)
    return(Z.out)
}