Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
864 lines (674 sloc) 26.1 KB
title author date output bibliography
dev-prosem-2015-09-16
Rick Gilmore
`r Sys.time()`
ioslides_presentation beamer_presentation slidy_presentation pdf_document md_document html_document
css incremental widescreen smaller
false
true
false
default
default
default
default
keep_md
true
bibliography.bib

Experience matters | Measuring the microstructure of visual experience to better understand perceptual development {.flexbox .vcenter}

### **Rick O. Gilmore**

Support: NSF BCS-1147440, NSF BCS-1238599, NICHD U01-HD-076595

Overview

  • Development of Optic Flow Processing
    • What is optic flow?
    • How does optic flow sensitivity develop?
    • How experience shapes the patterns of brain and behavioral development

What is Optic Flow?

  • Structured pattern of visual motion generated by observer movement

Examples of Optic Flow

<iframe width="560" height="315" src="https://www.youtube.com/embed/x76VEPXYaI0" frameborder="0" allowfullscreen></iframe>

Examples of Optic Flow {.flexbox .vcenter}

Your browser does not support the video tag.

Examples of Optic Flow {.flexbox .vcenter}

Your browser does not support the video tag.

What is Optic Flow? {.flexbox .vcenter}

Types of Optic Flow

  • Radial (expansion/contraction), rotation, linear/laminar/translational, shear

Different Actions, Different Flows {.flexbox .vcenter}

Action Type Flow Type
Forward/backward translation Expansion/contraction
Rotation around visual axis Rotation
Horizontal/vertical head rotation Translation
Horizontal/vertical eye movements Translation

Functions linked to optic flow processing

  • Environmental geometry
  • Egocentric position, trajectory
  • Forward models/sensorimotor stability
    • Self vs. world/object motion
  • Object detection, identification

How Does Optic Flow Sensitivity Develop?

  • Sensitivity at birth, [@jouen_optic_2000]
  • Infants + Brain responses stronger to fast, translational flow, [@hou_spatio-temporal_2009; @gilmore_development_2007] + Behavioral responses stronger to fast translational flow, [@kiorpes_development_2004] + Primate universal pattern? Not adult-like until late adolescence?
  • Adults + Brain responses stronger to radial flow, [@gilmore_development_2007; @fesi_cortical_2014].

Gaps

  • What influences developmental shifts?
    • Why fast speeds and linear flows?

Infants Spend Lots of Time Being Carried {.flexbox .vcenter}

[@Mathioudakis_2008]

What Types of Flow Occur During Carrying?

Infant View {.flexbox .vcenter}

Your browser does not support the video tag.

Adult View {.flexbox .vcenter}

Your browser does not support the video tag.

Methods

  • Head-mounted eye tracking videos
  • n=6 8.5-9.5 mo-old infants carried by mothers
  • 30 s video segments walking down the same indoor hallway
  • Frame-by-frame analysis of optic flow patterns, speeds.
  • [@raudies2013optic]

Reminiscent of [@held1963movement] {.flexbox .vcenter}

Flow Pattern Data {.flexbox .vcenter}

[@raudies_understanding_2012]

Flow Speed Data {.flexbox .vcenter}

[@raudies_understanding_2012]

Gaze Stability

[@raudies_understanding_2012]

Gaze Stability

[@raudies_understanding_2012]

Looking Where They're Going?

[@raudies_understanding_2012]

What is the Motion 'Prior'?

  • [@grzywacz1991theories,@weiss2002motion]
  • Visual system 'assumes' motion distributions are slow
  • Resolves ambiguities in direction under occlusion
  • Based on lab-based psychophysical results

What is the Empirical Motion 'Prior'?

[@raudies_visual_2014]

What is the Empirical Motion 'prior'?

[@raudies_visual_2014]

Summary

  • Infants' visual experiences ≠ mothers'
  • Faster speeds, more vertical motion
  • Laminar/translational motion common
  • Empirical speed prior not slow

Concerns

  • How general?
  • Geometry of environment?
  • Carrying vs. independent locomotion?
  • Cultural differences in home environment, relatives, carrying practices?
  • Changes across developmental milestones?

