Objective: Hit 100 putts from 3 ft away, each day for 7 days. Data captured with Blast Motion putting sensor. Metronome set to 90 bpms used for every session. Analysis begins with Tempo, shown below.


METRIC OVERVIEW


TEMPO OBSERVATIONS

Exploration of Speed Characteristics; Back Stroke Time, Forwards Stroke Time, and Loft Change


STROKE LENGTH OBSERVATIONS

Exploration of Directional Characteristics; Face Rotation and Face Angle at Impact


DIRECTIONAL CHANGE OBSERVATIONS

---
title: "100 Putts in 1 Week Dashboard"
output: 
  flexdashboard::flex_dashboard:
    storyboard: true
    social: menu
    source_code: embed
    
---

```{r setup, include=FALSE}
library(flexdashboard)
library(readr)
library(ggridges)
library(tidyverse)
library(qicharts2)
library(ggpubr)

df <- read_csv("Metrics - Scott Jacobs - 2024-12-26 - 2025-01-09.csv", skip = 8)

names(df) <- c("Date",  
               "Equipment",   
               "Action_Type", 
               "Back_Stroke_Time",  
               "Forward_Stroke_Time",     
               "Total_Stroke_Time",
               "Tempo", 
               "Impact_Stroke_Speed", 
               "Back_Stroke_Length", 
               "Loft_Change", 
               "Backstroke_Rotation", 
               "Forward_Stroke_Rotation", 
               "Face_Angle_at_Impact", 
               "Lie_Change"   )

              
df <- df %>% separate(col=Date, into = c("Month", "Day", "Yr", "Time") ) %>% unite("Mon_day", Month:Day, remove = FALSE )  
sessions <- length(unique(df$Mon_day))
day_df <- data.frame(Mon_day=sort(unique(df$Mon_day)), session=1:7)
df <- left_join(df, day_df)
```




### *Objective:* Hit 100 putts from 3 ft away, each day for 7 days. Data captured with Blast Motion putting sensor. Metronome set to 90 bpms used for every session. Analysis begins with Tempo, shown below.




```{r message=FALSE, warning=FALSE}
tempo_lb <- 1.8
tempo_ub <- 2.2
a <-  ggplot(df, aes(x = Tempo, y = Mon_day, fill = stat(x)) ) + 
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, gradient_lwd = 1.) + 
  scale_x_continuous(expand = c(0, 0)) +
  geom_vline(aes(xintercept = tempo_lb))+
  geom_vline(aes(xintercept = tempo_ub))+
  scale_fill_viridis_c(name = "Tempo", option = "C") +
  scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Tempo Distribution by Day", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```



```{r message=FALSE, warning=FALSE}

b <-  qic(Mon_day, Tempo,
    data  = df,
    chart = 'xbar',
    
    ylab  = '',
    xlab  = '') +
  geom_smooth(se = FALSE)+
  labs(title = 'Average Tempo', subtitle = "Flat trend is preferable")

```



```{r message=FALSE, warning=FALSE}

c <- qic(Mon_day, Tempo,
    data  = df,
    chart = 's',
    
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  labs(title = 'Standard Deviation of Tempo', subtitle = "Declining values are preferable")

```


```{r message=FALSE, warning=FALSE,fig.align='center', results='hide',fig.keep='all', fig.width=10, fig.height=8}
plot_1 <- ggarrange(a,
ggarrange( b, c,ncol = 2 #, labels = c("Mean Performance", "Variation in Performance"), label.y=1.08
           ),
                     nrow = 2, label=""
)

plot_1
```

***

*METRIC OVERVIEW*

- Tempo Distribution: Ideally narrow and tall around 1.8-2.0. This is the pattern that has been developing since the first day, where it started off diffuse and has begun to mound taller with a more narrow spread which indicates performance improvement.
- Mean Tempo Over Time: This chart is averaging all of the daily putts each day. Ideally, this should be a 'flat' trend, indicating consistent performance around a reasonable target (ie 1.8). 
- Standard Deviation of Tempo Over Time (Variation): This chart is conveying the standard deviation of tempo for each day. Ideally this chart's trend should be declining, then steadying at low number, indicating skill development.

***

*TEMPO OBSERVATIONS*

- Although average tempo seems to have remained rather constant over the exercise, the big change was in the variation, which declined substantially throughout.
- Tempo control was ok but remains a bit quick at ~1.8
- 2.0:1 tempo for me comes from slowing down the backstroke and feeling no pause before accelerating through


### Exploration of Speed Characteristics; Back Stroke Time, Forwards Stroke Time, and Loft Change


