seg.def.fit<-function (obj, Z, PSI, mfExt, opz, return.all.sol = FALSE) {
    useExp.k = TRUE
    est.k <- function(x1, y1, L0) {
        ax <- log(x1)
        .x <- cbind(1, ax, ax^2)
        b <- drop(solve(crossprod(.x), crossprod(.x, y1)))
        const <- b[1] - L0
        DD <- sqrt(b[2]^2 - 4 * const * b[3])
        kk <- exp((-b[2] + DD)/(2 * b[3]))
        return(round(kk))
    }
    dpmax <- function(x, y, pow = 1) {
        if (pow == 1) 
            -(x > y)
        else -pow * ((x - y) * (x > y))^(pow - 1)
    }
    in.psi <- function(LIM, PSI, ret.id = TRUE) {
        a <- PSI[1, ] <= LIM[1, ]
        b <- PSI[1, ] >= LIM[2, ]
        is.ok <- !a & !b
        if (ret.id) 
            return(is.ok)
        isOK <- all(is.ok) && all(!is.na(is.ok))
        isOK
    }
    far.psi <- function(Z, PSI, id.psi.group, ret.id = TRUE) {
        id.far.ok <- sapply(unique(id.psi.group), function(.x) (tabulate(rowSums(((Z > 
            PSI)[, id.psi.group == .x, drop = FALSE])) + 1) >= 
            2)[-1])
        id.far.ok <- unlist(id.far.ok)
        if (ret.id) 
            return(id.far.ok)
        else return(all(id.far.ok))
    }
    adj.psi <- function(psii, LIM) {
        pmin(pmax(LIM[1, ], psii), LIM[2, ])
    }
    fn.costr <- function(n.psi, isLeft = 1, isInterc = 1) {
        IU <- -diag(n.psi)
        sumU <- diag(n.psi)
        sumU[row(sumU) > col(sumU)] <- 1
        if (isLeft) {
            sumU <- cbind(1, sumU)
            IU <- diag(c(1, -rep(1, n.psi)))
        }
        A <- rbind(IU, sumU)
        if (isInterc) {
            A <- rbind(0, A)
            A <- cbind(c(1, rep(0, nrow(A) - 1)), A)
        }
        A <- cbind(A, matrix(0, nrow(A), n.psi))
        A
    }
    vincoli <- FALSE
    c1 <- apply((Z <= PSI), 2, all)
    c2 <- apply((Z >= PSI), 2, all)
    if (sum(c1 + c2) != 0 || is.na(sum(c1 + c2))) 
        stop("psi out of the range")
    n <- nrow(Z)
    min.step <- opz$min.step
    rangeZ <- apply(Z, 2, range)
    alpha <- opz$alpha
    limZ <- apply(Z, 2, quantile, names = FALSE, probs = c(alpha, 
        1 - alpha))
    digits <- opz$digits
    pow <- opz$pow
    nomiOK <- opz$nomiOK
    toll <- opz$toll
    h <- opz$h
    conv.psi <- opz$conv.psi
    gap <- opz$gap
    stop.if.error <- opz$stop.if.error
    fix.npsi <- opz$fix.npsi
    dev.new <- opz$dev0
    visual <- opz$visual
    id.psi.group <- opz$id.psi.group
    it.max <- old.it.max <- opz$it.max
    psi <- PSI[1, ]
    names(psi) <- id.psi.group
    epsilon <- 10
    dev.values <- psi.values <- NULL
    it <- 0
    epsilon <- 10
    k.values <- dev.values <- NULL
    psi.values <- list()
    psi.values[[length(psi.values) + 1]] <- NA
    nomiU <- opz$nomiU
    nomiV <- opz$nomiV
    call.ok <- opz$call.ok
    call.noV <- opz$call.noV
    toll <- opz$toll
    if (!in.psi(limZ, PSI, FALSE)) 
        stop("starting psi out of the range", call. = FALSE)
    if (!far.psi(Z, PSI, id.psi.group, FALSE)) 
        stop("psi values too close each other. Please change (decreases number of) starting values", 
            call. = FALSE)
    n.psi1 <- ncol(Z)
    if (is.null(opz$constr)) 
        opz$constr <- 0
    if ((opz$constr %in% 1:2) && class(obj) == "rq") {
        vincoli <- TRUE
        call.ok$method <- "fnc"
        call.ok$R <- quote(R)
        call.ok$r <- quote(r)
        call.noV$method <- "fnc"
        call.noV$R <- quote(R.noV)
        call.noV$r <- quote(r)
    }
    fn.obj <- opz$fn.obj
    U <- ((Z - PSI) * (Z > PSI))
    colnames(U) <- nomiU
    if (pow[1] != 1) 
        U <- U^pow[1]
    obj0 <- suppressWarnings(try(eval(call.noV, envir = mfExt), 
        silent = TRUE))
    if ("try-error" %in% class(obj0)) 
        stop("The first fit with U variables does not work..", 
            call. = FALSE)
    L0 <- eval(parse(text = fn.obj), list(x = obj0))
    n.intDev0 <- nchar(strsplit(as.character(L0), "\\.")[[1]][1])
    dev.values[length(dev.values) + 1] <- opz$dev0
    dev.values[length(dev.values) + 1] <- L0
    psi.values[[length(psi.values) + 1]] <- psi
    if (visual) {
        cat(paste("iter = ", sprintf("%2.0f", 0), "  min.f = ", 
            sprintf(paste("%", n.intDev0 + 6, ".5f", sep = ""), 
                L0), "  k = ", sprintf("%2.0f", NA), "  n.psi = ", 
            formatC(length(unlist(psi)), digits = 0, format = "f"), 
            "  ini.psi = ", paste(formatC(unlist(psi), digits = 3, 
                format = "f"), collapse = "  "), sep = ""), "\n")
    }
    id.warn <- FALSE
    while (abs(epsilon) > toll) {
        it <- it + 1
        n.psi0 <- n.psi1
        n.psi1 <- ncol(Z)
        if (n.psi1 != n.psi0) {
            U <- ((Z - PSI) * (Z > PSI))
            if (pow[1] != 1) 
                U <- U^pow[1]
            obj0 <- suppressWarnings(try(eval(call.noV, envir = mfExt), 
                silent = TRUE))
            L0 <- eval(parse(text = fn.obj), list(x = obj0))
        }
        V <- dpmax(Z, PSI, pow = pow[2])
        for (i in 1:n.psi1) {
            mfExt[nomiU[i]] <- U[, i]
            mfExt[nomiV[i]] <- V[, i]
        }
        R <- fn.costr(ncol(U), 1, 1)
        R.noV <- R[, -((ncol(R) - 1) + seq_len(ncol(U))), drop = FALSE]
        r <- rep(0, nrow(R))
        obj <- suppressWarnings(eval(call.ok, envir = mfExt))
        beta.c <- coef(obj)[nomiU]
        gamma.c <- coef(obj)[nomiV]
        if (any(is.na(c(beta.c, gamma.c)))) {
            if (fix.npsi) {
                if (return.all.sol) 
                  return(list(dev.values, psi.values))
                else stop("breakpoint estimate too close or at the boundary causing NA estimates.. too many breakpoints being estimated?", 
                  call. = FALSE)
            }
            else {
                id.coef.ok <- !is.na(gamma.c)
                psi <- psi[id.coef.ok]
                gamma.c <- gamma.c[id.coef.ok]
                beta.c <- beta.c[id.coef.ok]
                Z <- Z[, id.coef.ok, drop = FALSE]
                rangeZ <- rangeZ[, id.coef.ok, drop = FALSE]
                limZ <- limZ[, id.coef.ok, drop = FALSE]
                nomiOK <- nomiOK[id.coef.ok]
                id.psi.group <- id.psi.group[id.coef.ok]
                names(psi) <- id.psi.group
            }
        }
        psi.old <- psi
        psi <- psi.old + gamma.c/beta.c
        if (!is.null(digits)) 
            psi <- round(psi, digits)
        PSI <- matrix(rep(psi, rep(n, length(psi))), ncol = length(psi))
        U <- (Z - PSI) * (Z > PSI)
        if (pow[1] != 1) 
            U <- U^pow[1]
        for (i in 1:ncol(U)) mfExt[nomiU[i]] <- U[, i]
        obj1 <- suppressWarnings(try(eval(call.noV, envir = mfExt), 
            silent = TRUE))
        L1 <- if (class(obj1)[1] == "try-error") 
            L0 + 10
        else eval(parse(text = fn.obj), list(x = obj1))
        use.k <- k <- 1
        L1.k <- NULL
        L1.k[length(L1.k) + 1] <- L1
        while (L1 > L0) {
            k <- k + 1
            use.k <- if (useExp.k) 
                2^(k - 1)
            else k
            psi <- psi.old + (gamma.c/beta.c)/(use.k * h)
            if (!is.null(digits)) 
                psi <- round(psi, digits)
            PSI <- matrix(rep(psi, rep(n, length(psi))), ncol = length(psi))
            U <- (Z - PSI) * (Z > PSI)
            if (pow[1] != 1) 
                U <- U^pow[1]
            for (i in 1:ncol(U)) mfExt[nomiU[i]] <- U[, i]
            obj1 <- suppressWarnings(try(eval(call.noV, envir = mfExt), 
                silent = TRUE))
            L1 <- if (class(obj1)[1] == "try-error") 
                L0 + 10
            else eval(parse(text = fn.obj), list(x = obj1))
            L1.k[length(L1.k) + 1] <- L1
            if (1/(use.k * h) < min.step) {
                break
            }
        }
        if (visual) {
            flush.console()
            cat(paste("iter = ", sprintf("%2.0f", it), "  min.f = ", 
                sprintf(paste("%", n.intDev0 + 6, ".5f", sep = ""), 
                  L1), "  k = ", sprintf("%2.0f", k), "  n.psi = ", 
                formatC(length(unlist(psi)), digits = 0, format = "f"), 
                "  est.psi = ", paste(formatC(unlist(psi), digits = 3, 
                  format = "f"), collapse = "  "), sep = ""), 
                "\n")
        }
        epsilon <- if (conv.psi) 
            max(abs((psi - psi.old)/psi.old))
        else (L0 - L1)/(abs(L0) + 0.1)
        L0 <- L1
        k.values[length(k.values) + 1] <- use.k
        psi.values[[length(psi.values) + 1]] <- psi
        dev.values[length(dev.values) + 1] <- L0
        if (it >= it.max) {
            id.warn <- TRUE
            break
        }
        id.psi.far <- far.psi(Z, PSI, id.psi.group, TRUE)
        id.psi.in <- in.psi(limZ, PSI, TRUE)
        id.psi.ok <- id.psi.in & id.psi.far
        if (!all(id.psi.ok)) {
            if (fix.npsi) {
                psi <- adj.psi(psi, limZ)
                id.psi.far <- far.psi(Z, PSI, id.psi.group, TRUE)
                psi <- psi * ifelse(id.psi.far, 1, 0.9)
                PSI <- matrix(rep(psi, rep(nrow(Z), length(psi))), 
                  ncol = length(psi))
            }
            else {
                Z <- Z[, id.psi.ok, drop = FALSE]
                PSI <- PSI[, id.psi.ok, drop = FALSE]
                rangeZ <- rangeZ[, id.psi.ok, drop = FALSE]
                limZ <- limZ[, id.psi.ok, drop = FALSE]
                nomiOK <- nomiOK[id.psi.ok]
                id.psi.group <- id.psi.group[id.psi.ok]
                psi.old <- psi.old[id.psi.ok]
                psi <- psi[id.psi.ok]
                names(psi) <- id.psi.group
                if (ncol(PSI) <= 0) {
                  warning(paste("All breakpoints have been removed after", 
                    it, "iterations.. returning 0"), call. = FALSE)
                  return(0)
                }
            }
        }
    }
    if (id.warn) 
        warning(paste("max number of iterations (", it, ") attained", 
            sep = ""), call. = FALSE)
    attr(psi.values, "dev") <- dev.values
    attr(psi.values, "k") <- k.values
    psi <- unlist(tapply(psi, id.psi.group, sort))
    names(psi) <- id.psi.group
    names.coef <- names(coef(obj))
    PSI.old <- PSI
    PSI <- matrix(rep(psi, rep(nrow(Z), length(psi))), ncol = length(psi))
    if (sd(PSI - PSI.old) > 0) {
        U <- (Z - PSI) * (Z > PSI)
        colnames(U) <- paste("U", 1:ncol(U), sep = "")
        V <- -(Z > PSI)
        colnames(V) <- paste("V", 1:ncol(V), sep = "")
        for (i in 1:n.psi1) {
            mfExt[nomiU[i]] <- U[, i]
            mfExt[nomiV[i]] <- V[, i]
        }
        obj <- suppressWarnings(try(eval(call.noV, envir = mfExt), 
            silent = TRUE))
        L1 <- eval(parse(text = fn.obj), list(x = obj))
    }
    else {
        obj <- obj1
    }
    nomeCoef <- grep("coef", names(obj), value = TRUE)
    if(is.list(obj[[nomeCoef]])) {
        obj[[nomeCoef]][[1]] <- c(obj[[nomeCoef]][[1]], rep(0, ncol(V)))
        names(obj[[nomeCoef]][[1]]) <- names.coef[1:length(obj[[nomeCoef]][[1]])]
        } else {
            obj[[nomeCoef]] <- c(obj[[nomeCoef]], rep(0, ncol(V)))
            names(obj[[nomeCoef]]) <- names.coef        
            }
    
    obj$epsilon <- epsilon
    obj$it <- it
    obj <- list(obj = obj, it = it, psi = psi, psi.values = psi.values, 
        U = U, V = V, rangeZ = rangeZ, epsilon = epsilon, nomiOK = nomiOK, 
        SumSquares.no.gap = L1, id.psi.group = id.psi.group, 
        id.warn = id.warn, nomiV = nomiV, nomiU = nomiU, mfExt = mfExt)
    if (vincoli) {
        obj$R <- R
        obj$R.noV <- R.noV
        obj$r <- r
    }
    return(obj)
}