Methods

  • Simulation
    • How does "maturation" change optic flow?
    • Does environmental geometry change optic flow?
  • Measure natural scene statistics of optic flow
    • Videos from head-mounted cameras
    • Infants from India, Indiana

Simulating Optic Flow {.smaller}

$\begin{pmatrix}\dot{x} \\ \dot{y}\end{pmatrix}=\frac{1}{z} \begin{pmatrix}-f & 0 & x\\ 0 & -f & y \end{pmatrix} \begin{pmatrix}{v_x{}}\\ {v_y{}} \\{v_z{}}\end{pmatrix}+ \frac{1}{f} \begin{pmatrix} xy & -(f^2+x^2) & fy\\ f^2+y^2 & -xy & -fy \end{pmatrix} \begin{pmatrix} \omega_{x}\\ \omega_{y}\\ \omega_{z} \end{pmatrix}$

Parameters For Simulation

Parameter Crawling Infant Walking Infant
Eye height 0.30 m 0.60 m
Locomotor speed 0.33 m/s 0.61 m/s
Head tilt 20 deg 9 deg

[@kretch2014crawling],http://dx.doi.org/10.1111/cdev.12206

Parameters for Simulation

Geometric Feature Distance
Side wall +/- 2 m
Side wall height 2.5 m
Distance of ground plane 32 m
Field of view width 60 deg
Field of view height 45 deg

Simulating Flow Fields {.flexbox .vcenter}

Flow Direction Distributions by Geometry & Posture

Flow Speeds By Geometry and Posture {.flexbox .vcenter}


# Source libraries
library(ggplot2)
library(dplyr)
library(nlme)
library(knitr)
library(tidyr)

# knitr options, suppress everything by default.
opts_chunk$set(comment=NA, fig.width=8, fig.height=4.5, echo=FALSE, error=FALSE, warning=FALSE, message=FALSE, include=FALSE)

# Directories
dir_data <- '/Users/rick/github/gilmore-lab/ICDL-EpiRob-2015/data'
dir_figs <- '/Users/rick/github/gilmore-lab/ICDL-EpiRob-2015/figs'

# File names
fn_sim_spd_hist <- 'simulation-speed-hist.csv'
fn_seg_duration <- 'coded-segments.csv'
fn_spd_hist_bins <- 'speed-histogram-bins.csv'
fn_spd_hist_fits <- 'speed-histogram-fits.csv'
fn_patt <- 'pattern-histogram-bins.csv'
# Load speed histogram data from simulation
df.in <- read.csv( paste(dir_data, fn_sim_spd_hist, sep="/"), header=FALSE )

geom.names <- unlist( df.in[,1] )
locomotion.names <- unlist( df.in[,2] )
vals <- t( df.in[,3:23] )

bins <- seq(0,45, length.out=21)

df.th <- data.frame( Bin.Ctr = bins,
                     Geometry = rep( geom.names, each=21 ),
                     Locomotion = rep( locomotion.names, each=21 ),
                     Bin.Ct = as.vector( unlist( vals ) ) 
)

# Summarize counts by locomotion status
df.th.crawl <- df.th %>%
  filter( Locomotion == "crawling" ) %>%
  group_by( Geometry, Bin.Ctr ) %>%
  summarize( crawling.ct = sum( Bin.Ct) )

df.th.walk <- df.th %>%
  filter( Locomotion == "walking") %>%
  group_by( Geometry, Bin.Ctr ) %>%
  summarize( walking.ct = sum( Bin.Ct ))

# Merge data frames for analysis
df.th.loco <- merge( df.th.crawl, df.th.walk, 
                     by.x=c("Geometry", "Bin.Ctr"), 
                     by.y=c("Geometry", "Bin.Ctr")
) %>% mutate( tot.ct = crawling.ct + walking.ct ) %>%
  group_by( Geometry ) %>%
  mutate( tot.geom.ct = sum( tot.ct ) ) 

