Modified

April 22, 2025

Poster title

Synthesizing evidence about developmental patterns in human visual acuity as measured by Teller Acuity Cards

Authors

Rick Gilmore (rog1@psu.edu), Julia DiFulvio, Brianna Beamer, Nicole Cruz; The Pennsylvania State University

Abstract

Replication is a cornerstone of scientific rigor and a prerequisite for cumulative science. This project synthesized evidence from published research that employed a widely used measure of grating visual acuity (VA), Teller Acuity Cards (TAC). We sought to capture findings about the development of VA in early childhood into an aggregated dataset and share the dataset openly. Online literature searches identified papers that mentioned “teller acuity cards”, “visual acuity cards”, or “teller cards”. We found n=745 papers published from 1974-2024. Next, we identified empirical papers that used TAC to measure VA and which reported VA in an extractable tabular form. To-date, n=250 of 316 papers with available PDF versions have been evaluated and n=14 have been identified that present extractable data meeting our screening criteria. Available datasets represent more than n=3,991 participants and 7 countries (Australia, Brazil, Canada, China, Italy, Mexico, and the U.S.). As expected, group VA increases from birth to 36-months, with faster rates of change among children tested binocularly (0.47 cyc/deg per month) than those tested monocularly (0.35 cyc/deg per month). Group VA values at similar ages vary substantially across studies, especially in children older than 12 months. Our synthesis of published TAC VA data confirms anticipated age-related trends and points to avenues for future research, particularly regarding what factors account for cross-study and by-country differences in rates of development. We hope our soon-to-be openly shared dataset contributes toward a more cumulative science of visual development.

Status

The poster was accepted on February 6, 2025. It will be presented as follows:

Poster Session: Development: Infants, children
Date/Time: Sunday, May 18, 2025, 2:45 – 6:45 pm
Location: Pavilion

Visualization

The following code documents our data visualization work.

Setup

Code 
library(googledrive)
library(ggplot2)
library(readr)
library(dplyr)

Attaching package: 'dplyr'
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

Import

We use a Google Sheet to store the by-study data:

https://docs.google.com/spreadsheets/d/1UFZkbh9oU4JHpYsrkDQcNmDyqD4J-qB74dhyMzIkqKs/edit#gid=0

The Google Sheet has multiple tabs:

  • The typical_group tab contains group data from typically developing children.
  • The typical_indiv tab contains data from typically developing individual children.
  • The atypical_group tab contains group data from atypically developing children.
  • The atypical_indiv tab contains data from atypically developing individual children.
Code 
# Define a helper function

import_save_TAC <- function(sheet_name = "typical_group",
                            csv_name = "typical_group.csv") {
  
  this_sheet <- googlesheets4::read_sheet(ss = params$google_data_url,
                            sheet = sheet_name)
  out_fn <- file.path(params$data_dir, csv_name)
  readr::write_csv(this_sheet, out_fn)
  message("Data updated: ", out_fn)
}

# Create data files
if (!dir.exists(params$data_dir)) {
  message("Creating missing ",  params$data_dir, ".")
  dir.create(params$data_dir)
}

if (params$update_data) {
  if (params$use_sysenv_creds) {
    google_creds <- Sys.getenv("GMAIL_SURVEY")
    if (google_creds != "") {
      options(gargle_oauth_email = google_creds)
      googledrive::drive_auth()
    } else {
      message("No Google account information stored in `.Renviron`.")
      message(
        "Add authorized Google account name to `.Renviron` using `usethis::edit_r_environ()`."
      )
    }
  }
  
  purrr::map2(
    c(
      "typical_group",
      "typical_indiv",
      "atypical_group",
      "atypical_indiv"
    ),
    c(
      "typical_group.csv",
      "typical_indiv.csv",
      "atypical_group.csv",
      "atypical_indiv.csv"
    ),
    import_save_TAC
  )
  
  # import_save_TAC()
  
  # this_sheet <- googlesheets4::read_sheet(ss = params$google_data_url,
  #                           sheet = params$sheet_name)
  # out_fn <- file.path(params$data_dir, params$data_fn)
  # readr::write_csv(this_sheet, out_fn)
  # message("Data updated: ", out_fn)
} else {
  message("Using stored data.")
}
✔ Reading from "Legacy Project Acuity Data: By Paper".
✔ Range ''typical_group''.
Data updated: data/csv/typical_group.csv
✔ Reading from "Legacy Project Acuity Data: By Paper".
✔ Range ''typical_indiv''.
Data updated: data/csv/typical_indiv.csv
✔ Reading from "Legacy Project Acuity Data: By Paper".
✔ Range ''atypical_group''.
Data updated: data/csv/atypical_group.csv
✔ Reading from "Legacy Project Acuity Data: By Paper".
✔ Range ''atypical_indiv''.
Data updated: data/csv/atypical_indiv.csv
[[1]]
NULL

