求大神帮忙

function (object, chr, type = c("2", "m"), mapfx = c("haldane",
    "kosambi"), rm.rf = TRUE, window = 3, repeats = 1, criterion = c("Path_length",
    "AR_events", "AR_deviations", "Gradient_raw", "Inertia",
    "Least_squares", "minXO", "lkhdsum"), missfx = 2, ...)
{
    if (!inherits(object, "mpcross"))
        stop("Object must be of class mpcross")
    require(seriation)
    if (missing(object))
        stop("Object is required for analysis")
    if (is.null(object$rf))
        stop("Must calculate recombination fractions prior to ordering")
    if (missing(criterion))
        criterion <- "Path_length"
    decreasing <- FALSE
    if (criterion %in% c("Path_length", "AR_events", "AR_deviation",
        "Least_squares", "minXO"))
        decreasing <- TRUE
    if (sum(is.na(object$rf$theta)) > 0 & rm.rf == TRUE) {
        keepmrk <- cleanrf(object)
        obj <- subset(object, markers = keepmrk)
        cat("These markers have been removed due to missing theta estimates: \n")
        cat(setdiff(colnames(object$finals), colnames(obj$finals)),
            "\n")
        cat("Suggestion is to use add3pt() to insert them into framework map\n")
    }
    if (rm.rf == FALSE | sum(is.na(object$rf$theta)) == 0)
        obj <- object
    if (missing(mapfx))
        mapfx <- "haldane"
    if (mapfx == "haldane")
        mf <- haldaneR2X
    else mf <- kosambiR2X
    output <- obj
    if (is.null(obj$map) & is.null(obj$lg))
        stop("No grouping of markers input")
    if (is.null(obj$map) & !is.null(obj$lg)) {
        obj$map <- list(length = obj$lg$n.groups)
        for (i in 1:obj$lg$n.groups) {
            obj$map[[i]] <- rep(0, sum(obj$lg$groups == i, na.rm = TRUE))
            names(obj$map[[i]]) <- colnames(obj$finals)[which(obj$lg$groups ==
                i)]
        }
    }
    if (missing(chr))
        chr <- c(1:length(obj$map))
    if (is.character(chr))
        chr <- match(chr, names(obj$map))
    if (type == "2") {
        order <- list()
        if (criterion == "minXO") {
            write2cross(obj, "tmp", chr = chr)
            cr <- qtl:::readMWril("", "tmp.ril.csv", "tmp.founder.csv",
                type = attr(obj, "type"))
        }
        newmap <- obj$map
        for (i in chr) {
            nam <- match(names(obj$map[[i]]), colnames(obj$rf$theta))
            if (criterion == "lkhdsum") {
                mat1 <- obj$rf$lod[nam, nam]
                if (sum(is.na(mat1)) > 0)
                  mat1 <- fill(fill(mat1, missfx), 1)
                diag(mat1) <- 0
                dmat <- as.dist(mat1)
            }
            mat <- obj$rf$theta[nam, nam]
            mat[mat >= 0.5] <- 0.49
            if (sum(is.na(mat)) > 0)
                mat <- fill(fill(mat, missfx), 1)
            diag(mat) <- 0
            if (criterion != "lkhdsum")
                dmat <- as.dist(mf(mat))
            if (length(obj$map[[i]]) > 2) {
                methods <- c("TSP", "OLO", "ARSA", "Chen", "MDS",
                  "GW", "HC")
                ser <- sapply(methods, function(x) return(seriate(dmat,
                  method = x)))
                o2 <- do.call("rbind", lapply(ser, get_order))
                o2 <- rbind(1:nrow(mat), o2)
                if (criterion != "minXO") {
                  criterion1 <- criterion
                  if (criterion1 == "lkhdsum")
                    criterion <- "Path_length"
                  crit <- lapply(ser, function(x) return(criterion(dmat,
                    x, criterion)))
                  crit <- c(criterion(dmat, method = criterion),
                    crit)
                  minx <- which.min(unlist(crit))
                  if (!decreasing)
                    minx <- which.max(unlist(crit))
                }
                else {
                  crit <- compare_orders(cr, chr = names(obj$map)[[i]],
                    orders = o2, method = "countxo")
                  minx <- which.min(crit[, ncol(o2) + 1])
                }
                order[[i]] <- o2[minx, 1:ncol(o2)]
            }
            else order[[i]] <- c(1, 2)
            mat2 <- mat[order[[i]], order[[i]]]
            newmap[[i]] <- cumsum(mf(c(0, mat2[row(mat2) == (col(mat2) +
                1)])))
            names(newmap[[i]]) <- names(obj$map[[i]])[order[[i]]]
        }
        class(newmap) <- "map"
    }
    if (type == "m") {
        write2cross(obj, "tmp", chr = chr)
        cr <- qtl:::readMWril("", "tmp.ril.csv", "tmp.founder.csv",
            type = attr(obj, "type"))
        newmap <- list()
        order <- list()
        chr <- match(names(obj$map)[chr], names(cr$geno))
        for (i in chr) {
            rip <- ripple(cr, window = window, chr = names(cr$geno)[i])
            nmrk <- nmar(cr)[i]
            cat("Minimum XO for starting order: ", rip[1, nmrk +
                1], " for best order: ", rip[2, nmrk + 1], "\n")
            cr2 <- cr
            order[[i]] <- rip[2, 1:nmrk]
            repeats2 <- repeats
            while (repeats2 > 0 & (rip[1, nmrk + 1] != rip[2,
                nmrk + 1])) {
                cr2$geno[[i]]$data <- cr2$geno[[i]]$data[, order[[i]]]
                rip <- ripple(cr2, window = window, chr = names(cr$geno)[i])
                cat("Minimum XO for starting order: ", rip[1,
                  nmrk + 1], " for best order: ", rip[2, nmrk +
                  1], "\n")
                order[[i]] <- rip[2, 1:nmrk]
                repeats2 <- repeats2 - 1
            }
            nam <- match(colnames(cr2$geno[[i]]$data), colnames(obj$rf$theta))
            mat <- obj$rf$theta[nam, nam]
            mat <- fill(fill(mat, missfx), 1)
            mat[mat == 0.5] <- 0.49
            newmap[[i]] <- cumsum(mf(c(0, mat[row(mat) == (col(mat) +
                1)][1:(length(nam) - 1)])))
            names(newmap[[i]]) <- colnames(cr2$geno[[i]]$data)
        }
        names(newmap) <- names(cr$geno)[chr]
        class(newmap) <- "map"
    }
    output$oldmap <- obj$map
    output$map <- newmap
    output <- maporder(output)
    return(output)
}

粘贴过去的代码怎么一老格式不对呢

请问script out of bound是代码本身的原因还是数据不好导致的？？

都有可能，我上次遇到这种错误是因为科学计数法和一般计数法无法兼容，你一步步检查看看