Извините за то, что может быть неясно.
Я пытался запустить цикл функции ожидания запуска из пакета baseballr (https://rdrr.io/github/BillPetti/baseballr/src/R/run_expectancy_code.R), который вычисляет значения запуска по 159 возможным состояниям, чтобы сделать это для каждого из 10 091 уникальных шагов, которые у меня есть. Но я хочу, чтобы функция рассчитывалась не для тех отдельных шагов, а для постоянно повторно взвешенного информационного кадра всех шагов вместе, поэтому для каждого конкретного уникального шага я хочу, чтобы строки, относящиеся к этому шагу, были реплицированы так, чтобы составлять 20% итоговый фрейм данных, затем я хочу высоту тонов (и у меня эти данные хранятся в отдельном фрейме данных, называемом pitch_sdentifity), которые занимают места с 1 по 5 по сходству, чтобы составить еще 20%, с 6 по 10, чтобы получить 10%, с 11 по 11 30 - 5%, а остальные - 50%. Это экспериментально, но я бы хотел начать.
Я добился некоторого прогресса в настройке взвешивания, но я не думаю, что я реплицировал строки, и я больше всего изо всех сил пытался сделать этот процесс постоянным циклом, чтобы каждый уникальный шаг можно рассчитать ожидаемую продолжительность прогона после переоценки основного кадра данных. У меня также были проблемы с отображением всех данных об ожидаемой продолжительности в одном кадре данных - я не уверен, что вы можете вычислить функцию для данных, затем пересчитать, затем снова вычислить и т. Д., Пока она не будет зациклена для всех шагов, поэтому я получить один большой массив данных с наиболее важным третьим столбцом, в котором перечислены уникальные высоты тона, используемые в качестве основного для микса, чтобы я мог различать. Имейте в виду, что lefty_abs является основным фреймом данных со всеми строками, используемыми для расчета ожидаемого прогона, что pitch_sdentifity - это мой фрейм данных, в котором все тоны наиболее похожи и имеют ранг сходства. Для простоты я поместил вставки из dput-образцов всего самого конца. Я также добавил фрейм данных питчей, в котором перечислены только уникальные тона.
Это функция ожидаемого пробега в сочетании с моей попыткой перевеса
library(dplyr)
run_expectancy_code <- function(df, level = "plate appearance") {
single_outs <- c("strikeout", "caught_stealing_2b",
"pickoff_caught_stealing_2b", "other_out",
"caught_stealing_3b", "caught_stealing_home",
"field_out", "force_out", "pickoff_1b",
"batter_interference", "fielders_choice",
"pickoff_2b", "pickoff_caught_stealing_3b",
"pickoff_caught_stealing_home")
df <- df %>%
dplyr::arrange(game_pk, at_bat_number, pitch_number) %>%
dplyr::group_by(game_pk) %>%
dplyr::mutate(final_pitch_game =
ifelse(pitch_number == max(pitch_number), 1, 0)) %>%
dplyr::ungroup() %>%
dplyr::group_by(game_pk, at_bat_number, inning_topbot) %>%
dplyr::mutate(final_pitch_at_bat = ifelse(pitch_number == max(pitch_number), 1, 0)) %>%
dplyr::ungroup()
df <- df %>%
dplyr::arrange(game_pk, inning_topbot, at_bat_number, pitch_number) %>%
dplyr::mutate(runs_scored_on_pitch = stringr::str_count(des, "scores"),
runs_scored_on_pitch =
ifelse(events == "home_run", runs_scored_on_pitch + 1,
runs_scored_on_pitch),
bat_score_after = bat_score + runs_scored_on_pitch) %>%
dplyr::arrange(game_pk, at_bat_number, pitch_number) %>%
dplyr::mutate(final_pitch_inning =
ifelse(final_pitch_at_bat == 1 &
inning_topbot != lead(inning_topbot), 1, 0),
final_pitch_inning = ifelse(is.na(final_pitch_inning),
1, final_pitch_inning))
if (level == "plate appearance") {
df <- df %>%
dplyr::group_by(game_pk, inning, inning_topbot) %>%
dplyr::mutate(bat_score_start_inning = min(bat_score),
bat_score_end_inning = max(bat_score),
cum_runs_in_inning = cumsum(runs_scored_on_pitch),
runs_to_end_inning = bat_score_end_inning - bat_score) %>%
dplyr::ungroup() %>%
dplyr::mutate(base_out_state = paste(outs_when_up, " outs, ",
ifelse(!is.na(.$on_1b), "1b", "_"),
ifelse(!is.na(.$on_2b), "2b", "_"),
ifelse(!is.na(.$on_3b), "3b", "_")))
re_table <- run_expectancy_table(df)
df <- df %>%
left_join(re_table, by = "base_out_state")
df <- df %>%
dplyr::filter(final_pitch_at_bat == 1) %>%
dplyr::arrange(game_pk, inning, inning_topbot) %>%
dplyr::group_by(game_pk, inning, inning_topbot) %>%
dplyr::mutate(next_base_out_state = dplyr::lead(base_out_state)) %>%
dplyr::ungroup() %>%
dplyr::left_join(re_table,
by = c("next_base_out_state" = "base_out_state")) %>%
dplyr::rename(next_avg_re = avg_re.y,
avg_re = avg_re.x) %>%
dplyr::mutate(next_avg_re = ifelse(is.na(next_avg_re), 0, next_avg_re),
change_re = next_avg_re - avg_re,
re24 = change_re + runs_scored_on_pitch) %>%
dplyr::arrange(game_pk, inning, inning_topbot)
} else {
df <- df %>%
dplyr::group_by(game_pk, inning, inning_topbot) %>%
dplyr::mutate(bat_score_start_inning = min(bat_score),
bat_score_end_inning = max(bat_score),
cum_runs_in_inning = cumsum(runs_scored_on_pitch),
runs_to_end_inning = bat_score_end_inning - bat_score) %>%
dplyr::ungroup() %>%
dplyr::mutate(count_base_out_state =
paste(balls, "-", strikes, ", ",
outs_when_up, " outs, ",
ifelse(!is.na(.$on_1b), "1b", "_"),
ifelse(!is.na(.$on_2b), "2b", "_"),
ifelse(!is.na(.$on_3b), "3b", "_")))
re_table <- run_expectancy_table(df, level = "pitch")
df <- df %>%
left_join(re_table, by = "count_base_out_state")
df <- df %>%
#dplyr::filter(final_pitch_at_bat == 1) %>%
dplyr::arrange(game_pk, inning, inning_topbot) %>%
dplyr::group_by(game_pk, inning, inning_topbot) %>%
dplyr::mutate(next_count_base_out_state =
dplyr::lead(count_base_out_state)) %>%
dplyr::ungroup() %>%
dplyr::left_join(re_table,
by = c("next_count_base_out_state" =
"count_base_out_state")) %>%
dplyr::rename(next_avg_re = avg_re.y,
avg_re = avg_re.x) %>%
dplyr::mutate(next_avg_re = ifelse(is.na(next_avg_re), 0, next_avg_re),
change_re = next_avg_re - avg_re,
re24 = change_re + runs_scored_on_pitch) %>%
dplyr::arrange(game_pk, inning, inning_topbot)
}
assign("run_expectancy_state_table", re_table, envir = .GlobalEnv)
df
}
run_expectancy_table <- function(df, level = "plate appearance") {
if (level == "plate appearance") {
df <- df %>%
dplyr::filter(final_pitch_at_bat == 1, inning < 9) %>%
dplyr::group_by(base_out_state) %>%
dplyr::summarise(avg_re = mean(runs_to_end_inning, na.rm = TRUE)) %>%
dplyr::arrange(desc(avg_re))
} else {
df <- df %>%
dplyr::filter(inning < 9) %>%
dplyr::group_by(count_base_out_state) %>%
dplyr::summarise(avg_re = mean(runs_to_end_inning, na.rm = TRUE)) %>%
dplyr::arrange(desc(avg_re))
}
df
}
# reweighting below
{twenty<-nrow(lefty_abs)*0.20
samedf<-lefty_abs[lefty_abs$pitch_key%in%pitch_similarity$pitch_1,]
if (twenty<=nrow(samedf)) {
twentydf<-samedf[1:twenty,]
} else {
twentydf<-matrix(nrow = twenty,ncol = ncol(lefty_abs))
twentydf<-lefty_abs[1:twenty,]
number<-floor(twenty/nrow(samedf))
a<-1
b<-nrow(samedf)
c<-b
for (i in 1:number) {
twentydf[a:c,]<-samedf
a<-a+b
c<-c+b
}
twentydf[a:twenty,]<-samedf[1:(twenty-a+1),]
}
onefive<-pitch_similarity[pitch_similarity$rank>=1 & pitch_similarity$rank<=5,]
same2df<-lefty_abs[lefty_abs$pitch_key%in%onefive$pitch_2,]
if (twenty<=nrow(same2df)) {
twenty2df<-same2df[1:twenty,]
} else {
twenty2df<-lefty_abs[1:twenty,]
number2<-floor(twenty/nrow(same2df))
d<-1
e<-nrow(same2df)
f<-e
for (i in 1:number2) {
twenty2df[d:f,]<-same2df
d<-d+e
f<-f+e
}
twenty2df[d:twenty,]<-same2df[1:(twenty-d+1),]
}
sixten<-pitch_similarity[pitch_similarity$rank>=6 & pitch_similarity$rank<=10,]
same3df<-lefty_abs[lefty_abs$pitch_key%in%sixten$pitch_2,]
if (twenty/4<=nrow(same3df)) {
twenty3df<-same3df[1:(twenty/4),]
} else {
twenty3df<-lefty_abs[1:(twenty/4),]
number3<-floor(twenty/4/nrow(same3df))
g<-1
h<-nrow(same3df)
j<-h
for (i in 1:number3) {
twenty3df[g:j,]<-same3df
g<-g+h
j<-j+h
}
twenty3df[g:(twenty/4),]<-same3df[1:(twenty/4-g+1),]
twenty3df<-twenty3df[1:(twenty/4),]
}
eleven<-pitch_similarity[pitch_similarity$rank>=11 & pitch_similarity$rank<=30,]
same4df<-lefty_abs[lefty_abs$pitch_key%in%eleven$pitch_2,]
if (twenty/4<=nrow(same4df)) {
twenty4df<-same4df[1:twenty/4,]
} else {
twenty4df<-lefty_abs[1:(twenty/4),]
number4<-floor(twenty/4/nrow(same4df))
k<-1
l<-nrow(same4df)
m<-l
for (i in 1:number4) {
twenty4df[k:m,]<-same4df
k<-k+l
m<-m+l
}
twenty4df[k:(twenty/4),]<-same4df[1:(twenty/4-k+1),]
twenty4df<-twenty4df[1:(twenty/4),]
}
newdf<-rbind.data.frame(twentydf,twenty2df,twenty3df,twenty4df)
rest<-lefty_abs[!lefty_abs$pitch_key %in% newdf$pitch_key,]
rest<-rest[1:(nrow(lefty_abs)/2),]
final<-rbind.data.frame(newdf,rest)
run_expectancy_code(final, level = "pitch")
}
образец шага dput
structure(list(sample_pitches = structure(c(9L, 8L, 10L, 7L,
1L, 2L, 4L, 6L, 3L, 5L), .Label = c("150037-FF", "218596-FF",
"218596-FS", "218596-SI", "346800-FC", "346800-FF", "349193-FT",
"400010-FF", "493247-SI", "493247-SL"), class = "factor")), row.names = c(NA,
-10L), class = "data.frame")
образец схожести головки шага
> head(sample_similarity)
pitch_1 pitch_2 euclid_dist rank batter_handedness
1 493247-SI 434958-SI 0.4343468 4 L
2 493247-SI 503285-SI 0.6632168 13 L
3 493247-SI 448592-SI 0.7847100 20 L
4 493247-SI 434958-FF 0.7659369 17 L
5 493247-SI 501925-SI 0.2812055 1 L
глава левого пресса, потому что даже dput будет массивным -
> head(sample_lefty)
pitch_type game_date release_speed release_pos_x release_pos_z player_name batter
626 SI 2008-03-30 91.9 NA NA Peter Moylan 150217
627 SI 2008-03-30 91.0 NA NA Peter Moylan 150217
628 SI 2008-03-30 91.6 NA NA Peter Moylan 150217
629 SI 2008-03-30 89.6 NA NA Peter Moylan 150217
631 FF 2008-03-30 92.3 NA NA Jon Rauch 435263
pitcher events description spin_dir spin_rate_deprecated break_angle_deprecated
626 493247 strikeout foul_tip <NA> <NA> <NA>
627 493247 null foul <NA> <NA> <NA>
628 493247 null called_strike <NA> <NA> <NA>
629 493247 null ball <NA> <NA> <NA>
631 400010 field_out hit_into_play <NA> <NA> <NA>
break_length_deprecated zone des
626 <NA> 7 Cristian Guzman strikes out on a foul tip.
627 <NA> 8 null
628 <NA> 5 null
629 <NA> 13 null
631 <NA> 4 Brian McCann flies out to left fielder Willie Harris.
game_type stand p_throws home_team away_team type hit_location bb_type balls
626 R L R WSH ATL S 2 null 2
627 R L R WSH ATL S null null 2
628 R L R WSH ATL S null null 2
629 R L R WSH ATL B null null 1
631 R L R WSH ATL X 7 fly_ball 3
strikes game_year pfx_x pfx_z plate_x plate_z on_3b on_2b on_1b
626 2 2008 -1.1290775 -0.004106667 -0.402 1.789 NA NA NA
627 1 2008 -1.0738283 0.049930000 -0.014 1.658 NA NA NA
628 0 2008 -0.9675050 -0.107020000 0.203 2.070 NA NA NA
629 0 2008 -1.2086808 0.115863333 -0.724 1.017 NA NA NA
631 0 2008 -0.2232417 2.557116667 -0.742 2.725 NA NA NA
outs_when_up inning inning_topbot hc_x hc_y tfs_deprecated tfs_zulu_deprecated
626 0 9 Bot NA NA <NA> <NA>
627 0 9 Bot NA NA <NA> <NA>
628 0 9 Bot NA NA <NA> <NA>
629 0 9 Bot NA NA <NA> <NA>
631 2 9 Top 62.25 103.41 <NA> <NA>
fielder_2 umpire sv_id vx0 vy0 vz0 ax ay az sz_top
626 null <NA> 080330_224253 11.150 -133.360 -0.139 -12.709 33.238 -34.621 3.227
627 null <NA> 080330_224229 11.203 -132.113 -0.270 -11.476 39.266 -33.872 3.227
628 null <NA> 080330_224213 11.329 -132.914 1.120 -10.408 37.292 -35.805 3.227
629 null <NA> 080330_224155 9.866 -130.138 -1.565 -12.779 37.120 -33.067 3.227
631 null <NA> 080330_223858 0.224 -134.052 -9.971 -1.178 38.019 -3.179 3.644
sz_bot hit_distance_sc launch_speed launch_angle effective_speed release_spin_rate
626 1.508 NA NA NA NA NA
627 1.508 NA NA NA NA NA
628 1.508 NA NA NA NA NA
629 1.508 NA NA NA NA NA
631 1.724 NA NA NA NA NA
release_extension game_pk pitcher_1 fielder_2_1 fielder_3 fielder_4 fielder_5
626 NA 233759 493247 null null null null
627 NA 233759 493247 null null null null
628 NA 233759 493247 null null null null
629 NA 233759 493247 null null null null
631 NA 233759 400010 null null null null
fielder_6 fielder_7 fielder_8 fielder_9 release_pos_y estimated_ba_using_speedangle
626 null null null null NA NA
627 null null null null NA NA
628 null null null null NA NA
629 null null null null NA NA
631 null null null null NA NA
estimated_woba_using_speedangle woba_value woba_denom babip_value iso_value
626 NA 0 NA 0 0
627 NA NA NA NA NA
628 NA NA NA NA NA
629 NA NA NA NA NA
631 NA 0 NA 0 0
launch_speed_angle at_bat_number pitch_number pitch_name home_score away_score
626 NA 62 5 Sinker 2 2
627 NA 62 4 Sinker 2 2
628 NA 62 3 Sinker 2 2
629 NA 62 2 Sinker 2 2
631 NA 61 4 4-Seam Fastball 2 2
bat_score fld_score post_away_score post_home_score post_bat_score post_fld_score
626 2 2 2 2 2 2
627 2 2 2 2 2 2
628 2 2 2 2 2 2
629 2 2 2 2 2 2
631 2 2 2 2 2 2
if_fielding_alignment of_fielding_alignment barrel pitch_key
626 null null NA 493247-SI
627 null null NA 493247-SI
628 null null NA 493247-SI
629 null null NA 493247-SI
631 null null NA 400010-FF
>