[[2]]
NULL

[[3]]
NULL

[[4]]
NULL

Visualize

We’ll create visualizations for each group of data separately.

Typical Group

Code 
typ_group_df <-
  readr::read_csv(file.path(params$data_dir, "typical_group.csv"), show_col_types = FALSE)
Important

Rick Gilmore decided to take the mean of the age range reported in the (Xiang et al., 2021) data and create a new variable strictly for visualization purposes, age_grp_rog.

Code 
typ_group_df |>
  dplyr::mutate(author_date = paste0(author_first, "_", pub_year)) |>
  ggplot() +
  aes(
    x = age_grp_rog,
    y = central_tendency_cyc_deg,
    color = author_year
  ) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
  scale_y_continuous(limits = c(0, 30))
`geom_smooth()` using formula = 'y ~ x'
Warning: Removed 2 rows containing missing values or values outside the scale range
(`geom_smooth()`).
Figure 5.1: Developmental time course of mean grating acuity (in cyc/deg) for typically developing children as assessed by Teller Acuity Cards

Let’s try a version where we highlight the individual studies and the group trends.

Code 
typ_group_df |>
  #dplyr::mutate(author_date = paste0(author_first, "_", pub_year)) |>
  ggplot() +
  aes(
    x = age_grp_rog,
    y = central_tendency_cyc_deg,
    color = author_year
  ) +
  geom_point() +
  geom_line(aes(group = author_year)) +
  geom_smooth(aes(group = 1), se = TRUE) +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  scale_y_continuous(limits = c(0, 30)) +
  theme(legend.position = "none")
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Warning: The following aesthetics were dropped during statistical transformation:
colour.
ℹ This can happen when ggplot fails to infer the correct grouping structure in
  the data.
ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
  variable into a factor?
The following aesthetics were dropped during statistical transformation:
colour.
ℹ This can happen when ggplot fails to infer the correct grouping structure in
  the data.
ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
  variable into a factor?
Figure 5.2: Developmental time course of mean grating acuity (in cyc/deg) for typically developing children as assessed by Teller Acuity Cards

Generate a comparable figure with the n’s.

Code 
library(forcats)
library(dplyr)
typ_group_df |>
  filter(!is.na(n_participants)) |>
  group_by(binoc_monoc, author_year) |>
  summarize(n_subs = sum(n_participants)) |>
  mutate(author_year = fct_reorder(author_year, n_subs)) |>
  ggplot() +
  aes(
    x = author_year,
    y = n_subs,
    fill = author_year
  ) +
  geom_col() +
  facet_grid(cols = vars(binoc_monoc)) +
  coord_flip() +
  theme(legend.position = "none") +
  xlab("Source") +
  ylab("n observations")
`summarise()` has grouped output by 'binoc_monoc'. You can override using the
`.groups` argument.
Figure 5.3

Here’s one with a linear fit, points and no by-study lines.

Code 
typ_group_df |>
  dplyr::mutate(author_date = paste0(author_first, "_", pub_year)) |>
  ggplot() +
  aes(
    x = age_grp_rog,
    y = central_tendency_cyc_deg,
  ) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
  scale_y_continuous(limits = c(0, 30)) +
    theme_classic()
`geom_smooth()` using formula = 'y ~ x'
Figure 5.4: Developmental time course of mean grating acuity (in cyc/deg) for typically developing children as assessed by Teller Acuity Cards

Let’s limit consideration to children below three.

Code 
typ_group_df |>
  dplyr::filter(age_grp_rog <= 36) |>
  mutate(card_type = toupper(card_type)) |>
  ggplot() +
  aes(
    x = age_grp_rog,
    y = central_tendency_cyc_deg,
    color = card_type
  ) +
  geom_point() +
  geom_smooth(se = TRUE) +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
  scale_y_continuous(limits = c(0, 30)) +
  theme(legend.position = "bottom", legend.title = element_blank())
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Figure 5.5: Developmental time course of mean grating acuity (in cyc/deg) for typically developing children as assessed by two types of Teller Acuity Cards, TAC-I and TAC-II. loess fit added.
Code 
typ_group_df |>
  dplyr::mutate(author_date = paste0(author_first, "_", pub_year)) |>
  dplyr::filter(age_grp_rog <= 36) |>
  ggplot() +
  aes(
    x = age_grp_rog,
    y = central_tendency_cyc_deg,
    color = binoc_monoc
  ) +
  geom_point() +
  geom_smooth(se = TRUE, ) +
  #facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
  scale_y_continuous(limits = c(0, 30))
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Figure 5.6: Developmental time course of mean grating acuity (in cyc/deg) for typically developing children as assessed by Teller Acuity Cards

