1ace <- function (x, y, wt = rep(1, nrow(x)), cat = NULL, mon = NULL,
2    lin = NULL, circ = NULL, delrsq = 0.01)
3{
4    x <- as.matrix(x)
5    if (delrsq <= 0) {
6        cat("delrsq must be positive")
7        return()
8    }
9    iy <- ncol(x) + 1
10    l <- matrix(1, ncol = iy)
11    if (!is.null(circ)) {
12        for (i in 1:length(circ)) {
13            if (circ[i] < 0 || circ[i] > ncol(x)) {
14                cat("bad circ= specification")
15                return()
16            }
17            if (circ[i] == 0) {
18                nncol <- iy
19            }
20            else {
21                nncol <- circ[i]
22            }
23            if (l[nncol] != 2 & l[nncol] != 1) {
24               cat("conflicting transformation specifications")
25               return()
26            }
27            l[nncol] <- 2
28        }
29    }
30    if (length(mon)) {
31        for (i in 1:length(mon)) {
32            if (mon[i] < 0 || mon[i] > ncol(x)) {
33                cat("bad mon= specification")
34                return()
35            }
36            if (mon[i] == 0) {
37                nncol <- iy
38            }
39            else {
40                nncol <- mon[i]
41            }
42            if (l[nncol] != 3 && l[nncol] != 1) {
43              cat("conflicting transformation specifications")
44              return()
45            }
46            l[nncol] <- 3
47        }
48    }
49    if (length(lin)) {
50        for (i in 1:length(lin)) {
51            if (lin[i] < 0 || lin[i] > ncol(x)) {
52                cat("bad lin= specification")
53                return()
54            }
55            if (lin[i] == 0) {
56                nncol <- iy
57            }
58            else {
59                nncol <- lin[i]
60            }
61            if (l[nncol] != 4 && l[nncol] != 1) {
62                cat("conflicting transformation specifications")
63                return()
64            }
65            l[nncol] <- 4
66        }
67    }
68    if (length(cat)) {
69        for (i in 1:length(cat)) {
70            if (cat[i] < 0 || cat[i] > ncol(x)) {
71                cat("bad cat= specification")
72                return()
73            }
74            if (cat[i] == 0) {
75                nncol <- iy
76            }
77            else {
78                nncol <- cat[i]
79            }
80            if (l[nncol] != 5 && l[nncol] != 1) {
81              cat("conflicting transformation specifications")
82              return()
83            }
84            l[nncol] <- 5
85        }
86    }
87    tx <- x
88    ty <- y
89    m <- matrix(0, nrow = nrow(x), ncol = iy)
90    z <- matrix(0, nrow = nrow(x), ncol = 12)
91    z <- as.matrix(z)
92    ns <- 1
93    mode(x) <- "double"
94    mode(y) <- "double"
95    mode(tx) <- "double"
96    mode(ty) <- "double"
97    mode(wt) <- "double"
98    mode(delrsq) <- "double"
99    mode(z) <- "double"
100    junk <- .Fortran("mace", p = as.integer(ncol(x)), n = as.integer(nrow(x)),
101        x = t(x), y = y, w = as.double(wt), l = as.integer(l),
102        delrsq = delrsq, ns = as.integer(ns), tx = tx, ty = ty,
103        rsq = double(1), ierr = integer(1), m = as.integer(m),
104        z = z, PACKAGE = "acepack")
105    return(junk)
106}
107
108avas <- function (x, y, wt = rep(1, nrow(x)), cat = NULL, mon = NULL,
109    lin = NULL, circ = NULL, delrsq = 0.01, yspan = 0)
110{
111    x <- as.matrix(x);
112    if (delrsq <= 0) {
113        cat("delrsq must be positive")
114        return()
115    }
116    iy <- ncol(x) + 1
117    l <- matrix(1, ncol = iy)
118    if (length(circ)) {
119        for (i in 1:length(circ)) {
120            if (circ[i] < 0 || circ[i] > ncol(x)) {
121                cat("bad circ= specification")
122                return()
123            }
124            if (circ[i] == 0) {
125                nncol <- iy
126            }
127            else {
128                nncol <- circ[i]
129            }
130            if (l[nncol] != 2 & l[nncol] != 1) {
131              cat("conflicting transformation specifications")
132              return()
133            }
134            l[nncol] <- 2
135        }
136    }
137    if (length(mon)) {
138        for (i in 1:length(mon)) {
139            if (mon[i] < 0 || mon[i] > ncol(x)) {
140                cat("bad mon= specification")
141                return()
142            }
143            if (mon[i] == 0) {
144                nncol <- iy
145            }
146            else {
147                nncol <- mon[i]
148            }
149            if (l[nncol] != 3 && l[nncol] != 1) {
150              cat("conflicting transformation specifications")
151              return()
152            }
153            l[nncol] <- 3
154        }
155    }
156    if (length(lin)) {
157        for (i in 1:length(lin)) {
158            if (lin[i] < 0 || lin[i] > ncol(x)) {
159                cat("bad lin= specification")
160                return()
161            }
162            if (lin[i] == 0) {
163                nncol <- iy
164            }
165            else {
166                nncol <- lin[i]
167            }
168            if (l[nncol] != 4 && l[nncol] != 1) {
169                cat("conflicting transformation specifications")
170                return()
171            }
172            l[nncol] <- 4
173        }
174    }
175    if (length(cat)) {
176        for (i in 1:length(cat)) {
177            if (cat[i] < 0 || cat[i] > ncol(x)) {
178                cat("bad cat= specification")
179                return()
180            }
181            if (cat[i] == 0) {
182                nncol <- iy
183            }
184            else {
185                nncol <- cat[i]
186            }
187            if (l[nncol] != 5 && l[nncol] != 1) {
188              cat("conflicting transformation specifications")
189              return()
190            }
191            l[nncol] <- 5
192        }
193    }
194    tx <- x
195    ty <- y
196    m <- matrix(0, nrow = nrow(x), ncol = ncol(x) + 2)
197    z <- matrix(0, nrow = nrow(x), ncol = 17)
198    z <- as.matrix(z)
199    iters <- matrix(0, nrow = 100, ncol = 2)
200    mode(x) <- "double"
201    mode(y) <- "double"
202    mode(tx) <- "double"
203    mode(ty) <- "double"
204    mode(wt) <- "double"
205    mode(m) <- "integer"
206    mode(l) <- "integer"
207    mode(delrsq) <- "double"
208    mode(z) <- "double"
209    mode(yspan) <- "double"
210    mode(iters) <- "double"
211    junk <- .Fortran("avas", as.integer(ncol(x)), as.integer(nrow(x)),
212        x, y, wt, l, delrsq, tx = tx, ty = ty, rsq = double(1),
213        ierr = integer(1), m, z, yspan = yspan, niter = integer(1),
214        iters = iters, PACKAGE = "acepack")
215    junk$iters <- junk$iters[1:junk$niter, ]
216    return(list(x = t(x), y = y, tx = junk$tx, ty = junk$ty, rsq = junk$rsq,
217        l=l, m, yspan = junk$yspan, iters = junk$iters, niters = junk$niter))
218}
219