```{r message=FALSE, warning=FALSE}
bs_lb <- .55
bs_ub <- .65
a1 <-  ggplot(df, aes(x = Back_Stroke_Time, y = Mon_day, fill = stat(x)) ) + 
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, gradient_lwd = 1.) + 
    geom_vline(aes(xintercept = bs_lb))+
  geom_vline(aes(xintercept = bs_ub))+
  scale_x_continuous(expand = c(0, 0)) +
  scale_fill_viridis_c(name = "Time (secs)", option = "C") +
  scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Back_Stroke_Time Distribution", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```

```{r message=FALSE, warning=FALSE}
fs_lb <- .25
fs_ub <- .35
a2 <-  ggplot(df, aes(x = Forward_Stroke_Time, y = Mon_day, fill = stat(x)) ) + 
    geom_vline(aes(xintercept = fs_lb))+
  geom_vline(aes(xintercept = fs_ub))+
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, gradient_lwd = 1.) + 
  scale_x_continuous(expand = c(0, 0)) +
  scale_fill_viridis_c(name = "Time (secs)", option = "C") +
  scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Forward_Stroke_Time Distribution", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```


```{r}
lft_lb <- -.5
lft_ub <- .5
a3 <- ggplot(df, aes(x = Loft_Change, y = Mon_day, fill = stat(x)) ) +
  geom_vline(aes(xintercept = lft_lb))+
  geom_vline(aes(xintercept = lft_ub))+
  geom_density_ridges_gradient(scale = 2, rel_min_height = 0.01, gradient_lwd = 1.) + 
  scale_x_continuous(expand = c(0, 0)) +
  scale_fill_viridis_c(name = "Loft (Deg)", option = "G") +
  scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Loft_Change Distribution", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```

```{r message=FALSE, warning=FALSE}

b1 <-  qic(Mon_day, Back_Stroke_Time,
    data  = df,
    chart = 'xbar',
    ylab  = '',
    xlab  = '') +
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0.4,.60))+
  labs(title = 'Average Back_Stroke_Time', subtitle = "Flat trend is preferable")

```

```{r message=FALSE, warning=FALSE}

b2 <-  qic(Mon_day, Forward_Stroke_Time,
    data  = df,
    chart = 'xbar',
    ylab  = '',
    xlab  = '') +
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0.25,.40))+
  labs(title = 'Average Forward_Stroke_Time', subtitle = "Flat trend is preferable")

```


```{r}

b3 <- qic(Mon_day, Loft_Change,
    data  = df,
    chart = 'xbar',
    title = '',
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0,1.40))+
  labs(title = 'Average Loft_Change', subtitle = "Flat trend is preferable")

```

```{r message=FALSE, warning=FALSE}

c1 <- qic(Mon_day, Back_Stroke_Time,
    data  = df,
    chart = 's',
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0,.10))+
  labs(title = 'Standard Deviation of Back_Stroke_Time', subtitle = "Declining values are preferable")

```


```{r message=FALSE, warning=FALSE}

c2 <- qic(Mon_day, Forward_Stroke_Time,
    data  = df,
    chart = 's',
    
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0,.10))+
  labs(title = 'Standard Deviation of Forward_Stroke_Time', subtitle = "Declining values are preferable")

```




```{r}

c3 <- qic(Mon_day, Loft_Change,
    data  = df,
    chart = 's',
   
    ylab  = '',
    xlab  = '')+
  geom_smooth(se=FALSE)+
   scale_y_continuous(limits= c(0,1.10))+
  labs(title = 'Standard Deviation of Loft Change', subtitle = "Declining values are preferable")

```




```{r message=FALSE, warning=FALSE,fig.align='center', results='hide',fig.keep='all', fig.width=14, fig.height=8}
plot_1 <- ggarrange(a1,a2, a3, b1,b2,b3,c1,c2,c3, ncol=3, nrow = 3, label="")

plot_1
```


***

*STROKE LENGTH OBSERVATIONS*

- While most back stroke lengths (time) fit within the desired range, there exists a tendancy to get quick on the takeaway
- Similarly, the forward stroke generally fell within range but had the tendency to get quick
- Loft change was a big realization. Given dynamic loft's impact on distance control, this will be explored in future practice sessions


### Exploration of Directional Characteristics; Face Rotation and Face Angle at Impact


```{r message=FALSE, warning=FALSE}
bsr_lb <- -.5
bsr_ub <- .5
a1 <-  ggplot(df, aes(x = Backstroke_Rotation, y = Mon_day, fill = stat(x)) ) + 
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, gradient_lwd = 1.) + 
  geom_vline(aes(xintercept = bsr_lb))+
  geom_vline(aes(xintercept = bsr_ub))+
  scale_x_continuous(expand = c(0, 0)) +
  scale_fill_viridis_c(name = "Time (secs)", option = "C") +
  #scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Back_Stroke_Rotation Distribution", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```