Let’s look at TAC-I vs. TAC-II

Code 
typ_group_df |>
  dplyr::mutate(author_date = paste0(author_first, "_", pub_year)) |>
  dplyr::filter(age_grp_rog <= 36) |>
  dplyr::mutate(card_type = stringr::str_to_upper(card_type)) |>
  ggplot() +
  aes(
    x = age_grp_rog,
    y = central_tendency_cyc_deg,
    color = card_type
  ) +
  geom_point() +
  geom_smooth(se = TRUE) +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
  scale_y_continuous(limits = c(0, 30))
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Figure 5.7: Developmental time course of mean grating acuity (in cyc/deg) for typically developing children 3 and younger as assessed by Teller Acuity Cards. Comparison between TAC-I and TAC-II cards by binocular vs. monocular testing.

Variability

We need helper functions for converting standard deviation into consistent units.

Code 
sd_from_conf_bound <- function(mean, bound, n, p = .95) {
  ci_length <- abs(mean-bound)
  if (p == .95) {
    (ci_length/3.92)*sqrt(n)
  } else if( p == .90) {
    (ci_length/3.29)*sqrt(n)
  }
}

sd_to_octaves <- function(mean, sd) {
  log2(sd/mean)
}

# Tolerance intervals
#https://www.itl.nist.gov/div898/handbook/prc/section2/prc263.htm
# https://www.itl.nist.gov/div898/handbook/prc/section2/prc263.r
n = 43
p = 0.90 # proportion of population
g = 0.99 # confidence interval
nu = n-1
zp = qnorm(p)
zg = qnorm(g)
a = 1 - ((zg**2)/(2*nu))
b = zp**2 - (zg**2)/n
k1 = (zp + (zp**2 - a*b)**.5)/a
c(a,b,k1)
[1] 0.9355727 1.5165164 1.8751896

Many of the studies report variability in terms of octaves.

Code 
typ_group_df_sd <- typ_group_df |>
  dplyr::filter(sd_units %in% c("cyc_deg", "octave"),
                !is.na(sd)) |>
  dplyr::mutate(sd_oct = if_else(sd_units == "cyc_deg", log2(sd), sd))

typ_group_df_sd |>
  ggplot() +
  aes(x = central_tendency_cyc_deg, y = sd) +
  geom_point()
Figure 5.8: Relationship between the standard deviation (SD) of estimated visual acuity (cyc/deg) observed in typically developing children as assessed by Teller Acuity Cards.

Here is one with more styling.

Code 
typ_group_df_sd |>
  mutate(card_type = toupper(card_type)) |>
  ggplot() +
  aes(x = central_tendency_cyc_deg, y = sd, color = card_type) +
  geom_point() +
  geom_smooth() +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Acuity (cyc/deg)") +
  ylab("sd (octaves)") +
  theme(legend.position = "bottom", legend.title = element_blank())
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Figure 5.9: Relationship between the standard deviation (SD in octaves) of estimated visual acuity (cyc/deg) observed in typically developing children as assessed by Teller Acuity Cards and the mean or median acuity in cyc/deg.
Code 
typ_group_df_sd |>
  mutate(card_type = toupper(card_type)) |>
  ggplot() +
  aes(x = age_grp_rog, y = sd, color = card_type) +
  geom_point() +
  geom_smooth() +
  facet_grid(cols = vars(binoc_monoc)) +
  xlab("Age (mos)") +
  ylab("sd (octaves)") +
  theme(legend.position = "bottom", legend.title = element_blank())
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Figure 5.10: Relationship between the standard deviation (SD in octaves) of estimated visual acuity (cyc/deg) observed in typically developing children as assessed by Teller Acuity Cards and child age in months.

Tabular summaries

Code 
typ_group_df_binoc <- typ_group_df |>
  dplyr::select(author_year, age_grp_rog, binoc_monoc, n_participants) |>
  dplyr::filter(binoc_monoc == "binoc") 

typ_group_df_binoc |>
  group_by(author_year) |>
  dplyr::arrange(author_year) |>
  
  dplyr::summarise(tot_participants = sum(n_participants)) |>
  kableExtra::kable(format = 'html') |>
  kableExtra::kable_material()