p.thresh = .05
df.th.loco.stats <- df.th.loco %>%
  filter(tot.ct >= 5) %>%
  mutate( num = (walking.ct/tot.geom.ct - crawling.ct/tot.geom.ct)^2,
          denom = walking.ct/(tot.geom.ct^2) + crawling.ct/(tot.geom.ct)^2,
          chisq = num/denom ) %>%
  group_by(Geometry) %>%
  summarize( chisq.loco = sum( chisq ) ) %>%
  mutate( p.chisq = 1-pchisq( chisq.loco, 21) ) %>%
  filter( p.chisq < p.thresh )
```{r simulation-histogram-plot, include=TRUE} # Plot p <- ggplot( data=df.th, aes(x=Bin.Ctr, y=Bin.Ct, fill=Locomotion)) + geom_bar(position="dodge", stat="identity") + facet_grid(. ~ Geometry)+ xlab("Speed (deg/s)") + ylab("Number of observations") + theme( strip.text=element_text(size=20), axis.title=element_text(size=20), axis.text =element_text(size=18), legend.title=element_text(size=20), legend.text = element_text(size=20), legend.position="bottom" ) p ```

$\chi^2(20)$: r df.th.loco.stats[1,1]: r df.th.loco.stats[1,2], r df.th.loco.stats[2,1]: r df.th.loco.stats[2,2], r df.th.loco.stats[3,1]: r df.th.loco.stats[3,2], and r df.th.loco.stats[4,1]: r df.th.loco.stats[4,2].

Mean Simulated Flow Speeds By Posture and Geometry

Type of Locomotion Ground Plane Room Side Wall Two Walls
Crawling 14.41 14.42 14.43 14.62
Walking 9.38 8.56 7.39 9.18

Empirical Measurements of Optic Flow

  • First-person videos from head-mounted cameras
  • 20 infants, 41 days to 13.2 mos
  • Chennai, India & Bloomington, Indiana
  • Data: http://databrary.org/volume/81

6 weeks

Your browser does not support the video tag.

36 weeks

Your browser does not support the video tag.

Cultural Differences in Segment Durations {.flexbox .vcenter}

# read data file
df.segments <- read.csv(paste(dir_data, fn_seg_duration, sep="/"))

# Restrict consideration to segments < 3 min
df.segments.3m <- df.segments %>% 
  mutate(Minutes=Segment.ms/(1000*60)) %>%
  filter(Motion.Static != 'Unclassified') %>%
  filter(Minutes <= 3)

# Adjust country order
countries <- relevel(df.segments.3m$Country, "U.S.")
df.segments.3m$Country <- countries

# Calculate summary stats to annotate plot
df.summary <- df.segments.3m %>%
  group_by(Country, Motion.Static) %>%
  summarize(Minutes.med = median(Minutes),
            Minutes.mean = mean(Minutes))

df.summary$Minutes = c(1,1,1,1)

# Convert minutes to seconds for readability
df.summary$Label.med = paste0("median = ", round(df.summary$Minutes.med*60, 1), " s")
df.summary$Label.mean = paste0("mean = ", round(df.summary$Minutes.mean*60, 1), " s")
```{r segment-duration-plot, include=TRUE} # Plot p <- ggplot(df.segments.3m, aes(x=Minutes)) + facet_grid(Motion.Static ~ Country) + geom_histogram() + ylab('Number of Segments') + xlab('Segment Duration (min)') + theme_bw() + geom_text(data=df.summary, aes(x=rep(1.5,4), y=rep(400,4), label=Label.med), size=7) + geom_text(data=df.summary, aes(x=rep(1.5,4), y=rep(300,4), label=Label.mean), size=7) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) + theme(strip.text = element_text(size=20), axis.title = element_text(size=20), axis.text = element_text(size=20)) p ```

Segment Durations {.flexbox .vcenter}