```{r message=FALSE, warning=FALSE}
fsr_lb <- -.5
fsr_ub <- .5
a2 <-  ggplot(df, aes(x = Forward_Stroke_Rotation, y = Mon_day, fill = stat(x)) ) + 
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01, gradient_lwd = 1.) + 
  geom_vline(aes(xintercept = fsr_lb))+
  geom_vline(aes(xintercept = fsr_ub))+
  scale_x_continuous(expand = c(0, 0)) +
  scale_fill_viridis_c(name = "Time (secs)", option = "C") +
  #scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Forward_Stroke_Rotation Distribution", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```


```{r}
fai_lb <- -.5
fai_ub <- .5
a3 <- ggplot(df, aes(x = Face_Angle_at_Impact, y = Mon_day, fill = stat(x)) ) + 
  geom_density_ridges_gradient(scale = 2, rel_min_height = 0.01, gradient_lwd = 1.) + 
  geom_vline(aes(xintercept = fai_lb))+
  geom_vline(aes(xintercept = fai_ub))+
  scale_x_continuous(expand = c(0, 0)) +
  scale_fill_viridis_c(name = "Loft (Deg)", option = "G") +
  #scale_y_discrete(expand = expand_scale(mult = c(0.01, .7))) +
  theme_ridges()+
  labs(title = "Face_Angle_at_Impact Distribution", subtitle = "Narrower, taller distributions are preferable", y="", x="")
```

```{r message=FALSE, warning=FALSE}

b1 <-  qic(Mon_day, Backstroke_Rotation,
    data  = df,
    chart = 'xbar',
    
    ylab  = '',
    xlab  = '') +
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(2.5,3.60))+
  labs(title = 'Average Back_Stroke_Rotation', subtitle = "Flat trend is preferable")

```

```{r message=FALSE, warning=FALSE}

b2 <-  qic(Mon_day, Forward_Stroke_Rotation,
    data  = df,
    chart = 'xbar',
    
    ylab  = '',
    xlab  = '') +
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(3,5.0))+
  labs(title = 'Average Forward_Stroke_Rotation', subtitle = "Flat trend is preferable")

```


```{r}

b3 <- qic(Mon_day, Face_Angle_at_Impact,
    data  = df,
    chart = 'xbar',
    title = '',
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(-2.0,.60))+
  labs(title = 'Average Face_Angle_at_Impact', subtitle = "Flat trend is preferable")

```


```{r message=FALSE, warning=FALSE}

c1 <- qic(Mon_day, Backstroke_Rotation,
    data  = df,
    chart = 's',
    
    ylab  = '',
    xlab  = '')+
  
  geom_smooth(se=FALSE)+
  scale_y_continuous(limits= c(0,1.10))+
  labs(title = 'Standard Deviation of Backstroke_Rotation', subtitle = "Declining values are preferable")


```


```{r message=FALSE, warning=FALSE}

c2 <- qic(Mon_day, Forward_Stroke_Rotation,
    data  = df,
    chart = 's',
    
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0,1.70))+
  labs(title = 'Standard Deviation of Forward_Stroke_Rotation', subtitle = "Declining values are preferable")

```



```{r}

c3 <- qic(Mon_day, Face_Angle_at_Impact,
    data  = df,
    chart = 's',
    title = 'Loft Change (Xbar chart)',
    ylab  = '',
    xlab  = '')+
  geom_smooth(se = FALSE)+
  scale_y_continuous(limits= c(0,1.50))+
  labs(title = 'Standard Deviation of Face_Angle_at_Impact', subtitle = "Declining values are preferable")


```


```{r message=FALSE, warning=FALSE,fig.align='center', results='hide',fig.keep='all', fig.width=14, fig.height=8}
plot_1 <- ggarrange(a1,a2, a3, b1,b2,b3,c1,c2,c3, ncol=3, nrow = 3, label="")

plot_1
```

*** 

*DIRECTIONAL CHANGE OBSERVATIONS*

- It's worth noting that it is not clear that the Blast Motion capture technology adequately captures changes in face rotation since, when compared with directional readings from a Foresight GC3, readings differed substantially
- For this analysis, we will assume that although readings may not be accurate on an absolute basis, there is value in tracking relative performance ie the average performance and variation in performance characteristics
- Nevertheless, it was very surprising to see the amount of face rotation recorded in my stroke, which likely led to the face angle at impact being recorded as closed
- I plan to explore this in future putting sessions with additional technologies