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