big_blackbox_transpose <- function (data, missing, verbose = FALSE, dims = 1, minscale) { if (class(data) != "matrix") stop("Data is not a matrix, please convert it using as.matrix().") if (typeof(data) != "double") stop("Data are not numeric values, please convert it using as.numeric().") if (!(is.matrix(missing) | is.vector(missing))) stop("Argument 'missing' must be a vector or matrix.") if (mode(missing) != "numeric") stop("Argument 'missing' must only contain numeric values.") if (!is.logical(verbose)) stop("Argument 'verbose' must be set TRUE or FALSE.") if (minscale < 1) stop("Argument 'minscale' must be positive.") if (dims < 1) stop("Argument 'dims' must be positive.") # if (nrow(data) > 1500) stop("There are more than N = 1500 respondents in the data.") N <- nrow(data) NQ <- ncol(data) if (is.vector(missing)) data[data %in% missing] <- NA if (is.matrix(missing)) for (i in 1:ncol(data)) data[data[, i] %in% missing[, i], i] <- NA missval <- max(data, na.rm = TRUE) + 1 rawdata <- as.numeric(t(data)) rawdata[is.na(rawdata)] <- missval stimnames <- colnames(data) if (is.null(stimnames)) stimnames <- paste("stim", 1:N, sep = "") if (verbose) { deleted <- sum(is.na(apply(data, 1, sum))) cat("\n\n\tBeginning Blackbox Transpose Scaling...") cat(NQ, "stimuli have been provided.") } res <- .Fortran("blackboxt", as.integer(N), as.integer(NQ), as.integer(dims), as.integer(1), as.double(rep(missval, NQ)), as.integer(minscale), as.integer(rep(1, N)), as.double(rawdata), as.character("a"), fits = double(7 * dims), psimatrix = double(N * ((dims * (dims + 1))/2) + 2 * N * dims), wmatrix = double((NQ) * ((dims * (dims + 1))/2) + 2 * (NQ) * dims), lresp = integer(N + NQ), lmark = integer(N), fits2 = double(6), exitstatus = integer(1)) if (res$exitstatus != 1) stop("\n\n\t====== Blackbox-Transpose did not execute properly ======\n\n") stimuli <- vector("list", dims) start <- 1 end <- 2 * NQ for (i in 1:dims) { stimuli[[i]] <- as.data.frame(matrix(round(res$wmatrix[start:end], digits = 3), nrow = NQ, ncol = i + 1, byrow = T)) colnames(stimuli[[i]]) <- c(paste("coord", 1:i, "D", sep = ""), "R2") rownames(stimuli[[i]]) <- stimnames stimuli[[i]] <- cbind(N = res$lresp[(length(res$lresp) - NQ + 1):length(res$lresp)], stimuli[[i]]) start <- end + 1 end <- start + (i + 2) * NQ - 1 } individuals <- vector("list", dims) start <- 1 end <- 3 * N for (i in 1:dims) { individuals[[i]] <- as.data.frame(matrix(round(res$psimatrix[start:end], digits = 3), nrow = N, ncol = i + 2, byrow = T)) colnames(individuals[[i]]) <- c("c", paste("w", 1:i, sep = ""), "R2") if (!is.null(rownames(data))) rownames(individuals[[i]]) <- rownames(data) start <- end + 1 end <- start + (i + 3) * N - 1 individuals[[i]][!res$lmark, ] <- NA } fits <- matrix(res$fits, nrow = dims, ncol = 7, byrow = T) fits <- as.data.frame(fits[, c(1:3, 6:7), drop = FALSE]) colnames(fits) <- c("SSE", "SSE.explained", "percent", "SE", "singular") rownames(fits) <- paste("Dimension", 1:dims) result <- list(stimuli = stimuli, individuals = individuals, fits = fits, Nrow = res$fits2[1], Ncol = res$fits2[2], Ndata = res$fits2[3], Nmiss = res$fits2[4], SS_mean = res$fits2[6], dims = dims) class(result) <- c("blackbt") if (verbose) cat("\n\n\tBlackbox-Transpose estimation completed successfully.\n\n") result }