Data Prep

Read in the data, and split files into chart review and analysis data entries.

## Read in data
analysis_reliab <- read.csv("~/Library/CloudStorage/Box-Box/CLA RSS Data Sharing/577565_McGrattan_SMA/BABYVFSSIMP/data/SMA_clean_reliability_data_20250811.csv")
analysis <- read.csv("~/Library/CloudStorage/Box-Box/CLA RSS Data Sharing/577565_McGrattan_SMA/BABYVFSSIMP/data/SMA_clean_analysis_data_20250811.csv")

# Kinematics
sma_reliability <- read.csv("~/Library/CloudStorage/Box-Box/CLA RSS Data Sharing/1022295_McGrattan_SMA_KINEMATICS/SMA_Data/SMA_DAT_reliab_last20250811.csv")

#use all reliability ratings for BABYVFSSImp

#subset to capture only the consensus scores
analysis_con <- analysis %>% 
  filter(ID %in% analysis_reliab$ID)

List the reliability cases (n = 59) to ensure everyone is included:

analysis_reliab %>% 
  select(studyid_clean, rater_clean) %>% 
  group_by(studyid_clean) %>% 
  mutate(raternum = rep(1:2, times = length(unique(studyid_clean)))) %>% 
  pivot_wider(names_from = raternum, 
              values_from = rater_clean) %>% 
  kable()

Create function to calculate proportion of patients who were given each consensus score across each component.

#function for tables
OIprop.table <- function(data, var){
  temp <- substitute(var)
  data %>% 
    #filter(!is.na({{var}})) %>% 
    group_by({{var}}) %>% 
    summarize(count=n()) %>% 
    ungroup() %>% 
    mutate(proportion = round(count/sum(count), 2)) %>% 
    kable(col.names=c(paste0("Component ", gsub("oi_", "", temp), " Consensus Rating"), "Count", "Proportion"))
}

Create a function to pull out expected and actual frequencies from Kappa and Gwet statistic for pooling:

Calculate Reliability Ratings

First, clean up scores and rater ids to create agreement tables, then subset to only include data from cases both rated.

#replace any INF with NA
analysis_reliab[analysis_reliab=="Inf"] <- NA
analysis_reliab[analysis_reliab=="-Inf"] <- NA

analysis_con[analysis_con=="Inf"] <- NA
analysis_con[analysis_con=="-Inf"] <- NA

Set up function to return the agreement tables

pulloutrating <- function(data, component) {
  data %>% 
    mutate(temp = factor({{component}})) %>% 
    select(studyid_clean, rater_clean, temp) %>%
    pivot_wider(names_from = rater_clean, 
              values_from = temp) 
}

The percent agreement as well as three reliability scores are reported below. Each of the reliability estimates calculate the proportion of agreement between raters relative to the likelihood of them agreeing by chance (e.g., the marginal probabilities of agreement). Kappa is traditionally used, and may be most appropriate for most of this data, as responses are more evenly distributed across possible scores. Gwet’s agreement coefficient is also presented as a comparison in cases where Kappa may not be a good fit due to the skew of responses.

Percent Agreement is also reported. This will be higher than Kappa when marginal totals are skewed (e.g., all videos were rated the same way). This is straight agreement, not penalized by the probability raters might agree by chance.

Agreement Coefficient is an alternative to Kappa that may be more appropriate when the responses are highly skewed (e.g., the prevalence of certain ratings is low). This was developed by Gwet (2010) and uses a different method for penalizing agreement due to chance.

Kappa treats data as categorical, and only complete agreements “count” as agreement.

Weighted Kappa, by contrast, will weight disagreements based on how close they were, with closer values counting more than farther apart ratings. By default, equal-spaced or linear weights are used. Weighted Kappa values may be more appropriate for ordinal ratings with 3+ categories.

WHAT TO USE HERE: For this data:

Use weighted Kappa when ratings are ordered and have 3 or more categories.
Use (unweighted) Kappa for non-ordered/categorical ratings or those with only 2 categories
Use Gwet AC1 if Kappa is low BUT percent agreement is high, as this may indicate skewed responses.

Both types of Kappa can be interpreted based on the static Cohen guidelines (I believe these are the same as the Landis-Koch). Interpret AC1 using the tables - the appropriate Landis-Koch category the highest where CumProb is 0.95 or higher.

Reliability and OI by Component

Domain I - Lingual Motion/Pharyngeal Swallow Initiation

Component 1: Initiation of Nutritive Sucks (NS)

0 = Prompt (within 5 seconds of nipple entering mouth and after 5 or < non-nutritive sucks [NNS])
1 = Delayed (after > 5 sec. or > 6 NNS)
2 = No initiation of NS/

Table of Rater Agreement:

c1r <- pulloutrating(analysis_reliab, oi_1)

