TABLE OF CONTENTS

initRoutine/makeknots [ Functions ]

NAME

    makeknots --- make knots for a curve with a spline component

FUNCTION

Automatically initialize the set of spline knots if they are not given in the input. Also initializes candidate knots for adaptive knot selection.

SYNOPSIS

1292 makeknots <- function(curve, x, bounds = NULL)

INPUTS

    curve      an RCurve structure
    x          a set of data points to be used for constructing knots
    bounds     optional boundary knots (length 2 vector)

OUTPUTS

    the input RCurve, with additional spline.knots and spline.candknots components.

SOURCE

1295 {
1296     if(!curve$hasspline) return(curve)
1297     #   extract needed curve components
1298     BUF <- 0.01     # boundary buffer 
1299     knots <- curve$spline.knots;
1300     nknots <- curve$spline.nknots;
1301     ncandknots <- curve$spline.ncandknots;
1302     knotspacing <- curve$spline.knotspacing;
1303     adaptive <- curve$spline.adaptive
1304     ord <- curve$spline.ord
1305     candknots <- NULL
1306     K <- ord + nknots
1307     if(is.null(bounds)) {   # this version requires boundary knots to be given
1308         browser()
1309     }
1310     if(adaptive) nintknots <- ncandknots else nintknots <- nknots
1311     if(is.null(knots)){
1312         # distribute knots and candidate knots as quantiles of the data
1313         if(knotspacing == "quantile"){
1314             ibounds <- c(min(x), max(x))
1315             lrep <- ord; rrep <- ord
1316             if(ibounds[1] == bounds[1]) {nintknots <- nintknots + 1; lrep <- ord - 1}
1317             if(ibounds[2] == bounds[2]) {nintknots <- nintknots + 1; rrep <- ord - 1}
1318             candknots <- quantile(unique(x), seq(from = BUF, to = 1 - BUF, length = nintknots))
1319             # select the occupied knots as a random subset of the candidate knots
1320             occknots <- sort(sample(1:nintknots, nknots))
1321             knots <- candknots[occknots]
1322             candknots <- c(rep(bounds[1], lrep), candknots, rep(bounds[2], rrep))
1323             knots <- c(rep(bounds[1], lrep), knots, rep(bounds[2], rrep))
1324             attr(candknots, "occupied") <- c(rep(2, lrep), (1:nintknots)%in%occknots, 
1325                 rep(2, rrep))
1326         }
1327         # distribute knots and candidate knots equally over the data range
1328         if(knotspacing == "equal"){
1329             dbounds <- diff(bounds)
1330             # distribute candidate knots equally
1331             candknots <- seq(from = bounds[1] + BUF * dbounds, to = bounds[2] - BUF * dbounds,
1332                 length = nintknots + 2)
1333             candknots <- candknots[ - 1];candknots <- candknots[ - length(candknots)]
1334             occknots <- sort(sample(1:nintknots, nknots))
1335             # select the occupied knots as a random subset of the candidate knots
1336             knots <- candknots[occknots]
1337             knots <- c(rep(bounds[1], ord), knots, rep(bounds[2], ord))
1338             candknots <- c(rep(bounds[1], ord), candknots, rep(bounds[2], ord))
1339             attr(candknots, "occupied") <- c(rep(2, ord), (1:nintknots)%in%occknots, rep(2, ord))
1340         }
1341         # half of the knots are equally distributed, the other half are quantiles
1342         if(knotspacing == "mixed"){
1343             dbounds <- diff(bounds)
1344             # quantile candknots
1345             candknots1 <- quantile(unique(x), seq(from = BUF, to = 1 - BUF,
1346                 length = floor(nintknots / 2)))
1347             candknots2 <- seq(from = bounds[1] + BUF * dbounds, to = bounds[2] - BUF * dbounds,
1348                 length = ceiling(nintknots / 2))
1349             candknots <- sort(sample(unique(c(candknots1, candknots2)), nintknots))
1350             occknots <- sort(sample(1:nintknots, nknots))
1351             knots <- candknots[occknots]
1352             knots <- c(rep(bounds[1], ord), knots, rep(bounds[2], ord))
1353             candknots <- c(rep(bounds[1], ord), candknots, rep(bounds[2], ord))
1354             attr(candknots, "occupied") <- c(rep(2, ord), (1:nintknots)%in%occknots,
1355                 rep(2, ord))
1356         }
1357     }
1358     # attributes for the knots object
1359     attr(knots, "boundary") <- bounds
1360     attr(knots, "index") <- seq(from=-(ord - 1), length = length(knots), by = 1)
1361     attr(knots, "order") <- ord
1362     curve$spline.knots <- knots
1363     curve$spline.candknots <- candknots
1364     return(curve)
1365 }