-
Notifications
You must be signed in to change notification settings - Fork 6
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
4423110
commit d4f3504
Showing
18 changed files
with
534 additions
and
288 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,34 +1,43 @@ | ||
| GlobalEnvelope <- | ||
| function(Simulations, Alpha) { | ||
| GlobalEnvelope <- function( | ||
| Simulations, | ||
| Alpha) { | ||
|
|
||
| verifyclass(Simulations, "fv") | ||
|
|
||
| # Initialize | ||
| Simulations <- as.data.frame(Simulations)[, -1] # Eliminate r | ||
| NumberOfSimulations <- ncol(Simulations) | ||
| TargetNumber <- (1-Alpha)*NumberOfSimulations | ||
| TargetNumber <- (1 - Alpha) * NumberOfSimulations | ||
| KeptSimulations <- Simulations | ||
| PresentMinValues <- apply(Simulations, 1, min, na.rm=TRUE) | ||
| PresentMaxValues <- apply(Simulations, 1, max, na.rm=TRUE) | ||
| PresentMinValues <- apply(Simulations, 1, FUN = min, na.rm = TRUE) | ||
| PresentMaxValues <- apply(Simulations, 1, FUN = max, na.rm = TRUE) | ||
| # Loop until the target number of simulations is kept | ||
| while(ncol(KeptSimulations) > TargetNumber) { | ||
| # Remember previous min and max | ||
| PreviousMinValues <- PresentMinValues | ||
| PreviousMaxValues <- PresentMaxValues | ||
| # Select the simulations that gave extreme values | ||
| SimulationsToDrop <- c(unlist(apply(KeptSimulations, 1, which.min)), unlist(apply(KeptSimulations, 1, which.max))) | ||
| SimulationsToDrop <- c( | ||
| unlist(apply(KeptSimulations, MARGIN = 1, FUN = which.min)), | ||
| unlist(apply(KeptSimulations, MARGIN = 1, FUN = which.max)) | ||
| ) | ||
| # Drop them | ||
| KeptSimulations <- KeptSimulations[, -SimulationsToDrop] | ||
| # Fails if no simulations are left | ||
| if (is.null(dim(KeptSimulations))) | ||
| if (is.null(dim(KeptSimulations))) { | ||
| stop("Global envelope could not be calculated. More simulations are necessary.") | ||
| } | ||
| # Calculate min and max | ||
| PresentMinValues <- apply(KeptSimulations, 1, min, na.rm=TRUE) | ||
| PresentMaxValues <- apply(KeptSimulations, 1, max, na.rm=TRUE) | ||
| PresentMinValues <- apply(KeptSimulations, 1, FUN = min, na.rm = TRUE) | ||
| PresentMaxValues <- apply(KeptSimulations, 1, FUN = max, na.rm = TRUE) | ||
| } | ||
| # Interpolate because the kept number of simulations is not always the target | ||
| NumberOfKeptSimulations <- ncol(KeptSimulations) | ||
| Glo <- PresentMinValues + (PreviousMinValues-PresentMinValues)/NumberOfSimulations*(TargetNumber-NumberOfKeptSimulations) | ||
| Ghi <- PresentMaxValues + (PreviousMaxValues-PresentMaxValues)/NumberOfSimulations*(TargetNumber-NumberOfKeptSimulations) | ||
| Glo <- PresentMinValues + | ||
| (PreviousMinValues - PresentMinValues) / NumberOfSimulations * | ||
| (TargetNumber - NumberOfKeptSimulations) | ||
| Ghi <- PresentMaxValues + | ||
| (PreviousMaxValues - PresentMaxValues) / NumberOfSimulations * | ||
| (TargetNumber - NumberOfKeptSimulations) | ||
| return(rbind(Glo, Ghi)) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,31 +1,59 @@ | ||
| KEnvelope <- | ||
| function(X, r = NULL, NumberOfSimulations = 100, Alpha = 0.05, | ||
| ReferenceType = "", NeighborType = ReferenceType, SimulationType = "RandomPosition", | ||
| Precision = 0, Global = FALSE, verbose = interactive()) { | ||
| KEnvelope <- function( | ||
| X, | ||
| r = NULL, | ||
| NumberOfSimulations = 100, | ||
| Alpha = 0.05, | ||
| ReferenceType = "", | ||
| NeighborType = ReferenceType, | ||
| SimulationType = "RandomPosition", | ||
| Precision = 0, | ||
| Global = FALSE, | ||
| verbose = interactive()) { | ||
|
|
||
| CheckdbmssArguments() | ||
|
|
||
| # Choose the null hypothesis | ||
| SimulatedPP <- switch (SimulationType, | ||
| RandomPosition = expression(rRandomPositionK(X, Precision=Precision, CheckArguments = FALSE)), | ||
| RandomLabeling = expression(rRandomLabeling(X, CheckArguments = FALSE)), | ||
| PopulationIndependence = expression(rPopulationIndependenceK(X, ReferenceType, NeighborType, CheckArguments = FALSE)) | ||
| ) | ||
| if (is.null(SimulatedPP)) | ||
| SimulatedPP <- switch ( | ||
| SimulationType, | ||
| RandomPosition = expression( | ||
| rRandomPositionK(X, Precision = Precision, CheckArguments = FALSE) | ||
| ), | ||
| RandomLabeling = expression( | ||
| rRandomLabeling(X, CheckArguments = FALSE) | ||
| ), | ||
| PopulationIndependence = expression( | ||
| rPopulationIndependenceK( | ||
| X, | ||
| ReferenceType, | ||
| NeighborType, | ||
| CheckArguments = FALSE) | ||
| ) | ||
| ) | ||
| if (is.null(SimulatedPP)) { | ||
| stop(paste("The null hypothesis", sQuote(SimulationType), "has not been recognized.")) | ||
| } | ||
| # local envelope, keep extreme values for lo and hi (nrank=1) | ||
| Envelope <- envelope(X, fun=Khat, nsim=NumberOfSimulations, nrank=1, | ||
| r=r, ReferenceType=ReferenceType, NeighborType=NeighborType, | ||
| CheckArguments = FALSE, | ||
| simulate=SimulatedPP, verbose=verbose, savefuns=TRUE | ||
| ) | ||
| attr(Envelope, "einfo")$H0 <- switch (SimulationType, | ||
| RandomPosition = "Random Position", | ||
| RandomLabeling = "Random Labeling", | ||
| PopulationIndependence = "Population Independence" | ||
| ) | ||
| Envelope <- envelope( | ||
| X, | ||
| fun = Khat, | ||
| nsim = NumberOfSimulations, | ||
| nrank = 1, | ||
| r = r, | ||
| ReferenceType = ReferenceType, | ||
| NeighborType = NeighborType, | ||
| CheckArguments = FALSE, | ||
| simulate = SimulatedPP, | ||
| verbose = verbose, | ||
| savefuns = TRUE | ||
| ) | ||
| attr(Envelope, "einfo")$H0 <- switch ( | ||
| SimulationType, | ||
| RandomPosition = "Random Position", | ||
| RandomLabeling = "Random Labeling", | ||
| PopulationIndependence = "Population Independence" | ||
| ) | ||
| # Calculate confidence intervals | ||
| Envelope <- FillEnvelope(Envelope, Alpha, Global) | ||
| Envelope <- FillEnvelope(Envelope, Alpha = Alpha, Global = Global) | ||
| # Return the envelope | ||
| return (Envelope) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.