inst/shiny-simulator/app.R
In mladenjovanovic/vjsim: Vertical Jump Simulator
library(shiny)
library(plotly)
library(tidyverse)
library(vjsim)
library(DT)
library(ClustOfVar)
library(mgcv)
library(vip)
library(pdp)
library(ape)
# ----------------------------------------------
# Constants
gravity_const <- 9.81
time_step <- 0.001
fgen_length_out <- 1000
trace_variables <- c(
"time",
"distance",
"velocity",
"distance_to_take_off",
"push_off_perc",
"force_percentage",
"potential_force",
"activation",
"generated_force",
"viscous_force",
"ground_reaction_force",
"propulsive_force",
"acceleration",
"power",
"RFD",
"RPD"
)
summary_variables <- c(
"take_off_time",
"take_off_velocity",
"height",
"mean_GRF_over_distance",
"mean_GRF_over_time",
"peak_GRF",
"mean_velocity",
"peak_velocity",
"mean_power",
"peak_power",
"peak_RFD",
"GRF_at_100ms",
"GRF_at_200ms",
"peak_RPD",
"work_done",
"impulse"
)
parameter_variables <- c(
"mass",
"push_off_distance",
"max_force",
"max_velocity",
"time_to_max_activation"
)
profiling_variables <- c(
"external_load",
"mass",
"weight",
"take_off_time",
"take_off_velocity",
"height",
"mean_GRF_over_distance",
"mean_GRF_over_time",
"peak_GRF",
"mean_velocity",
"peak_velocity",
"mean_power",
"peak_power",
"peak_RFD",
"GRF_at_100ms",
"GRF_at_200ms",
"peak_RPD",
"work_done",
"impulse",
"ratio_peak_to_take_off_velocity",
"ratio_mean_to_take_off_velocity",
"ratio_mean_to_peak_velocity",
"ratio_mean_to_peak_power",
"ratio_mean_GRF_over_distance_to_time"
)
profile_summary_variables <- c(
"profile_mean_FV.F0",
"profile_mean_FV.V0",
"profile_mean_FV.Pmax",
"profile_mean_FV.Sfv",
"profile_mean_FV.Sfv_rel",
"profile_mean_power.Pmax",
"profile_mean_power.Pmax_location",
"profile_mean_power.F0_perc",
"profile_peak_FV.F0",
"profile_peak_FV.V0",
"profile_peak_FV.Pmax",
"profile_peak_FV.Sfv",
"profile_peak_FV.Sfv_rel",
"profile_peak_power.Pmax",
"profile_peak_power.Pmax_location",
"profile_peak_power.F0_perc",
"profile_load_take_off_velocity.V0",
"profile_load_take_off_velocity.L0",
"profile_load_take_off_velocity.Imax",
"profile_load_take_off_velocity.Slv",
"profile_load_take_off_velocity.Slv_rel",
"profile_load_impulse.Imax",
"profile_load_impulse.Imax_location",
"profile_load_impulse.L0_perc"
)
profile_type <- c(
"profile_mean_FV",
"profile_mean_power",
"profile_peak_FV",
"profile_peak_power",
"profile_load_take_off_velocity",
"profile_load_impulse"
)
samozino_models <- c(
"Practical",
"Theoretical"
)
samozino_models_opt <- c(
"samozino_practical_profile",
"samozino_theoretical_profile"
)
samozino_profile_variables <- c(
"samozino_theoretical_profile.F0",
"samozino_theoretical_profile.F0_rel",
"samozino_theoretical_profile.V0",
"samozino_theoretical_profile.Pmax",
"samozino_theoretical_profile.Pmax_rel",
"samozino_theoretical_profile.Sfv",
"samozino_theoretical_profile.Sfv_rel",
"samozino_theoretical_profile.take_off_velocity",
"samozino_theoretical_profile.height",
"samozino_theoretical_profile.optimal_F0",
"samozino_theoretical_profile.optimal_F0_rel",
"samozino_theoretical_profile.optimal_V0",
"samozino_theoretical_profile.optimal_height",
"samozino_theoretical_profile.optimal_height_diff",
"samozino_theoretical_profile.optimal_height_ratio",
"samozino_theoretical_profile.optimal_Pmax",
"samozino_theoretical_profile.optimal_Pmax_rel",
"samozino_theoretical_profile.optimal_take_off_velocity",
"samozino_theoretical_profile.optimal_take_off_velocity_diff",
"samozino_theoretical_profile.optimal_take_off_velocity_ratio",
"samozino_theoretical_profile.optimal_Sfv",
"samozino_theoretical_profile.optimal_Sfv_rel",
"samozino_theoretical_profile.Sfv_perc",
"samozino_theoretical_profile.FV_imbalance",
"samozino_theoretical_profile.probe_IMB",
"samozino_practical_profile.F0",
"samozino_practical_profile.F0_rel",
"samozino_practical_profile.V0",
"samozino_practical_profile.Pmax",
"samozino_practical_profile.Pmax_rel",
"samozino_practical_profile.Sfv",
"samozino_practical_profile.Sfv_rel",
"samozino_practical_profile.take_off_velocity",
"samozino_practical_profile.height",
"samozino_practical_profile.optimal_F0",
"samozino_practical_profile.optimal_F0_rel",
"samozino_practical_profile.optimal_V0",
"samozino_practical_profile.optimal_height",
"samozino_practical_profile.optimal_height_diff",
"samozino_practical_profile.optimal_height_ratio",
"samozino_practical_profile.optimal_Pmax",
"samozino_practical_profile.optimal_Pmax_rel",
"samozino_practical_profile.optimal_take_off_velocity",
"samozino_practical_profile.optimal_take_off_velocity_diff",
"samozino_practical_profile.optimal_take_off_velocity_ratio",
"samozino_practical_profile.optimal_Sfv",
"samozino_practical_profile.optimal_Sfv_rel",
"samozino_practical_profile.Sfv_perc",
"samozino_practical_profile.FV_imbalance",
"samozino_practical_profile.probe_IMB"
)
vj_probing_change <- seq(0.9, 1.1, length.out = 7)
# For profiling
external_load_options <- seq(-40, 120, 10)
external_load_options_selected <- seq(0, 80, 20)
# Function to extract one column from the probing data
get_metric_sensitivity <- function(probing_data, variable, invert = FALSE) {
df <- data.frame(
change_ratio = probing_data$change_ratio,
probing = probing_data$probing,
variable = probing_data[[variable]]
)
if (invert) {
df$change_ratio <- 1 / df$change_ratio
}
return(df)
}
# Function to extract one parameter
get_parameter_sensitivity <- function(probing_data, parameter, invert = FALSE, summary_variables = summary_variables, key_columns = 13) {
probing_data <- probing_data[probing_data$probing == parameter, ]
if (invert) {
probing_data$change_ratio <- 1 / df$change_ratio
}
df <- gather(probing_data, key = "variable", value = "value", -(1:key_columns)) %>%
filter(
variable %in% summary_variables
)
return(df)
}
data("vjsim_data")
vjsim_data_features <- colnames(vjsim_data)
# -----------------------------------------------
# User Interface
ui <- navbarPage(
"Vertical Jump Simulator",
# ----------------------------
# tabPanel("About"),
# ----------------------------
tabPanel(
"Simulator",
sidebarPanel(actionButton("calculate", "Calculate"),
h3("System constraints"),
h4("Bodyweight"),
sliderInput("athlete1_BW", "Athlete 1", value = 75, min = 65, max = 100, ticks = FALSE, step = 1),
sliderInput("athlete2_BW", "Athlete 2", value = 75, min = 65, max = 100, ticks = FALSE, step = 1),
hr(),
h4("Push-off Distance"),
sliderInput("athlete1_push_off_distance", "Athlete 1", value = 0.4, min = 0.3, max = 0.6, ticks = FALSE, step = 0.01),
sliderInput("athlete2_push_off_distance", "Athlete 2", value = 0.4, min = 0.3, max = 0.6, ticks = FALSE, step = 0.01),
hr(),
h3("Force Generator characteristics"),
h4("Maximal Force"),
sliderInput("athlete1_max_force", "Athlete 1", value = 3000, min = 2000, max = 5000, ticks = FALSE, step = 100),
sliderInput("athlete2_max_force", "Athlete 2", value = 3000, min = 2000, max = 5000, ticks = FALSE, step = 100),
hr(),
h4("Maximal Velocity"),
sliderInput("athlete1_max_velocity", "Athlete 1", value = 4, min = 3, max = 8, ticks = FALSE, step = 0.1),
sliderInput("athlete2_max_velocity", "Athlete 2", value = 4, min = 3, max = 8, ticks = FALSE, step = 0.1),
hr(),
h4("Force Length Characteristic (Decline Rate)"),
sliderInput("athlete1_decline_rate", "Athlete 1", value = 1, min = 0, max = 1.5, ticks = FALSE, step = 0.01),
sliderInput("athlete2_decline_rate", "Athlete 2", value = 1, min = 0, max = 1.5, ticks = FALSE, step = 0.01),
hr(),
h4("Force Length Characteristic (Peak Location)"),
sliderInput("athlete1_peak_location", "Athlete 1", value = -0.05, max = -0.01, min = -0.2, ticks = FALSE, step = 0.01),
sliderInput("athlete2_peak_location", "Athlete 2", value = -0.05, max = -0.01, min = -0.2, ticks = FALSE, step = 0.01),
hr(),
h4("Time to Max Activation"),
sliderInput("athlete1_time_to_max_activation", "Athlete 1", value = 0.2, min = 0.1, max = 0.5, ticks = FALSE, step = 0.01),
sliderInput("athlete2_time_to_max_activation", "Athlete 2", value = 0.2, min = 0.1, max = 0.5, ticks = FALSE, step = 0.01),
hr(),
h3("Special scenarios"),
checkboxInput("athlete1_constant_force", "Athlete 1: Constant force over push-off", value = FALSE),
checkboxInput("athlete2_constant_force", "Athlete 2: Constant force over push-off", value = FALSE),
checkboxInput("athlete1_no_viscous_force", "Athlete 1: No Viscous force", value = FALSE),
checkboxInput("athlete2_no_viscous_force", "Athlete 2: No Viscous force", value = FALSE),
checkboxInput("athlete1_instant_force", "Athlete 1: Instant force in time", value = FALSE),
checkboxInput("athlete2_instant_force", "Athlete 2: Instant force in time", value = FALSE),
width = 3
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Force Generator",
br(),
h4("Force-Length Characteristic"),
checkboxInput("use_distance_to_take_off", "Use distance to take off?", value = FALSE),
plotlyOutput("force_length_characteristic"),
br(),
h4("Force-Time Characteristic"),
plotlyOutput("force_time_characteristic"),
br(),
h4("Force-Velocity Characteristic"),
plotlyOutput("force_velocity_characteristic")
),
tabPanel(
"Jump Analysis",
br(),
fixedRow(
column(
6,
selectInput(
inputId = "jump_kinetics_x_var",
label = "X axis",
choices = trace_variables,
selected = "time"
)
),
column(
6,
selectInput(
inputId = "jump_kinetics_y_var",
label = "Y axis",
choices = trace_variables,
selected = "velocity"
)
)
),
br(),
plotlyOutput("jump_trace"),
br(),
h4("Jump summary"),
dataTableOutput("jump_summary_table"),
br(),
h4("Raw trace"),
br(),
h5("Athlete 1"),
dataTableOutput("athlete1_jump_trace"),
br(),
h5("Athlete 2"),
dataTableOutput("athlete2_jump_trace")
),
tabPanel(
"Jump Sensitivity",
br(),
selectInput(
inputId = "probing_variable",
label = "Probing summary variable",
choices = summary_variables,
selected = "height"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_jump_probing")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_jump_probing")
)
),
br(),
selectInput(
inputId = "parameter_variable",
label = "Probing Force Generator parameter",
choices = parameter_variables,
selected = "push_off_distance"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_parameter_probing")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_parameter_probing")
)
)
),
tabPanel(
"Profile Analysis",
br(),
selectInput(
inputId = "selected_external_load",
label = "External load",
choices = external_load_options,
multiple = TRUE,
selected = external_load_options_selected
),
br(),
fixedRow(
column(
6,
selectInput(
inputId = "jump_profile_x_var",
label = "X axis",
choices = profiling_variables,
selected = "mean_GRF_over_distance"
)
),
column(
6,
selectInput(
inputId = "jump_profile_y_var",
label = "Y axis",
choices = profiling_variables,
selected = "mean_velocity"
)
)
),
br(),
plotlyOutput("jump_profile"),
br(),
h4("Profile summaries"),
fixedRow(
column(
6,
h5("Athlete 1"),
dataTableOutput("athlete1_jump_profile_summary")
),
column(
6,
h5("Athlete 2"),
dataTableOutput("athlete2_jump_profile_summary")
)
),
h4("Profile data"),
br(),
h5("Athlete 1"),
dataTableOutput("athlete1_jump_profile_table"),
br(),
h5("Athlete 2"),
dataTableOutput("athlete2_jump_profile_table")
),
tabPanel(
"Profile Sensitivity",
br(),
selectInput(
inputId = "profile_variable",
label = "Probing profile variable",
choices = profile_summary_variables,
selected = "profile_mean_FV.Pmax"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_profile_probing")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_profile_probing")
)
),
br(),
fixedRow(
column(
6,
selectInput(
inputId = "profile_parameter_variable",
label = "Probing Force Generator parameter",
choices = parameter_variables,
selected = "push_off_distance"
),
br(),
h4("Athlete 1"),
plotlyOutput("athlete1_profile_parameter_probing")
),
column(
6,
selectInput(
inputId = "profile_type",
label = "Profile type",
choices = profile_type,
selected = "profile_mean_FV"
),
br(),
h4("Athlete 2"),
plotlyOutput("athlete2_profile_parameter_probing")
)
)
),
tabPanel(
"Optimization Analysis",
br(),
selectInput(
inputId = "samozino_model_optimization",
label = "Model",
choices = samozino_models,
selected = "Practical"
),
fixedRow(
column(
6,
br(),
h4("Athlete 1"),
plotlyOutput("athlete1_samozino_profile"),
br(),
h5("Sensitivity"),
plotlyOutput("athlete1_samozino_profile_probing"),
br(),
h5("Summary Table"),
dataTableOutput("athlete1_samozino_profile_summary")
),
column(
6,
br(),
h4("Athlete 2"),
plotlyOutput("athlete2_samozino_profile"),
br(),
h5("Sensitivity"),
plotlyOutput("athlete2_samozino_profile_probing"),
br(),
h5("Summary Table"),
dataTableOutput("athlete2_samozino_profile_summary")
)
)
),
tabPanel(
"Optimization Sensitivity",
br(),
selectInput(
width = "50%",
inputId = "samozino_profile_variable",
label = "Probing profile variable",
choices = samozino_profile_variables,
selected = "profile_mean_FV.Pmax"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_samozino_profile_probing_optimization")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_samozino_profile_probing_optimization")
)
),
br(),
fixedRow(
column(
6,
selectInput(
inputId = "profile_parameter_variable_opt",
label = "Probing Force Generator parameter",
choices = parameter_variables,
selected = "push_off_distance"
),
br(),
h4("Athlete 1"),
plotlyOutput("athlete1_samozino_profile_parameter_probing")
),
column(
6,
selectInput(
inputId = "samozino_model_optimization_opt",
label = "Model",
choices = samozino_models_opt,
selected = "samozino_practical_profile"
),
br(),
h4("Athlete 2"),
plotlyOutput("athlete2_samozino_profile_parameter_probing")
)
)
)
)
)
),
# ----------------------------
tabPanel(
"Explorer",
tabsetPanel(
type = "tabs",
tabPanel(
"Data",
br(),
dataTableOutput("explorer_data")
),
tabPanel(
"Explore",
br(),
fixedRow(
column(
6,
selectInput(
inputId = "explore_feature1", width = "80%",
label = "Feature 1",
choices = vjsim_data_features,
selected = "force_generator.Pmax_rel"
)
),
column(
6,
selectInput(
inputId = "explore_feature2", width = "80%",
label = "Feature 2",
choices = vjsim_data_features,
selected = "bodyweight_jump.height"
)
)
),
br(),
h4("Scatterplot"),
plotlyOutput("explore_chart", height = "600px"),
br(),
h4("Analysis"),
dataTableOutput("explore_table"),
br(),
h4("Descriptive stats"),
fixedRow(
column(
6,
plotlyOutput("explore_chart_histogram_feature1"),
dataTableOutput("explore_table_feature1")
),
column(
6,
plotlyOutput("explore_chart_histogram_feature2"),
dataTableOutput("explore_table_feature2")
)
)
),
tabPanel(
"Modeler",
br(),
fixedRow(
column(
5,
selectInput(
inputId = "modeler_target", width = "100%",
label = "Target variable",
choices = vjsim_data_features,
selected = "bodyweight_jump.height"
)
),
column(
7,
selectInput(
inputId = "modeler_predictors", width = "100%",
label = "Predictors",
choices = vjsim_data_features,
multiple = TRUE,
selected = "force_generator.Pmax_rel"
)
)
),
checkboxInput("interactions", "Add Interactions", FALSE),
actionButton("model", "Model"),
br(),
h3("Model Predictions"),
plotlyOutput("modeler_residuals", height = "600px"),
h3("Predictors importance"),
plotlyOutput("modeler_predictor_importance"),
h3("PDP+ICE plot"),
selectInput(
inputId = "pdp_ice_predictor",
label = "Predictor",
choices = c("")
),
checkboxInput("ice_line", "Add ICE", FALSE),
plotlyOutput("pdp_ice_plot", height = "600px"),
h3("Linear Regression Coefficients"),
verbatimTextOutput("modeler_linear_model_summary")
),
tabPanel(
"Feature Clustering",
br(),
fixedRow(
column(10,
selectInput(inputId = "feature_clustering", width = "100%",
label = "Features",
choices = vjsim_data_features,
multiple = TRUE,
selected = "")),
column(2, br(), actionButton("analyze", "Analyze"))),
br(),
plotOutput("feature_clustering_chart")
)
)
)
)
# -----------------------------------------------
# Server
server <- function(input, output, session) {
# ---------------------------------------------
# Reactive parameters
# These response when CALCULATE is pushed
# Bodyweight
athlete1_BW <- eventReactive(input$calculate,
{
return(input$athlete1_BW)
},
ignoreNULL = FALSE
)
athlete2_BW <- eventReactive(input$calculate,
{
return(input$athlete2_BW)
},
ignoreNULL = FALSE
)
# Push-off distance
athlete1_push_off_distance <- eventReactive(input$calculate,
{
return(input$athlete1_push_off_distance)
},
ignoreNULL = FALSE
)
athlete2_push_off_distance <- eventReactive(input$calculate,
{
return(input$athlete2_push_off_distance)
},
ignoreNULL = FALSE
)
# Max-Force
athlete1_max_force <- eventReactive(input$calculate,
{
return(input$athlete1_max_force)
},
ignoreNULL = FALSE
)
athlete2_max_force <- eventReactive(input$calculate,
{
return(input$athlete2_max_force)
},
ignoreNULL = FALSE
)
# Max Velocity
athlete1_max_velocity <- eventReactive(input$calculate,
{
if (input$athlete1_no_viscous_force) {
return(Inf)
} else {
return(input$athlete1_max_velocity)
}
},
ignoreNULL = FALSE
)
athlete2_max_velocity <- eventReactive(input$calculate,
{
if (input$athlete2_no_viscous_force) {
return(Inf)
} else {
return(input$athlete2_max_velocity)
}
},
ignoreNULL = FALSE
)
# Decline Rate
athlete1_decline_rate <- eventReactive(input$calculate,
{
if (input$athlete1_constant_force) {
return(0)
} else {
return(input$athlete1_decline_rate)
}
},
ignoreNULL = FALSE
)
athlete2_decline_rate <- eventReactive(input$calculate,
{
if (input$athlete2_constant_force) {
return(0)
} else {
return(input$athlete2_decline_rate)
}
},
ignoreNULL = FALSE
)
# Peak Location
athlete1_peak_location <- eventReactive(input$calculate,
{
if (input$athlete1_constant_force) {
return(0)
} else {
return(input$athlete1_peak_location)
}
},
ignoreNULL = FALSE
)
athlete2_peak_location <- eventReactive(input$calculate,
{
if (input$athlete2_constant_force) {
return(0)
} else {
return(input$athlete2_peak_location)
}
},
ignoreNULL = FALSE
)
# Time to max activation
athlete1_time_to_max_activation <- eventReactive(input$calculate,
{
if (input$athlete1_instant_force) {
return(0)
} else {
return(input$athlete1_time_to_max_activation)
}
},
ignoreNULL = FALSE
)
athlete2_time_to_max_activation <- eventReactive(input$calculate,
{
if (input$athlete2_instant_force) {
return(0)
} else {
return(input$athlete2_time_to_max_activation)
}
},
ignoreNULL = FALSE
)
# --------------
# Jump trace reactive element
athlete1_jump_trace <- eventReactive(input$calculate,
{
jump_trace <- vj_simulate(
mass = athlete1_BW(),
weight = athlete1_BW() * gravity_const,
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
save_trace = TRUE,
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location(),
time_to_max_activation = athlete1_time_to_max_activation()
)
return(jump_trace)
},
ignoreNULL = FALSE
)
athlete2_jump_trace <- eventReactive(input$calculate,
{
jump_trace <- vj_simulate(
mass = athlete2_BW(),
weight = athlete2_BW() * gravity_const,
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
save_trace = TRUE,
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location(),
time_to_max_activation = athlete2_time_to_max_activation()
)
return(jump_trace)
},
ignoreNULL = FALSE
)
# -------
# Jump probe reactive element
athlete1_jump_probe <- eventReactive(input$calculate,
{
jump_probe_raw <- probe_vj(
mass = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "raw",
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
jump_probe_ratio <- probe_vj(
mass = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
return(list(raw = jump_probe_raw, ratio = jump_probe_ratio))
},
ignoreNULL = FALSE
)
athlete2_jump_probe <- eventReactive(input$calculate,
{
jump_probe_raw <- probe_vj(
mass = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "raw",
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
jump_probe_ratio <- probe_vj(
mass = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
return(list(raw = jump_probe_raw, ratio = jump_probe_ratio))
},
ignoreNULL = FALSE
)
# --------
# Profile reactive element
athlete1_get_jump_profile <- eventReactive(input$calculate,
{
jump_profile <- vj_profile(
external_load = as.numeric(input$selected_external_load),
mass = athlete1_BW(),
# weight = athlete1_BW() * gravity_const,
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location(),
time_to_max_activation = athlete1_time_to_max_activation()
)
return(jump_profile)
},
ignoreNULL = FALSE
)
athlete2_get_jump_profile <- eventReactive(input$calculate,
{
jump_profile <- vj_profile(
external_load = as.numeric(input$selected_external_load),
mass = athlete2_BW(),
# weight = athlete2_BW() * gravity_const,
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location(),
time_to_max_activation = athlete2_time_to_max_activation()
)
return(jump_profile)
},
ignoreNULL = FALSE
)
# --------
# Profile probing reactive elements
# Jump probe reactive element
athlete1_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete1_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
athlete2_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete2_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
# ------------------------
# Samozino optimization
athlete1_samozino_profile <- eventReactive(input$calculate,
{
profile_data <- athlete1_get_jump_profile()
samozino_profile <- get_all_samozino_profiles(profile_data)
return(samozino_profile)
},
ignoreNULL = FALSE
)
athlete2_samozino_profile <- eventReactive(input$calculate,
{
profile_data <- athlete2_get_jump_profile()
samozino_profile <- get_all_samozino_profiles(profile_data)
return(samozino_profile)
},
ignoreNULL = FALSE
)
# ---------------------------
# Samozino probing
athlete1_samozino_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete1_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
profile_func = get_all_samozino_profiles,
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
athlete2_samozino_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete2_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
profile_func = get_all_samozino_profiles,
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
# Explorer
explore_data <- reactive({
df <- select_(vjsim_data, .dots = c(
input$explore_feature1,
input$explore_feature2
))
return(df)
})
# -----------------------------------------------------
# Explorer
# Modeler
modeler_linear_model <- eventReactive(input$model, {
# Update PDP list
updateSelectInput(session, "pdp_ice_predictor",
choices = input$modeler_predictors
)
model_df <- select_(vjsim_data, .dots = c(
input$modeler_target,
input$modeler_predictors
))
interactions_string <- "~."
if (input$interactions) interactions_string <- "~.*."
model <- lm(as.formula(paste(input$modeler_target, interactions_string)), data = model_df)
return(list(
data = model_df,
model = model
))
})
# -----------------------------------------------------
# Feature Clustering
feature_clustering_model <- eventReactive(input$analyze, {
cluster_model <- hclustvar(select_(vjsim_data, .dots = input$feature_clustering))
return(cluster_model)
})
# -----------------------------------------------------
# Simulator
# -----------------------------
# Force Generator panel
# ---------
output$force_length_characteristic <- renderPlotly({
current_distance <- seq(0, 0.6, length.out = fgen_length_out)
athlete1_DF <- data.frame(
current_distance = current_distance,
distance_perc = current_distance / athlete1_push_off_distance(),
distance_to_take_off = current_distance - athlete1_push_off_distance(),
force_perc = vjsim::fgen_get_force_percentage(
current_distance = current_distance,
push_off_distance = athlete1_push_off_distance(),
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
)
athlete1_DF$force <- athlete1_DF$force_perc * athlete1_max_force()
athlete2_DF <- data.frame(
current_distance = current_distance,
distance_perc = current_distance / athlete2_push_off_distance(),
distance_to_take_off = current_distance - athlete2_push_off_distance(),
force_perc = vjsim::fgen_get_force_percentage(
current_distance = current_distance,
push_off_distance = athlete2_push_off_distance(),
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
)
athlete2_DF$force <- athlete2_DF$force_perc * athlete2_max_force()
if (input$use_distance_to_take_off == TRUE) {
x_label <- "Distance to take-off (m)"
athlete1_DF$x <- athlete1_DF$distance_to_take_off
athlete2_DF$x <- athlete2_DF$distance_to_take_off
} else {
x_label <- "Distance (m)"
athlete1_DF$x <- athlete1_DF$current_distance
athlete2_DF$x <- athlete2_DF$current_distance
}
gg <- plot_ly() %>%
add_lines(
data = athlete1_DF, x = ~x, y = ~force,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"Distance =", round(current_distance, 2), "m\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(distance_perc * 100, 0), "%\n",
"Force =", round(force_perc * 100, 0), "%\n",
"Force =", round(force, 0), "N\n"
)
) %>%
add_lines(
data = athlete2_DF, x = ~x, y = ~force,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"Distance =", round(current_distance, 2), "m\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(distance_perc * 100, 0), "%\n",
"Force =", round(force_perc * 100, 0), "%\n",
"Force =", round(force, 0), "N\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = "Potential Force (N)",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = x_label,
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# -------------
output$force_time_characteristic <- renderPlotly({
current_time <- seq(0, 0.5, length.out = fgen_length_out)
athlete1_DF <- data.frame(
current_time = current_time,
activation = vjsim::fgen_get_activation(
current_time = current_time,
initial_activation = (athlete1_BW() * 9.81) / athlete1_max_force(),
time_to_max_activation = athlete1_time_to_max_activation()
)
)
athlete1_DF$force <- athlete1_DF$activation * athlete1_max_force()
athlete2_DF <- data.frame(
current_time = current_time,
activation = vjsim::fgen_get_activation(
current_time = current_time,
initial_activation = (athlete2_BW() * 9.81) / athlete2_max_force(),
time_to_max_activation = athlete2_time_to_max_activation()
)
)
athlete2_DF$force <- athlete2_DF$activation * athlete2_max_force()
gg <- plot_ly() %>%
add_lines(
data = athlete1_DF, x = ~current_time, y = ~force,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"Activation =", round(activation * 100, 0), "%\n",
"Time =", round(current_time, 2), "s\n",
"Force =", round(force, 0), "N\n"
)
) %>%
add_lines(
data = athlete2_DF, x = ~current_time, y = ~force,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"Activation =", round(activation * 100, 0), "%\n",
"Time =", round(current_time, 2), "s\n",
"Force =", round(force, 0), "N\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = "Generated Force (N)",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Time (s)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# -------------
output$force_velocity_characteristic <- renderPlotly({
external_force <- seq(0, athlete1_max_force(), length.out = fgen_length_out)
athlete1_DF <- data.frame(
external_force = external_force,
velocity = vjsim::fgen_get_velocity(
external_force = external_force,
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity()
)
)
external_force <- seq(0, athlete2_max_force(), length.out = fgen_length_out)
athlete2_DF <- data.frame(
external_force = external_force,
velocity = vjsim::fgen_get_velocity(
external_force = external_force,
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity()
)
)
gg <- plot_ly() %>%
add_lines(
data = athlete1_DF, x = ~external_force, y = ~velocity,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"External Force =", round(external_force, 0), "N\n",
"Max Velocity =", round(velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = athlete2_DF, x = ~external_force, y = ~velocity,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"External Force =", round(external_force, 0), "N\n",
"Max Velocity =", round(velocity, 2), "m/s\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = "Max Velocity (m/s)",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "External Force (s)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# ----------------------------------------------
# Jump trace
output$jump_trace <- renderPlotly({
withProgress(message = "Jump trace", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_trace <- athlete1_jump_trace()$trace
incProgress(1, detail = "Athlete 2")
athlete2_trace <- athlete2_jump_trace()$trace
})
athlete1_trace$x_var <- athlete1_trace[, input$jump_kinetics_x_var]
athlete1_trace$y_var <- athlete1_trace[, input$jump_kinetics_y_var]
athlete2_trace$x_var <- athlete2_trace[, input$jump_kinetics_x_var]
athlete2_trace$y_var <- athlete2_trace[, input$jump_kinetics_y_var]
gg <- plot_ly() %>%
add_lines(
data = athlete1_trace, x = ~x_var, y = ~y_var,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"Mass =", round(mass, 0), "kg\n",
"Weight =", round(weight, 0), "N\n",
"Time =", round(time, 2), "s\n",
"Distance =", round(distance, 2), "m\n",
"Velocity =", round(velocity, 2), "m/s\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(push_off_perc * 100, 0), "%\n",
"Force percentage =", round(force_percentage * 100, 0), "%\n",
"Potential force =", round(potential_force, 0), "N\n",
"Activation =", round(activation * 100, 0), "%\n",
"Generated force =", round(generated_force, 0), "N\n",
"Viscous force =", round(viscous_force, 0), "N\n",
"Ground reaction force =", round(ground_reaction_force, 0), "N\n",
"Propulsive force =", round(propulsive_force, 0), "N\n",
"Acceleration =", round(acceleration, 2), "m/s^2\n",
"Power =", round(power, 0), "W\n",
"RFD =", round(RFD, 0), "N/s\n",
"RPD =", round(RPD, 0), "W/s\n"
)
) %>%
add_lines(
data = athlete2_trace, x = ~x_var, y = ~y_var,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"Mass =", round(mass, 0), "kg\n",
"Weight =", round(weight, 0), "N\n",
"Time =", round(time, 2), "s\n",
"Distance =", round(distance, 2), "m\n",
"Velocity =", round(velocity, 2), "m/s\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(push_off_perc * 100, 0), "%\n",
"Force percentage =", round(force_percentage * 100, 0), "%\n",
"Potential force =", round(potential_force, 0), "N\n",
"Activation =", round(activation * 100, 0), "%\n",
"Generated force =", round(generated_force, 0), "N\n",
"Viscous force =", round(viscous_force, 0), "N\n",
"Ground reaction force =", round(ground_reaction_force, 0), "N\n",
"Propulsive force =", round(propulsive_force, 0), "N\n",
"Acceleration =", round(acceleration, 2), "m/s^2\n",
"Power =", round(power, 0), "W\n",
"RFD =", round(RFD, 0), "N/s\n",
"RPD =", round(RPD, 0), "W/s\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = input$jump_kinetics_y_var,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = input$jump_kinetics_x_var,
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# Summary table
output$jump_summary_table <- renderDataTable({
withProgress(message = "Jump summary", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_summary <- athlete1_jump_trace()$summary
incProgress(1, detail = "Athlete 2")
athlete2_summary <- athlete2_jump_trace()$summary
})
df <- rbind(
data.frame(Athlete = "Athlete 1", round(athlete1_summary, 2)),
data.frame(Athlete = "Athlete 2", round(athlete2_summary, 2))
)
# rownames(df) <- c("Athlete 1", "Athlete 2")
# df <- t(df)
df <- datatable(df, rownames = FALSE)
return(df)
})
# Trace table
output$athlete1_jump_trace <- renderDataTable({
withProgress(message = "Jump trace table", value = 0, {
incProgress(1, detail = "Athlete 1")
athlete1_trace <- athlete1_jump_trace()$trace
})
df <- datatable(athlete1_trace, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete1_trace), digits = 3)
return(df)
})
output$athlete2_jump_trace <- renderDataTable({
withProgress(message = "Jump trace table", value = 0, {
incProgress(1, detail = "Athlete 2")
athlete2_trace <- athlete2_jump_trace()$trace
})
df <- datatable(athlete2_trace, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete2_trace), digits = 3)
return(df)
})
# Jump probing
output$athlete1_jump_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_jump_probe()$raw
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_metric_sensitivity(athlete1_probing, input$probing_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
input$probing_variable, "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = input$probing_variable,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_jump_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_jump_probe()$raw
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_metric_sensitivity(athlete2_probing, input$probing_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
input$probing_variable, "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = input$probing_variable,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# -----------
# Parameter probing
output$athlete1_parameter_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_jump_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete1_probing,
input$parameter_variable,
summary_variables = summary_variables,
key_columns = 13
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_parameter_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_jump_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete2_probing,
input$parameter_variable,
summary_variables = summary_variables,
key_columns = 13
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# ---------------------------------------------
# Profiling
output$jump_profile <- renderPlotly({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
# bind together
athlete1_plot_data <- data.frame(
x_var = athlete1_jump_profile_data[, input$jump_profile_x_var],
y_var = athlete1_jump_profile_data[, input$jump_profile_y_var],
athlete1_jump_profile_data
)
athlete2_plot_data <- data.frame(
x_var = athlete2_jump_profile_data[, input$jump_profile_x_var],
y_var = athlete2_jump_profile_data[, input$jump_profile_y_var],
athlete2_jump_profile_data
)
gg <- plot_ly() %>%
add_lines(
data = athlete1_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 1", line = list(color = "#5DA5DA")
) %>%
add_markers(
data = athlete1_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 1", marker = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
add_lines(
data = athlete2_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 2", line = list(color = "#FAA43A")
) %>%
add_markers(
data = athlete2_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 2", marker = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = input$jump_profile_y_var,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = input$jump_profile_x_var,
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
output$athlete1_jump_profile_table <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
df <- datatable(athlete1_jump_profile_data, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete1_jump_profile_data), digits = 2)
return(df)
})
output$athlete2_jump_profile_table <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
df <- datatable(athlete2_jump_profile_data, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete2_jump_profile_data), digits = 2)
return(df)
})
# -----
# Summary profile tables
output$athlete1_jump_profile_summary <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
all_profiles <- get_all_profiles(athlete1_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
output$athlete2_jump_profile_summary <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
all_profiles <- get_all_profiles(athlete2_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
# -----------------------------------
# Profile Probing
output$athlete1_profile_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_metric_sensitivity(athlete1_probing, input$profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_profile_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_metric_sensitivity(athlete2_probing, input$profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete1_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete1_probing,
input$profile_parameter_variable,
summary_variables = profile_summary_variables,
key_columns = 12
) %>%
filter(grepl(input$profile_type, variable)) %>%
mutate(variable = str_remove(variable, paste(input$profile_type, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete2_probing,
input$profile_parameter_variable,
summary_variables = profile_summary_variables,
key_columns = 12
) %>%
filter(grepl(input$profile_type, variable)) %>%
mutate(variable = str_remove(variable, paste(input$profile_type, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# ------------------------------------------------------------
# Optimization
output$athlete1_samozino_profile <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_samozino_profile <- athlete1_samozino_profile()
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete1_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_V0
athlete1_plot_data <- data.frame(
x_var = athlete1_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete1_jump_profile_data[, "mean_velocity_as_TOV_half"],
athlete1_jump_profile_data
)
y_label <- "Take-off Velocity / 2 (m/s)"
} else {
F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_V0
athlete1_plot_data <- data.frame(
x_var = athlete1_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete1_jump_profile_data[, "mean_velocity"],
athlete1_jump_profile_data
)
y_label <- "Mean Velocity (m/s)"
}
plot_data <- tibble(
mean_force = seq(0, max(F0, optimal_F0), length.out = fgen_length_out),
mean_velocity = (mean_force / (-(F0 / V0))) + V0,
optimal_mean_velocity = (mean_force / (-(optimal_F0 / optimal_V0))) + optimal_V0,
take_off_velocity = get_take_off_velocity(
mean_force = mean_force,
mass = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const
),
take_off_velocity_half = take_off_velocity / 2
)
plot_data <- plot_data %>%
mutate(
mean_velocity = ifelse(mean_velocity < 0, NA, mean_velocity),
optimal_mean_velocity = ifelse(optimal_mean_velocity < 0, NA, optimal_mean_velocity)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~take_off_velocity_half,
name = "", line = list(color = "grey"),
hoverinfo = "text",
text = ~ paste(
"Model prediction\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"take_off_velocity", round(take_off_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~mean_velocity,
name = paste(input$samozino_model_optimization, "profile"), line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
input$samozino_model_optimization, "profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~optimal_mean_velocity,
name = "Optimal profile", line = list(color = "#5DA5DA", dash = "dot"),
hoverinfo = "text",
text = ~ paste(
"Optimal profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(optimal_mean_velocity, 2), "m/s\n"
)
) %>%
add_markers(
data = athlete1_plot_data, x = ~x_var, y = ~y_var,
name = "Jumps", marker = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Jumps", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = y_label,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Mean GRF Over Distance (N)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
output$athlete2_samozino_profile <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_samozino_profile <- athlete2_samozino_profile()
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete2_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_V0
athlete2_plot_data <- data.frame(
x_var = athlete2_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete2_jump_profile_data[, "mean_velocity_as_TOV_half"],
athlete2_jump_profile_data
)
y_label <- "Take-off Velocity / 2 (m/s)"
} else {
F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_V0
athlete2_plot_data <- data.frame(
x_var = athlete2_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete2_jump_profile_data[, "mean_velocity"],
athlete2_jump_profile_data
)
y_label <- "Mean Velocity (m/s)"
}
plot_data <- tibble(
mean_force = seq(0, max(F0, optimal_F0), length.out = fgen_length_out),
mean_velocity = (mean_force / (-(F0 / V0))) + V0,
optimal_mean_velocity = (mean_force / (-(optimal_F0 / optimal_V0))) + optimal_V0,
take_off_velocity = get_take_off_velocity(
mean_force = mean_force,
mass = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const
),
take_off_velocity_half = take_off_velocity / 2
)
plot_data <- plot_data %>%
mutate(
mean_velocity = ifelse(mean_velocity < 0, NA, mean_velocity),
optimal_mean_velocity = ifelse(optimal_mean_velocity < 0, NA, optimal_mean_velocity)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~take_off_velocity_half,
name = "", line = list(color = "grey"),
hoverinfo = "text",
text = ~ paste(
"Model prediction\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"take_off_velocity", round(take_off_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~mean_velocity,
name = paste(input$samozino_model_optimization, "profile"), line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
input$samozino_model_optimization, "profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~optimal_mean_velocity,
name = "Optimal profile", line = list(color = "#FAA43A", dash = "dot"),
hoverinfo = "text",
text = ~ paste(
"Optimal profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(optimal_mean_velocity, 2), "m/s\n"
)
) %>%
add_markers(
data = athlete2_plot_data, x = ~x_var, y = ~y_var,
name = "Jumps", marker = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Jumps", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = y_label,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Mean GRF Over Distance (N)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
output$athlete1_samozino_profile_probing <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_samozino_profile <- athlete1_samozino_profile()
incProgress(1, detail = "Athlete 1")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete1_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_V0
} else {
F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_V0
}
plot_data <- probe_samozino_take_off_velocity(
F0 = F0,
V0 = V0,
bodyweight = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const,
change_ratio = seq(0.9, 1.1, length.out = fgen_length_out)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~take_off_velocity,
name = ~probing, color = ~probing,
line = list(
color = c(
"F0" = "#5DA5DA",
"V0" = "#FAA43A",
"bodyweight" = "#4D4D4D"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Model Take-off Velocity", "=", round(take_off_velocity, 2), "m/s\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Model Take-off Velocity",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_samozino_profile_probing <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_samozino_profile <- athlete2_samozino_profile()
incProgress(1, detail = "Athlete 2")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete2_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_V0
} else {
F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_V0
}
plot_data <- probe_samozino_take_off_velocity(
F0 = F0,
V0 = V0,
bodyweight = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const,
change_ratio = seq(0.9, 1.1, length.out = fgen_length_out)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~take_off_velocity,
name = ~probing, color = ~probing,
line = list(
color = c(
"F0" = "#5DA5DA",
"V0" = "#FAA43A",
"bodyweight" = "#4D4D4D"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Model Take-off Velocity", "=", round(take_off_velocity, 2), "m/s\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Model Take-off Velocity",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete1_samozino_profile_summary <- renderDataTable({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
all_profiles <- get_all_samozino_profiles(athlete1_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
output$athlete2_samozino_profile_summary <- renderDataTable({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
all_profiles <- get_all_samozino_profiles(athlete2_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
# ----------------------------
# Probing
output$athlete1_samozino_profile_probing_optimization <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_metric_sensitivity(athlete1_probing, input$samozino_profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$samozino_profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$samozino_profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_samozino_profile_probing_optimization <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_metric_sensitivity(athlete2_probing, input$samozino_profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$samozino_profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$samozino_profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete1_samozino_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete1_probing,
input$profile_parameter_variable_opt,
summary_variables = samozino_profile_variables,
key_columns = 7
) %>%
filter(grepl(input$samozino_model_optimization_opt, variable)) %>%
mutate(variable = str_remove(variable, paste(input$samozino_model_optimization_opt, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable_opt, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable_opt, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_samozino_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete2_probing,
input$profile_parameter_variable_opt,
summary_variables = samozino_profile_variables,
key_columns = 7
) %>%
filter(grepl(input$samozino_model_optimization_opt, variable)) %>%
mutate(variable = str_remove(variable, paste(input$samozino_model_optimization_opt, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable_opt, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable_opt, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# ----------------------------------------------------------------------
# Explorer
output$explorer_data <- renderDataTable({
return(datatable(vjsim_data, rownames = FALSE) %>%
formatRound(columns = 1:ncol(vjsim_data), digits = 2))
})
output$explore_chart <- renderPlotly({
df <- explore_data()
plot_data <- data.frame(x = df[[1]], y = df[[2]])
gam_model <- mgcv::gam(y ~ s(x, bs = "cs"), data = plot_data, method = "REML")
lm_model <- stats::lm(y ~ x, data = plot_data)
gam_data <- data.frame(x = seq(min(plot_data$x), max(plot_data$x), length.out = fgen_length_out))
gam_data$y_gam <- predict(gam_model, newdata = gam_data)
gam_data$y_lm <- predict(lm_model, newdata = gam_data)
gg <- plot_ly() %>%
add_markers(
data = plot_data, x = ~x, y = ~y,
name = "Scatterplot", marker = list(color = "rgba(93,165,218, 0.5)"),
hoverinfo = "text",
text = ~ paste(
input$explore_feature1, "=", round(x, 2), "\n",
input$explore_feature2, "=", round(y, 2), "\n"
)
) %>%
add_lines(
data = gam_data, x = ~x, y = ~y_gam,
name = "GAM prediction", line = list(color = "black"),
hoverinfo = "text",
text = ~ paste(
input$explore_feature1, "=", round(x, 2), "\n",
"GAM prediction=", round(y_gam, 2), "\n"
)
) %>%
add_lines(
data = gam_data, x = ~x, y = ~y_lm,
name = "LM prediction", line = list(color = "grey", dash = "dot"),
hoverinfo = "text",
text = ~ paste(
input$explore_feature1, "=", round(x, 2), "\n",
"LM prediction=", round(y_lm, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = input$explore_feature2,
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = input$explore_feature1,
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
# gg <- ggplot(df, aes_string(x = input$explore_feature1, y = input$explore_feature2)) +
# theme_minimal() +
# geom_point(color = "#5DA5DA", alpha = 0.5) +
# stat_smooth(color = "black", alpha = 0.5, method = "gam", formula = y~s(x, bs = "cs"))
# return(gg)
})
output$explore_table <- renderDataTable({
df <- explore_data()
plot_data <- data.frame(x = df[[1]], y = df[[2]])
gam_model <- mgcv::gam(y ~ s(x, bs = "cs"), data = plot_data, method = "REML")
correlation <- cor(df[[1]], df[[2]])
output_df <- data.frame(
Pearson = correlation,
LM.Rsquared = correlation^2,
GAM.Rsquare = summary(gam_model)$r.sq
)
df <- datatable(output_df, rownames = FALSE) %>%
formatRound(columns = 1:3, digits = 2)
return(df)
})
output$explore_chart_histogram_feature1 <- renderPlotly({
df <- explore_data()
plot_data <- data.frame(x = df[[1]])
gg <- ggplot(plot_data, aes(x = x)) +
theme_minimal() +
geom_density(fill = "#5DA5DA", alpha = 0.5) +
labs(x = input$explore_feature1)
return(ggplotly(gg))
})
output$explore_chart_histogram_feature2 <- renderPlotly({
df <- explore_data()
plot_data <- data.frame(x = df[[2]])
gg <- ggplot(plot_data, aes(x = x)) +
theme_minimal() +
geom_density(fill = "#FAA43A", alpha = 0.5) +
labs(x = input$explore_feature2)
return(ggplotly(gg))
})
output$explore_table_feature1 <- renderDataTable({
df <- explore_data()
df <- data.frame(x = df[[1]]) %>%
summarize(
mean = mean(x),
SD = sd(x),
median = median(x),
IQR = IQR(x),
min = min(x),
max = max(x)
)
df <- datatable(df, rownames = FALSE) %>%
formatRound(columns = seq(1, ncol(df)), digits = 2)
return(df)
})
output$explore_table_feature2 <- renderDataTable({
df <- explore_data()
df <- data.frame(x = df[[2]]) %>%
summarize(
mean = mean(x),
SD = sd(x),
median = median(x),
IQR = IQR(x),
min = min(x),
max = max(x)
)
df <- datatable(df, rownames = FALSE) %>%
formatRound(columns = seq(1, ncol(df)), digits = 2)
return(df)
})
# -----------------------------------------------------------------------------
# Modeler
output$modeler_linear_model_summary <- renderPrint({
withProgress(message = "Modeling", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
incProgress(1)
})
return(summary(modeler_df$model))
})
output$modeler_residuals <- renderPlotly({
withProgress(message = "Modeling", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
plot_data <- data.frame(y = vjsim_data[[input$modeler_target]])
plot_data$resid <- resid(modeler_df$model)
plot_data$pred <- predict(modeler_df$model)
gg <- plot_ly() %>%
add_markers(
data = plot_data, x = ~y, y = ~pred,
name = "Predicted", marker = list(color = "rgba(93,165,218, 0.5)"),
hoverinfo = "text",
text = ~ paste(
input$modeler_target, "=", round(y, 2), "\n",
"Predicted =", round(pred, 2), "\n"
)
) %>%
add_lines(
data = plot_data, x = ~y, y = ~y,
name = "Identity line", line = list(color = "grey", dash = "dot")
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = paste("Predicted", input$modeler_target),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = input$modeler_target,
showgrid = TRUE, zeroline = FALSE
)
)
incProgress(1)
})
return(gg)
})
output$modeler_predictor_importance <- renderPlotly({
withProgress(message = "Feature Importante", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
gg <- ggplotly(vip::vip(modeler_df$model, train = modeler_df$data, method = "firm") + theme_minimal())
incProgress(1)
})
return(gg)
})
output$pdp_ice_plot <- renderPlotly({
withProgress(message = "PDP+ICE", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
gg <- ggplot()
if (input$pdp_ice_predictor %in% input$modeler_predictors) {
gg <- ggplotly(
pdp::partial(
modeler_df$model,
train = modeler_df$data,
pred.var = input$pdp_ice_predictor,
plot = TRUE,
rug = FALSE,
ice = input$ice_line,
plot.engine = "ggplot2",
alpha = ifelse(input$ice_line, 0.01, 1),
) +
theme_minimal() +
ylab(paste("Predicted", input$modeler_target))
)
}
incProgress(1)
})
return(gg)
})
# -------------------------------------------------
# Clustering
output$feature_clustering_chart <- renderPlot({
withProgress(message = "Feature Clustering", value = 0, {
incProgress(0.5)
pp <- plot(as.phylo(feature_clustering_model()), type = "phylogram", cex = 1,
direction = "leftwards",
no.margin = TRUE)
incProgress(1)
})
return(pp)
})
}
# Run the application
shinyApp(ui = ui, server = server)
mladenjovanovic/vjsim documentation built on Aug. 7, 2020, 10:10 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(shiny)
library(plotly)
library(tidyverse)
library(vjsim)
library(DT)
library(ClustOfVar)
library(mgcv)
library(vip)
library(pdp)
library(ape)
# ----------------------------------------------
# Constants
gravity_const <- 9.81
time_step <- 0.001
fgen_length_out <- 1000
trace_variables <- c(
"time",
"distance",
"velocity",
"distance_to_take_off",
"push_off_perc",
"force_percentage",
"potential_force",
"activation",
"generated_force",
"viscous_force",
"ground_reaction_force",
"propulsive_force",
"acceleration",
"power",
"RFD",
"RPD"
)
summary_variables <- c(
"take_off_time",
"take_off_velocity",
"height",
"mean_GRF_over_distance",
"mean_GRF_over_time",
"peak_GRF",
"mean_velocity",
"peak_velocity",
"mean_power",
"peak_power",
"peak_RFD",
"GRF_at_100ms",
"GRF_at_200ms",
"peak_RPD",
"work_done",
"impulse"
)
parameter_variables <- c(
"mass",
"push_off_distance",
"max_force",
"max_velocity",
"time_to_max_activation"
)
profiling_variables <- c(
"external_load",
"mass",
"weight",
"take_off_time",
"take_off_velocity",
"height",
"mean_GRF_over_distance",
"mean_GRF_over_time",
"peak_GRF",
"mean_velocity",
"peak_velocity",
"mean_power",
"peak_power",
"peak_RFD",
"GRF_at_100ms",
"GRF_at_200ms",
"peak_RPD",
"work_done",
"impulse",
"ratio_peak_to_take_off_velocity",
"ratio_mean_to_take_off_velocity",
"ratio_mean_to_peak_velocity",
"ratio_mean_to_peak_power",
"ratio_mean_GRF_over_distance_to_time"
)
profile_summary_variables <- c(
"profile_mean_FV.F0",
"profile_mean_FV.V0",
"profile_mean_FV.Pmax",
"profile_mean_FV.Sfv",
"profile_mean_FV.Sfv_rel",
"profile_mean_power.Pmax",
"profile_mean_power.Pmax_location",
"profile_mean_power.F0_perc",
"profile_peak_FV.F0",
"profile_peak_FV.V0",
"profile_peak_FV.Pmax",
"profile_peak_FV.Sfv",
"profile_peak_FV.Sfv_rel",
"profile_peak_power.Pmax",
"profile_peak_power.Pmax_location",
"profile_peak_power.F0_perc",
"profile_load_take_off_velocity.V0",
"profile_load_take_off_velocity.L0",
"profile_load_take_off_velocity.Imax",
"profile_load_take_off_velocity.Slv",
"profile_load_take_off_velocity.Slv_rel",
"profile_load_impulse.Imax",
"profile_load_impulse.Imax_location",
"profile_load_impulse.L0_perc"
)
profile_type <- c(
"profile_mean_FV",
"profile_mean_power",
"profile_peak_FV",
"profile_peak_power",
"profile_load_take_off_velocity",
"profile_load_impulse"
)
samozino_models <- c(
"Practical",
"Theoretical"
)
samozino_models_opt <- c(
"samozino_practical_profile",
"samozino_theoretical_profile"
)
samozino_profile_variables <- c(
"samozino_theoretical_profile.F0",
"samozino_theoretical_profile.F0_rel",
"samozino_theoretical_profile.V0",
"samozino_theoretical_profile.Pmax",
"samozino_theoretical_profile.Pmax_rel",
"samozino_theoretical_profile.Sfv",
"samozino_theoretical_profile.Sfv_rel",
"samozino_theoretical_profile.take_off_velocity",
"samozino_theoretical_profile.height",
"samozino_theoretical_profile.optimal_F0",
"samozino_theoretical_profile.optimal_F0_rel",
"samozino_theoretical_profile.optimal_V0",
"samozino_theoretical_profile.optimal_height",
"samozino_theoretical_profile.optimal_height_diff",
"samozino_theoretical_profile.optimal_height_ratio",
"samozino_theoretical_profile.optimal_Pmax",
"samozino_theoretical_profile.optimal_Pmax_rel",
"samozino_theoretical_profile.optimal_take_off_velocity",
"samozino_theoretical_profile.optimal_take_off_velocity_diff",
"samozino_theoretical_profile.optimal_take_off_velocity_ratio",
"samozino_theoretical_profile.optimal_Sfv",
"samozino_theoretical_profile.optimal_Sfv_rel",
"samozino_theoretical_profile.Sfv_perc",
"samozino_theoretical_profile.FV_imbalance",
"samozino_theoretical_profile.probe_IMB",
"samozino_practical_profile.F0",
"samozino_practical_profile.F0_rel",
"samozino_practical_profile.V0",
"samozino_practical_profile.Pmax",
"samozino_practical_profile.Pmax_rel",
"samozino_practical_profile.Sfv",
"samozino_practical_profile.Sfv_rel",
"samozino_practical_profile.take_off_velocity",
"samozino_practical_profile.height",
"samozino_practical_profile.optimal_F0",
"samozino_practical_profile.optimal_F0_rel",
"samozino_practical_profile.optimal_V0",
"samozino_practical_profile.optimal_height",
"samozino_practical_profile.optimal_height_diff",
"samozino_practical_profile.optimal_height_ratio",
"samozino_practical_profile.optimal_Pmax",
"samozino_practical_profile.optimal_Pmax_rel",
"samozino_practical_profile.optimal_take_off_velocity",
"samozino_practical_profile.optimal_take_off_velocity_diff",
"samozino_practical_profile.optimal_take_off_velocity_ratio",
"samozino_practical_profile.optimal_Sfv",
"samozino_practical_profile.optimal_Sfv_rel",
"samozino_practical_profile.Sfv_perc",
"samozino_practical_profile.FV_imbalance",
"samozino_practical_profile.probe_IMB"
)
vj_probing_change <- seq(0.9, 1.1, length.out = 7)
# For profiling
external_load_options <- seq(-40, 120, 10)
external_load_options_selected <- seq(0, 80, 20)
# Function to extract one column from the probing data
get_metric_sensitivity <- function(probing_data, variable, invert = FALSE) {
df <- data.frame(
change_ratio = probing_data$change_ratio,
probing = probing_data$probing,
variable = probing_data[[variable]]
)
if (invert) {
df$change_ratio <- 1 / df$change_ratio
}
return(df)
}
# Function to extract one parameter
get_parameter_sensitivity <- function(probing_data, parameter, invert = FALSE, summary_variables = summary_variables, key_columns = 13) {
probing_data <- probing_data[probing_data$probing == parameter, ]
if (invert) {
probing_data$change_ratio <- 1 / df$change_ratio
}
df <- gather(probing_data, key = "variable", value = "value", -(1:key_columns)) %>%
filter(
variable %in% summary_variables
)
return(df)
}
data("vjsim_data")
vjsim_data_features <- colnames(vjsim_data)
# -----------------------------------------------
# User Interface
ui <- navbarPage(
"Vertical Jump Simulator",
# ----------------------------
# tabPanel("About"),
# ----------------------------
tabPanel(
"Simulator",
sidebarPanel(actionButton("calculate", "Calculate"),
h3("System constraints"),
h4("Bodyweight"),
sliderInput("athlete1_BW", "Athlete 1", value = 75, min = 65, max = 100, ticks = FALSE, step = 1),
sliderInput("athlete2_BW", "Athlete 2", value = 75, min = 65, max = 100, ticks = FALSE, step = 1),
hr(),
h4("Push-off Distance"),
sliderInput("athlete1_push_off_distance", "Athlete 1", value = 0.4, min = 0.3, max = 0.6, ticks = FALSE, step = 0.01),
sliderInput("athlete2_push_off_distance", "Athlete 2", value = 0.4, min = 0.3, max = 0.6, ticks = FALSE, step = 0.01),
hr(),
h3("Force Generator characteristics"),
h4("Maximal Force"),
sliderInput("athlete1_max_force", "Athlete 1", value = 3000, min = 2000, max = 5000, ticks = FALSE, step = 100),
sliderInput("athlete2_max_force", "Athlete 2", value = 3000, min = 2000, max = 5000, ticks = FALSE, step = 100),
hr(),
h4("Maximal Velocity"),
sliderInput("athlete1_max_velocity", "Athlete 1", value = 4, min = 3, max = 8, ticks = FALSE, step = 0.1),
sliderInput("athlete2_max_velocity", "Athlete 2", value = 4, min = 3, max = 8, ticks = FALSE, step = 0.1),
hr(),
h4("Force Length Characteristic (Decline Rate)"),
sliderInput("athlete1_decline_rate", "Athlete 1", value = 1, min = 0, max = 1.5, ticks = FALSE, step = 0.01),
sliderInput("athlete2_decline_rate", "Athlete 2", value = 1, min = 0, max = 1.5, ticks = FALSE, step = 0.01),
hr(),
h4("Force Length Characteristic (Peak Location)"),
sliderInput("athlete1_peak_location", "Athlete 1", value = -0.05, max = -0.01, min = -0.2, ticks = FALSE, step = 0.01),
sliderInput("athlete2_peak_location", "Athlete 2", value = -0.05, max = -0.01, min = -0.2, ticks = FALSE, step = 0.01),
hr(),
h4("Time to Max Activation"),
sliderInput("athlete1_time_to_max_activation", "Athlete 1", value = 0.2, min = 0.1, max = 0.5, ticks = FALSE, step = 0.01),
sliderInput("athlete2_time_to_max_activation", "Athlete 2", value = 0.2, min = 0.1, max = 0.5, ticks = FALSE, step = 0.01),
hr(),
h3("Special scenarios"),
checkboxInput("athlete1_constant_force", "Athlete 1: Constant force over push-off", value = FALSE),
checkboxInput("athlete2_constant_force", "Athlete 2: Constant force over push-off", value = FALSE),
checkboxInput("athlete1_no_viscous_force", "Athlete 1: No Viscous force", value = FALSE),
checkboxInput("athlete2_no_viscous_force", "Athlete 2: No Viscous force", value = FALSE),
checkboxInput("athlete1_instant_force", "Athlete 1: Instant force in time", value = FALSE),
checkboxInput("athlete2_instant_force", "Athlete 2: Instant force in time", value = FALSE),
width = 3
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel(
"Force Generator",
br(),
h4("Force-Length Characteristic"),
checkboxInput("use_distance_to_take_off", "Use distance to take off?", value = FALSE),
plotlyOutput("force_length_characteristic"),
br(),
h4("Force-Time Characteristic"),
plotlyOutput("force_time_characteristic"),
br(),
h4("Force-Velocity Characteristic"),
plotlyOutput("force_velocity_characteristic")
),
tabPanel(
"Jump Analysis",
br(),
fixedRow(
column(
6,
selectInput(
inputId = "jump_kinetics_x_var",
label = "X axis",
choices = trace_variables,
selected = "time"
)
),
column(
6,
selectInput(
inputId = "jump_kinetics_y_var",
label = "Y axis",
choices = trace_variables,
selected = "velocity"
)
)
),
br(),
plotlyOutput("jump_trace"),
br(),
h4("Jump summary"),
dataTableOutput("jump_summary_table"),
br(),
h4("Raw trace"),
br(),
h5("Athlete 1"),
dataTableOutput("athlete1_jump_trace"),
br(),
h5("Athlete 2"),
dataTableOutput("athlete2_jump_trace")
),
tabPanel(
"Jump Sensitivity",
br(),
selectInput(
inputId = "probing_variable",
label = "Probing summary variable",
choices = summary_variables,
selected = "height"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_jump_probing")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_jump_probing")
)
),
br(),
selectInput(
inputId = "parameter_variable",
label = "Probing Force Generator parameter",
choices = parameter_variables,
selected = "push_off_distance"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_parameter_probing")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_parameter_probing")
)
)
),
tabPanel(
"Profile Analysis",
br(),
selectInput(
inputId = "selected_external_load",
label = "External load",
choices = external_load_options,
multiple = TRUE,
selected = external_load_options_selected
),
br(),
fixedRow(
column(
6,
selectInput(
inputId = "jump_profile_x_var",
label = "X axis",
choices = profiling_variables,
selected = "mean_GRF_over_distance"
)
),
column(
6,
selectInput(
inputId = "jump_profile_y_var",
label = "Y axis",
choices = profiling_variables,
selected = "mean_velocity"
)
)
),
br(),
plotlyOutput("jump_profile"),
br(),
h4("Profile summaries"),
fixedRow(
column(
6,
h5("Athlete 1"),
dataTableOutput("athlete1_jump_profile_summary")
),
column(
6,
h5("Athlete 2"),
dataTableOutput("athlete2_jump_profile_summary")
)
),
h4("Profile data"),
br(),
h5("Athlete 1"),
dataTableOutput("athlete1_jump_profile_table"),
br(),
h5("Athlete 2"),
dataTableOutput("athlete2_jump_profile_table")
),
tabPanel(
"Profile Sensitivity",
br(),
selectInput(
inputId = "profile_variable",
label = "Probing profile variable",
choices = profile_summary_variables,
selected = "profile_mean_FV.Pmax"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_profile_probing")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_profile_probing")
)
),
br(),
fixedRow(
column(
6,
selectInput(
inputId = "profile_parameter_variable",
label = "Probing Force Generator parameter",
choices = parameter_variables,
selected = "push_off_distance"
),
br(),
h4("Athlete 1"),
plotlyOutput("athlete1_profile_parameter_probing")
),
column(
6,
selectInput(
inputId = "profile_type",
label = "Profile type",
choices = profile_type,
selected = "profile_mean_FV"
),
br(),
h4("Athlete 2"),
plotlyOutput("athlete2_profile_parameter_probing")
)
)
),
tabPanel(
"Optimization Analysis",
br(),
selectInput(
inputId = "samozino_model_optimization",
label = "Model",
choices = samozino_models,
selected = "Practical"
),
fixedRow(
column(
6,
br(),
h4("Athlete 1"),
plotlyOutput("athlete1_samozino_profile"),
br(),
h5("Sensitivity"),
plotlyOutput("athlete1_samozino_profile_probing"),
br(),
h5("Summary Table"),
dataTableOutput("athlete1_samozino_profile_summary")
),
column(
6,
br(),
h4("Athlete 2"),
plotlyOutput("athlete2_samozino_profile"),
br(),
h5("Sensitivity"),
plotlyOutput("athlete2_samozino_profile_probing"),
br(),
h5("Summary Table"),
dataTableOutput("athlete2_samozino_profile_summary")
)
)
),
tabPanel(
"Optimization Sensitivity",
br(),
selectInput(
width = "50%",
inputId = "samozino_profile_variable",
label = "Probing profile variable",
choices = samozino_profile_variables,
selected = "profile_mean_FV.Pmax"
),
fixedRow(
column(
6,
h4("Athlete 1"),
plotlyOutput("athlete1_samozino_profile_probing_optimization")
),
column(
6,
h4("Athlete 2"),
plotlyOutput("athlete2_samozino_profile_probing_optimization")
)
),
br(),
fixedRow(
column(
6,
selectInput(
inputId = "profile_parameter_variable_opt",
label = "Probing Force Generator parameter",
choices = parameter_variables,
selected = "push_off_distance"
),
br(),
h4("Athlete 1"),
plotlyOutput("athlete1_samozino_profile_parameter_probing")
),
column(
6,
selectInput(
inputId = "samozino_model_optimization_opt",
label = "Model",
choices = samozino_models_opt,
selected = "samozino_practical_profile"
),
br(),
h4("Athlete 2"),
plotlyOutput("athlete2_samozino_profile_parameter_probing")
)
)
)
)
)
),
# ----------------------------
tabPanel(
"Explorer",
tabsetPanel(
type = "tabs",
tabPanel(
"Data",
br(),
dataTableOutput("explorer_data")
),
tabPanel(
"Explore",
br(),
fixedRow(
column(
6,
selectInput(
inputId = "explore_feature1", width = "80%",
label = "Feature 1",
choices = vjsim_data_features,
selected = "force_generator.Pmax_rel"
)
),
column(
6,
selectInput(
inputId = "explore_feature2", width = "80%",
label = "Feature 2",
choices = vjsim_data_features,
selected = "bodyweight_jump.height"
)
)
),
br(),
h4("Scatterplot"),
plotlyOutput("explore_chart", height = "600px"),
br(),
h4("Analysis"),
dataTableOutput("explore_table"),
br(),
h4("Descriptive stats"),
fixedRow(
column(
6,
plotlyOutput("explore_chart_histogram_feature1"),
dataTableOutput("explore_table_feature1")
),
column(
6,
plotlyOutput("explore_chart_histogram_feature2"),
dataTableOutput("explore_table_feature2")
)
)
),
tabPanel(
"Modeler",
br(),
fixedRow(
column(
5,
selectInput(
inputId = "modeler_target", width = "100%",
label = "Target variable",
choices = vjsim_data_features,
selected = "bodyweight_jump.height"
)
),
column(
7,
selectInput(
inputId = "modeler_predictors", width = "100%",
label = "Predictors",
choices = vjsim_data_features,
multiple = TRUE,
selected = "force_generator.Pmax_rel"
)
)
),
checkboxInput("interactions", "Add Interactions", FALSE),
actionButton("model", "Model"),
br(),
h3("Model Predictions"),
plotlyOutput("modeler_residuals", height = "600px"),
h3("Predictors importance"),
plotlyOutput("modeler_predictor_importance"),
h3("PDP+ICE plot"),
selectInput(
inputId = "pdp_ice_predictor",
label = "Predictor",
choices = c("")
),
checkboxInput("ice_line", "Add ICE", FALSE),
plotlyOutput("pdp_ice_plot", height = "600px"),
h3("Linear Regression Coefficients"),
verbatimTextOutput("modeler_linear_model_summary")
),
tabPanel(
"Feature Clustering",
br(),
fixedRow(
column(10,
selectInput(inputId = "feature_clustering", width = "100%",
label = "Features",
choices = vjsim_data_features,
multiple = TRUE,
selected = "")),
column(2, br(), actionButton("analyze", "Analyze"))),
br(),
plotOutput("feature_clustering_chart")
)
)
)
)
# -----------------------------------------------
# Server
server <- function(input, output, session) {
# ---------------------------------------------
# Reactive parameters
# These response when CALCULATE is pushed
# Bodyweight
athlete1_BW <- eventReactive(input$calculate,
{
return(input$athlete1_BW)
},
ignoreNULL = FALSE
)
athlete2_BW <- eventReactive(input$calculate,
{
return(input$athlete2_BW)
},
ignoreNULL = FALSE
)
# Push-off distance
athlete1_push_off_distance <- eventReactive(input$calculate,
{
return(input$athlete1_push_off_distance)
},
ignoreNULL = FALSE
)
athlete2_push_off_distance <- eventReactive(input$calculate,
{
return(input$athlete2_push_off_distance)
},
ignoreNULL = FALSE
)
# Max-Force
athlete1_max_force <- eventReactive(input$calculate,
{
return(input$athlete1_max_force)
},
ignoreNULL = FALSE
)
athlete2_max_force <- eventReactive(input$calculate,
{
return(input$athlete2_max_force)
},
ignoreNULL = FALSE
)
# Max Velocity
athlete1_max_velocity <- eventReactive(input$calculate,
{
if (input$athlete1_no_viscous_force) {
return(Inf)
} else {
return(input$athlete1_max_velocity)
}
},
ignoreNULL = FALSE
)
athlete2_max_velocity <- eventReactive(input$calculate,
{
if (input$athlete2_no_viscous_force) {
return(Inf)
} else {
return(input$athlete2_max_velocity)
}
},
ignoreNULL = FALSE
)
# Decline Rate
athlete1_decline_rate <- eventReactive(input$calculate,
{
if (input$athlete1_constant_force) {
return(0)
} else {
return(input$athlete1_decline_rate)
}
},
ignoreNULL = FALSE
)
athlete2_decline_rate <- eventReactive(input$calculate,
{
if (input$athlete2_constant_force) {
return(0)
} else {
return(input$athlete2_decline_rate)
}
},
ignoreNULL = FALSE
)
# Peak Location
athlete1_peak_location <- eventReactive(input$calculate,
{
if (input$athlete1_constant_force) {
return(0)
} else {
return(input$athlete1_peak_location)
}
},
ignoreNULL = FALSE
)
athlete2_peak_location <- eventReactive(input$calculate,
{
if (input$athlete2_constant_force) {
return(0)
} else {
return(input$athlete2_peak_location)
}
},
ignoreNULL = FALSE
)
# Time to max activation
athlete1_time_to_max_activation <- eventReactive(input$calculate,
{
if (input$athlete1_instant_force) {
return(0)
} else {
return(input$athlete1_time_to_max_activation)
}
},
ignoreNULL = FALSE
)
athlete2_time_to_max_activation <- eventReactive(input$calculate,
{
if (input$athlete2_instant_force) {
return(0)
} else {
return(input$athlete2_time_to_max_activation)
}
},
ignoreNULL = FALSE
)
# --------------
# Jump trace reactive element
athlete1_jump_trace <- eventReactive(input$calculate,
{
jump_trace <- vj_simulate(
mass = athlete1_BW(),
weight = athlete1_BW() * gravity_const,
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
save_trace = TRUE,
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location(),
time_to_max_activation = athlete1_time_to_max_activation()
)
return(jump_trace)
},
ignoreNULL = FALSE
)
athlete2_jump_trace <- eventReactive(input$calculate,
{
jump_trace <- vj_simulate(
mass = athlete2_BW(),
weight = athlete2_BW() * gravity_const,
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
save_trace = TRUE,
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location(),
time_to_max_activation = athlete2_time_to_max_activation()
)
return(jump_trace)
},
ignoreNULL = FALSE
)
# -------
# Jump probe reactive element
athlete1_jump_probe <- eventReactive(input$calculate,
{
jump_probe_raw <- probe_vj(
mass = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "raw",
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
jump_probe_ratio <- probe_vj(
mass = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
return(list(raw = jump_probe_raw, ratio = jump_probe_ratio))
},
ignoreNULL = FALSE
)
athlete2_jump_probe <- eventReactive(input$calculate,
{
jump_probe_raw <- probe_vj(
mass = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "raw",
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
jump_probe_ratio <- probe_vj(
mass = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
return(list(raw = jump_probe_raw, ratio = jump_probe_ratio))
},
ignoreNULL = FALSE
)
# --------
# Profile reactive element
athlete1_get_jump_profile <- eventReactive(input$calculate,
{
jump_profile <- vj_profile(
external_load = as.numeric(input$selected_external_load),
mass = athlete1_BW(),
# weight = athlete1_BW() * gravity_const,
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location(),
time_to_max_activation = athlete1_time_to_max_activation()
)
return(jump_profile)
},
ignoreNULL = FALSE
)
athlete2_get_jump_profile <- eventReactive(input$calculate,
{
jump_profile <- vj_profile(
external_load = as.numeric(input$selected_external_load),
mass = athlete2_BW(),
# weight = athlete2_BW() * gravity_const,
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const,
time_step = time_step,
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location(),
time_to_max_activation = athlete2_time_to_max_activation()
)
return(jump_profile)
},
ignoreNULL = FALSE
)
# --------
# Profile probing reactive elements
# Jump probe reactive element
athlete1_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete1_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
athlete2_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete2_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
# ------------------------
# Samozino optimization
athlete1_samozino_profile <- eventReactive(input$calculate,
{
profile_data <- athlete1_get_jump_profile()
samozino_profile <- get_all_samozino_profiles(profile_data)
return(samozino_profile)
},
ignoreNULL = FALSE
)
athlete2_samozino_profile <- eventReactive(input$calculate,
{
profile_data <- athlete2_get_jump_profile()
samozino_profile <- get_all_samozino_profiles(profile_data)
return(samozino_profile)
},
ignoreNULL = FALSE
)
# ---------------------------
# Samozino probing
athlete1_samozino_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete1_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete1_push_off_distance(),
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity(),
time_to_max_activation = athlete1_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
profile_func = get_all_samozino_profiles,
# Extra params
weight = athlete1_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
athlete2_samozino_profile_probe <- eventReactive(input$calculate,
{
profile_probe_ratio <- probe_profile(
mass = athlete2_BW(),
external_load = as.numeric(input$selected_external_load),
push_off_distance = athlete2_push_off_distance(),
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity(),
time_to_max_activation = athlete2_time_to_max_activation(),
change_ratio = vj_probing_change,
aggregate = "ratio",
profile_func = get_all_samozino_profiles,
# Extra params
weight = athlete2_BW() * gravity_const,
gravity_const = gravity_const,
time_step = time_step,
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
return(list(ratio = profile_probe_ratio))
},
ignoreNULL = FALSE
)
# Explorer
explore_data <- reactive({
df <- select_(vjsim_data, .dots = c(
input$explore_feature1,
input$explore_feature2
))
return(df)
})
# -----------------------------------------------------
# Explorer
# Modeler
modeler_linear_model <- eventReactive(input$model, {
# Update PDP list
updateSelectInput(session, "pdp_ice_predictor",
choices = input$modeler_predictors
)
model_df <- select_(vjsim_data, .dots = c(
input$modeler_target,
input$modeler_predictors
))
interactions_string <- "~."
if (input$interactions) interactions_string <- "~.*."
model <- lm(as.formula(paste(input$modeler_target, interactions_string)), data = model_df)
return(list(
data = model_df,
model = model
))
})
# -----------------------------------------------------
# Feature Clustering
feature_clustering_model <- eventReactive(input$analyze, {
cluster_model <- hclustvar(select_(vjsim_data, .dots = input$feature_clustering))
return(cluster_model)
})
# -----------------------------------------------------
# Simulator
# -----------------------------
# Force Generator panel
# ---------
output$force_length_characteristic <- renderPlotly({
current_distance <- seq(0, 0.6, length.out = fgen_length_out)
athlete1_DF <- data.frame(
current_distance = current_distance,
distance_perc = current_distance / athlete1_push_off_distance(),
distance_to_take_off = current_distance - athlete1_push_off_distance(),
force_perc = vjsim::fgen_get_force_percentage(
current_distance = current_distance,
push_off_distance = athlete1_push_off_distance(),
decline_rate = athlete1_decline_rate(),
peak_location = athlete1_peak_location()
)
)
athlete1_DF$force <- athlete1_DF$force_perc * athlete1_max_force()
athlete2_DF <- data.frame(
current_distance = current_distance,
distance_perc = current_distance / athlete2_push_off_distance(),
distance_to_take_off = current_distance - athlete2_push_off_distance(),
force_perc = vjsim::fgen_get_force_percentage(
current_distance = current_distance,
push_off_distance = athlete2_push_off_distance(),
decline_rate = athlete2_decline_rate(),
peak_location = athlete2_peak_location()
)
)
athlete2_DF$force <- athlete2_DF$force_perc * athlete2_max_force()
if (input$use_distance_to_take_off == TRUE) {
x_label <- "Distance to take-off (m)"
athlete1_DF$x <- athlete1_DF$distance_to_take_off
athlete2_DF$x <- athlete2_DF$distance_to_take_off
} else {
x_label <- "Distance (m)"
athlete1_DF$x <- athlete1_DF$current_distance
athlete2_DF$x <- athlete2_DF$current_distance
}
gg <- plot_ly() %>%
add_lines(
data = athlete1_DF, x = ~x, y = ~force,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"Distance =", round(current_distance, 2), "m\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(distance_perc * 100, 0), "%\n",
"Force =", round(force_perc * 100, 0), "%\n",
"Force =", round(force, 0), "N\n"
)
) %>%
add_lines(
data = athlete2_DF, x = ~x, y = ~force,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"Distance =", round(current_distance, 2), "m\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(distance_perc * 100, 0), "%\n",
"Force =", round(force_perc * 100, 0), "%\n",
"Force =", round(force, 0), "N\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = "Potential Force (N)",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = x_label,
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# -------------
output$force_time_characteristic <- renderPlotly({
current_time <- seq(0, 0.5, length.out = fgen_length_out)
athlete1_DF <- data.frame(
current_time = current_time,
activation = vjsim::fgen_get_activation(
current_time = current_time,
initial_activation = (athlete1_BW() * 9.81) / athlete1_max_force(),
time_to_max_activation = athlete1_time_to_max_activation()
)
)
athlete1_DF$force <- athlete1_DF$activation * athlete1_max_force()
athlete2_DF <- data.frame(
current_time = current_time,
activation = vjsim::fgen_get_activation(
current_time = current_time,
initial_activation = (athlete2_BW() * 9.81) / athlete2_max_force(),
time_to_max_activation = athlete2_time_to_max_activation()
)
)
athlete2_DF$force <- athlete2_DF$activation * athlete2_max_force()
gg <- plot_ly() %>%
add_lines(
data = athlete1_DF, x = ~current_time, y = ~force,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"Activation =", round(activation * 100, 0), "%\n",
"Time =", round(current_time, 2), "s\n",
"Force =", round(force, 0), "N\n"
)
) %>%
add_lines(
data = athlete2_DF, x = ~current_time, y = ~force,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"Activation =", round(activation * 100, 0), "%\n",
"Time =", round(current_time, 2), "s\n",
"Force =", round(force, 0), "N\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = "Generated Force (N)",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Time (s)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# -------------
output$force_velocity_characteristic <- renderPlotly({
external_force <- seq(0, athlete1_max_force(), length.out = fgen_length_out)
athlete1_DF <- data.frame(
external_force = external_force,
velocity = vjsim::fgen_get_velocity(
external_force = external_force,
max_force = athlete1_max_force(),
max_velocity = athlete1_max_velocity()
)
)
external_force <- seq(0, athlete2_max_force(), length.out = fgen_length_out)
athlete2_DF <- data.frame(
external_force = external_force,
velocity = vjsim::fgen_get_velocity(
external_force = external_force,
max_force = athlete2_max_force(),
max_velocity = athlete2_max_velocity()
)
)
gg <- plot_ly() %>%
add_lines(
data = athlete1_DF, x = ~external_force, y = ~velocity,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"External Force =", round(external_force, 0), "N\n",
"Max Velocity =", round(velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = athlete2_DF, x = ~external_force, y = ~velocity,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"External Force =", round(external_force, 0), "N\n",
"Max Velocity =", round(velocity, 2), "m/s\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = "Max Velocity (m/s)",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "External Force (s)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# ----------------------------------------------
# Jump trace
output$jump_trace <- renderPlotly({
withProgress(message = "Jump trace", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_trace <- athlete1_jump_trace()$trace
incProgress(1, detail = "Athlete 2")
athlete2_trace <- athlete2_jump_trace()$trace
})
athlete1_trace$x_var <- athlete1_trace[, input$jump_kinetics_x_var]
athlete1_trace$y_var <- athlete1_trace[, input$jump_kinetics_y_var]
athlete2_trace$x_var <- athlete2_trace[, input$jump_kinetics_x_var]
athlete2_trace$y_var <- athlete2_trace[, input$jump_kinetics_y_var]
gg <- plot_ly() %>%
add_lines(
data = athlete1_trace, x = ~x_var, y = ~y_var,
name = "Athlete 1", line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1\n",
"Mass =", round(mass, 0), "kg\n",
"Weight =", round(weight, 0), "N\n",
"Time =", round(time, 2), "s\n",
"Distance =", round(distance, 2), "m\n",
"Velocity =", round(velocity, 2), "m/s\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(push_off_perc * 100, 0), "%\n",
"Force percentage =", round(force_percentage * 100, 0), "%\n",
"Potential force =", round(potential_force, 0), "N\n",
"Activation =", round(activation * 100, 0), "%\n",
"Generated force =", round(generated_force, 0), "N\n",
"Viscous force =", round(viscous_force, 0), "N\n",
"Ground reaction force =", round(ground_reaction_force, 0), "N\n",
"Propulsive force =", round(propulsive_force, 0), "N\n",
"Acceleration =", round(acceleration, 2), "m/s^2\n",
"Power =", round(power, 0), "W\n",
"RFD =", round(RFD, 0), "N/s\n",
"RPD =", round(RPD, 0), "W/s\n"
)
) %>%
add_lines(
data = athlete2_trace, x = ~x_var, y = ~y_var,
name = "Athlete 2", line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2\n",
"Mass =", round(mass, 0), "kg\n",
"Weight =", round(weight, 0), "N\n",
"Time =", round(time, 2), "s\n",
"Distance =", round(distance, 2), "m\n",
"Velocity =", round(velocity, 2), "m/s\n",
"Distance to take-off =", round(distance_to_take_off, 2), "m\n",
"Distance =", round(push_off_perc * 100, 0), "%\n",
"Force percentage =", round(force_percentage * 100, 0), "%\n",
"Potential force =", round(potential_force, 0), "N\n",
"Activation =", round(activation * 100, 0), "%\n",
"Generated force =", round(generated_force, 0), "N\n",
"Viscous force =", round(viscous_force, 0), "N\n",
"Ground reaction force =", round(ground_reaction_force, 0), "N\n",
"Propulsive force =", round(propulsive_force, 0), "N\n",
"Acceleration =", round(acceleration, 2), "m/s^2\n",
"Power =", round(power, 0), "W\n",
"RFD =", round(RFD, 0), "N/s\n",
"RPD =", round(RPD, 0), "W/s\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = input$jump_kinetics_y_var,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = input$jump_kinetics_x_var,
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
# Summary table
output$jump_summary_table <- renderDataTable({
withProgress(message = "Jump summary", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_summary <- athlete1_jump_trace()$summary
incProgress(1, detail = "Athlete 2")
athlete2_summary <- athlete2_jump_trace()$summary
})
df <- rbind(
data.frame(Athlete = "Athlete 1", round(athlete1_summary, 2)),
data.frame(Athlete = "Athlete 2", round(athlete2_summary, 2))
)
# rownames(df) <- c("Athlete 1", "Athlete 2")
# df <- t(df)
df <- datatable(df, rownames = FALSE)
return(df)
})
# Trace table
output$athlete1_jump_trace <- renderDataTable({
withProgress(message = "Jump trace table", value = 0, {
incProgress(1, detail = "Athlete 1")
athlete1_trace <- athlete1_jump_trace()$trace
})
df <- datatable(athlete1_trace, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete1_trace), digits = 3)
return(df)
})
output$athlete2_jump_trace <- renderDataTable({
withProgress(message = "Jump trace table", value = 0, {
incProgress(1, detail = "Athlete 2")
athlete2_trace <- athlete2_jump_trace()$trace
})
df <- datatable(athlete2_trace, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete2_trace), digits = 3)
return(df)
})
# Jump probing
output$athlete1_jump_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_jump_probe()$raw
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_metric_sensitivity(athlete1_probing, input$probing_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
input$probing_variable, "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = input$probing_variable,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_jump_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_jump_probe()$raw
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_metric_sensitivity(athlete2_probing, input$probing_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
input$probing_variable, "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = input$probing_variable,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# -----------
# Parameter probing
output$athlete1_parameter_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_jump_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete1_probing,
input$parameter_variable,
summary_variables = summary_variables,
key_columns = 13
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_parameter_probing <- renderPlotly({
withProgress(message = "Jump probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_jump_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete2_probing,
input$parameter_variable,
summary_variables = summary_variables,
key_columns = 13
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# ---------------------------------------------
# Profiling
output$jump_profile <- renderPlotly({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
# bind together
athlete1_plot_data <- data.frame(
x_var = athlete1_jump_profile_data[, input$jump_profile_x_var],
y_var = athlete1_jump_profile_data[, input$jump_profile_y_var],
athlete1_jump_profile_data
)
athlete2_plot_data <- data.frame(
x_var = athlete2_jump_profile_data[, input$jump_profile_x_var],
y_var = athlete2_jump_profile_data[, input$jump_profile_y_var],
athlete2_jump_profile_data
)
gg <- plot_ly() %>%
add_lines(
data = athlete1_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 1", line = list(color = "#5DA5DA")
) %>%
add_markers(
data = athlete1_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 1", marker = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Athlete 1", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
add_lines(
data = athlete2_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 2", line = list(color = "#FAA43A")
) %>%
add_markers(
data = athlete2_plot_data, x = ~x_var, y = ~y_var,
name = "Athlete 2", marker = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Athlete 2", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = input$jump_profile_y_var,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = input$jump_profile_x_var,
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
output$athlete1_jump_profile_table <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
df <- datatable(athlete1_jump_profile_data, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete1_jump_profile_data), digits = 2)
return(df)
})
output$athlete2_jump_profile_table <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
df <- datatable(athlete2_jump_profile_data, rownames = FALSE) %>%
formatRound(columns = 1:ncol(athlete2_jump_profile_data), digits = 2)
return(df)
})
# -----
# Summary profile tables
output$athlete1_jump_profile_summary <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
all_profiles <- get_all_profiles(athlete1_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
output$athlete2_jump_profile_summary <- renderDataTable({
withProgress(message = "Jump profiling", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
all_profiles <- get_all_profiles(athlete2_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
# -----------------------------------
# Profile Probing
output$athlete1_profile_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_metric_sensitivity(athlete1_probing, input$profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_profile_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_metric_sensitivity(athlete2_probing, input$profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete1_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete1_probing,
input$profile_parameter_variable,
summary_variables = profile_summary_variables,
key_columns = 12
) %>%
filter(grepl(input$profile_type, variable)) %>%
mutate(variable = str_remove(variable, paste(input$profile_type, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete2_probing,
input$profile_parameter_variable,
summary_variables = profile_summary_variables,
key_columns = 12
) %>%
filter(grepl(input$profile_type, variable)) %>%
mutate(variable = str_remove(variable, paste(input$profile_type, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# ------------------------------------------------------------
# Optimization
output$athlete1_samozino_profile <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_samozino_profile <- athlete1_samozino_profile()
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete1_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_V0
athlete1_plot_data <- data.frame(
x_var = athlete1_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete1_jump_profile_data[, "mean_velocity_as_TOV_half"],
athlete1_jump_profile_data
)
y_label <- "Take-off Velocity / 2 (m/s)"
} else {
F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_V0
athlete1_plot_data <- data.frame(
x_var = athlete1_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete1_jump_profile_data[, "mean_velocity"],
athlete1_jump_profile_data
)
y_label <- "Mean Velocity (m/s)"
}
plot_data <- tibble(
mean_force = seq(0, max(F0, optimal_F0), length.out = fgen_length_out),
mean_velocity = (mean_force / (-(F0 / V0))) + V0,
optimal_mean_velocity = (mean_force / (-(optimal_F0 / optimal_V0))) + optimal_V0,
take_off_velocity = get_take_off_velocity(
mean_force = mean_force,
mass = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const
),
take_off_velocity_half = take_off_velocity / 2
)
plot_data <- plot_data %>%
mutate(
mean_velocity = ifelse(mean_velocity < 0, NA, mean_velocity),
optimal_mean_velocity = ifelse(optimal_mean_velocity < 0, NA, optimal_mean_velocity)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~take_off_velocity_half,
name = "", line = list(color = "grey"),
hoverinfo = "text",
text = ~ paste(
"Model prediction\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"take_off_velocity", round(take_off_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~mean_velocity,
name = paste(input$samozino_model_optimization, "profile"), line = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
input$samozino_model_optimization, "profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~optimal_mean_velocity,
name = "Optimal profile", line = list(color = "#5DA5DA", dash = "dot"),
hoverinfo = "text",
text = ~ paste(
"Optimal profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(optimal_mean_velocity, 2), "m/s\n"
)
) %>%
add_markers(
data = athlete1_plot_data, x = ~x_var, y = ~y_var,
name = "Jumps", marker = list(color = "#5DA5DA"),
hoverinfo = "text",
text = ~ paste(
"Jumps", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = y_label,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Mean GRF Over Distance (N)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
output$athlete2_samozino_profile <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_samozino_profile <- athlete2_samozino_profile()
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete2_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_V0
athlete2_plot_data <- data.frame(
x_var = athlete2_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete2_jump_profile_data[, "mean_velocity_as_TOV_half"],
athlete2_jump_profile_data
)
y_label <- "Take-off Velocity / 2 (m/s)"
} else {
F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_V0
athlete2_plot_data <- data.frame(
x_var = athlete2_jump_profile_data[, "mean_GRF_over_distance"],
y_var = athlete2_jump_profile_data[, "mean_velocity"],
athlete2_jump_profile_data
)
y_label <- "Mean Velocity (m/s)"
}
plot_data <- tibble(
mean_force = seq(0, max(F0, optimal_F0), length.out = fgen_length_out),
mean_velocity = (mean_force / (-(F0 / V0))) + V0,
optimal_mean_velocity = (mean_force / (-(optimal_F0 / optimal_V0))) + optimal_V0,
take_off_velocity = get_take_off_velocity(
mean_force = mean_force,
mass = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const
),
take_off_velocity_half = take_off_velocity / 2
)
plot_data <- plot_data %>%
mutate(
mean_velocity = ifelse(mean_velocity < 0, NA, mean_velocity),
optimal_mean_velocity = ifelse(optimal_mean_velocity < 0, NA, optimal_mean_velocity)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~take_off_velocity_half,
name = "", line = list(color = "grey"),
hoverinfo = "text",
text = ~ paste(
"Model prediction\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"take_off_velocity", round(take_off_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~mean_velocity,
name = paste(input$samozino_model_optimization, "profile"), line = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
input$samozino_model_optimization, "profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n"
)
) %>%
add_lines(
data = plot_data, x = ~mean_force, y = ~optimal_mean_velocity,
name = "Optimal profile", line = list(color = "#FAA43A", dash = "dot"),
hoverinfo = "text",
text = ~ paste(
"Optimal profile\n",
"mean_GRF_over_distance =", round(mean_force, 0), "N\n",
"mean_velocity =", round(optimal_mean_velocity, 2), "m/s\n"
)
) %>%
add_markers(
data = athlete2_plot_data, x = ~x_var, y = ~y_var,
name = "Jumps", marker = list(color = "#FAA43A"),
hoverinfo = "text",
text = ~ paste(
"Jumps", "\n",
"external_load =", round(external_load, 2), "kg\n",
"mass =", round(mass, 2), "kg\n",
"weight =", round(weight, 2), "N\n",
"take_off_time =", round(take_off_time, 2), "s\n",
"take_off_velocity =", round(take_off_velocity, 2), "m/s\n",
"height =", round(height, 2), "m\n",
"mean_GRF_over_distance =", round(mean_GRF_over_distance, 0), "N\n",
"mean_GRF_over_time =", round(mean_GRF_over_time, 0), "N\n",
"peak_GRF =", round(peak_GRF, 0), "N\n",
"mean_velocity =", round(mean_velocity, 2), "m/s\n",
"peak_velocity =", round(peak_velocity, 2), "m/s\n",
"mean_power =", round(mean_power, 0), "W\n",
"peak_power =", round(peak_power, 0), "W\n",
"peak_RFD =", round(peak_RFD, 0), "N/s\n",
"peak_RPD =", round(peak_RPD, 0), "W/s\n",
"work_done =", round(work_done, 2), "J\n",
"impulse =", round(impulse, 2), "Ns\n"
)
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = y_label,
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Mean GRF Over Distance (N)",
showgrid = TRUE, zeroline = TRUE
)
)
return(gg)
})
output$athlete1_samozino_profile_probing <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_samozino_profile <- athlete1_samozino_profile()
incProgress(1, detail = "Athlete 1")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete1_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_practical_profile$optimal_V0
} else {
F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete1_samozino_profile$list$samozino_theoretical_profile$optimal_V0
}
plot_data <- probe_samozino_take_off_velocity(
F0 = F0,
V0 = V0,
bodyweight = athlete1_BW(),
push_off_distance = athlete1_push_off_distance(),
gravity_const = gravity_const,
change_ratio = seq(0.9, 1.1, length.out = fgen_length_out)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~take_off_velocity,
name = ~probing, color = ~probing,
line = list(
color = c(
"F0" = "#5DA5DA",
"V0" = "#FAA43A",
"bodyweight" = "#4D4D4D"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Model Take-off Velocity", "=", round(take_off_velocity, 2), "m/s\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Model Take-off Velocity",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_samozino_profile_probing <- renderPlotly({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_samozino_profile <- athlete2_samozino_profile()
incProgress(1, detail = "Athlete 2")
})
if (input$samozino_model_optimization == "Practical") {
F0 <- athlete2_samozino_profile$list$samozino_practical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_practical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_practical_profile$optimal_V0
} else {
F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$F0
V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$V0
optimal_F0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_F0
optimal_V0 <- athlete2_samozino_profile$list$samozino_theoretical_profile$optimal_V0
}
plot_data <- probe_samozino_take_off_velocity(
F0 = F0,
V0 = V0,
bodyweight = athlete2_BW(),
push_off_distance = athlete2_push_off_distance(),
gravity_const = gravity_const,
change_ratio = seq(0.9, 1.1, length.out = fgen_length_out)
)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~take_off_velocity,
name = ~probing, color = ~probing,
line = list(
color = c(
"F0" = "#5DA5DA",
"V0" = "#FAA43A",
"bodyweight" = "#4D4D4D"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Model Take-off Velocity", "=", round(take_off_velocity, 2), "m/s\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Model Take-off Velocity",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete1_samozino_profile_summary <- renderDataTable({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_jump_profile_data <- athlete1_get_jump_profile()
incProgress(1, detail = "Athlete 1")
})
all_profiles <- get_all_samozino_profiles(athlete1_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
output$athlete2_samozino_profile_summary <- renderDataTable({
withProgress(message = "Samozino profile", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_jump_profile_data <- athlete2_get_jump_profile()
incProgress(1, detail = "Athlete 2")
})
all_profiles <- get_all_samozino_profiles(athlete2_jump_profile_data)$data_frame
df <- datatable(all_profiles, rownames = FALSE) %>%
formatRound(columns = 3, digits = 2)
return(df)
})
# ----------------------------
# Probing
output$athlete1_samozino_profile_probing_optimization <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_metric_sensitivity(athlete1_probing, input$samozino_profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$samozino_profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$samozino_profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_samozino_profile_probing_optimization <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_metric_sensitivity(athlete2_probing, input$samozino_profile_variable)
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~variable,
name = ~probing, color = ~probing,
line = list(
color = c(
"mass" = "#4D4D4D",
"max_force" = "#5DA5DA",
"max_velocity" = "#FAA43A",
"push_off_distance" = "#60BD68",
"time_to_max_activation" = "#B276B2"
)
),
hoverinfo = "text",
text = ~ paste(
probing, "\n",
"Normalized change =", round(change_ratio, 2), "\n",
"Normalized", input$samozino_profile_variable, "chage", "=", round(variable, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = paste("Normalized", input$samozino_profile_variable, "chage"),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = "Normalized parameter change",
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete1_samozino_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 1")
athlete1_probing <- athlete1_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 1")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete1_probing,
input$profile_parameter_variable_opt,
summary_variables = samozino_profile_variables,
key_columns = 7
) %>%
filter(grepl(input$samozino_model_optimization_opt, variable)) %>%
mutate(variable = str_remove(variable, paste(input$samozino_model_optimization_opt, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable_opt, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable_opt, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
output$athlete2_samozino_profile_parameter_probing <- renderPlotly({
withProgress(message = "Profile probing", value = 0, {
incProgress(0.5, detail = "Athlete 2")
athlete2_probing <- athlete2_samozino_profile_probe()$ratio
incProgress(1, detail = "Athlete 2")
})
# Convert
plot_data <- get_parameter_sensitivity(
athlete2_probing,
input$profile_parameter_variable_opt,
summary_variables = samozino_profile_variables,
key_columns = 7
) %>%
filter(grepl(input$samozino_model_optimization_opt, variable)) %>%
mutate(variable = str_remove(variable, paste(input$samozino_model_optimization_opt, ".", sep = "")))
gg <- plot_ly() %>%
add_lines(
data = plot_data, x = ~change_ratio, y = ~value,
name = ~variable, color = ~variable,
hoverinfo = "text",
text = ~ paste(
variable, "\n",
input$profile_parameter_variable_opt, " change =", round(change_ratio, 2), "\n",
variable, "change =", round(value, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = "Normalized metric change",
showgrid = TRUE, zeroline = TRUE
),
xaxis = list(
side = "left", title = paste("Normalized", input$profile_parameter_variable_opt, "change"),
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
})
# ----------------------------------------------------------------------
# Explorer
output$explorer_data <- renderDataTable({
return(datatable(vjsim_data, rownames = FALSE) %>%
formatRound(columns = 1:ncol(vjsim_data), digits = 2))
})
output$explore_chart <- renderPlotly({
df <- explore_data()
plot_data <- data.frame(x = df[[1]], y = df[[2]])
gam_model <- mgcv::gam(y ~ s(x, bs = "cs"), data = plot_data, method = "REML")
lm_model <- stats::lm(y ~ x, data = plot_data)
gam_data <- data.frame(x = seq(min(plot_data$x), max(plot_data$x), length.out = fgen_length_out))
gam_data$y_gam <- predict(gam_model, newdata = gam_data)
gam_data$y_lm <- predict(lm_model, newdata = gam_data)
gg <- plot_ly() %>%
add_markers(
data = plot_data, x = ~x, y = ~y,
name = "Scatterplot", marker = list(color = "rgba(93,165,218, 0.5)"),
hoverinfo = "text",
text = ~ paste(
input$explore_feature1, "=", round(x, 2), "\n",
input$explore_feature2, "=", round(y, 2), "\n"
)
) %>%
add_lines(
data = gam_data, x = ~x, y = ~y_gam,
name = "GAM prediction", line = list(color = "black"),
hoverinfo = "text",
text = ~ paste(
input$explore_feature1, "=", round(x, 2), "\n",
"GAM prediction=", round(y_gam, 2), "\n"
)
) %>%
add_lines(
data = gam_data, x = ~x, y = ~y_lm,
name = "LM prediction", line = list(color = "grey", dash = "dot"),
hoverinfo = "text",
text = ~ paste(
input$explore_feature1, "=", round(x, 2), "\n",
"LM prediction=", round(y_lm, 2), "\n"
)
) %>%
layout(
showlegend = TRUE,
yaxis = list(
side = "left", title = input$explore_feature2,
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = input$explore_feature1,
showgrid = TRUE, zeroline = FALSE
)
)
return(gg)
# gg <- ggplot(df, aes_string(x = input$explore_feature1, y = input$explore_feature2)) +
# theme_minimal() +
# geom_point(color = "#5DA5DA", alpha = 0.5) +
# stat_smooth(color = "black", alpha = 0.5, method = "gam", formula = y~s(x, bs = "cs"))
# return(gg)
})
output$explore_table <- renderDataTable({
df <- explore_data()
plot_data <- data.frame(x = df[[1]], y = df[[2]])
gam_model <- mgcv::gam(y ~ s(x, bs = "cs"), data = plot_data, method = "REML")
correlation <- cor(df[[1]], df[[2]])
output_df <- data.frame(
Pearson = correlation,
LM.Rsquared = correlation^2,
GAM.Rsquare = summary(gam_model)$r.sq
)
df <- datatable(output_df, rownames = FALSE) %>%
formatRound(columns = 1:3, digits = 2)
return(df)
})
output$explore_chart_histogram_feature1 <- renderPlotly({
df <- explore_data()
plot_data <- data.frame(x = df[[1]])
gg <- ggplot(plot_data, aes(x = x)) +
theme_minimal() +
geom_density(fill = "#5DA5DA", alpha = 0.5) +
labs(x = input$explore_feature1)
return(ggplotly(gg))
})
output$explore_chart_histogram_feature2 <- renderPlotly({
df <- explore_data()
plot_data <- data.frame(x = df[[2]])
gg <- ggplot(plot_data, aes(x = x)) +
theme_minimal() +
geom_density(fill = "#FAA43A", alpha = 0.5) +
labs(x = input$explore_feature2)
return(ggplotly(gg))
})
output$explore_table_feature1 <- renderDataTable({
df <- explore_data()
df <- data.frame(x = df[[1]]) %>%
summarize(
mean = mean(x),
SD = sd(x),
median = median(x),
IQR = IQR(x),
min = min(x),
max = max(x)
)
df <- datatable(df, rownames = FALSE) %>%
formatRound(columns = seq(1, ncol(df)), digits = 2)
return(df)
})
output$explore_table_feature2 <- renderDataTable({
df <- explore_data()
df <- data.frame(x = df[[2]]) %>%
summarize(
mean = mean(x),
SD = sd(x),
median = median(x),
IQR = IQR(x),
min = min(x),
max = max(x)
)
df <- datatable(df, rownames = FALSE) %>%
formatRound(columns = seq(1, ncol(df)), digits = 2)
return(df)
})
# -----------------------------------------------------------------------------
# Modeler
output$modeler_linear_model_summary <- renderPrint({
withProgress(message = "Modeling", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
incProgress(1)
})
return(summary(modeler_df$model))
})
output$modeler_residuals <- renderPlotly({
withProgress(message = "Modeling", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
plot_data <- data.frame(y = vjsim_data[[input$modeler_target]])
plot_data$resid <- resid(modeler_df$model)
plot_data$pred <- predict(modeler_df$model)
gg <- plot_ly() %>%
add_markers(
data = plot_data, x = ~y, y = ~pred,
name = "Predicted", marker = list(color = "rgba(93,165,218, 0.5)"),
hoverinfo = "text",
text = ~ paste(
input$modeler_target, "=", round(y, 2), "\n",
"Predicted =", round(pred, 2), "\n"
)
) %>%
add_lines(
data = plot_data, x = ~y, y = ~y,
name = "Identity line", line = list(color = "grey", dash = "dot")
) %>%
layout(
showlegend = FALSE,
yaxis = list(
side = "left", title = paste("Predicted", input$modeler_target),
showgrid = TRUE, zeroline = FALSE
),
xaxis = list(
side = "left", title = input$modeler_target,
showgrid = TRUE, zeroline = FALSE
)
)
incProgress(1)
})
return(gg)
})
output$modeler_predictor_importance <- renderPlotly({
withProgress(message = "Feature Importante", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
gg <- ggplotly(vip::vip(modeler_df$model, train = modeler_df$data, method = "firm") + theme_minimal())
incProgress(1)
})
return(gg)
})
output$pdp_ice_plot <- renderPlotly({
withProgress(message = "PDP+ICE", value = 0, {
incProgress(0.5)
modeler_df <- modeler_linear_model()
gg <- ggplot()
if (input$pdp_ice_predictor %in% input$modeler_predictors) {
gg <- ggplotly(
pdp::partial(
modeler_df$model,
train = modeler_df$data,
pred.var = input$pdp_ice_predictor,
plot = TRUE,
rug = FALSE,
ice = input$ice_line,
plot.engine = "ggplot2",
alpha = ifelse(input$ice_line, 0.01, 1),
) +
theme_minimal() +
ylab(paste("Predicted", input$modeler_target))
)
}
incProgress(1)
})
return(gg)
})
# -------------------------------------------------
# Clustering
output$feature_clustering_chart <- renderPlot({
withProgress(message = "Feature Clustering", value = 0, {
incProgress(0.5)
pp <- plot(as.phylo(feature_clustering_model()), type = "phylogram", cex = 1,
direction = "leftwards",
no.margin = TRUE)
incProgress(1)
})
return(pp)
})
}
# Run the application
shinyApp(ui = ui, server = server)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.