```{r anova-segment-duration-plot} # Restrict analysis to Moving and Stationary conditions keep <- c("Moving", "Stationary") df.motion.static <- subset(df.segments, Motion.Static %in% keep) df.motion.static$Motion.Static <- factor(df.motion.static$Motion.Static)

Restrict to segments < 1.5 min to reduce effects of outliers

df.trim.1.5min <- df.motion.static %>% filter(Segment.ms <= 1.5601000)

Create summary data frame

df.trim.1.5min.summ <- df.trim.1.5min %>% group_by(AgeMatchGroup, Country, Participant.ID, Motion.Static) %>% summarize(Segment.ms.med = median(Segment.ms), Segment.ms.sem = sd(Segment.ms)/sqrt(n()), Segment.ms.mean = mean(Segment.ms)) %>% mutate(Segment.sec.mean=Segment.ms.mean/1000, Segment.sec.sem=Segment.ms.sem/1000)

c <- relevel( df.trim.1.5min.summ$Country, "U.S.") # make U.S. first for consistency df.trim.1.5min.summ$Country <- c


```{r segment-duration-by-status-country, include=TRUE}
# Plot
ylims <- aes(ymax=Segment.sec.mean+Segment.sec.sem, ymin=Segment.sec.mean-Segment.sec.sem)
p <- ggplot( data=df.trim.1.5min.summ, aes(x=AgeMatchGroup, y=Segment.sec.mean, color=Motion.Static)) +
  facet_grid(. ~ Country) +
  geom_point() +
  geom_pointrange(ylims) +
  geom_smooth( method=lm ) +
  scale_color_discrete( name="Motion Status") +
  xlab("Age Group (wks)") +
  ylab("Segment Duration (s)") +
  theme(strip.text=element_text(size=20), 
        axis.title=element_text(size=20),
        axis.text=element_text(size=16),
        legend.text=element_text(size=18),
        legend.title = element_text(size=18),
        legend.position ="bottom")
p

Normalized Durations as $p$(total-time) {.flexbox .vcenter}

```{r compute-normalized-durations} # Start with untrimmed. # Fix leveling order...again c <- relevel( df.motion.static$Country, "U.S.") # make U.S. first for consistency df.motion.static$Country <- c

Sum total duration by participant and motion condition

df.motion.static.summ.by.motion <- df.motion.static %>% group_by(Country, AgeMatchGroup, Participant.ID, Motion.Static) %>% summarize(Segment.ms.tot = sum(Segment.ms))

df.motion.static.summ.grand <- df.motion.static.summ.by.motion %>% group_by(Country, AgeMatchGroup, Participant.ID) %>% summarize(Segment.ms.tot.grand = sum(Segment.ms.tot))

df.motion.static.summ <- merge( df.motion.static.summ.grand, df.motion.static.summ.by.motion)

df.motion.static.summ <- df.motion.static.summ %>% group_by( Country, AgeMatchGroup, Participant.ID, Motion.Static) %>% summarize(Segment.ms.p = Segment.ms.tot/Segment.ms.tot.grand)


<div class="centered">
```{r normalized-duration-plot, include=TRUE, fig.width=8, fig.height=4}
# Now plot
p <- ggplot(data=df.motion.static.summ, aes(x=AgeMatchGroup, y=Segment.ms.p, color= Motion.Static)) +
  facet_grid( . ~ Country ) +
  geom_point() + 
  geom_smooth( method=lm ) +
  xlab("Age Group (wks)") +
  ylab("Proportion of Time") +
  theme(strip.text = element_text(size=20), 
        axis.title = element_text(size=20),
        axis.text = element_text(size=20),
        legend.text = element_text(size=18),
        legend.title = element_text(size=18)) +
  theme(legend.position="bottom") + 
  scale_color_discrete(name="Motion Status")
p
lme.p.segment <- lme(fixed = Segment.ms.p ~ Country*AgeMatchGroup, data = df.motion.static.summ[df.motion.static.summ$Motion.Static=='Stationary',], random = ~ 1 | Participant.ID)
ul = unlist(anova(lme.p.segment))

Natural Scene Statistics for Optic Flow

  • Selected 10 5 s segments/participant, both moving and stationary
  • Estimated frame by frame flow fields
  • Details in Raudies & Gilmore 2014

Speed Distributions {.flexbox .vcenter}

