Skip to content

Commit

Permalink
first commit of the public development tree for abrem. This commit is…
Browse files Browse the repository at this point in the history
… NOT based on any previous commits and forms the basis of a later master branch on which the stable r-forge commits will be based.

Signed-off-by: Jurgen Symynck <[email protected]>
  • Loading branch information
Jurgen Symynck committed Sep 20, 2014
0 parents commit 01a2773
Show file tree
Hide file tree
Showing 59 changed files with 5,306 additions and 0 deletions.
4 changes: 4 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
\.lnk$
\.zip$

^\.git
7 changes: 7 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
*Thumbs.db
*.lnk
~*
*~
.Rhistory
vignettes/*
!vignettes/using_abrem.Rnw
44 changes: 44 additions & 0 deletions ChangeLog
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
2014-04-17 Jurgen Symynck <[email protected]>

* upgraded abrem 0.1.14 to 0.1.16:
No changes, trying to counter build problems on r-forge (having to do with linking to RcppArmaddillo)

2014-04-17 Jurgen Symynck <[email protected]>

* upgraded abrem 0.1.12 to 0.1.14:
General man page updates and reorganization, more error checking, added support for subtracting threshold parameters from the data before plotting, replaced "bernard" with "benard", renamed option "blives" to "unrel", renamed option "conf.n" to "unrel.n", added some debugging datasets and a mixed model (synthetic) dataset.
Many more modifications to the code for debugging and (currently) undocumented features. (choose fit calculation code, choose confidence calculation code, plot superSMITH reports ...)
Removed the two "vignettes" that used to be accessible with browseVignettes(), but not anymore since R 3.1.

* Abrem.R (Abrem): added support for arguments of class "numeric",
* plot.abrem.R (plot.abrem): "main" title now plots without overlapping the top x-axis labels
* options.abrem.R (options.abrem): added option "mar", added some previously undocumented options, placed options in alphabetical order.


2014-03-23 Jurgen Symynck <[email protected]>

* upgraded abrem 0.1.10 to 0.1.12:
Nothing changed, using this version for debugging svn.


2013-12-09 Jurgen Symynck <[email protected]>

* upgraded abrem 0.1.8 to 0.1.10:
General man page cleanup and reorganization. Moved the detailed description of some options to the manpage of the most approporiate function.
added support for contour calculation.
removed abrem:::MLEw3p_secant.r; now calling the version in package debias.
removed abrem:::MRRw3pxy; now calling the version in package debias.

* Abrem.R (Abrem): added fail and susp argument options
* options.abrem.R (options.abrem): added in.legend logical option for
* calculateSingleConf.R (calculateSingleConf): named likelihood ratio bounds to "lrb" instead of "lira"
* calculateSingleFit.R (calculateSingleFit): reduced length of file; more efficient code reusage.

2013-11-02 Jurgen Symynck <[email protected]>

* upgraded abrem 0.1.7 to 0.1.8:
Added missing information (specifically about dist and method.fit) in several man pages.
General man page cleanup and reorganization.
Change dependencies to debias (>= 0.1.7) and pivotals (>= 0.1.9)

* calculatesinglefit.R (CalculateSingleFit): replaced RBAw() with RBAbeta()
14 changes: 14 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
Package: abrem
Type: Package
Title: Abernethy Reliability Methods
Version: 0.1.21
Date: August 23, 2014
Author: Jurgen Symynck <[email protected]>
Maintainer: Jurgen Symynck <[email protected]>
Description: Implementation of reliability methods presented in "The New Weibull Handbook", Fifth Edition by Dr. Robert B. Abernethy. This package is dedicated to the control and view of models developed in dependant packages abremPivotals and abremDebias (under construction) implemented using the R object model.
Depends: abremPivotals (>= 0.2.8), debias (>= 0.1.9)
Suggests: MASS, boot
License: GPL-3
URL: http://r-forge.r-project.org/projects/abernethy, http://www.openreliability.org
BugReports: email the author at <[email protected]>
LazyLoad: yes
15 changes: 15 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
export(
Abrem,
abrem.fit,
abrem.conf,
params.to.ob,
options.abrem,
plot.abrem,
print.abrem,
contour.abrem)
S3method(plot, abrem)
S3method(print, abrem)
S3method(contour, abrem)
importFrom(abremPivotals)
importFrom(debias)

154 changes: 154 additions & 0 deletions R/Abrem.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,154 @@
# R package 'abrem'
# Abernethy Reliability Methods
# Implementations of lifetime data analysis methods described in
# 'The New Weibull Handbook, Fifth edition' by Dr. Robert B. Abernethy.
# August 2014, Jurgen Symynck
# Copyright 2014, Jurgen Symynck
#
# For more info, visit http://www.openreliability.org/
#
# For the latest version of this file, check the Subversion repository at
# http://r-forge.r-project.org/projects/abernethy/
#
# Disclaimer:
# The author is not affiliated with Dr. Abernethy or Wes Fulton - CEO of
# Fulton Findings(TM) and author of the software package SuperSMITH
#-------------------------------------------------------------------------------
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
# +-----------------------------------+
# | execute this software with R: |
# | http://www.r-project.org/ |
# +-----------------------------------+

Abrem <- function(x,...){
# TODO: add code to convert a Surv() object into an abrem object
#arg <- list(...)
arg <- splitargs(...)

# arg2 <- arg[!(names(arg) %in% names(options.abrem()))]
# extract the arguments that are NOT abrem options.
opa <- modifyList(options.abrem(), arg$opa)
ret <- list()
class(ret) <- "abrem"
timeorder <- c()
# lowest <- 1
if(!missing(x)){
ret$data <- NULL
if(is.vector(x) || is.numeric(x)){
# TODO: the effects of adding is.numeric(x) are not tested thoroughly yet...
if(opa$verbosity >= 2)message(
'Abrem: Argument \"x\" is a (numeric) vector of (life-)time observations...')
if(any(is.na(x))) timeorder <- 1:length(x)
else timeorder <- order(x)
# the above is to prevent ordering attempts when NA values are
# present in the lifetime observation vector.
# having NA values implies that the data must be ordered.
ret$data <- data.frame(time=x[timeorder],event=1)
}
if(is.data.frame(x)){
if(!is.null(x$time) && !is.null(x$event)){
if(opa$verbosity >= 2)message(
'Abrem: Argument \"x\" is a dataframe with $time and $event ',
'columns...')
if(any(is.na(x$time))) timeorder <- 1:length(x$time)
else timeorder <- order(x$time)
ret$data <- as.data.frame(x[timeorder,])
# ret$data$event <- 1
# # temporarily set event vector to 1
}else{
stop(': Argument \"x\" is missing $time and/or ",
"$event columns...')
}
}
}else{
ti <- c(arg$rem$time,arg$rem$fail)
if(xor(!is.null(arg$rem$time), !is.null(arg$rem$fail))){
if(is.vector(ti)){
if(opa$verbosity >= 2)message(
'Abrem: Argument \"time\" or \"fail\" is vector of complete (life-)time observations...')
if(any(is.na(ti))) timeorder <- 1:length(arg$rem$time)
else timeorder <- order(ti)
ret$data <- data.frame(time=ti[timeorder],event=1)
}else{stop('Argument \"time\" or fail\" must be vector.')}
}
if(!is.null(arg$rem$susp)){
if(is.vector(arg$rem$susp)){
if(opa$verbosity >= 2)message(
'Abrem: Argument \"susp\" is vector of right-censored (suspended) (life-)time observations...')
timeorder <- order(c(ti,arg$rem$susp))
ret$data <- data.frame(time=c(ti,arg$rem$susp)[timeorder],
event=c(rep(1,length(ti)),rep(0,length(arg$rem$susp)))[timeorder])
}else{stop('Argument \"susp\" must be a vector.')}
}
#else{stop("No (life-)time observations were provided.")}
}

### setting the event vector correctly ###
if(!is.null(arg$rem$event) && !is.null(ret$data)){
if(is.vector(arg$rem$event)){
if(opa$verbosity >= 2)message(
'Abrem: Argument \"event\" is event vector...')
ret$data$event <- arg$rem$event[timeorder]
}
}
addpppcolumns <- function(ppos){
if(opa$verbosity >= 2)message(paste0(
'Abrem: Adding ',ppos,' ranks to (life-)time observations...'))
ret$data <<- cbind(ret$data,ppp=NA)
if(any(is.na(ret$data$time))){
# experimental code, in combination with support in
# abremPivotals::gePPP for event vector arguments

ret$data[ret$data$event==1,'ppp'] <<-
abremPivotals::getPPP(
x=ret$data$event,
ppos=ppos)$ppp
}else{
ret$data[ret$data$event==1,'ppp'] <<-
abremPivotals::getPPP(
x=ret$data$time[ret$data$event==1],
s=ret$data$time[ret$data$event==0],
ppos=ppos)$ppp
}
colnames(ret$data) <<- c(
colnames(ret$data)[-ncol(ret$data)],
paste0("ppp.",ppos))
# renaming the added column to include the type of ranking
}

if(any(
c("benard","beta","mean","km","hazen","blom") %in% tolower(opa$ppos))){
do.call(addpppcolumns,as.list(tolower(opa$ppos)))
}
if(any(
c("kaplan-meier","kaplanmeier","kaplan_meier","kaplan.meier") %in%
tolower(opa$ppos))){
do.call(addpppcolumns,list("km"))
}
ret$n <- length(ret$data$time)
# TODO: this assumes that any NA time (in any present
# in the time column is there for a good reason:
# accompanied with a censoring indicator (0 or FALSE)
# TODO: check if the above code is still valid!
# this feature must be researched in combination wirh abremPivotals:lslr()
ret$fail <- sum(ret$data$event)
# TODO: Warning; this only works when event can take values of 0 and one!
# This can be solved when events are changed to factors, as they really are
ret$susp <- ret$n-ret$fail
ret$options <- opa
# always store a full copy of the options.abrem structure here
ret
# TODO: check what to do with the automatically added row names that are sometimes out of order
}
50 changes: 50 additions & 0 deletions R/F0inv.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,50 @@
# R package 'abrem'
# Abernethy Reliability Methods
# Implementations of lifetime data analysis methods described in
# 'The New Weibull Handbook, Fifth edition' by Dr. Robert B. Abernethy.
# August 2014, Jurgen Symynck
# Copyright 2014, Jurgen Symynck
#
# For more info, visit http://www.openreliability.org/
#
# For the latest version of this file, check the Subversion repository at
# http://r-forge.r-project.org/projects/abernethy/
#
# Disclaimer:
# The author is not affiliated with Dr. Abernethy or Wes Fulton - CEO of
# Fulton Findings(TM) and author of the software package SuperSMITH
#-------------------------------------------------------------------------------
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
# +-----------------------------------+
# | execute this software with R: |
# | http://www.r-project.org/ |
# +-----------------------------------+

F0 <- function(q)
1-exp(-exp(q))

F0inv <- function(p,log="x"){
# transformation function to plot its argument
# on the y-axis of the Weibull plot. This transformation function
# lets the Weibull curve appear as a straight line on the weibull paper
#
# This is also the inverse Cumulative Distribution function of the
# standardized Weibull plot with beta=eta=1
# comparing both implementationss of F0inv() with
# system.time() does not show any significant difference
# log(log(1/(1-p)))}
if(log %in% c("x",""))ret <- log(qweibull(p,1,1)) else ret <- qlnorm(p,0,1)
ret
}
59 changes: 59 additions & 0 deletions R/abrem.conf.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,59 @@
# R package 'abrem'
# Abernethy Reliability Methods
# Implementations of lifetime data analysis methods described in
# 'The New Weibull Handbook, Fifth edition' by Dr. Robert B. Abernethy.
# August 2014, Jurgen Symynck
# Copyright 2014, Jurgen Symynck
#
# For more info, visit http://www.openreliability.org/
#
# For the latest version of this file, check the Subversion repository at
# http://r-forge.r-project.org/projects/abernethy/
#
# Disclaimer:
# The author is not affiliated with Dr. Abernethy or Wes Fulton - CEO of
# Fulton Findings(TM) and author of the software package SuperSMITH
#-------------------------------------------------------------------------------
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
# +-----------------------------------+
# | execute this software with R: |
# | http://www.r-project.org/ |
# +-----------------------------------+

abrem.conf <- function(x,which="all",...){
# x is a single Abrem or a list of Abrem objects
# supported_blifeconf <- c("mcpivotals","bbb")
if(missing(x)){
stop('Argument \"x\" is missing.')
}else{
if(identical(class(x),"abrem")) x <- list(x)
if(!all(sapply(x,function(x)identical(class(x),"abrem")))){
stop('Argument \"x\" is not of class \"abrem\" or ",
"a list of \"abrem\" objects.')
}
dr <- findMaxDataRange(x,0)
# for reasonably large confidence bounds
calculateConfsInAbrem <- function(abrem){
if(!is.null(abrem$fit)){
abrem$fit <- lapply(abrem$fit,calculateSingleConf,
opadata=abrem$options,datarange=dr,...)
# TODO: add error detection
}
abrem
}
abremlist <- lapply(x,calculateConfsInAbrem)
}
if(length(abremlist)==1) abremlist[[1]] else abremlist
}
Loading

0 comments on commit 01a2773

Please sign in to comment.