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
17d1841
commit f72d35e
Showing
7 changed files
with
456 additions
and
402 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,15 +1,22 @@ | ||
| Package: histogram | ||
| Type: Package | ||
| Title: Construction of regular and irregular histograms with different | ||
| options for automatic choice of bins | ||
| Version: 0.0-23 | ||
| Date: 2009-12-23 | ||
| Author: Thoralf Mildenberger, Yves Rozenholc, David Zasada. | ||
| Maintainer: Thoralf Mildenberger <mildenbe@statistik.tu-dortmund.de> | ||
| Description: Automatic construction of regular and irregular histograms | ||
| as described in Rozenholc/Mildenberger/Gather (2009). | ||
| Title: Construction of Regular and Irregular Histograms with Different | ||
| Options for Automatic Choice of Bins | ||
| Version: 0.0-24 | ||
| Date: 2016-10-16 | ||
| Authors@R: c(person("Thoralf", "Mildenberger", role = c("aut", "cre"), | ||
| email = "mild@zhaw.ch"), | ||
| person("Yves", "Rozenholc", role = "aut"), | ||
| person("David", "Zasada", role = "aut")) | ||
| Author: Thoralf Mildenberger [aut, cre], | ||
| Yves Rozenholc [aut], | ||
| David Zasada [aut] | ||
| Maintainer: Thoralf Mildenberger <mild@zhaw.ch> | ||
| Description: Automatic construction of regular and irregular histograms as described in Rozenholc/Mildenberger/Gather (2010). | ||
| License: GPL (>= 2) | ||
| LazyLoad: yes | ||
| Packaged: 2009-12-23 13:24:37 UTC; mildenberger | ||
| ByteCompile: yes | ||
| NeedsCompilation: no | ||
| Packaged: 2016-10-16 11:53:03 UTC; thoralf | ||
| Repository: CRAN | ||
| Date/Publication: 2009-12-24 10:42:12 | ||
| Date/Publication: 2016-10-16 17:39:09 |
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 |
|---|---|---|
| @@ -0,0 +1,12 @@ | ||
| 585b5e846c6e08b01a502d694b755d1b *DESCRIPTION | ||
| 2eee5e1ba5f04ca53172f7dc99b8cc67 *NAMESPACE | ||
| ab1e64d23e14a119e78ddabc58d2bc18 *NEWS | ||
| aaa37ba9791531fe0a4f9d035b765cdf *R/DynamicExtreme.R | ||
| 5a8c58e38abf7ce910a120a86d91f13f *R/DynamicList.R | ||
| 4410f07bbec87addbc63d54c62b5218e *R/PathList.R | ||
| 82b767d1bd543f658faf5b9bdd971086 *R/greedy.R | ||
| 2a020c19585b2feebdc68681ad46b53b *R/histogram.R | ||
| 66b51a4ae95e20b8176947a7a0e1079c *R/histogram.irregular.R | ||
| db6698fc59594df25bd06e4d6456e7a1 *R/histogram.regular.R | ||
| cbb0bfb6be33de3e0fa608f9d0ad49d3 *R/utils.R | ||
| e1aa6fdb961cac16db5d8c7fdc98fd9e *man/histogram.Rd |
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,2 +1,4 @@ | ||
| importFrom("graphics", "hist") | ||
| importFrom("stats", "quantile") | ||
| export(histogram) | ||
|
|
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 |
|---|---|---|
| @@ -0,0 +1,19 @@ | ||
| Version 0.0-24, released 2016/10/17: | ||
|
|
||
| * NAs are now removed (giving a warning), previously histogram() failed when NAs were present | ||
| * package is now byte-compiled on install (resulting in a speed-up for lagrer datasets) | ||
| * partial matchings in function call to DynamicExtreme() replaced by proper function arguments | ||
| * added reference to published paper | ||
| * histogram title should now be correct in all cases | ||
| * now explicitly imports hist() and quantile() | ||
| * some small changes to DESCRIPTION file | ||
|
|
||
| Version 0.0-23, released 2009/12/24 | ||
|
|
||
|
|
||
| Version 0.0-22, released 2009/12/16 | ||
|
|
||
|
|
||
| Version 0.0-21, released 2009/11/12 | ||
|
|
||
| * First release on CRAN |
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,75 +1,87 @@ | ||
| `histogram` <- function( y, type="combined", grid="data", breaks=NULL, penalty="default", greedy=TRUE, right=TRUE, control=list(), verbose=TRUE, plot=TRUE ) { | ||
|
|
||
| # check data vector | ||
| if ( length(unique(y))<2 ) | ||
| stop( "data vector must consist of at least two distinct values!" ) | ||
|
|
||
| # handle invalid penalty/type combination | ||
| penalty = tolower( penalty ) | ||
| if ( any( penalty==c("br","nml","sc","mdl") ) && ( tolower(type)!="regular" && tolower(type)!="r" ) ) { | ||
| warning( "Penalty '", penalty, "' not supported for irregular histograms - creating regular histogram." ) | ||
| type <- "regular" | ||
| } | ||
| # handle invalid parameter "breaks" | ||
| if ( length(breaks) > 1 ) { | ||
| warning( "Breaks is a vector of length ", length(breaks), " - using first value only", call.=FALSE ) | ||
| breaks = breaks[1] | ||
| } | ||
| if ( ! is.null(breaks) ) { | ||
| breaks <- floor( breaks ) | ||
| if ( breaks < 2 ) { | ||
| warning( "Breaks must be an integer <= 2 - using breaks=2", call.=FALSE ) | ||
| breaks <- 2 | ||
| } | ||
| } | ||
|
|
||
| # histogram type: regular | ||
| if ( tolower(type)=="regular" || tolower(type)=="r" ) | ||
| out<-histogram.regular( y, penalty=penalty, breaks=breaks, control=control, right=right, verbose=verbose, plot=plot, yvarname=deparse( substitute(y)) )$H | ||
|
|
||
| # histogram type: irregular | ||
| if ( tolower(type)=="irregular" || tolower(type)=="i" ) | ||
| out<-histogram.irregular( y, grid=grid, breaks=breaks, penalty=penalty, greedy=greedy, control=control, right=right, verbose=verbose, plot=plot, yvarname=deparse( substitute(y)) )$H | ||
|
|
||
| # histogram type: combined | ||
| if ( tolower(type)=="combined" || tolower(type)=="c" ) { | ||
|
|
||
| # check penalty-parameter | ||
| penalty = tolower( penalty ) | ||
| if ( ! any( penalty==c("default","pena","penb","penr") ) ) { | ||
| warning( "Penalty '", penalty, "' not supported for combined histograms - using default setting for irregular histograms", call.=FALSE ) | ||
| penalty = "default" | ||
| } | ||
|
|
||
| if ( verbose ) | ||
| message( "Choosing between regular and irregular histogram:\n\n1.", appendLF=FALSE ) | ||
| out1 <- histogram.regular( y, penalty="br", breaks=NULL, control=control, right=right, verbose=verbose, plot=FALSE ) | ||
| if ( verbose ) | ||
| message( "2.",appendLF=FALSE ) | ||
| out2 <- histogram.irregular( y, grid=grid, breaks=NULL, penalty=penalty, greedy=greedy, control=control, right=right, verbose=verbose, plot=FALSE ) | ||
|
|
||
| #compare maximized likelihood or frgular and irregular histogram | ||
| if (out1$lhvalue>=out2$lhvalue) { | ||
| out<-out1$H | ||
| if (verbose) | ||
| message("\nRegular histogram chosen.\n") | ||
| } | ||
| else { | ||
| out<-out2$H | ||
| if ( verbose ) | ||
| message("\nIrregular histogram chosen.\n") | ||
| } | ||
|
|
||
| # Bugfix: Name of y-var gets lost above - reset it. | ||
| out$xname = deparse( substitute(y)) | ||
|
|
||
| if ( plot ) | ||
| plot(out, freq=FALSE) | ||
| } | ||
|
|
||
|
|
||
| if ( verbose ) | ||
| print( out ) | ||
|
|
||
| return( invisible(out) ) | ||
| } | ||
| `histogram` <- function( y, type="combined", grid="data", breaks=NULL, penalty="default", greedy=TRUE, right=TRUE, control=list(), verbose=TRUE, plot=TRUE ) { | ||
|
|
||
| # save y name for later (before doing anything to it) | ||
|
|
||
| xname <- deparse( substitute(y)) | ||
|
|
||
| # check data vector | ||
|
|
||
| if ( any(is.na(y)) ) { | ||
| warning("Removing NAs from data vector") | ||
| y <- y[!is.na(y)] | ||
| } | ||
|
|
||
|
|
||
| if ( length(unique(y))<2 ) | ||
| stop( "data vector must consist of at least two distinct values!" ) | ||
|
|
||
| # handle invalid penalty/type combination | ||
| penalty = tolower( penalty ) | ||
| if ( any( penalty==c("br","nml","sc","mdl") ) && ( tolower(type)!="regular" && tolower(type)!="r" ) ) { | ||
| warning( "Penalty '", penalty, "' not supported for irregular histograms - creating regular histogram." ) | ||
| type <- "regular" | ||
| } | ||
| # handle invalid parameter "breaks" | ||
| if ( length(breaks) > 1 ) { | ||
| warning( "Breaks is a vector of length ", length(breaks), " - using first value only", call.=FALSE ) | ||
| breaks = breaks[1] | ||
| } | ||
| if ( ! is.null(breaks) ) { | ||
| breaks <- floor( breaks ) | ||
| if ( breaks < 2 ) { | ||
| warning( "Breaks must be an integer <= 2 - using breaks=2", call.=FALSE ) | ||
| breaks <- 2 | ||
| } | ||
| } | ||
|
|
||
| # histogram type: regular | ||
| if ( tolower(type)=="regular" || tolower(type)=="r" ) | ||
| out<-histogram.regular( y, penalty=penalty, breaks=breaks, control=control, right=right, verbose=verbose, plot=plot, yvarname=xname )$H | ||
|
|
||
| # histogram type: irregular | ||
| if ( tolower(type)=="irregular" || tolower(type)=="i" ) | ||
| out<-histogram.irregular( y, grid=grid, breaks=breaks, penalty=penalty, greedy=greedy, control=control, right=right, verbose=verbose, plot=plot, yvarname=xname )$H | ||
|
|
||
| # histogram type: combined | ||
| if ( tolower(type)=="combined" || tolower(type)=="c" ) { | ||
|
|
||
| # check penalty-parameter | ||
| penalty = tolower( penalty ) | ||
| if ( ! any( penalty==c("default","pena","penb","penr") ) ) { | ||
| warning( "Penalty '", penalty, "' not supported for combined histograms - using default setting for irregular histograms", call.=FALSE ) | ||
| penalty = "default" | ||
| } | ||
|
|
||
| if ( verbose ) | ||
| message( "Choosing between regular and irregular histogram:\n\n1.", appendLF=FALSE ) | ||
| out1 <- histogram.regular( y, penalty="br", breaks=NULL, control=control, right=right, verbose=verbose, plot=FALSE ) | ||
| if ( verbose ) | ||
| message( "2.",appendLF=FALSE ) | ||
| out2 <- histogram.irregular( y, grid=grid, breaks=NULL, penalty=penalty, greedy=greedy, control=control, right=right, verbose=verbose, plot=FALSE ) | ||
|
|
||
| #compare maximized likelihood or frgular and irregular histogram | ||
| if (out1$lhvalue>=out2$lhvalue) { | ||
| out<-out1$H | ||
| if (verbose) | ||
| message("\nRegular histogram chosen.\n") | ||
| } | ||
| else { | ||
| out<-out2$H | ||
| if ( verbose ) | ||
| message("\nIrregular histogram chosen.\n") | ||
| } | ||
|
|
||
| # Bugfix: Name of y-var gets lost above - reset it. | ||
|
|
||
| out$xname <- xname | ||
|
|
||
| if ( plot ) | ||
| plot(out, freq=FALSE) | ||
| } | ||
|
|
||
|
|
||
| if ( verbose ) | ||
| print( out ) | ||
|
|
||
| return( invisible(out) ) | ||
| } |
Oops, something went wrong.