R/eq5dmap.R
In sheejamk/eq5dmapR: Scoring EQ-5D responses and mapping EQ-5D-5L responses to 3L index values
##############################################################################################################
#' Function to value EQ-5D-3L individual responses to index value for any country
#' @param country default is UK
#' @param this.response a must input,response for EQ-5D-3L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-3L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-3L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-3L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-3L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples valueEQ5D3Lindscores("UK",1,2,3,2,2)
#' @examples valueEQ5D3Lindscores("UK",c(1,2,3,2,2))
#' @examples valueEQ5D3Lindscores("UK",12322)
#' @export
#' @description Function to value EQ-5D-3L descriptive system to the index values (ref: Dolan et al. 1997 and code inspired from https://github.com/brechtdv/eq5d-mapping)
valueEQ5D3Lindscores<-function(country="UK",this.response, this.response2=NA, this.response3=NA, this.response4=NA, this.response5=NA) {
responses=c(this.response,this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(this.response))>0){ # first value should be not be a NA, do not contain NA
this.score.3L<-NA
values.state=NA
return(values.state)
}else{# check first value should be a vector containiing responses or a 5digit number
if(length(this.response)!=5 && length(this.response)!=1){
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}else{ #first value a vector or a 5 figit number
if(length(this.response)==5){#first value a vector
this.score.3L <- paste(this.response,collapse = "")
responses<-this.response
}else{
if(length(this.response)==1){#first value 5 digit number or actual response for mobility
if(this.response>=11111 && this.response<=33333){ # valid 5 digit number
this.score.3L <- this.response
responses<-convertNumberToIndividualDigits(this.score.3L)
}else{ #first value might be valid- a response to mobility
if(this.response<=3 && this.response>0 ){ #valid response to mobility
four.res=c(this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(four.res))==0){
if(any(responses<=5)){
this.score.3L <- paste(responses,collapse = "")#all valid and generate the score
}else{#error values
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}else{
#missing values
this.score.3L<-NA
values.state=NA
return(values.state)
}
}else{
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}
}
}
}
}
if(this.score.3L<11111 || this.score.3L>33333){
print("Invalid EQ-5D-3L responses")
return(-1)
}else{
if(country=="UK"){
## if a dimension include a value >= 3 then add N3
N3 <- any(responses == 3)
## the intercept should not be subtracted for the perfect health state
intercept <- ifelse(all(responses== 1),
0.000, # perfect health
0.081) # less than perfect health
## values are taken from the reference for UK
products=c(0.176,0.006,0.022,0.140,0.094)
ind=which(responses == 3)
prod<-sum((responses[ind]-2)* products[ind])
## construct the index value
## values are taken from the reference for UK
index <- 1 - # full health
intercept - # intercept
0.069 * (responses[1] - 1) - # mobility
0.104 * (responses[2] - 1) - # self-care
0.036 * (responses[3] - 1) - # usual activities
0.123 * (responses[4] - 1) - # pain/discomfort
0.071 * (responses[5] - 1) - # anxiety/depression
0.269 * N3- # any dimension at level 3
prod
## return the index value
return(index)
}else{
print("No method for countries other than UK")
return(-1)
}
}
}
###########################################################################################################
#' Helper function to correctly identify the country specific tariffs
#' @param country default is UK
#' @param this.response a must input,response for EQ-5D-3L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-3L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-3L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-3L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-3L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples valueEQ5D3L_indscores("UK",1,2,3,2,2)
#' @export
#' @description This function is helper function to correctly identify the country specific tariffs
valueEQ5D3L_indscores<-function(country,this.response,this.response2=NA, this.response3=NA,this.response4=NA, this.response5=NA){
if( country=="UK"){
ans=valueEQ5D3Lindscores(country,this.response,this.response2, this.response3,this.response4, this.response5)
return(ans)
}else{
print("No tariffs found for the country you specified. Please try later !!")
return(-1)
}
}
###########################################################################################################
#' Function to value EQ-5D-3L columns to index values for any country and group by gender and age
#' @param eq5dresponse.data the data containing eq5d responses
#' @param mobility column name for EQ-5D-3L mobility
#' @param self.care column name for response for EQ-5D-3L self care
#' @param usual.activities column name for response for EQ-5D-3L usual activities
#' @param pain.discomfort column name for response for EQ-5D-3L pain/discomfort
#' @param anxiety column name for response for EQ-5D-3L anxiety/depression
#' @param country country of interest, by default is UK, if groupby has to specifiy the country should be specified
#' @param groupby male or female -grouping by gender, default NULL
#' @param agelimit vector of ages to show upper and lower limits
#' @return the descriptive statistics of index values, frequence table and the modified data where the last column will be the index values
#' @examples valueEQ5D3L(data, "Mobility", "SelfCare","UsualActivity", "Pain", "Anxiety",UK,NULL,c(10,70))
#' @export
#' @description Main function to value EQ-5D-5L descriptive system to 5L index values.
valueEQ5D3L<-function(eq5dresponse.data,mobility,self.care,usual.activities,pain.discomfort,anxiety,country,groupby,agelimit){
eq5d.colnames<-c(mobility, self.care,usual.activities,pain.discomfort,anxiety)
ans.eq5d.colnames<-sapply(eq5d.colnames,checkColumnExist,eq5dresponse.data)
if(all(ans.eq5d.colnames==0)){# if the eq5d column names match
working.data=subsetGenderAgeToGroup(eq5dresponse.data,groupby,agelimit)
if(nrow(working.data)<1){
print("No entries with the given criteria -Please check the contents or the criteria")
return(-1)
}else{
scores=c()
for(j in 1:nrow(working.data)){
res1=working.data[j,mobility]
res2=working.data[j,self.care]
res3=working.data[j,usual.activities]
res4=working.data[j,pain.discomfort]
res5=working.data[j,anxiety]
this.score<-valueEQ5D3L_indscores(country,res1,res2,res3,res4,res5)
if(this.score!=-1){
scores=c(scores,this.score)
}else{
print("responses not valid -3L scores can not be valued")
return(-1)
}
}
names(scores)<-"EQ-5D-3Lscores"
new.data=cbind(working.data,scores)
colnames(new.data)<-c(colnames(working.data), "EQ-5D-3L scores")
stats<-descriptiveStatDataColumn(scores,"EQ-5D-3L")
freqtable<-getFrequencyTable(scores)
first=is.null(groupby) || toupper(groupby)=="NA" || is.na(groupby)
second=is.null(agelimit) || toupper(agelimit)=="NA" || is.na(agelimit)
if(first & second){
title<-paste("Histogram of EQ-5D-3L index values", sep="")
}else{
if(first & !second){
title<-paste("Histogram of EQ-5D-3L index values",
" with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}else{
if(!second& second){
title<-paste("Histogram of EQ-5D-3L index values for ",
groupby, sep="")
}else{
title<-paste("Histogram of EQ-5D-3L index values for ",
groupby, " with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}
}
}
hist.plot <-graphics::hist(scores,main=title)
results<- list("stats" = stats, "frequencyTable" = freqtable, "histogram"= hist.plot,"modifiedData"=new.data)
return(results)
}
}else{# if the eq 5d column names do not match
print("EQ-5D column names do not match")
return(-1)
}
}
##########################################################################################################
#' Function to value EQ-5D-5L scores for countries UK, Spain, Ireland, China, Thailand, Hong Kong, Indonesia, and Germany
#' @param country a country name from the list UK,ES,IR, IN,CN, TH, HK, and DE
#' @param this.response a must input,response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value based on UK tariffs if success, -1 if failure
#' @examples valueEQ5D5L_8countriesIndscores("UK",23434)
#' @examples valueEQ5D5L_8countriesIndscores("ES",2,3,4,3,4)
#' @examples valueEQ5D5L_8countriesIndscores("IN",c("IN",2,3,4,3,4))
#' @export
valueEQ5D5L_8countriesIndscores<-function(country,this.response,this.response2=NA, this.response3=NA, this.response4=NA, this.response5=NA){
responses=c(this.response,this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(this.response))>0){ # first value should be not be a NA, do not contain NA
this.score.5L<-NA
values.state=NA
return(values.state)
}else{# check first value should be a vector containiing responses or a 5digit number
if(length(this.response)!=5 && length(this.response)!=1){
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}else{ #first value a vector or a 5 figit number
if(length(this.response)==5){#first value a vector
this.score.5L <- paste(this.response,collapse = "")
responses<-this.response
}else{
if(length(this.response)==1){#first value 5 digit number or actual response for mobility
if(this.response>=11111 && this.response<=55555){ # valid 5 digit number
this.score.5L <- this.response
responses<-convertNumberToIndividualDigits(this.score.5L)
}else{ #first value might be valid- a response to mobility
if(this.response<=3 && this.response>0 ){ #valid response to mobility
four.res=c(this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(four.res))==0){
if(any(responses<=5)){
this.score.5L <- paste(responses,collapse = "")#all valid and generate the score
}else{#error values
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}else{
#missing values
this.score.5L<-NA
values.state=NA
return(values.state)
}
}else{
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}
}
}
}
}
if(this.score.5L<11111 || this.score.5L>55555){
print("Invalid EQ-5D-5L responses")
return(-1)
}else{
the.scores5L=convertNumberToIndividualDigits(this.score.5L)
if(!is.null(country) & toupper(country)!="NA"& !is.na(country)){
if(country=="ES"){
eq5d.valueset=EQ5D5L_tariffs_ES.df
}
if(country=="CN"){
eq5d.valueset=EQ5D5L_tariffs_CN.df
}
if(country=="DE"){
eq5d.valueset=EQ5D5L_tariffs_DE.df
}
if(country=="IN"){
eq5d.valueset=EQ5D5L_tariffs_IN.df
}
if(country=="IR"){
eq5d.valueset=EQ5D5L_tariffs_IR.df
}
if(country=="HK"){
eq5d.valueset=EQ5D5L_tariffs_HK.df
}
if(country=="TH"){
eq5d.valueset=EQ5D5L_tariffs_TH.df
}
if(country=="UK"){
eq5d.valueset=EQ5D5L_tariffs_UK.df
}
}
eq5d.valueset[is.na(eq5d.valueset)]<- 0
#Use the formula in the publication given above -Table 2
sum.response=eq5d.valueset$Mobility[the.scores5L[1]]+eq5d.valueset$Self.care[the.scores5L[2]]+
eq5d.valueset$Usual.activities[the.scores5L[3]]+eq5d.valueset$Pain.discomfort[the.scores5L[4]]+
eq5d.valueset$Anxiety.depression[the.scores5L[5]]
values.state=1-sum.response
return(values.state)
}
}
##########################################################################################################
#' Helper function to correctly identify the country specific tariffs
#' @param country default is UK
#' @param this.response a must input,response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-5L, -1 if any error
#' @examples valueEQ5D5L_indscores("JP",1,2,3,2,2)
#' @export
#' @description This function is helper function to correctly identify the country specific tariffs
valueEQ5D5L_indscores<-function(country,this.response,this.response2=NA, this.response3=NA,
this.response4=NA, this.response5=NA){
if(country=="ES" || country=="IN" || country=="IR" || country=="UK" || country=="TH"
|| country=="HK" || country=="DE" || country=="CN" ){
ans<-valueEQ5D5L_8countriesIndscores(country,this.response,this.response2, this.response3,
this.response4, this.response5)
return(ans)
}else{
if(country=="NL" || country=="JP" || country=="UY"){
#valueEQ5D5L_3countriesIndscores(country,this.response,this.response2, this.response3,
# this.response4, this.response5)
print("currently not implemented")
return(-1)
}else{
if(country=="CA"){
#valueEQ5D5L_CAIndscores(country,this.response,this.response2, this.response3,
# this.response4, this.response5)
print("currently not implemented")
return(-1)
}else{
print("No tariffs found for the country you specified. Please try later !!")
return(-1)
}
}
}
}
###########################################################################################################
#' Function to value EQ-5D-5L scores for any country and group by gende and age
#' @param eq5dresponse.data the data containing eq5d responses
#' @param mobility column name for EQ-5D-5L mobility
#' @param self.care column name for response for EQ-5D-5L self care
#' @param usual.activities column name for response for EQ-5D-5L usual activities
#' @param pain.discomfort column name for response for EQ-5D-5L pain/discomfort
#' @param anxiety column name for response for EQ-5D-5L anxiety/depression
#' @param country country of interest, by default is UK, if groupby has to specifiy the country should be specified
#' @param groupby male or female -grouping by gender, default NULL
#' @param agelimit vector of ages to show upper and lower limits
#' @return index value if success, -1 if failure
#' @examples valueEQ5D5L(data, "Mobility", "SelfCare","UsualActivity", "Pain", "Anxiety",UK,NULL,c(10,70))
#' @export
#' @description Function to value EQ-5D-5L descriptive system to 5L index value.
valueEQ5D5L<-function(eq5dresponse.data,mobility, self.care,usual.activities,pain.discomfort,anxiety,
country="UK",groupby=NULL,agelimit=NULL){
eq5d.colnames<-c(mobility, self.care,usual.activities,pain.discomfort,anxiety)
ans.eq5d.colnames<-sapply(eq5d.colnames,checkColumnExist,eq5dresponse.data)
if(all(ans.eq5d.colnames==0)){# if the eq5d column names match
working.data=subsetGenderAgeToGroup(eq5dresponse.data,groupby,agelimit)
scores=c()
if(nrow(working.data)<1){
print("No entries with the given criteria -Please check the contents or the criteria")
return(-1)
}else{
for(j in 1:nrow(working.data)){
res1=working.data[j,mobility]
res2=working.data[j,self.care]
res3=working.data[j,usual.activities]
res4=working.data[j,pain.discomfort]
res5=working.data[j,anxiety]
this.score<-valueEQ5D5L_indscores(country,c(res1,res2,res3,res4,res5))
if(this.score!=-1){
scores=c(scores,this.score)
}else{
print("EQ-5D-5L esponses not valid - 5L scores can not be valued")
return(-1)
}
}
names(scores)<-"EQ-5D-5Lscores"
new.data=cbind(working.data,scores)
colnames(new.data)<-c(colnames(working.data), "EQ-5D-5L scores")
stats<-descriptiveStatDataColumn(scores,"EQ-5D-5L")
freqtable<-getFrequencyTable(scores)
first=is.null(groupby) || toupper(groupby)=="NA" || is.na(groupby)
second=is.null(agelimit) || toupper(agelimit)=="NA" || is.na(agelimit)
if(first & second){
title<-paste("Histogram of EQ-5D-5L index values", sep="")
}else{
if(first & !second){
title<-paste("Histogram of EQ-5D-5L index values",
" with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}else{
if(!second& second){
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, sep="")
}else{
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, " with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}
}
}
hist.plot <-graphics::hist(scores,main=title)
results<- list("stats" = stats, "frequencyTable" = freqtable, "histogram"= hist.plot,"modifiedData"=new.data)
return(results)
}
}else{# if the eq 5d column names do not match
print("EQ-5D column names do not match")
return(-1)
}
}
###########################################################################################################
#' Function to map EQ-5D-5L descriptive system to 3L index value
#' @param method default is "Van Hout", no other method currently currently implemented
#' @param this.response response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples eq5dmap5Lto3LUKIndscores("Van Hout",11125)
#' @examples eq5dmap5Lto3LUKIndscores("Van Hou",c(1,1,1,2,5))
#' @examples eq5dmap5Lto3LUKIndscores("Van Hout",1,1,1,2,5)
#' @export
#' @description Function to map EQ-5D-5L descriptive system to 3L index value (ref:Van Hout et al 2012 and code inspired from https://github.com/brechtdv/eq5d-mapping)
eq5dmap5Lto3LUKIndscores<-function(method="Van Hout",this.response,this.response2=NA,this.response3=NA,this.response4=NA,this.response5=NA) {
responses=c(this.response,this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(this.response))>0){ # first value should be not be a NA, do not contain NA
this.score.5L<-NA
values.state=NA
return(values.state)
}else{# check first value should be a vector containiing responses or a 5digit number
if(length(this.response)!=5 && length(this.response)!=1){
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}else{ #first value a vector or a 5 figit number
if(length(this.response)==5){#first value a vector
this.score.5L <- paste(this.response,collapse = "")
}else{
if(length(this.response)==1){#first value 5 digit number or actual response for mobility
if(this.response>=11111 && this.response<=55555){ # valid 5 digit number
this.score.5L <- this.response
}else{ #first value might be valid- a response to mobility
if(this.response<=5 && this.response>0 ){ #valid response to mobility
four.res=c(this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(four.res))==0){
if(any(responses<=5)){
this.score.5L <- paste(responses,collapse = "")#all valid and generate the score
}else{#error values
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}else{
#missing values
this.score.5L<-NA
values.state=NA
return(values.state)
}
}else{
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}
}
}
}
}
if(this.score.5L<11111 || this.score.5L>55555){
print("Invalid EQ-5D-5L responses")
return(-1)
}else{
## create a vector of all possible 3L index values (length == 3^5)
index_3L <- numeric(243)
## create a dataframe of all possible 3L scores
scores_3L <-
expand.grid(AD = seq(3),
PD = seq(3),
UA = seq(3),
SC = seq(3),
MO = seq(3))
## calculate the index value for each score
## using function EQ5D_be based on Cleemput et al., 2010
for (i in seq(243)) {
index_3L[i] <-
valueEQ5D3Lindscores("UK",scores_3L[i, "MO"],
scores_3L[i, "SC"],
scores_3L[i, "UA"],
scores_3L[i, "PD"],
scores_3L[i, "AD"])
}
## create a dataframe of all possible 5L scores
scores_5L <-
expand.grid(AD = seq(5),
PD = seq(5),
UA = seq(5),
SC = seq(5),
MO = seq(5))
## 5L to 3L CROSSWALK
## load 'probability matrix' from 'EQ-5D-5L_Crosswalk_Value_Sets'
## this is saved as dataframe 'm'
## file <- system.file('extdata', "Probability_matrix_crosswalk.csv",package = 'EQ5Dmapping')
## prob.matrix=read.csv(file,header=FALSE)
if(toupper(method)=="VAN HOUT"){
prob.matrix =Probability_matrix_crosswalk.df
m<-prob.matrix
rows_m=nrow(m)
cols_m=ncol(m)
if(rows_m!=3125 || cols_m!=243){
print("Error in number of cols or rows of probability matrix")
return(-1)
}
## multiply each row of 't(m)' with 'index_3L'
m_prod <- t(t(m) * index_3L)
## obtain sum per row
## crosswalked index value for each 5L score
m_sums <- rowSums(m_prod)
## reorder columns and convert to matrix
scores_5L <- with(scores_5L, cbind(MO, SC, UA, PD, AD))
## create 5L score labels
scores_5L_chr <- apply(scores_5L, 1, paste, collapse = "")
this_score <- which(scores_5L_chr == paste(this.score.5L, collapse = ""))
return(m_sums[this_score])
}else{
print("The specified method is not implemented")
return(-1)
}
}
}
###########################################################################################################
#' Helper Function to to choose the country based tariffs for mapping 5L to 3L
#' @param country default is UK, no other country currently currently implemented
#' @param this.response response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples eq5dmap5Lto3L_indscores("Van Hout",11125)
#' @examples eq5dmap5Lto3L_indscores("Van Hou",c(1,1,1,2,5))
#' @examples eq5dmap5Lto3L_indscores("Van Hout",1,1,1,2,5)
#' @export
#' @description Helper Function to to choose the country based tariffs for mapping 5L to 3L
eq5dmap5Lto3L_indscores<-function(country,this.response,this.response2=NA,this.response3=NA,this.response4=NA,this.response5=NA) {
if(country=="UK"){
ans=eq5dmap5Lto3LUKIndscores("Van Hout",this.response,this.response2,this.response3,this.response4,this.response5)
return(ans)
}else{
print("Method for any other country other than UK is not implemented")
return(-1)
}
}
###########################################################################################################
#' Function to map EQ-5D-5L scores to EQ-5D-3L index values as per the specific country and group by gender and age
#' @param eq5dresponse.data the data containing eq5d5L responses
#' @param mobility column name for EQ-5D-5L mobility
#' @param self.care column name for response for EQ-5D-5L self care
#' @param usual.activities column name for response for EQ-5D-5L usual activities
#' @param pain.discomfort column name for response for EQ-5D-5L pain/discomfort
#' @param anxiety column name for response for EQ-5D-5L anxiety/depression
#' @param country country of interest, by default is UK, if groupby has to specifiy the country should be specified
#' @param groupby male or female -grouping by gender, default NULL
#' @param agelimit vector of ages to show upper and lower limits
#' @return index value if success, -1 if failure
#' @examples eq5dmap5Lto3L(data, "Mobility", "SelfCare","UsualActivity", "Pain", "Anxiety",UK,NULL,c(10,70))
#' @export
#' @description Function to map EQ-5D-5L scores to EQ-5D-3L index values
eq5dmap5Lto3L<-function(eq5dresponse.data,mobility, self.care,usual.activities,pain.discomfort,anxiety,
country="UK",groupby=NULL,agelimit=NULL){
eq5d.colnames<-c(mobility, self.care,usual.activities,pain.discomfort,anxiety)
ans.eq5d.colnames<-sapply(eq5d.colnames,checkColumnExist,eq5dresponse.data)
if(all(ans.eq5d.colnames==0)){# if the eq5d column names match
working.data=subsetGenderAgeToGroup(eq5dresponse.data,groupby,agelimit)
scores=c()
if(nrow(working.data)<1){
print("No entries with the given criteria -Please check the contents or the criteria")
return(-1)
}else{
for(j in 1:nrow(working.data)){
res1=working.data[j,mobility]
res2=working.data[j,self.care]
res3=working.data[j,usual.activities]
res4=working.data[j,pain.discomfort]
res5=working.data[j,anxiety]
this.score<-eq5dmap5Lto3L_indscores(country,c(res1,res2,res3,res4,res5))
if(this.score!=-1){
scores=c(scores,this.score)
}else{
print("EQ-5D-5L esponses not valid - 5L scores can not be valued")
return(-1)
}
}
#names(scores)<-"Mapped EQ-5D-3Lscores"
new.data=cbind(working.data,scores)
colnames(new.data)<-c(colnames(working.data), "Mapped EQ-5D-3L scores")
stats<-descriptiveStatDataColumn(scores,"EQ-5D-3L")
freqtable<-getFrequencyTable(scores)
first=is.null(groupby) || toupper(groupby)=="NA" || is.na(groupby)
second=is.null(agelimit) || toupper(agelimit)=="NA" || is.na(agelimit)
if(first & second){
title<-paste("Histogram of EQ-5D-5L index values", sep="")
}else{
if(first & !second){
title<-paste("Histogram of EQ-5D-5L index values",
" with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}else{
if(!second& second){
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, sep="")
}else{
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, " with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}
}
}
hist.plot <-graphics::hist(scores,main=title)
results<- list("stats" = stats, "frequencyTable" = freqtable, "histogram"= hist.plot,"modifiedData"=new.data)
return(results)
}
}else{# if the eq 5d column names do not match
print("EQ-5D column names do not match")
return(-1)
}
}
sheejamk/eq5dmapR documentation built on July 6, 2019, 11:49 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
##############################################################################################################
#' Function to value EQ-5D-3L individual responses to index value for any country
#' @param country default is UK
#' @param this.response a must input,response for EQ-5D-3L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-3L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-3L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-3L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-3L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples valueEQ5D3Lindscores("UK",1,2,3,2,2)
#' @examples valueEQ5D3Lindscores("UK",c(1,2,3,2,2))
#' @examples valueEQ5D3Lindscores("UK",12322)
#' @export
#' @description Function to value EQ-5D-3L descriptive system to the index values (ref: Dolan et al. 1997 and code inspired from https://github.com/brechtdv/eq5d-mapping)
valueEQ5D3Lindscores<-function(country="UK",this.response, this.response2=NA, this.response3=NA, this.response4=NA, this.response5=NA) {
responses=c(this.response,this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(this.response))>0){ # first value should be not be a NA, do not contain NA
this.score.3L<-NA
values.state=NA
return(values.state)
}else{# check first value should be a vector containiing responses or a 5digit number
if(length(this.response)!=5 && length(this.response)!=1){
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}else{ #first value a vector or a 5 figit number
if(length(this.response)==5){#first value a vector
this.score.3L <- paste(this.response,collapse = "")
responses<-this.response
}else{
if(length(this.response)==1){#first value 5 digit number or actual response for mobility
if(this.response>=11111 && this.response<=33333){ # valid 5 digit number
this.score.3L <- this.response
responses<-convertNumberToIndividualDigits(this.score.3L)
}else{ #first value might be valid- a response to mobility
if(this.response<=3 && this.response>0 ){ #valid response to mobility
four.res=c(this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(four.res))==0){
if(any(responses<=5)){
this.score.3L <- paste(responses,collapse = "")#all valid and generate the score
}else{#error values
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}else{
#missing values
this.score.3L<-NA
values.state=NA
return(values.state)
}
}else{
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}
}
}
}
}
if(this.score.3L<11111 || this.score.3L>33333){
print("Invalid EQ-5D-3L responses")
return(-1)
}else{
if(country=="UK"){
## if a dimension include a value >= 3 then add N3
N3 <- any(responses == 3)
## the intercept should not be subtracted for the perfect health state
intercept <- ifelse(all(responses== 1),
0.000, # perfect health
0.081) # less than perfect health
## values are taken from the reference for UK
products=c(0.176,0.006,0.022,0.140,0.094)
ind=which(responses == 3)
prod<-sum((responses[ind]-2)* products[ind])
## construct the index value
## values are taken from the reference for UK
index <- 1 - # full health
intercept - # intercept
0.069 * (responses[1] - 1) - # mobility
0.104 * (responses[2] - 1) - # self-care
0.036 * (responses[3] - 1) - # usual activities
0.123 * (responses[4] - 1) - # pain/discomfort
0.071 * (responses[5] - 1) - # anxiety/depression
0.269 * N3- # any dimension at level 3
prod
## return the index value
return(index)
}else{
print("No method for countries other than UK")
return(-1)
}
}
}
###########################################################################################################
#' Helper function to correctly identify the country specific tariffs
#' @param country default is UK
#' @param this.response a must input,response for EQ-5D-3L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-3L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-3L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-3L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-3L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples valueEQ5D3L_indscores("UK",1,2,3,2,2)
#' @export
#' @description This function is helper function to correctly identify the country specific tariffs
valueEQ5D3L_indscores<-function(country,this.response,this.response2=NA, this.response3=NA,this.response4=NA, this.response5=NA){
if( country=="UK"){
ans=valueEQ5D3Lindscores(country,this.response,this.response2, this.response3,this.response4, this.response5)
return(ans)
}else{
print("No tariffs found for the country you specified. Please try later !!")
return(-1)
}
}
###########################################################################################################
#' Function to value EQ-5D-3L columns to index values for any country and group by gender and age
#' @param eq5dresponse.data the data containing eq5d responses
#' @param mobility column name for EQ-5D-3L mobility
#' @param self.care column name for response for EQ-5D-3L self care
#' @param usual.activities column name for response for EQ-5D-3L usual activities
#' @param pain.discomfort column name for response for EQ-5D-3L pain/discomfort
#' @param anxiety column name for response for EQ-5D-3L anxiety/depression
#' @param country country of interest, by default is UK, if groupby has to specifiy the country should be specified
#' @param groupby male or female -grouping by gender, default NULL
#' @param agelimit vector of ages to show upper and lower limits
#' @return the descriptive statistics of index values, frequence table and the modified data where the last column will be the index values
#' @examples valueEQ5D3L(data, "Mobility", "SelfCare","UsualActivity", "Pain", "Anxiety",UK,NULL,c(10,70))
#' @export
#' @description Main function to value EQ-5D-5L descriptive system to 5L index values.
valueEQ5D3L<-function(eq5dresponse.data,mobility,self.care,usual.activities,pain.discomfort,anxiety,country,groupby,agelimit){
eq5d.colnames<-c(mobility, self.care,usual.activities,pain.discomfort,anxiety)
ans.eq5d.colnames<-sapply(eq5d.colnames,checkColumnExist,eq5dresponse.data)
if(all(ans.eq5d.colnames==0)){# if the eq5d column names match
working.data=subsetGenderAgeToGroup(eq5dresponse.data,groupby,agelimit)
if(nrow(working.data)<1){
print("No entries with the given criteria -Please check the contents or the criteria")
return(-1)
}else{
scores=c()
for(j in 1:nrow(working.data)){
res1=working.data[j,mobility]
res2=working.data[j,self.care]
res3=working.data[j,usual.activities]
res4=working.data[j,pain.discomfort]
res5=working.data[j,anxiety]
this.score<-valueEQ5D3L_indscores(country,res1,res2,res3,res4,res5)
if(this.score!=-1){
scores=c(scores,this.score)
}else{
print("responses not valid -3L scores can not be valued")
return(-1)
}
}
names(scores)<-"EQ-5D-3Lscores"
new.data=cbind(working.data,scores)
colnames(new.data)<-c(colnames(working.data), "EQ-5D-3L scores")
stats<-descriptiveStatDataColumn(scores,"EQ-5D-3L")
freqtable<-getFrequencyTable(scores)
first=is.null(groupby) || toupper(groupby)=="NA" || is.na(groupby)
second=is.null(agelimit) || toupper(agelimit)=="NA" || is.na(agelimit)
if(first & second){
title<-paste("Histogram of EQ-5D-3L index values", sep="")
}else{
if(first & !second){
title<-paste("Histogram of EQ-5D-3L index values",
" with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}else{
if(!second& second){
title<-paste("Histogram of EQ-5D-3L index values for ",
groupby, sep="")
}else{
title<-paste("Histogram of EQ-5D-3L index values for ",
groupby, " with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}
}
}
hist.plot <-graphics::hist(scores,main=title)
results<- list("stats" = stats, "frequencyTable" = freqtable, "histogram"= hist.plot,"modifiedData"=new.data)
return(results)
}
}else{# if the eq 5d column names do not match
print("EQ-5D column names do not match")
return(-1)
}
}
##########################################################################################################
#' Function to value EQ-5D-5L scores for countries UK, Spain, Ireland, China, Thailand, Hong Kong, Indonesia, and Germany
#' @param country a country name from the list UK,ES,IR, IN,CN, TH, HK, and DE
#' @param this.response a must input,response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value based on UK tariffs if success, -1 if failure
#' @examples valueEQ5D5L_8countriesIndscores("UK",23434)
#' @examples valueEQ5D5L_8countriesIndscores("ES",2,3,4,3,4)
#' @examples valueEQ5D5L_8countriesIndscores("IN",c("IN",2,3,4,3,4))
#' @export
valueEQ5D5L_8countriesIndscores<-function(country,this.response,this.response2=NA, this.response3=NA, this.response4=NA, this.response5=NA){
responses=c(this.response,this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(this.response))>0){ # first value should be not be a NA, do not contain NA
this.score.5L<-NA
values.state=NA
return(values.state)
}else{# check first value should be a vector containiing responses or a 5digit number
if(length(this.response)!=5 && length(this.response)!=1){
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}else{ #first value a vector or a 5 figit number
if(length(this.response)==5){#first value a vector
this.score.5L <- paste(this.response,collapse = "")
responses<-this.response
}else{
if(length(this.response)==1){#first value 5 digit number or actual response for mobility
if(this.response>=11111 && this.response<=55555){ # valid 5 digit number
this.score.5L <- this.response
responses<-convertNumberToIndividualDigits(this.score.5L)
}else{ #first value might be valid- a response to mobility
if(this.response<=3 && this.response>0 ){ #valid response to mobility
four.res=c(this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(four.res))==0){
if(any(responses<=5)){
this.score.5L <- paste(responses,collapse = "")#all valid and generate the score
}else{#error values
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}else{
#missing values
this.score.5L<-NA
values.state=NA
return(values.state)
}
}else{
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}
}
}
}
}
if(this.score.5L<11111 || this.score.5L>55555){
print("Invalid EQ-5D-5L responses")
return(-1)
}else{
the.scores5L=convertNumberToIndividualDigits(this.score.5L)
if(!is.null(country) & toupper(country)!="NA"& !is.na(country)){
if(country=="ES"){
eq5d.valueset=EQ5D5L_tariffs_ES.df
}
if(country=="CN"){
eq5d.valueset=EQ5D5L_tariffs_CN.df
}
if(country=="DE"){
eq5d.valueset=EQ5D5L_tariffs_DE.df
}
if(country=="IN"){
eq5d.valueset=EQ5D5L_tariffs_IN.df
}
if(country=="IR"){
eq5d.valueset=EQ5D5L_tariffs_IR.df
}
if(country=="HK"){
eq5d.valueset=EQ5D5L_tariffs_HK.df
}
if(country=="TH"){
eq5d.valueset=EQ5D5L_tariffs_TH.df
}
if(country=="UK"){
eq5d.valueset=EQ5D5L_tariffs_UK.df
}
}
eq5d.valueset[is.na(eq5d.valueset)]<- 0
#Use the formula in the publication given above -Table 2
sum.response=eq5d.valueset$Mobility[the.scores5L[1]]+eq5d.valueset$Self.care[the.scores5L[2]]+
eq5d.valueset$Usual.activities[the.scores5L[3]]+eq5d.valueset$Pain.discomfort[the.scores5L[4]]+
eq5d.valueset$Anxiety.depression[the.scores5L[5]]
values.state=1-sum.response
return(values.state)
}
}
##########################################################################################################
#' Helper function to correctly identify the country specific tariffs
#' @param country default is UK
#' @param this.response a must input,response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-5L, -1 if any error
#' @examples valueEQ5D5L_indscores("JP",1,2,3,2,2)
#' @export
#' @description This function is helper function to correctly identify the country specific tariffs
valueEQ5D5L_indscores<-function(country,this.response,this.response2=NA, this.response3=NA,
this.response4=NA, this.response5=NA){
if(country=="ES" || country=="IN" || country=="IR" || country=="UK" || country=="TH"
|| country=="HK" || country=="DE" || country=="CN" ){
ans<-valueEQ5D5L_8countriesIndscores(country,this.response,this.response2, this.response3,
this.response4, this.response5)
return(ans)
}else{
if(country=="NL" || country=="JP" || country=="UY"){
#valueEQ5D5L_3countriesIndscores(country,this.response,this.response2, this.response3,
# this.response4, this.response5)
print("currently not implemented")
return(-1)
}else{
if(country=="CA"){
#valueEQ5D5L_CAIndscores(country,this.response,this.response2, this.response3,
# this.response4, this.response5)
print("currently not implemented")
return(-1)
}else{
print("No tariffs found for the country you specified. Please try later !!")
return(-1)
}
}
}
}
###########################################################################################################
#' Function to value EQ-5D-5L scores for any country and group by gende and age
#' @param eq5dresponse.data the data containing eq5d responses
#' @param mobility column name for EQ-5D-5L mobility
#' @param self.care column name for response for EQ-5D-5L self care
#' @param usual.activities column name for response for EQ-5D-5L usual activities
#' @param pain.discomfort column name for response for EQ-5D-5L pain/discomfort
#' @param anxiety column name for response for EQ-5D-5L anxiety/depression
#' @param country country of interest, by default is UK, if groupby has to specifiy the country should be specified
#' @param groupby male or female -grouping by gender, default NULL
#' @param agelimit vector of ages to show upper and lower limits
#' @return index value if success, -1 if failure
#' @examples valueEQ5D5L(data, "Mobility", "SelfCare","UsualActivity", "Pain", "Anxiety",UK,NULL,c(10,70))
#' @export
#' @description Function to value EQ-5D-5L descriptive system to 5L index value.
valueEQ5D5L<-function(eq5dresponse.data,mobility, self.care,usual.activities,pain.discomfort,anxiety,
country="UK",groupby=NULL,agelimit=NULL){
eq5d.colnames<-c(mobility, self.care,usual.activities,pain.discomfort,anxiety)
ans.eq5d.colnames<-sapply(eq5d.colnames,checkColumnExist,eq5dresponse.data)
if(all(ans.eq5d.colnames==0)){# if the eq5d column names match
working.data=subsetGenderAgeToGroup(eq5dresponse.data,groupby,agelimit)
scores=c()
if(nrow(working.data)<1){
print("No entries with the given criteria -Please check the contents or the criteria")
return(-1)
}else{
for(j in 1:nrow(working.data)){
res1=working.data[j,mobility]
res2=working.data[j,self.care]
res3=working.data[j,usual.activities]
res4=working.data[j,pain.discomfort]
res5=working.data[j,anxiety]
this.score<-valueEQ5D5L_indscores(country,c(res1,res2,res3,res4,res5))
if(this.score!=-1){
scores=c(scores,this.score)
}else{
print("EQ-5D-5L esponses not valid - 5L scores can not be valued")
return(-1)
}
}
names(scores)<-"EQ-5D-5Lscores"
new.data=cbind(working.data,scores)
colnames(new.data)<-c(colnames(working.data), "EQ-5D-5L scores")
stats<-descriptiveStatDataColumn(scores,"EQ-5D-5L")
freqtable<-getFrequencyTable(scores)
first=is.null(groupby) || toupper(groupby)=="NA" || is.na(groupby)
second=is.null(agelimit) || toupper(agelimit)=="NA" || is.na(agelimit)
if(first & second){
title<-paste("Histogram of EQ-5D-5L index values", sep="")
}else{
if(first & !second){
title<-paste("Histogram of EQ-5D-5L index values",
" with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}else{
if(!second& second){
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, sep="")
}else{
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, " with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}
}
}
hist.plot <-graphics::hist(scores,main=title)
results<- list("stats" = stats, "frequencyTable" = freqtable, "histogram"= hist.plot,"modifiedData"=new.data)
return(results)
}
}else{# if the eq 5d column names do not match
print("EQ-5D column names do not match")
return(-1)
}
}
###########################################################################################################
#' Function to map EQ-5D-5L descriptive system to 3L index value
#' @param method default is "Van Hout", no other method currently currently implemented
#' @param this.response response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples eq5dmap5Lto3LUKIndscores("Van Hout",11125)
#' @examples eq5dmap5Lto3LUKIndscores("Van Hou",c(1,1,1,2,5))
#' @examples eq5dmap5Lto3LUKIndscores("Van Hout",1,1,1,2,5)
#' @export
#' @description Function to map EQ-5D-5L descriptive system to 3L index value (ref:Van Hout et al 2012 and code inspired from https://github.com/brechtdv/eq5d-mapping)
eq5dmap5Lto3LUKIndscores<-function(method="Van Hout",this.response,this.response2=NA,this.response3=NA,this.response4=NA,this.response5=NA) {
responses=c(this.response,this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(this.response))>0){ # first value should be not be a NA, do not contain NA
this.score.5L<-NA
values.state=NA
return(values.state)
}else{# check first value should be a vector containiing responses or a 5digit number
if(length(this.response)!=5 && length(this.response)!=1){
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}else{ #first value a vector or a 5 figit number
if(length(this.response)==5){#first value a vector
this.score.5L <- paste(this.response,collapse = "")
}else{
if(length(this.response)==1){#first value 5 digit number or actual response for mobility
if(this.response>=11111 && this.response<=55555){ # valid 5 digit number
this.score.5L <- this.response
}else{ #first value might be valid- a response to mobility
if(this.response<=5 && this.response>0 ){ #valid response to mobility
four.res=c(this.response2,this.response3,this.response4,this.response5)
if(sum(is.na(four.res))==0){
if(any(responses<=5)){
this.score.5L <- paste(responses,collapse = "")#all valid and generate the score
}else{#error values
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}else{
#missing values
this.score.5L<-NA
values.state=NA
return(values.state)
}
}else{
print("Invalid EQ-5D-5L responses-check the responses to each question")
return(-1)
}
}
}
}
}
}
if(this.score.5L<11111 || this.score.5L>55555){
print("Invalid EQ-5D-5L responses")
return(-1)
}else{
## create a vector of all possible 3L index values (length == 3^5)
index_3L <- numeric(243)
## create a dataframe of all possible 3L scores
scores_3L <-
expand.grid(AD = seq(3),
PD = seq(3),
UA = seq(3),
SC = seq(3),
MO = seq(3))
## calculate the index value for each score
## using function EQ5D_be based on Cleemput et al., 2010
for (i in seq(243)) {
index_3L[i] <-
valueEQ5D3Lindscores("UK",scores_3L[i, "MO"],
scores_3L[i, "SC"],
scores_3L[i, "UA"],
scores_3L[i, "PD"],
scores_3L[i, "AD"])
}
## create a dataframe of all possible 5L scores
scores_5L <-
expand.grid(AD = seq(5),
PD = seq(5),
UA = seq(5),
SC = seq(5),
MO = seq(5))
## 5L to 3L CROSSWALK
## load 'probability matrix' from 'EQ-5D-5L_Crosswalk_Value_Sets'
## this is saved as dataframe 'm'
## file <- system.file('extdata', "Probability_matrix_crosswalk.csv",package = 'EQ5Dmapping')
## prob.matrix=read.csv(file,header=FALSE)
if(toupper(method)=="VAN HOUT"){
prob.matrix =Probability_matrix_crosswalk.df
m<-prob.matrix
rows_m=nrow(m)
cols_m=ncol(m)
if(rows_m!=3125 || cols_m!=243){
print("Error in number of cols or rows of probability matrix")
return(-1)
}
## multiply each row of 't(m)' with 'index_3L'
m_prod <- t(t(m) * index_3L)
## obtain sum per row
## crosswalked index value for each 5L score
m_sums <- rowSums(m_prod)
## reorder columns and convert to matrix
scores_5L <- with(scores_5L, cbind(MO, SC, UA, PD, AD))
## create 5L score labels
scores_5L_chr <- apply(scores_5L, 1, paste, collapse = "")
this_score <- which(scores_5L_chr == paste(this.score.5L, collapse = ""))
return(m_sums[this_score])
}else{
print("The specified method is not implemented")
return(-1)
}
}
}
###########################################################################################################
#' Helper Function to to choose the country based tariffs for mapping 5L to 3L
#' @param country default is UK, no other country currently currently implemented
#' @param this.response response for EQ-5D-5L mobility or the 5 digit response, or the vector of responses, e.g. 11111, c(1,1,1,1,1) or 1
#' @param this.response2 response for EQ-5D-5L self care, or NA if the responses are given as this.response
#' @param this.response3 response for EQ-5D-5L usual activities,or NA if the responses are given as this.response
#' @param this.response4 response for EQ-5D-5L pain/discomfort, or NA if the responses are given as this.response
#' @param this.response5 response for EQ-5D-5L anxiety/depression, or NA if the responses are given as this.response
#' @return index value of EQ-5D-3L, -1 if any error
#' @examples eq5dmap5Lto3L_indscores("Van Hout",11125)
#' @examples eq5dmap5Lto3L_indscores("Van Hou",c(1,1,1,2,5))
#' @examples eq5dmap5Lto3L_indscores("Van Hout",1,1,1,2,5)
#' @export
#' @description Helper Function to to choose the country based tariffs for mapping 5L to 3L
eq5dmap5Lto3L_indscores<-function(country,this.response,this.response2=NA,this.response3=NA,this.response4=NA,this.response5=NA) {
if(country=="UK"){
ans=eq5dmap5Lto3LUKIndscores("Van Hout",this.response,this.response2,this.response3,this.response4,this.response5)
return(ans)
}else{
print("Method for any other country other than UK is not implemented")
return(-1)
}
}
###########################################################################################################
#' Function to map EQ-5D-5L scores to EQ-5D-3L index values as per the specific country and group by gender and age
#' @param eq5dresponse.data the data containing eq5d5L responses
#' @param mobility column name for EQ-5D-5L mobility
#' @param self.care column name for response for EQ-5D-5L self care
#' @param usual.activities column name for response for EQ-5D-5L usual activities
#' @param pain.discomfort column name for response for EQ-5D-5L pain/discomfort
#' @param anxiety column name for response for EQ-5D-5L anxiety/depression
#' @param country country of interest, by default is UK, if groupby has to specifiy the country should be specified
#' @param groupby male or female -grouping by gender, default NULL
#' @param agelimit vector of ages to show upper and lower limits
#' @return index value if success, -1 if failure
#' @examples eq5dmap5Lto3L(data, "Mobility", "SelfCare","UsualActivity", "Pain", "Anxiety",UK,NULL,c(10,70))
#' @export
#' @description Function to map EQ-5D-5L scores to EQ-5D-3L index values
eq5dmap5Lto3L<-function(eq5dresponse.data,mobility, self.care,usual.activities,pain.discomfort,anxiety,
country="UK",groupby=NULL,agelimit=NULL){
eq5d.colnames<-c(mobility, self.care,usual.activities,pain.discomfort,anxiety)
ans.eq5d.colnames<-sapply(eq5d.colnames,checkColumnExist,eq5dresponse.data)
if(all(ans.eq5d.colnames==0)){# if the eq5d column names match
working.data=subsetGenderAgeToGroup(eq5dresponse.data,groupby,agelimit)
scores=c()
if(nrow(working.data)<1){
print("No entries with the given criteria -Please check the contents or the criteria")
return(-1)
}else{
for(j in 1:nrow(working.data)){
res1=working.data[j,mobility]
res2=working.data[j,self.care]
res3=working.data[j,usual.activities]
res4=working.data[j,pain.discomfort]
res5=working.data[j,anxiety]
this.score<-eq5dmap5Lto3L_indscores(country,c(res1,res2,res3,res4,res5))
if(this.score!=-1){
scores=c(scores,this.score)
}else{
print("EQ-5D-5L esponses not valid - 5L scores can not be valued")
return(-1)
}
}
#names(scores)<-"Mapped EQ-5D-3Lscores"
new.data=cbind(working.data,scores)
colnames(new.data)<-c(colnames(working.data), "Mapped EQ-5D-3L scores")
stats<-descriptiveStatDataColumn(scores,"EQ-5D-3L")
freqtable<-getFrequencyTable(scores)
first=is.null(groupby) || toupper(groupby)=="NA" || is.na(groupby)
second=is.null(agelimit) || toupper(agelimit)=="NA" || is.na(agelimit)
if(first & second){
title<-paste("Histogram of EQ-5D-5L index values", sep="")
}else{
if(first & !second){
title<-paste("Histogram of EQ-5D-5L index values",
" with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}else{
if(!second& second){
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, sep="")
}else{
title<-paste("Histogram of EQ-5D-5L index values for ",
groupby, " with ages between ", agelimit[1], " and ",agelimit[2], sep="")
}
}
}
hist.plot <-graphics::hist(scores,main=title)
results<- list("stats" = stats, "frequencyTable" = freqtable, "histogram"= hist.plot,"modifiedData"=new.data)
return(results)
}
}else{# if the eq 5d column names do not match
print("EQ-5D column names do not match")
return(-1)
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.