R/fGTDL.R

In filipesilv4/GTDL: Distribuição GTDL

#'@title Distribuição GTDL
#'@name GTDL
#'
#'@description Função de risco, função de sobrevivência, densidade e MMV.
#'.
#'
#'@param t variável aleatória não negativa que representa o tempo de falha.
#'@param theta vetor com 3 entradas: lambda vetor de escalares,
#'uma medida de efeito alpha e um vetor de parâmetros gama.
#'
#'@details Conjunto de quatro funções que recebem os parametros t e theta. Theta
#'sendo um vetor com 3 parametros (lambda, alpha e gama). Na função maxGTDL o
#'parametro theta recebe uma lista.
#'
#'@references
#'MILANI, Eder Angelo. Modelo logístico generalizado dependente do tempo com
#'fragilidade. 2011.
#'
#'Mackenzie, G. Regression Models for Survival Data:
#'The Generalized Time-Dependent Logistic Family.
#'Journal of the Royal Statistical Society. 1996.
#'
#'@author Jalmar M. F. Carrasco
#'@author Filipe O. Silva \email{silva.filipe@ufba.br}
#'
#'
#'@examples
#'
#'Exemplo-I
#'
#'library(GTDL)
#'library(ggplot2)
#'
#'t <- seq(0, 20, by = 0.01)
#'theta <- c(1.00, -0.05, -1.00)
#'y1 <- hGTDL(t, theta)
#'y2 <- sGTDL(t, theta)
#'y3 <- dGTDL(t, theta)
#'
#'df <- data.frame(t, y1, y2, y3)
#'
#'ggplot(df, aes(t)) + geom_line(aes(y = y1))
#'+ geom_line(aes(y = y2), linetype = 2)
#'+ geom_line(aes(y = y3), linetype = 3)
#'+ labs(title = "Generalized Logistic Model" ,y = "")
#'
#'Exemplo-II
#'
#'t <- seq(0, 20, by = 0.01)
#'theta1 <- c(1.00, 0.50, -1.00)
#'theta2 <- c(1.00, -0.50, 1.00)
#'theta3 <- c(1.00, -0.25, 1.00)
#'theta4 <- c(1.00, -0.06, -1.60)
#'theta5 <- c(1.00, 0.25, -1.00)
#'
#'y1 <- hGTDL(t, theta1)
#'y2 <- hGTDL(t, theta2)
#'y3 <- hGTDL(t, theta3)
#'y4 <- hGTDL(t, theta4)
#'y5 <- hGTDL(t, theta5)
#'
#'df <- data.frame(t, y1, y2, y3, y4, y5)
#'
#'ggplot(df, aes(t)) + geom_line(aes(y = y1), linetype = 2)
#'+ geom_line(aes(y = y2), linetype = 3) + geom_line(aes(y = y3), linetype = 4)
#'+ geom_line(aes(y = y4), linetype = 5) + geom_line(aes(y = y5), linetype = 6)
#'+ labs(title = "Hazard plots", y = "")
#'
#'Exemplo-III
#'
#'library(survival)
#'maxGTDL(theta = list(lambda=1,alpha=1,gama=-1), t = log(lung$time))
#'
#'Exemplo-IV
#'
#'
#'t <- seadecovid2$TEMPO
#'c <- seadecovid2$EVOLUCAO
#'delta <- list(t, c)
#'theta <- c(1,1,-1)
#'
#'maxGTDL2(theta = list(lambda=1,alpha=1,gama=-1), delta = delta)
#'
#'
#'@rdname GTDL
#'@export
hGTDL <- function(t, theta){

  lambda <- theta[1]
  alpha <- theta[2]
  gama <- theta[3]

  numerador <- lambda*exp(t[1]*alpha + gama)

  denominador <- 1 + exp(t[1]*alpha + gama)

  h <- numerador / denominador

  return(h)

}
#'@rdname GTDL
#'@export
sGTDL <- function(t, theta){

  s <- dGTDL(t, theta) / hGTDL(t, theta)

  return(s)


}
#'@rdname GTDL
#'@export
dGTDL <- function(t, theta, log = FALSE){

  lambda <- theta[1]
  alpha <- theta[2]
  gama <- theta[3]

  h <- hGTDL(t, theta)

  d <- h*((1 + exp(t*alpha + gama))/(1 + exp(gama)))^(-lambda / alpha)


  if(log){

    return(log(d))

  } else {

    return(d)
  }

}

lvero <- function(lambda, alpha, gama, t){

  theta <- c(lambda,alpha,gama)

  f <- sum(dGTDL(theta, t=t,log=TRUE))

  return(-f)
}

lvero2 <- function(lambda, alpha, gama, delta){

  theta <- c(lambda,alpha,gama)

  f <- sum(c*log(hGTDL(t, theta))
           + log(sGTDL(t, theta)))

  return(-f)

}

#'@import bbmle
#'@rdname GTDL
#'@export
maxGTDL <- function(theta, t){


  modelo <- mle2(lvero, start = theta, data=list(t=t))

  return(summary(modelo))
}

#'@import bbmle
#'@rdname GTDL
#'@export
maxGTDL2 <- function(theta, delta){

  t <- delta[[1]]

  c <- delta[[2]]

  modelo <- mle2(lvero2, start = theta, data = list(t = t, c = c))

  return(summary(modelo))
}