Table 5.1: Participants tested binocularly by study
author_year tot_participants
Brown1986 40
Cavallini2002 414
Courage1990 140
Dobson1987 30
Heersema1988 40
Heersema1990 20
Kohl1988 36
Leone2014 544
McDonald1985 16
McDonald1986a 20
McDonald1986b 18
Rodriguez1996 150
Salomao1995 646
Sarbajna2024 74
Teller1986 247
Wen2022 155
Xiang2021 215
van Hof-van Duin1986 NA

There were n=NA participants tested binocularly from n=18 studies.

Code 
typ_group_df_monoc <- typ_group_df |>
  dplyr::select(author_first, pub_year, age_grp_rog, binoc_monoc, n_participants) |>
  dplyr::filter(binoc_monoc == "monoc") 

typ_group_df_monoc |>
  group_by(pub_year, author_first) |>
  dplyr::arrange(pub_year) |>
  dplyr::summarise(tot_participants = sum(n_participants)) |>
  kableExtra::kable(format = 'html') |>
  kableExtra::kable_material()
`summarise()` has grouped output by 'pub_year'. You can override using the
`.groups` argument.
Table 5.2: Participants tested monocularly by study
pub_year author_first tot_participants
NA Leone 442
NA Mayer 911
NA Salomao 624
NA Sarbajna 151
NA Teller 71
NA Xiang 208

There were n=2407 participants tested monocularly.

Atypical Group

Code 
atyp_group_df <-
  readr::read_csv(file.path(params$data_dir, "atypical_group.csv"), show_col_types = FALSE)
