estimateGLRPoisHook   package:surveillance   R Documentation(latin1)

_H_o_o_k _f_u_n_c_t_i_o_n _f_o_r _i_n-_c_o_n_t_r_o_l _m_e_a_n _e_s_t_i_m_a_t_i_o_n

_D_e_s_c_r_i_p_t_i_o_n:

     Allows the user to specify his own estimation routine for the
     in-control mean of 'algo.glrpois'

_U_s_a_g_e:

     estimateGLRPoisHook()

_D_e_t_a_i_l_s:

     This hook function allows the user to customize the behaviour of
     the algorithm.

_V_a_l_u_e:

     A vector of length as 'range' containing the predicted values.

_A_u_t_h_o_r(_s):

     M. Hoehle

_S_e_e _A_l_s_o:

     'algo.glrpois'

_E_x_a_m_p_l_e_s:

     ## Not run: 
     estimateGLRPoisHook <- function() {
       #Fetch control object from parent
       control <- parent.frame()$control
       #The period
       p <- parent.frame()$disProgObj$freq
       #Current range to perform surveillance on
       range <- parent.frame()$range

       #Define training & test data set (the rest)
       train <- 1:(range[1]-1)
       test <- range
       
       #Perform an estimation based on all observations before timePoint
       #Event better - don't do this at all in the algorithm - force
       #user to do it himself - coz its a model selection problem
       data <- data.frame(y=parent.frame()$disProgObj$observed[t],t=train)
       #Build the model equation
       formula <- "y ~ 1 "
       if (control$mu0Model$trend) { formula <- paste(formula," + t",sep="") }
       for (s in 1:control$mu0Model$S) {
         formula <- paste(formula,"+cos(2*",s,"*pi/p*t)+ sin(2*",s,"*pi/p*t)",sep="")
       }
       #Fit the GLM
       m <- eval(substitute(glm(form,family=poisson(),data=data),list(form=as.formula(formula))))

       #Predict mu_{0,t}
       return(as.numeric(predict(m,newdata=data.frame(t=range),type="response")))
     }
     ## End(Not run)

