{"id":2064,"date":"2021-07-13T21:15:32","date_gmt":"2021-07-13T21:15:32","guid":{"rendered":"http:\/\/optimumsportsperformance.com\/blog\/?p=2064"},"modified":"2021-07-13T21:15:32","modified_gmt":"2021-07-13T21:15:32","slug":"force-decks-force-plate-shiny-dashboard","status":"publish","type":"post","link":"https:\/\/optimumsportsperformance.com\/blog\/force-decks-force-plate-shiny-dashboard\/","title":{"rendered":"Force Decks &#8211; Force Plate Shiny Dashboard"},"content":{"rendered":"<p>Last week, two of the data scientists at <strong><span style=\"color: #0000ff;\"><a style=\"color: #0000ff;\" href=\"https:\/\/twitter.com\/VALDPerformance\">Vald Performance<\/a>, <\/span><\/strong><span style=\"color: #000000;\">Josh Ruddy and Nick Murray, <\/span><span style=\"color: #000000;\">put out a <span style=\"color: #0000ff;\"><strong><a style=\"color: #0000ff;\" href=\"https:\/\/valdperformance.com\/analyse-countermovement-data-rstudio\/\">free online tutorial on how to create a force plate reports using R<\/a><\/strong><\/span> with data from their Force Decks software.<\/span><\/p>\n<p>It was a nice tutorial to give an overview of some of the power behind ggplot2 and the suite of packages that come with tidyverse. Since they made the data available (in the link above), I decided to pull it down and put together a quick shiny app for those that might be interested in extending the report to an interactive web app.<\/p>\n<p>This isn&#8217;t the first time I&#8217;ve build a shiny app for the blog using force plate data. Interested readers might want to check out <span style=\"color: #0000ff;\"><strong><a style=\"color: #0000ff;\" href=\"https:\/\/optimumsportsperformance.com\/blog\/r-tips-tricks-force-velocity-power-profile-graphs-in-r-shiny\/\">my post from a year ago where I built a shiny interactive report for force-velocity profiling<\/a><\/strong><\/span>.<\/p>\n<p>You can watch a short preview of the end product in the below video link and the screen shots below the link show a static view of what the final shiny App will look like.<\/p>\n<p>A few key features:<\/p>\n<ol>\n<li>App always defaults to the most recent testing day on the <em>testDay<\/em> tab.<\/li>\n<li>The user can select the position group at the top and that position group will be maintained across all tabs. For example, if you select <em>Forwards<\/em>, when you switch between tabs one and two, forwards will always be there.<\/li>\n<li>The time series plots on the <em>Player Time Series<\/em> tab are done using plotly, so they are interactive, allowing the user to hover over each test session and see the change from week-to-week in the tool tip. When the change exceeds the meaningful change, the point turns red. Finally, because it is plotly, the user can slice out specific dates that they want to look at (as you can see me do in the video example), which comes in handy when there are a large number of tests over time.<\/li>\n<\/ol>\n<p>All code and data s accessible through my <span style=\"color: #0000ff;\"><strong><a style=\"color: #0000ff;\" href=\"https:\/\/github.com\/pw2\/R-Tips-Tricks\">GitHub page<\/a><\/strong><\/span>.<\/p>\n<p><a href=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/vald_shiny_app.mov\"><span style=\"color: #0000ff;\"><strong><span style=\"color: #0000ff;\">vald_shiny_app<\/span><\/strong><\/span><\/a><\/p>\n<p><a href=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM.png\"><img loading=\"lazy\" decoding=\"async\" class=\"aligncenter size-large wp-image-2067\" src=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM-1024x515.png\" alt=\"\" width=\"625\" height=\"314\" srcset=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM-1024x515.png 1024w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM-300x151.png 300w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM-768x387.png 768w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM-624x314.png 624w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.48.56-PM.png 1798w\" sizes=\"auto, (max-width: 625px) 100vw, 625px\" \/><\/a> <a href=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM.png\"><img loading=\"lazy\" decoding=\"async\" class=\"aligncenter size-large wp-image-2068\" src=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM-1024x518.png\" alt=\"\" width=\"625\" height=\"316\" srcset=\"https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM-1024x518.png 1024w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM-300x152.png 300w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM-768x388.png 768w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM-624x315.png 624w, https:\/\/optimumsportsperformance.com\/blog\/wp-content\/uploads\/2021\/07\/Screen-Shot-2021-07-13-at-1.49.11-PM.png 1790w\" sizes=\"auto, (max-width: 625px) 100vw, 625px\" \/><\/a><\/p>\n<p><span style=\"text-decoration: underline;\"><strong>Loading and preparing the data<\/strong><\/span><\/p>\n<ul>\n<li>I load the data in using <strong>read.csv()<\/strong> and <strong>file.choose()<\/strong>, so navigate to wherever you have the data on your computer and select it.<\/li>\n<li>There is some light cleaning to change the date in to a date variable. Additionally, there were no player positions in the original data set, so I just made some up and joined those in.<\/li>\n<\/ul>\n<pre class=\"brush: r; title: ; notranslate\" title=\"\">\r\n\r\n### packages ------------------------------------------------------------------\r\nlibrary(tidyverse)\r\nlibrary(lubridate)\r\nlibrary(psych)\r\nlibrary(shiny)\r\nlibrary(plotly)\r\n\r\ntheme_set(theme_light())\r\n\r\n### load &amp; clean data ---------------------------------------------------------\r\ncmj &lt;- read.csv(file.choose(), header = TRUE) %&gt;%\r\n  janitor::clean_names() %&gt;%\r\n  mutate(date = dmy(date))\r\n\r\nplayer_positions &lt;- data.frame(name = unique(cmj$name),\r\n                               position = c(rep(&quot;Forwards&quot;, times = 15),\r\n                                            rep(&quot;Mids&quot;, times = 15),\r\n                                            rep(&quot;Backs&quot;, times = 15)))\r\n\r\n# join position data with jump data\r\ncmj &lt;- cmj %&gt;%\r\n  inner_join(player_positions)\r\n\r\n<\/pre>\n<p>&nbsp;<\/p>\n<p><span style=\"text-decoration: underline;\"><strong>Determining Typical Error and Meaningful Change<\/strong><\/span><\/p>\n<ul>\n<li>In this example, I&#8217;ll just pretend as if the first 2 sessions represented our test-retest data and I&#8217;ll work from there.<\/li>\n<li>Typical Error Measurement (TEM) was calculated as the standard deviation of differences between test 1 and 2 divided by the square root of 2.<\/li>\n<li>For the meaningful change, instead of using 0.2 (the commonly used smallest worthwhile change multiplier) I decided to use a moderate change (0.6), since 0.2 is such a small fraction of the between subject SD.<\/li>\n<li>For info on these two values, <strong><span style=\"color: #0000ff;\"><a style=\"color: #0000ff;\" href=\"https:\/\/optimumsportsperformance.com\/blog\/doing-things-in-python-that-youd-normally-do-in-excel-data-analysis-for-strength-conditioning-coaches-turner-et-al-2015\/\">I covered them in a blog post last week using Python and a paper Anthony Turner and colleagues wrote<\/a><\/span><\/strong>.<\/li>\n<\/ul>\n<pre class=\"brush: r; title: ; notranslate\" title=\"\">\r\n\r\nchange_standards &lt;- cmj %&gt;%\r\n  group_by(name) %&gt;%\r\n  mutate(test_id = row_number()) %&gt;%\r\n  filter(test_id &lt; 3) %&gt;%\r\n  select(name, test_id, rel_con_peak_power) %&gt;%\r\n  pivot_wider(names_from = test_id,\r\n              names_prefix = &quot;test_&quot;,\r\n              values_from = rel_con_peak_power) %&gt;%\r\n  mutate(diff = test_2 - test_1) %&gt;%\r\n  ungroup() %&gt;%\r\n  summarize(TEM = sd(diff) \/ sqrt(2),\r\n            moderate_change = 0.6 * sd(c(test_1, test_2)))\r\n\r\n<\/pre>\n<p><span style=\"text-decoration: underline;\"><strong>Building the Shiny App<\/strong><\/span><\/p>\n<ul>\n<li>In the user interface, I first create my sidebar panel, allowing the user to select the position group of interest. You&#8217;ll notice that this sidebar panel is not within the tab panels, which is why it stands alone and allows us to select a position group that will be retained across all tabs.<\/li>\n<li>Next, I set up 2 tabs. Notice that in the first tab (<em>testDay)<\/em> I include a select input, to allow the user to select the date of interest. In the selected argument I tell shiny to always select the max(cmj$date) so that the most recent session is always shown to the user.<\/li>\n<li>The server is pretty straight forward. I commented out where each tab data is built. Basically, it is just taking the user specified information and performing simple data filtering and then ggplot2 charts to provide us with the relevant information.<\/li>\n<li>On the <em>testDay<\/em> plot, we use the meaningful change to shade the region around 0 in grey and we use the TEM around the athlete&#8217;s observed performance on a given day to specify the amount of error that we might expect for the test.<\/li>\n<li>One the <em>Player Time Series<\/em> plot we have the athlete&#8217;s average line and \u00b11 SD lines to accompany their data, with points changing color when the week-to-week change exceeds out meaningful change.<\/li>\n<\/ul>\n<pre class=\"brush: r; title: ; notranslate\" title=\"\">\r\n### Shiny App -----------------------------------------------------------------------------\r\n\r\n## Set up user interface\r\n\r\nui &lt;- fluidPage(\r\n  \r\n  ## set title of the app\r\n  titlePanel(&quot;Team CMJ Analysis&quot;),\r\n  \r\n  ## create a selection bar for position group that works across all tabs\r\n  sidebarPanel(\r\n    selectInput(inputId = &quot;position&quot;,\r\n                label = &quot;Select Position Group:&quot;,\r\n                choices = unique(cmj$position),\r\n                selected = &quot;Backs&quot;,\r\n                multiple = FALSE),\r\n    width = 2\r\n  ),\r\n  \r\n  ## set up 2 tabs: One for team daily analysis and one for player time series\r\n  tabsetPanel(\r\n    \r\n    tabPanel(title = &quot;testDay&quot;,\r\n             \r\n             selectInput(inputId = &quot;date&quot;,\r\n                         label = &quot;Select Date:&quot;,\r\n                         choices = unique(cmj$date)&#x5B;-1],\r\n                         selected = max(cmj$date),\r\n                         multiple = FALSE),\r\n             \r\n             mainPanel(plotOutput(outputId = &quot;day_plt&quot;, width = &quot;100%&quot;, height = &quot;650px&quot;),\r\n                       width = 12)),\r\n    \r\n    tabPanel(title = &quot;Player Time Series&quot;,\r\n             \r\n             mainPanel(plotlyOutput(outputId = &quot;player_plt&quot;, width = &quot;100%&quot;, height = &quot;700px&quot;),\r\n                       width = 12))\r\n  )\r\n  \r\n)\r\n\r\n\r\nserver &lt;- function(input, output){\r\n  \r\n  ##### Day plot tab ####\r\n  ## day plot data\r\n  day_dat &lt;- reactive({\r\n    \r\n    d &lt;- cmj %&gt;%\r\n      group_by(name) %&gt;%\r\n      mutate(change_power = rel_con_peak_power - lag(rel_con_peak_power)) %&gt;%\r\n      filter(date == input$date,\r\n             position == input$position)\r\n    \r\n    d\r\n    \r\n  })\r\n  \r\n  ## day plot\r\n  output$day_plt &lt;- renderPlot({ day_dat() %&gt;%\r\n      ggplot(aes(x = reorder(name, change_power), y = change_power)) +\r\n      geom_rect(aes(ymin = -change_standards$moderate_change, ymax = change_standards$moderate_change),\r\n                xmin = 0,\r\n                xmax = Inf,\r\n                fill = &quot;light grey&quot;,\r\n                alpha = 0.6) +\r\n      geom_hline(yintercept = 0) +\r\n      geom_point(size = 4) +\r\n      geom_errorbar(aes(ymin = change_power - change_standards$TEM, ymax = change_power + change_standards$TEM),\r\n                    width = 0.2,\r\n                    size = 1.2) +\r\n      theme(axis.text.x = element_text(angle = 60, vjust = 1, hjust = 1),\r\n            axis.text = element_text(size = 16, face = &quot;bold&quot;),\r\n            axis.title = element_text(size = 18, face = &quot;bold&quot;),\r\n            plot.title = element_text(size = 22)) +\r\n      labs(x = NULL,\r\n           y = &quot;Weekly Change&quot;,\r\n           title = &quot;Week-to-Week Change in Realtive Concentric Peak Power&quot;)\r\n    \r\n  })\r\n  \r\n  ##### Player plot tab ####\r\n  ## player plot data\r\n  \r\n  player_dat &lt;- reactive({\r\n    \r\n    d &lt;- cmj %&gt;%\r\n      group_by(name) %&gt;%\r\n      mutate(avg = mean(rel_con_peak_power),\r\n             sd = sd(rel_con_peak_power),\r\n             change = rel_con_peak_power - lag(rel_con_peak_power),\r\n             change_flag = ifelse(change &gt;= change_standards$moderate_change | change &lt;= -change_standards$moderate_change, &quot;Flag&quot;, &quot;No Flag&quot;)) %&gt;%\r\n      filter(position == input$position)\r\n    \r\n    d\r\n  })\r\n  \r\n  ## player plot\r\n  output$player_plt &lt;- renderPlotly({\r\n    \r\n    plt &lt;- player_dat() %&gt;%\r\n      ggplot(aes(x = date, y = rel_con_peak_power, label = change)) +\r\n      geom_rect(aes(ymin = avg - sd, ymax = avg + sd),\r\n                xmin = 0,\r\n                xmax = Inf,\r\n                fill = &quot;light grey&quot;,\r\n                alpha = 0.6) +\r\n      geom_hline(aes(yintercept = avg - sd),\r\n                 color = &quot;black&quot;,\r\n                 linetype = &quot;dashed&quot;,\r\n                 size = 1.2) +\r\n      geom_hline(aes(yintercept = avg + sd),\r\n                 color = &quot;black&quot;,\r\n                 linetype = &quot;dashed&quot;,\r\n                 size = 1.2) +\r\n      geom_hline(aes(yintercept = avg), size = 1) +\r\n      geom_line(size = 1) +\r\n      geom_point(shape = 21,\r\n                 size = 3,\r\n                 aes(fill = change_flag)) +\r\n      facet_wrap(~name) +\r\n      scale_fill_manual(values = c(&quot;red&quot;, &quot;black&quot;, &quot;black&quot;)) +\r\n      theme(axis.text = element_text(size = 13, face = &quot;bold&quot;),\r\n            axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1),\r\n            plot.title = element_text(size = 18),\r\n            strip.background = element_rect(fill = &quot;black&quot;),\r\n            strip.text = element_text(size = 13, face = &quot;bold&quot;),\r\n            legend.position = &quot;none&quot;) +\r\n      labs(x = NULL,\r\n           y = NULL,\r\n           title = &quot;Relative Concentric Peak Power&quot;)\r\n    \r\n    ggplotly(plt)\r\n    \r\n  })\r\n  \r\n  \r\n}\r\n\r\n\r\n\r\nshinyApp(ui, server)\r\n\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>Last week, two of the data scientists at Vald Performance, Josh Ruddy and Nick Murray, put out a free online tutorial on how to create a force plate reports using R with data from their Force Decks software. It was a nice tutorial to give an overview of some of the power behind ggplot2 and [&hellip;]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"closed","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[45,43,42,27],"tags":[],"class_list":["post-2064","post","type-post","status-publish","format-standard","hentry","category-r-tips-tricks","category-sports-analytics","category-sports-science","category-strength-and-conditioning"],"_links":{"self":[{"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/posts\/2064","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/comments?post=2064"}],"version-history":[{"count":4,"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/posts\/2064\/revisions"}],"predecessor-version":[{"id":2071,"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/posts\/2064\/revisions\/2071"}],"wp:attachment":[{"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/media?parent=2064"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/categories?post=2064"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/optimumsportsperformance.com\/blog\/wp-json\/wp\/v2\/tags?post=2064"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}