--- a
+++ b/R/common.R
@@ -0,0 +1,152 @@
+#Some miscellaneous functions used by both
+#predict form parameters and predict from data
+
+##' @importFrom stats uniroot
+NULL
+
+##' Return the number of days in the year 
+##' 
+##' This allows the user control over
+##' whether the package uses 365.25, 365 (or any other number) of days
+##' in a year. 
+##' 
+##' The number of days in a month is then set as daysinyear()/12 
+##' 
+##' @return The number of days in the year
+##' @export 
+standarddaysinyear <- function() {
+  getOption('eventPrediction.daysinyear',
+            365.25)
+}
+
+
+# Round a number and force trailing zeros to be output
+# @param number The number to be output
+# @param dp The number of digits to display after the decimal point
+# @return A string (e.g. "43.400")
+roundForceOutputZeros <- function(number,dp){
+  if(dp < 1) {
+    stop("Invalid argument dp must be positive")
+  }
+  roundnumber <- as.character(round(number,digits=dp))
+  outputdp <- nchar(strsplit(as.character(roundnumber),"\\.")[[1]][2]) 
+  zeros <- rep("0",dp-outputdp)
+  return(paste(roundnumber,paste(zeros,collapse=""),sep=""))
+  
+}
+
+# Calculate the number of subjects on each arm
+# 
+# \code{floor((r/(r+1))*N)} are allocated to the experimental arm
+# the rest are allocated ot the control arm
+# 
+# @param singleArm logical TRUE if study is a single arm
+# @param r Allocation ratio, see Study object
+# @param N Total number of subjects on the trial
+# @return A vector (N_control,N_experimental)
+getNs <- function(singleArm,r,N){
+  if (singleArm){
+    return(c(N,0))
+  }
+  
+  is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  abs(x - round(x)) < tol
+  
+  oldres <- (r/(r+1))*N
+  res <- if(!is.wholenumber(oldres)) floor(oldres) else oldres
+  res <- c(N-res,res)
+  
+  if(any(res==0)){
+    stop("Too few subjects recruited for given randomization balance
+         All subjects would be recruited onto the same arm.")
+  }
+  
+  return(res)
+}
+
+# Add line breaks to a string
+# @param title text to add line breaks to
+# @param text.width Target number of characters per row
+# @return text with line breaks
+AddLineBreaks <- function( title, text.width ) {
+  wrapper <- function(x, ... ) paste(strwrap(x, ... ) ) 
+  wtext <- wrapper(title, width = text.width )
+  return(paste(wtext,collapse="\n"))
+}
+
+##' Function which attempts to read in a csv file
+##' picking a delimiter from a given set of options
+##' 
+##' The function works by counting the number of occurences 
+##' of each delimiter on each line and for exactly one 
+##' of the delimiter options all lines contain the same number
+##' of occurences (>0) then this delimiter is used
+##' 
+##' @param path The path to the csv file to be read
+##' @param delim_options A vector of characters from which the
+##' delimiter should be chosen
+##' @return If successful a data frame containing the csv file
+##' if unsuccessful an error is thrown 
+##' @export
+csvSniffer <- function(path,delim_options=c(',',';','\t')){
+  #currently reading file twice ought to be improved
+  vec <- readLines(con=path)
+  #remove empty lines
+  vec <- vec[sapply(vec, nchar) > 0] 
+  ans <- sapply(delim_options,function(x){
+    a <- unlist(lapply(vec,function(y)sum(unlist(strsplit(y,split=""))==x)))
+    if(all(a==a[1]) && a[1] != 0) TRUE else FALSE  
+  })
+  if(sum(ans) != 1){
+    stop("Cannot determine delimiter")
+  }
+  read.csv(path,sep=names(ans[ans==TRUE])) 
+}
+
+
+##' Given trial assumptions describing an exponential model
+##' Use the method of moments to fit a single Weibull distribution
+##' 
+##' See, for example, Lei, Y. Evaluation of three methods for estimating the Weibull distribution 
+##' parameters of Chinese pine (Pinus tabulaeformis). Journal of Forest Science 54.12 (2008): 566-571.
+##' 
+##' @param HR Hazard ratio
+##' @param r Randomization balance
+##' @param M control arm median 
+##' @export
+FitMixtureModel <- function(HR,r,M){
+  
+  lapply(list(HR=HR,r=r,M=M),function(x){
+    if(!is.numeric(x) || x <= 0 || length(x)!=1){
+      stop("All arguments to FitMixtureModel must be numeric, positive and of length 1")
+    }
+  })
+  
+  ml2 <- M/log(2)
+  mu <- (ml2*(1+r/HR))/(r+1) # = E(control)/(r+1) + rE(active)/r+1
+  sigma <- (ml2/(1+r)) * sqrt(1+2*r-2*r/HR + (r*(r+2))/(HR*HR))
+  
+  return(RootFindRateShape(mu,sigma))
+}
+
+
+# Fit shape and rate given mean and sd of Weibull
+# distribution
+# 
+# @param mu mean of Weibull
+# @param sigma sd of distribution  
+RootFindRateShape <- function(mu,sigma){
+  f <- function(x){
+    sigma/mu - sqrt(gamma(1+2/x) - gamma(1+1/x)^2)/gamma(1+1/x)  
+  }
+
+  shape <- tryCatch({ 
+    uniroot(f,c(0.1,10))$root
+  },error=function(cond){
+    warning(paste("Error fitting shape:",cond,"Returning NA"))
+    return(list(rate=NA,shape=NA))  
+  }
+  )
+
+  rate <- gamma(1+1/shape)/mu
+  return(list(rate=rate,shape=shape))
+}