Rでコロナ接触アプリCOCOAのjsonデータを触ってみたい。通知されないような濃厚じゃない接触の回数も表示させる
COCOAログチェッカーが話題になっていた
GitHub - ktansai/COVID-19-ExposeChecker
cocoalog.jpcocoalog.jp
iPhoneからjson形式でCOCOAのデータをエクスポートできるようだ。
それを、COCOAログチェッカーにコピペすると”コロナすれ違い人数”とでも呼ぶべきか、濃厚じゃない接触数を表示してくれる。
これをRでやってみる。
COCOAからJSONデータがエクスポートできるので、それを保存しておく。そのCOCOAデータをR言語で読み込んて加工して出力する。
library(jsonlite)
library(RJSONIO)
library(dplyr)
library(lubridate)
ad_data <- fromJSON("ここにiPhoneからエクスポートしたファイルのパスを書く")
thresholds <- ad_data[["exposure_configuration"]][["apple_exposure_config_v2"]][["attenuation_duration_thresholds"]] #46 60 65濃厚接触判定db
score_categoly <- c(60, 150, 78, 0.6) #categoly1-4のscore
taranslation_sc <- c("1m以内", "1～2m", "1～3m", "2m以上")
alart_score <- 1350 #濃厚接触アラート
ew <- ad_data[["exposure_windows"]] #ScanInstances
TypicalAttenuationDb <- duration <- Infectiousness <- time1 <- NULL
for(i in 1:length(ew)){
time1 <- c(time1, ew[[i]]$DateMillisSinceEpoch)
Infectiousness <- c(Infectiousness, ew[[i]]$Infectiousness)
temp_ew <- ew[[i]]$ScanInstances
temp_ta <- temp_dr <- 0
for(j in 1:length(temp_ew)){
temp_dr <- temp_dr + temp_ew[[j]]["SecondsSinceLastScan"]
temp_ta <- max(temp_ta + temp_ew[[j]]["TypicalAttenuationDb"] )
}
duration <- c(duration, as.numeric(temp_dr))
TypicalAttenuationDb <- c(TypicalAttenuationDb, as.numeric(temp_ta))
}
#date1 <- as.POSIXct(time1/1000, origin = "1970-01-01", tz = "Asia/Tokyo", format = "%Y-%m-%d") ##UNIX時間をJSTに msなのでsに/1000
date1 <- as_datetime(time1/(1000), tz="Asia/Tokyo") %>% format("%Y-%m-%d")
duration <- duration / 60 #minute
dat <- data.frame(time = date1, duration = duration, TypicalAttenuationDb = TypicalAttenuationDb, Infectiousness = Infectiousness)
temp <- (table(date1))
df <- data.frame(date=names(temp), count = as.numeric(temp))
df$max_db <- df$duration <- 0
for(i in 1:nrow(df)){
df$duration[i] <- sum(dat$duration[dat$time == df$date[i]])
df$max_db[i] <- max(dat$TypicalAttenuationDb[dat$time == df$date[i]])
}
df
dat
df2 <- NULL
for(i in 1:length(ew)){
temp_time <- ew[[i]]$DateMillisSinceEpoch
temp_infect <- ew[[i]]$Infectiousness
temp_ew <- ew[[i]]$ScanInstances
temp_id <- temp_min <- temp_ta <- temp_dr <- NULL
for(j in 1:length(temp_ew)){
temp_dr <- c(temp_dr , temp_ew[[j]]["SecondsSinceLastScan"])
temp_ta <- c(temp_ta , temp_ew[[j]]["TypicalAttenuationDb"])
temp_min <- c(temp_min, temp_ew[[j]]["MinAttenuationDb"])
temp_id <- c(temp_id, i)
}
temp_df <- data.frame(SecondsSinceLastScan = temp_dr, TypicalAttenuationDb = temp_ta, MinAttenuationDb = temp_min, DateMillisSinceEpoch=temp_time,
Infectiousness = temp_infect, Count = temp_id)
df2 <- rbind(df2, temp_df)
}
df2$date <- as_datetime(df2$DateMillisSinceEpoch/(1000), tz="Asia/Tokyo") %>% format("%Y-%m-%d")
df2$minute <- df2$SecondsSinceLastScan / 60 #minute
cat_1 <- as.numeric(cut(df2$TypicalAttenuationDb, breaks = c(-Inf, thresholds, Inf), include.lowest = T, labels = 1:4, ordered_result = T,right = FALSE))
cat_2 <- as.numeric(cut(df2$MinAttenuationDb, breaks = c(-Inf, thresholds, Inf), include.lowest = T, labels = 1:4, ordered_result = T,right = FALSE))
df2$categoly_1_4 <- (cat_1 > cat_2) * cat_1 + (cat_2 >= cat_1) * cat_2
#df2$categoly_1_4 <- cat_1
df2 %>% select(date, categoly_1_4, minute, TypicalAttenuationDb, MinAttenuationDb, Count) -> df3
rownames(df3) <- NULL
df3$Score <- df2$minute * (df2$categoly_1_4 == 1) * score_categoly[1] + df2$minute * (df2$categoly_1_4 == 2) * score_categoly[2] +
df2$minute * (df2$categoly_1_4 == 3) * score_categoly[3] + df2$minute * (df2$categoly_1_4 == 4) * score_categoly[4]
df3$translation <- taranslation_sc[df3$categoly_1_4]
temp <- df3 %>% group_by(date) %>% mutate(Total_counts_day = length(unique(Count)), Count_id_day = dense_rank(Count))
#temp2 <- df3 %>% left_join(temp, by = "date", copy = TRUE)
temp3 <- temp %>% group_by(date, Count, categoly_1_4) %>%
mutate(Minutes_by_day_cat = sum(minute), Score_by_day_cat = sum(Score), Min_db = min(TypicalAttenuationDb, MinAttenuationDb),
Max_db = max(TypicalAttenuationDb, MinAttenuationDb))
temp4 <- temp3 %>% group_by(date) %>% mutate(Count_by_day = dense_rank(Count), Score_by_day = sum(Score), Minute_by_day = sum(minute),
Alrart_by_day = Score_by_day >= alart_score)
daily_log <- temp4 %>% group_by(date) %>% select(date, Alrart_by_day, Score_by_day, Minute_by_day, Total_counts_day) %>% slice(1)
day_categoly_log <- temp4 %>% group_by(date, Count, categoly_1_4) %>% select(date, Count_by_day, Minutes_by_day_cat, Score_by_day_cat,
Min_db, Max_db, translation) %>% slice(1)
print(daily_log)
print(day_categoly_log)
こんな感じになる。COCOAログチェッカーは2週間前までだが、それ以前も中にデータが有れば表示される。
cocoalog.jpとほぼ一致した。
dbの範囲が一部異なるが、こっちのほうが範囲が広いのでヨシ。
日毎の総スコアは低いのが一律60点だったり算出法がブラックボックスなので不明。日内の各スコアは一致しているのでヨシ。
> print(daily_log) # A tibble: 26 x 5 # Groups: date [26] date Alrart_by_day Score_by_day Minute_by_day Total_counts_day <chr> <lgl> <dbl> <dbl> <int> 1 2022-04-04 FALSE 12.6 21 1 2 2022-04-06 FALSE 1.8 3 1 3 2022-05-08 FALSE 1.8 3 1 4 2022-05-10 FALSE 24.6 41 4 5 2022-06-04 FALSE 1.8 3 1 6 2022-06-19 FALSE 2.4 4 1 7 2022-07-16 FALSE 3.6 6 2 8 2022-07-22 FALSE 1.8 3 1 9 2022-07-23 FALSE 3.6 6 2 10 2022-07-25 FALSE 1.8 3 1 # ... with 16 more rows > print(day_categoly_log) # A tibble: 60 x 9 # Groups: date, Count, categoly_1_4 [60] Count categoly_1_4 date Count_by_day Minutes_by_day_cat Score_by_day_cat Min_db Max_db translation <int> <dbl> <chr> <int> <dbl> <dbl> <dbl> <dbl> <chr> 1 1 4 2022-04-04 1 21 12.6 67 92 2m以上 2 2 4 2022-04-06 1 3 1.8 94 94 2m以上 3 3 4 2022-05-08 1 3 1.8 87 91 2m以上 4 4 4 2022-05-10 1 19 11.4 92 98 2m以上 5 5 4 2022-05-10 2 4 2.4 97 97 2m以上 6 6 4 2022-05-10 3 5 3 98 98 2m以上 7 7 4 2022-05-10 4 13 7.8 93 99 2m以上 8 8 4 2022-06-04 1 3 1.8 79 83 2m以上 9 9 4 2022-06-19 1 4 2.4 91 94 2m以上 10 10 4 2022-07-16 1 3 1.8 93 95 2m以上 # ... with 50 more rows
