QSS4.5.1の練習問題3
佐藤 慧
7/10/2020
データフレームの用意
すべての日付で7日平均が出せるように，選挙日96日前からのデータを含める。
intrade08_96days <- subset(intrade08,
subset = (as.Date("2008-11-04") - 96 <= day &
day <= "2008-11-04")
)[, c("state", "day", "PriceD")]
pres08 <- pres08[ , c("state", "EV")]orderでstateとdayごとに並べ替える
あらかじめ並べ替えておけば，for文が簡単に書ける。
intrade08_96days <-
intrade08_96days[order(intrade08_96days$state, intrade08_96days$day), ]for文で7日平均を出す
まず，結果を収めるベクトル列をデータフレームに追加する。
intrade08_96days$avgD_7days = rep(NA, nrow(intrade08_96days))
head(intrade08_96days)## state day PriceD avgD_7days
## 31927 AK 2008-07-31 22 NA
## 31978 AK 2008-08-01 20 NA
## 32029 AK 2008-08-02 22 NA
## 32080 AK 2008-08-03 22 NA
## 32131 AK 2008-08-04 22 NA
## 32182 AK 2008-08-05 22 NA次にfor文をつくる。
データが州の名前と日付順に並んでいるintrade08_96daysに対し，7行目から終わりまでの範囲で，PriceD列のi-6行(6行上)から現在のi行までを足し合わせ，その結果をさきほど作ったavgD_7days列のi行目に入れる。
たとえば7行目であれば(i = 7)，1行目から7行目までのPriceD列の合計が返ってくる。
各州において，1-6行目(96-91日前，7月31日-8月5日)は他の州の終わりのほうの(11月4日近くの)データを反映してしまうが，これらはそもそも各州の7行目(90日前，8月6日)以降の7日平均を算出するためにしか使わないため，あとで削除するので問題ない。
for (i in 7:nrow(intrade08_96days)) {
intrade08_96days$avgD_7days[i] <-
sum(intrade08_96days$PriceD[(i-6):i]) / 7
}
head(intrade08_96days)## state day PriceD avgD_7days
## 31927 AK 2008-07-31 22 NA
## 31978 AK 2008-08-01 20 NA
## 32029 AK 2008-08-02 22 NA
## 32080 AK 2008-08-03 22 NA
## 32131 AK 2008-08-04 22 NA
## 32182 AK 2008-08-05 22 NAavgD_7days列の1-6行目はNAになっているはず。
96-91日前までのデータを削除する
df4 <- subset(intrade08_96days,
subset = (as.Date("2008-08-06") <= day)
)選挙人データと結合し，予想選挙人数の変数作成
df5 <- merge(df4, pres08, all.x = TRUE)
df5$expectedD = (df5$avgD_7days / 100) * df5$EVdayで並べ替え，不要な変数を削除する
df6 <- df5[order(df5$day), ][ , c("day", "expectedD")]dayごとの予想選挙人数の和を計算し，結果をdf化する
df7 <- data.frame(tapply(df6$expectedD, df6$day, sum))
df8 <- data.frame(date = as.Date(rownames(df7)),
expectedD = df7[, 1])プロット
plot(df8$date, df8$expectedD)
スクリプト
まとめると次のようになる。
intrade08_96days <- subset(intrade08,
subset = (as.Date("2008-11-04") - 96 <= day &
day <= "2008-11-04")
)[, c("state", "day", "PriceD")]
pres08 <- pres08[ , c("state", "EV")]
intrade08_96days <-
intrade08_96days[order(intrade08_96days$state, intrade08_96days$day), ]
intrade08_96days$avgD_7days = rep(NA, nrow(intrade08_96days))
for (i in 7:nrow(intrade08_96days)) {
intrade08_96days$avgD_7days[i] <-
sum(intrade08_96days$PriceD[(i-6):i]) / 7
}
df4 <- subset(intrade08_96days,
subset = (as.Date("2008-08-06") <= day)
)
df5 <- merge(df4, pres08, all.x = TRUE)
df5$expectedD = (df5$avgD_7days / 100) * df5$EV
df6 <- df5[order(df5$day), ][ , c("day", "expectedD")]
df7 <- data.frame(tapply(df6$expectedD, df6$day, sum))
df8 <- data.frame(date = as.Date(rownames(df7)),
expectedD = df7[, 1])
plot(df8$date, df8$expectedD)スクリプト2
たとえば，以下のような別解も可能。オブジェクト名が微妙に違うのは気にしないでほしい。
intrade08 %>%
filter(as.Date("2008-11-04") - 96 <= day & day <= "2008-11-04") %>%
select(state, day, PriceD) %>%
arrange(state, day) %>%
mutate(avgD_7days = NA) -> trade_log
for (i in 7:nrow(trade_log)) {
trade_log$avgD_7days[i] <- sum(trade_log$PriceD[(i-6):i]) / 7
}
trade_log %>%
filter(as.Date("2008-11-04") - 90 <= day) %>%
left_join(.,
pres08 %>%
select(state, EV),
by = "state"
) %>%
mutate(expectedD = (avgD_7days/100)*EV) %>%
group_by(day) %>%
summarise(expectedD = sum(expectedD)) %>%
data.frame() %>%
ggplot(mapping = aes(x = day, y = expectedD)) +
geom_point() +
geom_line() +
scale_y_continuous(limits = c(200, 400)) +
ggtitle("Expected Results Based on Seven days Moving Avarage")