```{r speed-distributions, include=TRUE} # Load data df_speed_hist <- read.csv(paste(dir_data, fn_spd_hist_bins, sep="/"))

df_speed_hist$Country <- relevel( df_speed_hist$Country, "U.S.")

U.S Histogram

p <- df_speed_hist %>% ggplot(aes(x=Speed, y=N.obs)) + facet_grid(Motion.status ~ Country) + geom_bar(stat="identity") + ylab('N observations') + xlab('Speed (deg/s)') + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), strip.text = element_text(size=20), axis.title = element_text(size=20), axis.text = element_text(size=20) ) p

</div>

## Comparing Shapes of (Trimmed) Speed Distributions

- Fit $\gamma$ distribution to trimmed (0,100) speed histograms

<div class="centered">
$f(x;k,\theta) =  \alpha\frac{x^{k-1}e^{-\frac{x}{\theta}}}{\theta^k\Gamma(k)}$

$\alpha$, amplitude; $\kappa$, shape; and $\theta$, scale parameters.
</div>

## Illustrative Speed Histograms -- 6 weeks {.flexbox .vcenter}

<div class="columns-2">
<img src='https://rawgit.com/psu-psychology/cognitive/master/brown-bag/2015-09-09-gilmore/img/006AP.png' width="400px"> 
<img src='https://rawgit.com/psu-psychology/cognitive/master/brown-bag/2015-09-09-gilmore/img/006MO.png' width="400px">
</div>

## Illustrative Speed Histograms -- 34 weeks {.flexbox .vcenter}

<div class="columns-2">
<img src='https://rawgit.com/psu-psychology/cognitive/master/brown-bag/2015-09-09-gilmore/img/034JC.png' width=400px> 
<img src='https://rawgit.com/psu-psychology/cognitive/master/brown-bag/2015-09-09-gilmore/img/034NW.png' width=400px>
</div>

## Illustrative Speed Histograms -- 58 weeks {.flexbox .vcenter}

<div class="columns-2">
<img src='https://rawgit.com/psu-psychology/cognitive/master/brown-bag/2015-09-09-gilmore/img/057AP.png' width=400px/> 
<img src='https://rawgit.com/psu-psychology/cognitive/master/brown-bag/2015-09-09-gilmore/img/058LA.png' width=400px/></div>

## Fitted $\kappa$ Parameters {.flexbox .vcenter}

<div class="centered">
```{r speed-fitted-parameters}
# Load data
df_spd_fits <- read.csv(paste(dir_data, fn_spd_hist_fits, sep="/"))

# Re-label to fix country order
countries <- relevel(df_spd_fits$Country, "U.S.")
df_spd_fits$Country <- countries

# Fix Motion.Static level labels
levels(df_spd_fits$Motion.status) <- c("Moving", "Stationary")
# Plot $\kappa$ parameter
p.k <- df_spd_fits %>%
  gather(Parameter.name, Fitted.value, a, k, theta ) %>%
  filter(Parameter.name=='k') %>%
  ggplot(aes(x=Motion.status, y=Fitted.value, color=Motion.status)) +
  facet_grid(. ~ Country) +
  geom_boxplot() +
  geom_point() +
  xlab("") + 
  ylab("Parameter Estimate") +
  theme(strip.text = element_text(size=20), 
        axis.title = element_text(size=20),
        axis.text = element_text(size=20),
        legend.position="none")
p.k
p.k <- df_spd_fits %>%
  gather(Parameter.name, Fitted.value, a, k, theta ) %>%
  filter(Parameter.name=='k') %>%
  ggplot(aes(x=AgeMatchGroup, y=Fitted.value, color=Motion.status)) +
  facet_grid(. ~ Country) +
  geom_point() +
  geom_smooth(method=lm) +
  xlab("Age Group (mos)") +
  ylab("Parameter Estimate") +
  theme(strip.text = element_text(size=20), 
        axis.title = element_text(size=20),
        axis.text = element_text(size=20),
        legend.position="none")
p.k
# Linear mixed effects model
lme.k <- lme(fixed = k ~ Motion.status*AgeMatchGroup*Country, random = ~ 1 | Participant.ID, data = df_spd_fits)
anova(lme.k)

Fitted $\alpha$ Parameters {.flexbox .vcenter}

