# R/lcc_intervals.R In lcc: Longitudinal Concordance Correlation

#### Documented in lcc_intervals

#######################################################################
#                                                                     #
# Package: lcc                                                        #
#                                                                     #
# File: lcc_intervals.R                                               #
# Contains: lcc_intervals  function                                   #
#                                                                     #
# Written by Thiago de Paula Oliveira                                 #
# copyright (c) 2017-18, Thiago P. Oliveira                           #
#                                                                     #
# First version: 11/10/2017                                           #
# Last update: 29/07/2019                                             #
# License: GNU General Public License version 2 (June, 1991) or later #
#                                                                     #
#######################################################################

##' @title Internal Functions to Compute the Non-Parametric Confidence
##'   Intervals for LCC.
##'
##' @description This is an internally called functions used to compute
##'   the non-parametric confidence intervals for LCC.
##'
##' @usage NULL
##'
##' @author Thiago de Paula Oliveira, \email{thiago.paula.oliveira@@alumni.usp.br}
##'
##' @importFrom stats quantile sd qnorm
##'
##' @keywords internal
lcc_intervals<-function(rho, tk.plot, tk.plot2, ldb, model, ci,
percentileMet, LCC_Boot, alpha){
ZFisher<-function(x){
1/2*log((1+x)/(1-x))
}
if(ldb == 1) {
LCC_IC <- matrix(0, ncol=length(LCC_Boot), nrow=length(LCC_Boot[[1]]))
if(percentileMet=="TRUE"){
for(i in 1:length(LCC_Boot)) {
if(is.null(LCC_Boot[[i]])==FALSE){
LCC_IC[,i] <- LCC_Boot[[i]]
}else(cat(i,"\n"))
}
ENV.LCC <- apply(LCC_IC, 1, quantile, probs=c(alpha/2,1-alpha/2))
}else{
for(i in 1:length(LCC_Boot)) {
if(is.null(LCC_Boot[[i]])==FALSE){
LCC_IC[,i] <- ZFisher(LCC_Boot[[i]])
}else(cat(i,"\n"))
}
SE<-apply(LCC_IC, 1, sd)
mean<-apply(LCC_IC, 1, mean)
ENV.LCC<-matrix(NA, nrow = 2, ncol = length(SE))
for(i in 1:length(SE)){
ENV.LCC[,i]<-c(mean[i], mean[i])-
c(qnorm(1-alpha/2)*SE[i],qnorm(alpha/2)*SE[i])
}
ENV.LCC<-(exp(2*ENV.LCC)-1)/(exp(2*ENV.LCC)+1)
}
CI.LCC<-list("rho"=rho,"ENV.LCC"=ENV.LCC)
}else{
LCC_IC<-list()
ENV.LCC<-list()
SE_LCC<-list()
mean_LCC<-list()
for(i in 1:ldb){
LCC_IC[[i]] <- matrix(0, ncol=length(LCC_Boot),
nrow=length(LCC_Boot[[1]][[i]]))
if(percentileMet=="TRUE"){
for(j in 1:length(LCC_Boot)) {
if(is.null(LCC_Boot[[j]])==FALSE){
LCC_IC[[i]][,j] <- LCC_Boot[[j]][[i]]
}else(cat(i,"\n"))
}
ENV.LCC[[i]] <- apply(LCC_IC[[i]], 1, quantile,
probs=c(alpha/2,1-alpha/2))
}else{
for(j in 1:length(LCC_Boot)) {
if(is.null(LCC_Boot[[j]])==FALSE){
LCC_IC[[i]][,j] <- ZFisher(LCC_Boot[[j]][[i]])
}else(cat(i,"\n"))
}
SE_LCC[[i]]<-apply(LCC_IC[[i]], 1, sd)
mean_LCC[[i]]<-apply(LCC_IC[[i]], 1, mean)
ENV.LCC[[i]]<-matrix(NA, nrow = 2, ncol = length(SE_LCC[[i]]))
for(k in 1:length(SE_LCC[[i]])){
ENV.LCC[[i]][,k]<-c(mean_LCC[[i]][k], mean_LCC[[i]][k])-
c(qnorm(1-alpha/2)*SE_LCC[[i]][k],qnorm(alpha/2)*SE_LCC[[i]][k])
}
ENV.LCC[[i]]<-(exp(2*ENV.LCC[[i]])-1)/(exp(2*ENV.LCC[[i]])+1)
}
}
CI.LCC<-list("rho"=rho,"ENV.LCC"=ENV.LCC)
}
return(CI.LCC)
}

## Try the lcc package in your browser

Any scripts or data that you put into this service are public.

lcc documentation built on Feb. 26, 2021, 5:07 p.m.