ftable(c1r$HM, c1r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		16	0	0
1		0	1	0
2		1	0	10

Percentage Agreement

data.frame(sum(c1r$HM == c1r$KLM, na.rm=T)/nrow(na.omit(c1r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
96.4

IRR coefficients:

table <- table(c1r$HM, c1r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.952	0.047	(0.855,1)	0e+00
Kappa	Cohen’s Kappa	0.930	0.069	(0.789,1)	1.479e-13
Weighted Kappa	Cohen’s Kappa	0.925	0.073	(0.775,1)	7.738e-13

c1wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c1r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.99908
(0.6 to 0.8)	Substantial	1
(0.4 to 0.6)	Moderate	1
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_1)

Component 1 Consensus Rating	Count	Proportion
0	16	0.27
1	1	0.02
2	14	0.24
NA	28	0.47

Component 2 – Number of Sucks to Form Bolus

1 = Sucking 1 time
2 = Sucking 2 times
3 = Sucking 3 times
4 = Sucking 4 times
5 = Sucking 5 times
6 = Sucking 6 or more times
7 = Sucking with no bolus extraction

Table of Rater Agreement:

c2r <- pulloutrating(analysis_reliab, oi_2)
  
ftable(c2r$HM, c2r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	2	3	4	5	6	7
HM
2		1	0	0	0	0	0
3		1	1	2	0	0	0
4		0	0	2	0	0	1
5		0	0	1	1	0	0
6		0	0	1	0	4	0
7		0	1	0	0	0	11

Percentage Agreement

data.frame(sum(c2r$HM == c2r$KLM, na.rm=T)/nrow(na.omit(c2r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
74.1

IRR coefficients:

table <- table(c2r$HM, c2r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.697	0.100	(0.49,0.903)	2.28e-07
Kappa	Cohen’s Kappa	0.647	0.106	(0.429,0.865)	1.905e-06
Weighted Kappa	Cohen’s Kappa	0.733	0.104	(0.518,0.947)	1.902e-07

c2wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c2r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.15456
(0.6 to 0.8)	Substantial	0.82712
(0.4 to 0.6)	Moderate	0.99813
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_2)

Component 2 Consensus Rating	Count	Proportion
2	1	0.02
3	2	0.03
4	8	0.14
5	1	0.02
6	4	0.07
7	15	0.25
NA	28	0.47

Component 3 – Nutritive Suck Rhythmicity

0 = Organized; rhythmic tongue movement patterns
1 = Intermittent organization; inconsistent use of rhythmic tongue patterns
2 = Disorganized; no rhythmic tongue pattern

Table of Rater Agreement:

c3r <- pulloutrating(analysis_reliab, oi_3)
  
ftable(c3r$HM, c3r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		0	5	0
1		0	11	0
2		0	0	13

Percentage Agreement

data.frame(sum(c3r$HM == c3r$KLM, na.rm=T)/nrow(na.omit(c3r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
82.8

IRR coefficients:

table <- table(c3r$HM, c3r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.758	0.103	(0.548,0.968)	4.918e-08
Kappa	Cohen’s Kappa	0.708	0.100	(0.502,0.913)	1.149e-07
Weighted Kappa	Cohen’s Kappa	0.742	0.081	(0.575,0.908)	7.049e-10

c3wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c3r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.33722
(0.6 to 0.8)	Substantial	0.93397
(0.4 to 0.6)	Moderate	0.99969
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_3)

Component 3 Consensus Rating	Count	Proportion
0	3	0.05
1	16	0.27
2	12	0.20
NA	28	0.47

Component 4 – Suck/Swallow Bolus Control

0 = Cohesive bolus contained in oral cavity
1 = Diffuse bolus contained in oral cavity
2 = Contrast escape into pharynx

Table of Rater Agreement:

c4r <- pulloutrating(analysis_reliab, oi_4)

ftable(c4r$HM, c4r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	2
HM
2		57

Percentage Agreement

data.frame(sum(c4r$HM == c4r$KLM, na.rm=T)/nrow(na.omit(c4r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
100

IRR coefficients:

table <- table(c4r$HM, c4r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	NaN	NaN	(NaN,NaN)	NaN
Kappa	Cohen’s Kappa	NaN	NaN	(NaN,NaN)	NaN
Weighted Kappa	Cohen’s Kappa	NaN	NaN	(NaN,NaN)	NaN

c4wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c4r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	NaN
(0.6 to 0.8)	Substantial	NaN
(0.4 to 0.6)	Moderate	NaN
(0.2 to 0.4)	Fair	NaN
(0 to 0.2)	Slight	NaN
(-1 to 0)	Poor	NaN

Consensus Agreement:

OIprop.table(analysis_con, oi_4)

Component 4 Consensus Rating	Count	Proportion
2	58	0.98
NA	1	0.02

Component 5 – Bolus Location at Initiation of Pharyngeal Swallow

0 = Above or at valleculae
1 = Between valleculae and pyriform sinuses
2 = In pyriform sinuses
3 = No initiation at any location, absent swallow

Table of Rater Agreement:

c5r <- pulloutrating(analysis_reliab, oi_5)
  
ftable(c5r$HM, c5r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	2	3
HM
0		2	5	0
2		1	46	0
3		1	1	3

Percentage Agreement

data.frame(sum(c5r$HM == c5r$KLM, na.rm=T)/nrow(na.omit(c5r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
86.4

IRR coefficients:

table <- table(c5r$HM, c5r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.842	0.055	(0.732,0.952)	0e+00
Kappa	Cohen’s Kappa	0.525	0.138	(0.249,0.801)	3.352e-04
Weighted Kappa	Cohen’s Kappa	0.487	0.154	(0.179,0.795)	2.45e-03

c5wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c5r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.77537
(0.6 to 0.8)	Substantial	0.99999
(0.4 to 0.6)	Moderate	1
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_5)

Component 5 Consensus Rating	Count	Proportion
0	10	0.17
2	46	0.78
3	3	0.05

Component 6 – Timing of Initiation of Pharyngeal Swallow

0 = Immediate or ≤ 1 second
1 = > 1 or ≤ 2 seconds
2 = > 2 seconds

Table of Rater Agreement:

c6r <- pulloutrating(analysis_reliab, oi_6)
  
ftable(c6r$HM, c6r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		19	7	3
1		1	4	2
2		4	1	16

Percentage Agreement

data.frame(sum(c6r$HM == c6r$KLM, na.rm=T)/nrow(na.omit(c6r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
68.4

IRR coefficients:

table <- table(c6r$HM, c6r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.542	0.091	(0.359,0.725)	1.996e-07
Kappa	Cohen’s Kappa	0.494	0.094	(0.305,0.683)	2.583e-06
Weighted Kappa	Cohen’s Kappa	0.546	0.097	(0.352,0.741)	6.27e-07

c6wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c6r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.00261
(0.6 to 0.8)	Substantial	0.26563
(0.4 to 0.6)	Moderate	0.93834
(0.2 to 0.4)	Fair	0.9999
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_6)

Component 6 Consensus Rating	Count	Proportion
0	25	0.42
1	11	0.19
2	23	0.39

Domain II – Palatal-Pharyngeal Approximation

Component 7 – Palatal-Pharyngeal Approximation/Palatal Integrity

0 = No contrast between soft palate (SP)/posterior pharyngeal wall (PW)
1 = Trace column of contrast or air between SP and PW
2 = Narrow column of contrast or air between SP and PW
3 = Wide column of contrast or air between SP and PW

Table of Rater Agreement:

c7r <- pulloutrating(analysis_reliab, oi_7)
  
ftable(c7r$HM, c7r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3
HM
0		16	2	5	0
1		1	7	5	0
2		1	1	9	1
3		1	0	5	3

Percentage Agreement

data.frame(sum(c7r$HM == c7r$KLM, na.rm=T)/nrow(na.omit(c7r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
61.4

IRR coefficients:

table <- table(c7r$HM, c7r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.494	0.085	(0.323,0.665)	3.363e-07
Kappa	Cohen’s Kappa	0.468	0.084	(0.3,0.637)	7.462e-07
Weighted Kappa	Cohen’s Kappa	0.551	0.084	(0.382,0.72)	2.121e-08

c7wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c7r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.00019
(0.6 to 0.8)	Substantial	0.10966
(0.4 to 0.6)	Moderate	0.86285
(0.2 to 0.4)	Fair	0.99968
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_7)

Component 7 Consensus Rating	Count	Proportion
0	26	0.44
1	11	0.19
2	15	0.25
3	7	0.12

Component 8 – Location of Bolus at Time of Palatal-Pharyngeal Approximation

0 = No contrast beyond the oropharynx
1 = Contrast entry to the nasopharynx
2 = Contrast entry to the nasal cavity

Table of Rater Agreement:

c8r <- pulloutrating(analysis_reliab, oi_8)
  
ftable(c8r$HM, c8r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		18	4	3
1		2	4	2
2		1	4	19

Percentage Agreement

data.frame(sum(c8r$HM == c8r$KLM, na.rm=T)/nrow(na.omit(c8r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
71.9

IRR coefficients:

table <- table(c8r$HM, c8r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.590	0.089	(0.412,0.769)	1.521e-08
Kappa	Cohen’s Kappa	0.556	0.089	(0.378,0.734)	5.906e-08
Weighted Kappa	Cohen’s Kappa	0.639	0.084	(0.471,0.806)	3.106e-10

c8wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c8r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.01004
(0.6 to 0.8)	Substantial	0.45793
(0.4 to 0.6)	Moderate	0.98273
(0.2 to 0.4)	Fair	0.99999
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_8)

Component 8 Consensus Rating	Count	Proportion
0	25	0.42
1	11	0.19
2	23	0.39

Domain III – Airway Invasion/Laryngeal Closure

Component 9 – Early Laryngeal Vestibular Closure

0 = Complete; no air/contrast in laryngeal vestibule
1 = Trace column of air/contrast in laryngeal vestibule
2 = Narrow column of air/contrast in laryngeal vestibule
3 = Wide column of air/contrast in laryngeal vestibule

Table of Rater Agreement:

c9r <- pulloutrating(analysis_reliab, oi_9)
  
ftable(c9r$HM, c9r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3
HM
0		3	1	2	0
1		0	3	3	0
2		3	2	29	0
3		1	1	4	4

Percentage Agreement

data.frame(sum(c9r$HM == c9r$KLM, na.rm=T)/nrow(na.omit(c9r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
69.6

IRR coefficients:

table <- table(c9r$HM, c9r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.629	0.079	(0.471,0.787)	8.897e-11
Kappa	Cohen’s Kappa	0.447	0.104	(0.239,0.654)	6.889e-05
Weighted Kappa	Cohen’s Kappa	0.433	0.116	(0.201,0.664)	4.349e-04

c9wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c9r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.01572
(0.6 to 0.8)	Substantial	0.64327
(0.4 to 0.6)	Moderate	0.99805
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_9)

Component 9 Consensus Rating	Count	Proportion
0	4	0.07
1	5	0.08
2	41	0.69
3	9	0.15

Component 10 – Late Laryngeal Vestibular Closure

0 = Complete; no air/contrast in laryngeal vestibule
1 = Trace column of air/contrast in laryngeal vestibule
2 = Narrow column of air/contrast in laryngeal vestibule
3 = Wide column of air/contrast in laryngeal vestibule

Table of Rater Agreement:

c10r <- pulloutrating(analysis_reliab, oi_10)
c10r$HM <- factor(c10r$HM, levels=0:3)
c10r$KLM <- factor(c10r$KLM, levels=0:3)
  
ftable(c10r$HM, c10r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3
HM
0		6	8	0	0
1		0	18	6	0
2		0	4	8	2
3		1	0	3	0

Percentage Agreement

data.frame(sum(c10r$HM == c10r$KLM, na.rm=T)/nrow(na.omit(c10r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
57.1

IRR coefficients:

table <- table(c10r$HM, c10r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.452	0.087	(0.278,0.626)	2.953e-06
Kappa	Cohen’s Kappa	0.351	0.094	(0.163,0.539)	4.293e-04
Weighted Kappa	Cohen’s Kappa	0.458	0.084	(0.29,0.627)	1.196e-06

c10wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c10r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	4e-05
(0.6 to 0.8)	Substantial	0.04587
(0.4 to 0.6)	Moderate	0.72432
(0.2 to 0.4)	Fair	0.998
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_10)

Component 10 Consensus Rating	Count	Proportion
0	6	0.10
1	29	0.49
2	18	0.31
3	6	0.10

Component 11 – Timing of Airway Entry

0 = None, no airway entry 1 = Pre-swallow
2 = During swallow 3 = Post-swallow
4 = Any combination of 2 or more of the above

Table of Rater Agreement:

c11r <- pulloutrating(analysis_reliab, oi_11)
  
ftable(c11r$HM, c11r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3	4
HM
0		5	0	2	0	1
1		0	1	0	0	1
2		1	0	17	1	2
3		0	0	0	0	0
4		1	0	4	3	18

Percentage Agreement

data.frame(sum(c11r$HM == c11r$KLM, na.rm=T)/nrow(na.omit(c11r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
71.9

IRR coefficients:

table <- table(c11r$HM, c11r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.664	0.072	(0.52,0.808)	7.363e-13
Kappa	Cohen’s Kappa	0.573	0.087	(0.399,0.747)	1.661e-08
Weighted Kappa	Cohen’s Kappa	0.609	0.093	(0.424,0.795)	1.689e-08

c11wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c11r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.03075
(0.6 to 0.8)	Substantial	0.81263
(0.4 to 0.6)	Moderate	0.99987
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_11)

Component 11 Consensus Rating	Count	Proportion
0	7	0.12
1	2	0.03
2	22	0.37
4	28	0.47

Component 12 – Amount of Penetration

Original

0 = None
1 = Trace
2 = More than trace

Table of Rater Agreement:

c12r <- pulloutrating(analysis_reliab, oi_12)
  
ftable(c12r$HM, c12r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		5	1	2
1		0	3	3
2		3	4	37

Percentage Agreement

data.frame(sum(c12r$HM == c12r$KLM, na.rm=T)/nrow(na.omit(c12r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
77.6

IRR coefficients:

table <- table(c12r$HM, c12r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.717	0.074	(0.568,0.865)	1.288e-13
Kappa	Cohen’s Kappa	0.463	0.122	(0.218,0.708)	3.644e-04
Weighted Kappa	Cohen’s Kappa	0.501	0.128	(0.245,0.757)	2.426e-04

c12wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c12r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.13314
(0.6 to 0.8)	Substantial	0.94086
(0.4 to 0.6)	Moderate	0.99999
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_12)

Component 12 Consensus Rating	Count	Proportion
0	7	0.12
1	6	0.10
2	46	0.78

Update: Recode to Binary 0 and 1

0 = None
1 = Present (Trace or More than trace)

Table of Rater Agreement:

analysis_reliab$oi_12_binary <- ifelse(analysis_reliab$oi_12 == 0, 0, 1)
analysis_con$oi_12_binary <- ifelse(analysis_con$oi_12 == 0, 0, 1)

c12r <- pulloutrating(analysis_reliab, oi_12_binary)
  
ftable(c12r$HM, c12r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1
HM
0		5	3
1		3	47

Percentage Agreement

data.frame(sum(c12r$HM == c12r$KLM, na.rm=T)/nrow(na.omit(c12r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
89.7

IRR coefficients:

table <- table(c12r$HM, c12r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.864	0.057	(0.749,0.979)	0e+00
Kappa	Cohen’s Kappa	0.565	0.159	(0.247,0.883)	7.492e-04
Weighted Kappa	Cohen’s Kappa	0.565	0.159	(0.247,0.883)	7.492e-04

c12bwk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c12r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.86513
(0.6 to 0.8)	Substantial	1
(0.4 to 0.6)	Moderate	1
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_12_binary)

Component 12_binary Consensus Rating	Count	Proportion
0	7	0.12
1	52	0.88

Component 13 – Frequency of Penetration

0 = None
1 = 1 swallow
2 = Intermittent (>1 swallow and <50% of swallows)
3 = Repeated or frequent (≥50%)

Table of Rater Agreement:

c13r <- pulloutrating(analysis_reliab, oi_13)
  
ftable(c13r$HM, c13r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3
HM
0		5	0	1	2
1		0	1	2	1
2		3	1	22	2
3		0	1	4	13

Percentage Agreement

data.frame(sum(c13r$HM == c13r$KLM, na.rm=T)/nrow(na.omit(c13r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
70.7

IRR coefficients:

table <- table(c13r$HM, c13r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.627	0.077	(0.472,0.782)	4.575e-11
Kappa	Cohen’s Kappa	0.542	0.090	(0.361,0.723)	1.477e-07
Weighted Kappa	Cohen’s Kappa	0.527	0.105	(0.316,0.738)	5.617e-06

c13wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c13r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.01357
(0.6 to 0.8)	Substantial	0.63756
(0.4 to 0.6)	Moderate	0.99821
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_13)

Component 13 Consensus Rating	Count	Proportion
0	7	0.12
1	4	0.07
2	28	0.47
3	20	0.34

Domain IV – Aspiration

Component 14 – Amount of Aspiration

Original

0 = None
1 = Trace
2 = More than trace

Table of Rater Agreement:

c14r <- pulloutrating(analysis_reliab, oi_14)
  
ftable(c14r$HM, c14r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		24	2	2
1		3	5	4
2		0	2	16

Percentage Agreement

data.frame(sum(c14r$HM == c14r$KLM, na.rm=T)/nrow(na.omit(c14r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
77.6

IRR coefficients:

table <- table(c14r$HM, c14r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.674	0.082	(0.51,0.838)	2.874e-11
Kappa	Cohen’s Kappa	0.642	0.083	(0.476,0.807)	1.758e-10
Weighted Kappa	Cohen’s Kappa	0.729	0.071	(0.587,0.871)	1.377e-14

c14wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c14r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.0642
(0.6 to 0.8)	Substantial	0.8157
(0.4 to 0.6)	Moderate	0.99955
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_14)

Component 14 Consensus Rating	Count	Proportion
0	26	0.44
1	12	0.20
2	21	0.36

Update - Recode to Binary

0 = None
1 = Trace or More than Trace

Table of Rater Agreement:

analysis_reliab$oi_14_binary <- ifelse(analysis_reliab$oi_14 == 0, 0, 1)
analysis_con$oi_14_binary <- ifelse(analysis_con$oi_14 == 0, 0, 1)

c14r <- pulloutrating(analysis_reliab, oi_14_binary)
  
ftable(c14r$HM, c14r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1
HM
0		24	4
1		3	27

Percentage Agreement

data.frame(sum(c14r$HM == c14r$KLM, na.rm=T)/nrow(na.omit(c14r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
87.9

IRR coefficients:

table <- table(c14r$HM, c14r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.759	0.085	(0.588,0.93)	2.366e-12
Kappa	Cohen’s Kappa	0.758	0.086	(0.586,0.93)	2.761e-12
Weighted Kappa	Cohen’s Kappa	0.758	0.086	(0.586,0.93)	2.761e-12

c14wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c14r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.31644
(0.6 to 0.8)	Substantial	0.9676
(0.4 to 0.6)	Moderate	0.99998
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_14_binary)

Component 14_binary Consensus Rating	Count	Proportion
0	26	0.44
1	33	0.56

Component 15 – Frequency of Aspiration

0 = None
1 = 1 swallow
2 = Intermittent (>1 swallow and <50% of swallows)
3 = Repeated or frequent (≥50%)

Table of Rater Agreement:

c15r <- pulloutrating(analysis_reliab, oi_15)
  
ftable(c15r$HM, c15r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3
HM
0		24	2	2	0
1		2	4	9	0
2		1	1	8	0
3		0	1	1	3

Percentage Agreement

data.frame(sum(c15r$HM == c15r$KLM, na.rm=T)/nrow(na.omit(c15r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
67.2

IRR coefficients:

table <- table(c15r$HM, c15r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.579	0.082	(0.416,0.743)	2.255e-09
Kappa	Cohen’s Kappa	0.515	0.082	(0.35,0.68)	5.306e-08
Weighted Kappa	Cohen’s Kappa	0.632	0.077	(0.478,0.786)	2.894e-11

c15wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c15r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.0037
(0.6 to 0.8)	Substantial	0.40066
(0.4 to 0.6)	Moderate	0.98518
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_15)

Component 15 Consensus Rating	Count	Proportion
0	26	0.44
1	11	0.19
2	18	0.31
3	4	0.07

Domain V – Pharyngeal Transport and Clearance

Component 16 – Epiglottic Movement

0 = Complete
1 = Partial
2 = Absent

Table of Rater Agreement:

c16r <- pulloutrating(analysis_reliab, oi_16)
  
ftable(c16r$HM, c16r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		9	2	0
1		4	14	1
2		0	3	23

Percentage Agreement

data.frame(sum(c16r$HM == c16r$KLM, na.rm=T)/nrow(na.omit(c16r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
82.1

IRR coefficients:

table <- table(c16r$HM, c16r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.737	0.076	(0.585,0.89)	1.83e-13
Kappa	Cohen’s Kappa	0.721	0.078	(0.564,0.878)	1.009e-12
Weighted Kappa	Cohen’s Kappa	0.785	0.062	(0.661,0.91)	0e+00

c16wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c16r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.20793
(0.6 to 0.8)	Substantial	0.96297
(0.4 to 0.6)	Moderate	0.99999
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_16)

Component 16 Consensus Rating	Count	Proportion
0	12	0.20
1	20	0.34
2	27	0.46

Component 17 – Tongue Base (TB) Retraction

0 = No contrast between TB and posterior pharyngeal wall (PW)
1 = Trace column of contrast or air between TB and PW
2 = Narrow column of contrast or air between TB and PW
3 = Wide column of contrast or air between TB and PW
4 = No visible posterior motion of TB

Table of Rater Agreement:

c17r <- pulloutrating(analysis_reliab, oi_17)
  
ftable(c17r$HM, c17r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	1	2	3	4
HM
1		1	1	0	0
2		0	23	2	0
3		0	7	18	0
4		0	0	4	0

Percentage Agreement

data.frame(sum(c17r$HM == c17r$KLM, na.rm=T)/nrow(na.omit(c17r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
75

IRR coefficients:

table <- table(c17r$HM, c17r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.693	0.072	(0.548,0.838)	2.345e-13
Kappa	Cohen’s Kappa	0.554	0.096	(0.361,0.748)	4.116e-07
Weighted Kappa	Cohen’s Kappa	0.601	0.084	(0.432,0.77)	2.336e-09

c17wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c17r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.07097
(0.6 to 0.8)	Substantial	0.89931
(0.4 to 0.6)	Moderate	0.99997
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_17)

Component 17 Consensus Rating	Count	Proportion
1	1	0.02
2	27	0.46
3	28	0.47
4	3	0.05

Component 18 – Pharyngeal Stripping Wave

Original

0 = Present, complete
1 = Present, diminished
2 = Absent

Table of Rater Agreement:

c18r <- pulloutrating(analysis_reliab, oi_18)
  
ftable(c18r$HM, c18r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2
HM
0		10	11	0
1		2	16	1
2		1	6	9

Percentage Agreement

data.frame(sum(c18r$HM == c18r$KLM, na.rm=T)/nrow(na.omit(c18r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
62.5

IRR coefficients:

table <- table(c18r$HM, c18r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.449	0.095	(0.259,0.64)	1.623e-05
Kappa	Cohen’s Kappa	0.434	0.094	(0.245,0.622)	2.38e-05
Weighted Kappa	Cohen’s Kappa	0.506	0.091	(0.324,0.688)	7.622e-07

c18wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c18r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.00013
(0.6 to 0.8)	Substantial	0.05786
(0.4 to 0.6)	Moderate	0.696
(0.2 to 0.4)	Fair	0.99532
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_18)

Component 18 Consensus Rating	Count	Proportion
0	16	0.27
1	27	0.46
2	16	0.27

Update: Recode to Binary 0 and 1

0 = None
1 = Present (complete or diminished)

Table of Rater Agreement:

analysis_reliab$oi_18_binary <- ifelse(analysis_reliab$oi_18 == 0, 0, 1)
analysis_con$oi_18_binary <- ifelse(analysis_con$oi_18 == 0, 0, 1)

c18r <- pulloutrating(analysis_reliab, oi_18_binary)
  
ftable(c18r$HM, c18r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1
HM
0		10	11
1		3	32

Percentage Agreement

data.frame(sum(c18r$HM == c18r$KLM, na.rm=T)/nrow(na.omit(c18r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
75

IRR coefficients:

table <- table(c18r$HM, c18r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.567	0.113	(0.34,0.793)	5.835e-06
Kappa	Cohen’s Kappa	0.423	0.123	(0.176,0.67)	1.156e-03
Weighted Kappa	Cohen’s Kappa	0.423	0.123	(0.176,0.67)	1.156e-03

c18bwk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c18r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.02037
(0.6 to 0.8)	Substantial	0.38558
(0.4 to 0.6)	Moderate	0.92831
(0.2 to 0.4)	Fair	0.99935
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_18_binary)

Component 18_binary Consensus Rating	Count	Proportion
0	16	0.27
1	43	0.73

Component 19 – Valleculae Residue

0 = None, complete clearance of contrast
1 = Trace amount
2 = Collection
3 = Majority of bolus
4 = No clearance of bolus

Table of Rater Agreement:

c19r <- pulloutrating(analysis_reliab, oi_19)
  
ftable(c19r$HM, c19r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	1	2	3	4
HM
1		6	4	0	0
2		2	20	2	0
3		0	2	8	4
4		0	3	1	4

Percentage Agreement

data.frame(sum(c19r$HM == c19r$KLM, na.rm=T)/nrow(na.omit(c19r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
67.9

IRR coefficients:

table <- table(c19r$HM, c19r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.584	0.082	(0.42,0.749)	2.396e-09
Kappa	Cohen’s Kappa	0.529	0.089	(0.351,0.708)	2.078e-07
Weighted Kappa	Cohen’s Kappa	0.618	0.079	(0.46,0.776)	1.571e-10

c19wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c19r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.00461
(0.6 to 0.8)	Substantial	0.4251
(0.4 to 0.6)	Moderate	0.987
(0.2 to 0.4)	Fair	1
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_19)

Component 19 Consensus Rating	Count	Proportion
1	9	0.15
2	23	0.39
3	12	0.20
4	15	0.25

Component 20 – Pyriform Residue

0 = None, complete clearance of contrast
1 = Trace amount
2 = Collection
3 = Majority of bolus
4 = No clearance of bolus

Table of Rater Agreement:

c20r <- pulloutrating(analysis_reliab, oi_20)
  
ftable(c20r$HM, c20r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3	4
HM
0		3	5	0	0	0
1		0	3	3	0	0
2		0	3	14	3	0
3		0	0	2	8	4
4		0	0	2	2	4

Percentage Agreement

data.frame(sum(c20r$HM == c20r$KLM, na.rm=T)/nrow(na.omit(c20r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
57.1

IRR coefficients:

table <- table(c20r$HM, c20r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.472	0.082	(0.307,0.637)	4.484e-07
Kappa	Cohen’s Kappa	0.435	0.084	(0.266,0.604)	3.546e-06
Weighted Kappa	Cohen’s Kappa	0.636	0.062	(0.511,0.76)	2.42e-14

c20wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c20r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	4e-05
(0.6 to 0.8)	Substantial	0.06153
(0.4 to 0.6)	Moderate	0.80585
(0.2 to 0.4)	Fair	0.99946
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_20)

Component 20 Consensus Rating	Count	Proportion
0	3	0.05
1	11	0.19
2	18	0.31
3	12	0.20
4	15	0.25

Component 21 – Pharyngoesophageal Segment (Upper Esophageal Sphincter)

0 = Complete distention or full duration; no obstruction of bolus movement
1 = Partial distension or partial duration; partial obstruction of bolus movement
2 = Minimal distension or incomplete duration; marked obstruction of bolus movement
3 = No distension with total obstruction of bolus movement

Table of Rater Agreement:

c21r <- pulloutrating(analysis_reliab, oi_21)
  
ftable(c21r$HM, c21r$KLM, dnn = c("HM", "KLM")) %>% 
  pander()

	KLM	0	1	2	3
HM
0		9	8	0	0
1		1	11	2	0
2		0	2	11	4
3		0	0	4	4

Percentage Agreement

data.frame(sum(c21r$HM == c21r$KLM, na.rm=T)/nrow(na.omit(c21r))*100) %>% 
  kable(col.names = "Percent Agreement", digits=1, align = "l")

Percent Agreement
62.5

IRR coefficients:

table <- table(c21r$HM, c21r$KLM, dnn = c("H", "W"))
weights <- Kappa(table)$Weights

bind_rows("Agreement Coefficient" = gwet.ac1.table(table), 
          "Kappa" =  kappa2.table(table), 
          "Weighted Kappa" = kappa2.table(table, weights=weights), .id="Type") %>% 
  kable(digits=3)

Type	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
Agreement Coefficient	Gwet’s AC1	0.504	0.086	(0.332,0.676)	2.614e-07
Kappa	Cohen’s Kappa	0.493	0.085	(0.322,0.664)	3.654e-07
Weighted Kappa	Cohen’s Kappa	0.663	0.059	(0.544,0.782)	8.882e-16

c21wk <- kappa2.table(table, weights=weights)

Interpreting AC1: Gwet recommends to “retain an agreement strength level that is associated with ComProb that exceeds 0.95.”

ac1 <- gwet.ac1.raw(na.omit(c21r[,-1]))$est
landis.koch.bf(ac1$coeff.val, ac1$coeff.se) %>% 
  kable()

	Landis-Koch	CumProb
(0.8 to 1)	Almost Perfect	0.00032
(0.6 to 0.8)	Substantial	0.13408
(0.4 to 0.6)	Moderate	0.88504
(0.2 to 0.4)	Fair	0.99977
(0 to 0.2)	Slight	1
(-1 to 0)	Poor	1

Consensus Agreement:

OIprop.table(analysis_con, oi_21)

Component 21 Consensus Rating	Count	Proportion
0	16	0.27
1	15	0.25
2	13	0.22
3	15	0.25

Overall weighted kappas

#combine all in table
wkappavals <- data.frame()

for (i in grep("c[[:digit:]]{1,2}wk", ls(), value=T)) {
  temp <- get(i)
  temp$component = gsub("c|wk", "", i)
  wkappavals <- bind_rows(wkappavals, temp)
}

wkappavals %>% 
  relocate(component) %>% 
  arrange(coeff.val) %>% 
  kable(digits = 3)

component	coeff.name	coeff.val	coeff.se	coeff.ci	coeff.pval
9	Cohen’s Kappa	0.433	0.116	(0.201,0.664)	4.349e-04
10	Cohen’s Kappa	0.458	0.084	(0.29,0.627)	1.196e-06
5	Cohen’s Kappa	0.487	0.154	(0.179,0.795)	2.45e-03
12	Cohen’s Kappa	0.501	0.128	(0.245,0.757)	2.426e-04
18	Cohen’s Kappa	0.506	0.091	(0.324,0.688)	7.622e-07
13	Cohen’s Kappa	0.527	0.105	(0.316,0.738)	5.617e-06
6	Cohen’s Kappa	0.546	0.097	(0.352,0.741)	6.27e-07
7	Cohen’s Kappa	0.551	0.084	(0.382,0.72)	2.121e-08
17	Cohen’s Kappa	0.601	0.084	(0.432,0.77)	2.336e-09
11	Cohen’s Kappa	0.609	0.093	(0.424,0.795)	1.689e-08
19	Cohen’s Kappa	0.618	0.079	(0.46,0.776)	1.571e-10
15	Cohen’s Kappa	0.632	0.077	(0.478,0.786)	2.894e-11
20	Cohen’s Kappa	0.636	0.062	(0.511,0.76)	2.42e-14
8	Cohen’s Kappa	0.639	0.084	(0.471,0.806)	3.106e-10
21	Cohen’s Kappa	0.663	0.059	(0.544,0.782)	8.882e-16
2	Cohen’s Kappa	0.733	0.104	(0.518,0.947)	1.902e-07
3	Cohen’s Kappa	0.742	0.081	(0.575,0.908)	7.049e-10
14	Cohen’s Kappa	0.758	0.086	(0.586,0.93)	2.761e-12
16	Cohen’s Kappa	0.785	0.062	(0.661,0.91)	0e+00
1	Cohen’s Kappa	0.925	0.073	(0.775,1)	7.738e-13
4	Cohen’s Kappa	NaN	NaN	(NaN,NaN)	NaN

Swallowtail Reliability

Need the reliability exams/raters and which measures (best, worst, mean) to use for reliability.

Because this data is continuous, rather than ordinal like the BabyVFSSimP, an intraclass correlation coefficient will be used to assess reliability between the two raters.

# add rater 
sma_reliability1 <- sma_reliability %>% 
  filter(Measurement_name == "PESop" | Measurement_name == "PCR") %>% 
  select(Subject.ID, datafile, Measurement_name, Mean, Worst_OI, Best_OI, Worst_OI_5p) %>% 
  pivot_wider(names_from = "Measurement_name", 
              values_from = c("Mean", "Worst_OI", "Best_OI", "Worst_OI_5p")) %>% 
  group_by(Subject.ID) %>% 
  arrange(datafile) %>% 
  mutate(rater = 1:2)

PCR

Mean

mpcr <- sma_reliability1 %>% 
  select(Subject.ID, rater, Mean_PCR) %>% 
  pivot_wider(names_from = rater, 
              values_from = Mean_PCR, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(mpcr, model= "twoway", type = "consistency", unit = "average")

 Average Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 15 
     Raters = 2 
   ICC(C,2) = 0.777

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(14,14) = 4.49 , p = 0.00405 

 95%-Confidence Interval for ICC Population Values:
  0.337 < ICC < 0.925

Best

bpcr <- sma_reliability1 %>% 
  select(Subject.ID, rater, Best_OI_PCR) %>% 
  pivot_wider(names_from = rater, 
              values_from = Best_OI_PCR, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(bpcr, model= "twoway", type = "consistency", unit = "single")

 Single Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 15 
     Raters = 2 
   ICC(C,1) = -0.02

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(14,14) = 0.961 , p = 0.529 

 95%-Confidence Interval for ICC Population Values:
  -0.512 < ICC < 0.482

Worst

wpcr <- sma_reliability1 %>% 
  select(Subject.ID, rater, Worst_OI_PCR) %>% 
  pivot_wider(names_from = rater, 
              values_from = Worst_OI_PCR, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(wpcr, model= "twoway", type = "consistency", unit = "single")

 Single Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 15 
     Raters = 2 
   ICC(C,1) = 0.376

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(14,14) = 2.21 , p = 0.0754 

 95%-Confidence Interval for ICC Population Values:
  -0.149 < ICC < 0.736

Worst - average of worst 5% of scores

w5pcr <- sma_reliability1 %>% 
  select(Subject.ID, rater, Worst_OI_5p_PCR) %>% 
  pivot_wider(names_from = rater, 
              values_from = Worst_OI_5p_PCR, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(w5pcr, model= "twoway", type = "consistency", unit = "single")

 Single Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 15 
     Raters = 2 
   ICC(C,1) = 0.543

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(14,14) = 3.38 , p = 0.0148 

 95%-Confidence Interval for ICC Population Values:
  0.063 < ICC < 0.819

PeSOP

Mean

mpesop <- sma_reliability1 %>% 
  select(Subject.ID, rater, Mean_PESop) %>% 
  pivot_wider(names_from = rater, 
              values_from = Mean_PESop, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(mpesop, model= "twoway", type = "consistency", unit = "average")

 Average Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 14 
     Raters = 2 
   ICC(C,2) = 0.716

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(13,13) = 3.52 , p = 0.0154 

 95%-Confidence Interval for ICC Population Values:
  0.116 < ICC < 0.909

Best

bpesop <- sma_reliability1 %>% 
  select(Subject.ID, rater, Best_OI_PESop) %>% 
  pivot_wider(names_from = rater, 
              values_from = Best_OI_PESop, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(bpesop, model= "twoway", type = "consistency", unit = "single")

 Single Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 14 
     Raters = 2 
   ICC(C,1) = 0.19

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(13,13) = 1.47 , p = 0.249 

 95%-Confidence Interval for ICC Population Values:
  -0.359 < ICC < 0.641

Worst

wpesop <- sma_reliability1 %>% 
  select(Subject.ID, rater, Worst_OI_PESop) %>% 
  pivot_wider(names_from = rater, 
              values_from = Worst_OI_PESop, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(wpesop, model= "twoway", type = "consistency", unit = "single")

 Single Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 14 
     Raters = 2 
   ICC(C,1) = 0.0803

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(13,13) = 1.17 , p = 0.388 

 95%-Confidence Interval for ICC Population Values:
  -0.452 < ICC < 0.571

Worst - average of worst 5% of scores

w5pesop <- sma_reliability1 %>% 
  select(Subject.ID, rater, Worst_OI_5p_PESop) %>% 
  pivot_wider(names_from = rater, 
              values_from = Worst_OI_5p_PESop, 
              names_prefix = "rater") %>% 
  ungroup() %>% 
  select(-Subject.ID)

icc(w5pesop, model= "twoway", type = "consistency", unit = "single")

 Single Score Intraclass Correlation

   Model: twoway 
   Type : consistency 

   Subjects = 14 
     Raters = 2 
   ICC(C,1) = -0.0128

 F-Test, H0: r0 = 0 ; H1: r0 > 0 
   F(13,13) = 0.975 , p = 0.518 

 95%-Confidence Interval for ICC Population Values:
  -0.523 < ICC < 0.505

Reliability & OI Score Analysis

2025-08-11

Data Prep

Calculate Reliability Ratings

Reliability and OI by Component

Domain I - Lingual Motion/Pharyngeal Swallow Initiation

Component 1: Initiation of Nutritive Sucks (NS)

Component 2 – Number of Sucks to Form Bolus

Component 3 – Nutritive Suck Rhythmicity

Component 4 – Suck/Swallow Bolus Control

Component 5 – Bolus Location at Initiation of Pharyngeal Swallow

Component 6 – Timing of Initiation of Pharyngeal Swallow

Domain II – Palatal-Pharyngeal Approximation

Component 7 – Palatal-Pharyngeal Approximation/Palatal Integrity

Component 8 – Location of Bolus at Time of Palatal-Pharyngeal Approximation

Domain III – Airway Invasion/Laryngeal Closure

Component 9 – Early Laryngeal Vestibular Closure

Component 10 – Late Laryngeal Vestibular Closure

Component 11 – Timing of Airway Entry

Component 12 – Amount of Penetration

Component 13 – Frequency of Penetration

Domain IV – Aspiration

Component 14 – Amount of Aspiration

Component 15 – Frequency of Aspiration

Domain V – Pharyngeal Transport and Clearance

Component 16 – Epiglottic Movement

Component 17 – Tongue Base (TB) Retraction

Component 18 – Pharyngeal Stripping Wave

Component 19 – Valleculae Residue

Component 20 – Pyriform Residue

Component 21 – Pharyngoesophageal Segment (Upper Esophageal Sphincter)

Overall weighted kappas

Swallowtail Reliability

PCR

Mean

Best

Worst

Worst - average of worst 5% of scores

PeSOP

Mean

Best

Worst

Worst - average of worst 5% of scores