str(atyp_group_df)
spc_tbl_ [60 × 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ BIBTEXKEY                     : chr [1:60] "Mash1998-sg" "Mash1998-sg" "Mash1998-sg" "Mash1998-sg" ...
 $ author_first                  : chr [1:60] "Mash" "Mash" "Mash" "Mash" ...
 $ title                         : chr [1:60] "Long-term reliability and predictive validity of the teller acuity card procedure" "Long-term reliability and predictive validity of the teller acuity card procedure" "Long-term reliability and predictive validity of the teller acuity card procedure" "Long-term reliability and predictive validity of the teller acuity card procedure" ...
 $ condition                     : chr [1:60] "preterm_birth" "preterm_birth" "preterm_birth" "preterm_birth" ...
 $ age_mos                       : num [1:60] 4 8 11 17 24 30 36 48 4 8 ...
 $ binoc_minoc                   : chr [1:60] "monoc" "monoc" "monoc" "monoc" ...
 $ eye                           : chr [1:60] "OD" "OD" "OD" "OD" ...
 $ n_participants                : num [1:60] 95 103 90 82 83 95 105 125 95 103 ...
 $ mean_acuity                   : num [1:60] 2.18 3.87 3.53 5.6 7.05 ...
 $ acuity_units                  : chr [1:60] "cyc_deg" "cyc_deg" "cyc_deg" "cyc_deg" ...
 $ mean_acuity_standard_deviation: num [1:60] 0.76 0.66 0.8 0.76 0.76 0.76 0.66 0.53 0.73 0.63 ...
 $ std_dev_units                 : chr [1:60] "cyc_deg" "cyc_deg" "cyc_deg" "cyc_deg" ...
 $ indiv_eye_acuity_cyc_deg      : logi [1:60] NA NA NA NA NA NA ...
 $ st_dev_indiv_eye              : logi [1:60] NA NA NA NA NA NA ...
 $ country                       : chr [1:60] "united_states" "united_states" "united_states" "united_states" ...
 $ card_type                     : chr [1:60] "tac_i" "tac_i" "tac_i" "tac_i" ...
 - attr(*, "spec")=
  .. cols(
  ..   BIBTEXKEY = col_character(),
  ..   author_first = col_character(),
  ..   title = col_character(),
  ..   condition = col_character(),
  ..   age_mos = col_double(),
  ..   binoc_minoc = col_character(),
  ..   eye = col_character(),
  ..   n_participants = col_double(),
  ..   mean_acuity = col_double(),
  ..   acuity_units = col_character(),
  ..   mean_acuity_standard_deviation = col_double(),
  ..   std_dev_units = col_character(),
  ..   indiv_eye_acuity_cyc_deg = col_logical(),
  ..   st_dev_indiv_eye = col_logical(),
  ..   country = col_character(),
  ..   card_type = col_character()
  .. )
 - attr(*, "problems")=<externalptr>

Some of the acuity measurements were in LogMAR, so we must transform these to cycles per degree before plotting.

Code 
logMAR_to_cyc_per_deg <- function(logMARmin) {
  60/(10^(logMARmin))
}

atyp_group_df <- atyp_group_df |>
  dplyr::mutate(central_tendency_cyc_deg = if_else(acuity_units == "cyc_deg", mean_acuity, 
                                              logMAR_to_cyc_per_deg(mean_acuity)))
Code 
atyp_group_df |>
  ggplot() +
  aes(
    x = age_mos,
    y = central_tendency_cyc_deg,
    color = eye
  ) +
  geom_point() +
  geom_smooth(se = FALSE) +
  facet_grid(cols = vars(condition)) +
  xlab("Age (mos)") +
  ylab("Mean acuity (cyc/deg)") +
  theme(legend.position = "bottom") +
  scale_y_continuous(limits = c(0, 30))
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
: span too small.  fewer data values than degrees of freedom.
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
: pseudoinverse used at 2.955
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
: neighborhood radius 6.045
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
: reciprocal condition number 0
Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
: There are other near singularities as well. 36.542
Figure 5.11: Developmental time course of mean grating acuity (in cyc/deg) for atypically developing children as assessed by Teller Acuity Cards

Typical Individual

Code 
typ_indiv_df <-
  readr::read_csv(file.path(params$data_dir, "typical_indiv.csv"), show_col_types = FALSE)
str(atyp_group_df)
tibble [60 × 17] (S3: tbl_df/tbl/data.frame)
 $ BIBTEXKEY                     : chr [1:60] "Mash1998-sg" "Mash1998-sg" "Mash1998-sg" "Mash1998-sg" ...
 $ author_first                  : chr [1:60] "Mash" "Mash" "Mash" "Mash" ...
 $ title                         : chr [1:60] "Long-term reliability and predictive validity of the teller acuity card procedure" "Long-term reliability and predictive validity of the teller acuity card procedure" "Long-term reliability and predictive validity of the teller acuity card procedure" "Long-term reliability and predictive validity of the teller acuity card procedure" ...
 $ condition                     : chr [1:60] "preterm_birth" "preterm_birth" "preterm_birth" "preterm_birth" ...
 $ age_mos                       : num [1:60] 4 8 11 17 24 30 36 48 4 8 ...
 $ binoc_minoc                   : chr [1:60] "monoc" "monoc" "monoc" "monoc" ...
 $ eye                           : chr [1:60] "OD" "OD" "OD" "OD" ...
 $ n_participants                : num [1:60] 95 103 90 82 83 95 105 125 95 103 ...
 $ mean_acuity                   : num [1:60] 2.18 3.87 3.53 5.6 7.05 ...
 $ acuity_units                  : chr [1:60] "cyc_deg" "cyc_deg" "cyc_deg" "cyc_deg" ...
 $ mean_acuity_standard_deviation: num [1:60] 0.76 0.66 0.8 0.76 0.76 0.76 0.66 0.53 0.73 0.63 ...
 $ std_dev_units                 : chr [1:60] "cyc_deg" "cyc_deg" "cyc_deg" "cyc_deg" ...
 $ indiv_eye_acuity_cyc_deg      : logi [1:60] NA NA NA NA NA NA ...
 $ st_dev_indiv_eye              : logi [1:60] NA NA NA NA NA NA ...
 $ country                       : chr [1:60] "united_states" "united_states" "united_states" "united_states" ...
 $ card_type                     : chr [1:60] "tac_i" "tac_i" "tac_i" "tac_i" ...
 $ central_tendency_cyc_deg      : num [1:60] 2.18 3.87 3.53 5.6 7.05 ...
Code 
typ_indiv_df |>
  ggplot() +
  aes(
    x = age_mos,
    y = mean_acuity_cyc_deg,
    color = sub_id
  ) +
  geom_point() +
  geom_line() +
  #geom_smooth() +
  #facet_grid(cols = vars(eye)) +
  #geom_smooth(group = 1, se = TRUE) +
  xlab("Age (mos)") +
  ylab("Acuity (cyc/deg)") +
  theme(legend.position = "bottom") +
  scale_y_continuous(limits = c(0, 30)) +
  scale_x_continuous(limits = c(0, 50))
Figure 5.12: Developmental time course of mean grating acuity (in cyc/deg) for typically developing individual children as assessed by Teller Acuity Cards
Xiang, Y., Long, E., Liu, Z., Li, X., Lin, Z., Zhu, Y., … Lin, H. (2021). Study to establish visual acuity norms with teller acuity cards II for infants from southern china. Eye, 35(10), 2787–2792. https://doi.org/10.1038/s41433-020-01314-y