# Plot alpha parameter
p.a <- df_spd_fits %>%
  gather(Parameter.name, Fitted.value, a, k, theta ) %>%
  filter(Parameter.name=='a') %>%
  ggplot(aes(x=Motion.status, y=Fitted.value, color=Motion.status)) +
  facet_grid(. ~ Country) +
  geom_boxplot() +
  geom_point() +
  xlab("") + 
  ylab("Parameter Estimate") +
  theme(strip.text = element_text(size=20), 
        axis.title = element_text(size=20),
        axis.text = element_text(size=20),
        legend.position="none")
p.a
# Linear mixed effects model
lme.alpha <- lme(fixed = a ~ Motion.status*AgeMatchGroup*Country, random = ~ 1 | Participant.ID, data = df_spd_fits)
anova(lme.alpha)

Fitted $\theta$ Parameters {.flexbox .vcenter}

# Plot theta parameter
p.theta <- df_spd_fits %>%
  gather(Parameter.name, Fitted.value, a, k, theta ) %>%
  filter(Parameter.name=='theta') %>%
  ggplot(aes(x=Motion.status, y=Fitted.value, color=Motion.status)) +
  facet_grid(. ~ Country) +
  geom_boxplot() +
  geom_point() +
  xlab("") + 
  ylab("Parameter Estimate") +
  theme(strip.text = element_text(size=20), 
        axis.title = element_text(size=20),
        axis.text = element_text(size=20),
        legend.position="none")
p.theta
# Linear mixed effects model
lme.theta <- lme(fixed = theta ~ Motion.status*AgeMatchGroup*Country, random = ~ 1 | Participant.ID, data = df_spd_fits)
anova(lme.theta)

Summary: Empirical Flow Speed Effects

  • Fast speeds (> 100 deg/s) common
  • Moving ≠ Stationary
  • Broad distribution: $\kappa$, $\alpha$(moving) > $\kappa$, $\alpha$(stationary)
  • U.S. ~ India

Empirical Pattern Distributions

  • Correlation with 'canonical' flow patterns
    • radial
    • rotational
    • translational

Pattern Correlation Results

Pattern Correlation Results by Country {.flexbox .vcenter}

df_patt <- read.csv(paste(dir_data, fn_patt, sep="/"))
levels(df_patt$Pattern) <- list(Rotation="cw", Radial="exp", Laminar=c("left", "up"))
```{r plot-hist, include = TRUE} hist_patt_theme <- theme(strip.text = element_text(size=16), axis.title = element_text(size=18), axis.text = element_text(size=16), legend.position = "bottom", legend.title = element_blank(), legend.text = element_text(size = 18) )

p_patt_hist <- df_patt %>% arrange(Motion.status) %>% ggplot(aes(x=Corr.Bin.Ctr, y=Corr.Bin.Count, fill=Motion.status)) + geom_bar(stat="identity") + facet_grid(Pattern ~ Country) + xlab("Correlation") + ylab("N obs") + hist_patt_theme p_patt_hist


Moving Laminar ≠ Stationary Laminar in 13/22 infants.

</div>

## Conclusions: Simulation

- Posture influences optic flow speeds & patterns
    + Crawling: faster speeds, more translational flow
    + Proximity to ground and pitch of head
    + Geometry matters relatively little
    
## Conclusions: Empirical Data

- Time stationary >> time in motion
- Time stationary declines with age (India)
- Fast speeds, broad speed distributions
- Individual differences in moving vs. stationary speed distributions
- Laminar flow >> radial or rotational flow, especially when stationary
- **Replicates and extends Raudies & Gilmore '12, '14**

## Summmary of Findings

- Infants commonly experience fast, laminar flows.
- Statistics of visual input may shape developmental transition from fast laminar to slow radial flow.
- Measuring the microstructure of experience hard, but informative.
    + Broadly supported by [EEG data with children](gilmore-thomas-fesi-2015.html)

## Thank you

## Stack

- RStudio, <https://www.rstudio.com/>
    - R Markdown, <http://rmarkdown.rstudio.com/>
- GitHub, <http://github.com/gilmore-lab/>, <http://github.com/psu-psychology/developmental>
- Databrary, <https://databrary.org/volume/81>
    - Access to identifiable data (e.g. videos) restricted
    - Access agreement + institutional authorization
- Datayvu, <http://datavyu.org>
- Matlab

## References {.smaller}