Data 분석 - 해열제별 효능분석

벌써 어려운 주제가 나왔는데, 효능을 분석하려면 Fever테이블과 Reducer테이블을 같이 사용해야 합니다.

저도 답은 모릅니다. 일단 드는 생각은 데이터를 좀더 들여다보면 알겠지만 대부분의 열 측정은 1~3일내에 연달아 발생합니다.
따라서 하나의 event seqence단위로 분석을 해야 할것 같아요. 해열제를 언제 복용했는지에 맞춰서 그 앞뒤로 열이 어떻게 달라지는 지 알아볼 수 있으니까요. 만약에 제가 지금 진행한다면

Fever 테이블을 -1값 제거한후 csv로 저장
Fever테이블과 Reducer테이블을 하나로 합쳐서 fever&reducer 테이블 생성 date__ /fever/kind/type/dose 201706190909/ 38.2 / / / 201706190911 / / 1 / 2 / 10 201706190930/37.0 / / /
이런식으로 붙여보면 좋을 것 같네요.
환자별로 정렬하고 같은 환자 내에서는 시간순서로 정렬해 csv로 저장
이 뒤에 다시 데이터를 좀 들여다 보면서 insight찾기 .

이대로 괜찮으면 항목별로 이슈 등록해서 진행해주세요. 다른 의견 있으면 얼마든지 댓글로!! 어떠한 피드백이라도 환영합니다.

깔끔하게 정리 될 것 같습니다. 찹고해서 진행해 보도록 하겠습니다

대략적으로 1~6 번 약들에 대해서 6시간안에 평균적으로 얼마나 체온이 감소했는지, 시간당 체온 감소량은 얼마인지 계산해 보았습니다. R을 사용하였는데, mysql서버에서 data export가 막혀있어, reducer의 상위 5만개, fever의 상위 5만개만 사용한 테스트 버젼이며, 데이터가 늘어나면 정확도가 높아질 것으로 예상했습니다

기본 형태는 이런식으로 각 아이가 (Aid, Baby_id) 특정 날짜에 약을 먹으면 (eat_date) 그 이후 6시간안에 측정된 체온 (date, fever)을 통해 약 복용후의 시간(time_pass), 그리고 복용한 전후의 체온변화 (fever drop)을 계산하였습니다.

오차를 최소화하기 위하여 측정 3회 이하인 케이스는 제거하였고, 중복된 열도 제거하였습니다.

결과적으로 각 약품에 대한 평균 체온감소 및 시간 당 체온감소는 으로 나왔습니다.

7~12번 약품의 경우 전체에 대하여 차지하는 비율이 0.7% 정도이기에 상위 5만개에 추가가 되지 않은 것으로 보입니다.

이후 데이터 셋을 늘려, 교차효과나 질병 당 효과를 더 계산하려합니다 수정사항이 있는지, 놓친 부분이 있는지 조언 부탁드립니다.

사용한 R코드 첨부합니다

fv <- fread("fever.csv")
rd <- fread("reducer.csv")
fv <- distinct(fv[,2:6])

fv[,date:= as.numeric(date)]
setkey(fv, c("Aid","baby_id")) 
setkey(rd, c(Aid,baby_id)) 

fv
fv.1 <- fv %>%
  order_by(date)

fv.1 <- fv %>%
  filter(fever != -1)

mg2 <- merge(fv.1, rd, by = c("Aid", "baby_id"))

fv.2 <- filter(mg2, eat_date <= date)
fv.3 <- fv.2 %>%
  select(`_id`,Aid, baby_id, eat_date, date, fever, kind, volume) %>%
  arrange(Aid, baby_id, eat_date, date) %>%
  mutate(time_pass = ymd_hm(date) - ymd_hm(eat_date)) %>%
  filter(time_pass <= 21600)

fv.3$cnt = 0

for(i in 2:nrow(fv.3)){
  fv.3[i,]$cnt = ifelse((fv.3[i,]$time_pass-fv.3[i-1,]$time_pass >= 0), 0 ,1 )
}

fv.4 <- fv.3 %>%
  group_by(Aid, baby_id) %>%
  mutate(num = n()) %>%
  filter(num >= 3)

fv.5<- fv.3 %>%
  filter(Aid %in% fv.4$Aid & baby_id %in% fv.4$baby_id)
fv.5[1,]$cnt = 1

fv.5$fever_drop = 0
temp =0

for(i in 1:nrow(fv.5)){
  temp = ifelse(fv.5[i,]$cnt == 1, fv.5[i,]$fever, temp)
  fv.5[i,]$fever_drop = fv.5[i,]$fever - temp
}

fv.7 <- fv.5 %>%
  filter(time_pass != 0) %>%
  mutate(fdpt = fever_drop/as.numeric(time_pass)*10000)

fv.6 <- fv.7 %>%
  group_by(kind) %>%
  summarise(fd = mean(fever_drop), fpt = mean(fdpt))

금방 뽑아보니 좋네요. 굿! 멋진데요?
6시간으로 약효의 기준을 잡은 것은 훌륭합니다. 보통 약효가 하루 3번 먹일 때 기준으로 생각하면 적절하네요. 더해서 ,실제로 보호자들이 한 시퀀스 안에서 약을 얼마나 자주 먹이는 지 알아보고 그것을 바탕으로 기준을 삼으면 좋을 것 같습니다. 데이터를 잘 보면 2~4시간에는 열이 떨어졌다가 그 뒤에는 다시 열이 올라가는게 보이죠.
timepass와 fever_drop의 상관관계를 뽑아보면 뭐 재밌는게 나올듯...! 일단 분포를 좀 본다음에 linear나 sigmoid로 regression 해 볼 수 있을 것 같네요. 먹은지 얼마 뒤에 가장 많이 체온이 떨어지는지, 약효별로 나눠서 뽑아보면 어떤 약이 가장 빨리 떨어지는지도 대강 눈으로 확인 해 볼수 있을것 같습니다. 거기서 얻은 insight로 다시 시간 조건을 만들어 볼 수 있을것 같습니다.
reducer와 fever를 똑같이 5만개로 뽑은것은 좀 애매하지 않을까요? fever테이블의 레코드 수가 훨씬 많기 때문에 특정 reducer만 뒤에 몰려 있을거에요. 아마 필터링 됐겠네요. 필터링 된 이후의 n수를 한번 보면 좋을것 같네요. 샘플을 다시 해보자면 적절한 시간 범위로 조회해서 통계를 내는것이 좋을것 같아요.
평균 체온감소 vs 시간당 체온감소 어느게 의미가 더 있을까요? 시간당 체온감소는 linear하게 체온이 떨어진다는 가정이 들어있는거라서 아무래도 평균 체온감소에 더 손을 들어주고 싶습니다. 그리고 평균을 보여줄때는 반드시 표준편차나 n수가 옆에 같이 있었으면 좋겠네요. 약품 항목별로 정말 유의하게 차이가 나는건지 알아보려면 필수! 시간도 자료의 의미를 보여주려면 10000같은 숫자보다는 600이나 3600이었으면 해석하기가 더 좋을듯!
약에 의해 체온이 전부 떨어진다고 나왔는데 보호자들의 행동이나 입력 방식때문에 생기는 bias가 있지 않을까요? 생각해볼 거리가 있네요.

아... 너무 저만 쓰는것 같아서 끊습니다. 본인의 방법에 대해서 간단히 discussion이랑 얻은 insight 같이 달아주면 좋겠네요. 결과를 빨리 보는것보다 의미에 대해서 생각을 많이 해보면 더 좋은 결과가 나옵니다. 지금 충분히 빨리 하고 있으니 조금 천천히 해도 됩니다. ㅎㅎ 모든이슈를 혼자 다 하면 안돼요!

덧. 여기는 마크다운양식 사용되어 코드 보기좋게 입력 할 수 있어요. 코드 조각은 backqoute(`) 세개로 시작과 끝을 표시하면 됩니다. 댓글 수정하였으니 한번 수정버튼 눌러서 확인해보세요. 코드에 주석으로 간단히 설명을 해주면 가독성이 더 좋아질것 같습니다.

알려주신 부분 중에 가장 먼저 time_pass와 fever_drop의 관계를 해열제 종류별로 보았습니다 이번엔 전체 데이터를 모두 사용하였습니다. 1,2,6번 약은 크기가 커서 돌리는 중이며 나머지에 대한 결과 첨부합니다 해열제 별 체온감소효과.xlsx 붉은 줄은 기본 리니어리그레션 파란줄은 lowess를 사용했습니다 해열제별로 2~4시간정도에 효과가 나타나는 공통점을 보았을때 결과가 잘 나온 것 같다고 생각하며 해열제 별로 꽤나 패턴차이가 있어 놀랐습니다 현제까지만 본다면 좌약이 가장 효과가 빠르고 좋은 것 같습니다.

이번에 새로온 인턴 친구과 같이 뉴럴넥을 통해 fever drop = function(age, weight, time_pass, kind, gender) 모델을 만들어 사용자가 정보 입력시 특정 시간 이 지나면 예상 체온을 보여주는 서비스에 도움을 주는 것을 다음 목표로 잡았습니다

이와 더블어 난 연령 혹은 질병 혹은 복용량 별로 각 체온저하 그래프의 모습이 어떡게 달라지는지도 보려고 합니다 조언 부탁드립니다

rda <- fread("Reducer1.csv")
baby <- fread("baby.csv")
fva.1 <- distinct(fva[,2:5])

fva.1 <- `colnames<-`(fva.1, c("Aid","baby_id","fever","date"))
rda <- `colnames<-`(rda, c("_id","Aid","baby_id","kind","volume","eat", "eat_date"))
baby <- `colnames<-`(baby, c("_id","Aid","baby_id","weight","gender","born_to_day"))

#filter the dummy
baby.f <- baby %>%
  filter(born_to_day <=5000 & weight <= 40)
rda.f <- rda %>%
  filter(kind != 0 & volume!= 0 $ volume <= 400)
fva.f <- fva.1 %>%

mga <- merge(fva.1, rda, by = c("Aid", "baby_id"),allow.cartesian=TRUE)

fva.2 <- filter(mga, eat_date <= date)

fva.3 <- fva.2 %>%
  select(`_id`,Aid, baby_id, eat_date, date, fever, kind, volume) %>%
  arrange(Aid, baby_id, eat_date, date)

fva.4 <- fva.3 %>%
  mutate(time_pass = ymd_hm(date) - ymd_hm(eat_date)) %>%
  filter(time_pass <= 21600)

fva.5 <- fva.4 %>%
  group_by(Aid, baby_id,eat_date) %>%
  mutate(num = n()) %>%
  filter(num >= 2)

fva.foe <- fva.5 %>%
  filter(time_pass <= 600) %>%
  distinct("Aid","baby_id","eat_date" )

fva.6 <- fva.5 %>%
  filter(Aid %in% fva.foe$Aid & baby_id %in% fva.foe$baby_id & eat_date %in% fva.foe$eat_date)

#kind base split

#too big to roll
fva.k1 <- fva.5 %>%
  filter(kind == 1)

fva.k1.1 <- ft(fva.k1)
fva.k1.2 <- fevdrop(fva.k1.1)

fva.k2 <- fva.5 %>%
  filter(kind == 2)
fva.k2.1 <- ft(fva.k2)
fva.k2.2 <- fevdrop(fva.k2.1)
getPlot(fva.k3.2)

fva.k3 <- fva.5 %>%
  filter(kind == 3)
fva.k3.1 <- ft(fva.k3)
fva.k3.2 <- fevdrop(fva.k3.1)
getPlot(fva.k3.2)

fva.k4 <- fva.5 %>%
  filter(kind == 4)
fva.k4.1 <- ft(fva.k4)
fva.k4.2 <- fevdrop(fva.k4.1)
getPlot(fva.k4.2)

fva.k5 <- fva.5 %>%
  filter(kind == 5)
fva.k5.1 <- ft(fva.k5)
fva.k5.2 <- fevdrop(fva.k5.1)
getPlot(fva.k5.2)

# too big to roll
fva.k6 <- fva.5 %>%
  filter(kind == 6)
fva.k6.1 <- ft(fva.k6)
fva.k6.2 <- fevdrop(fva.k6.1)

fva.k7 <- fva.5 %>%
  filter(kind == 7)
fva.k7.1 <- ft(fva.k7)
fva.k7.2 <- fevdrop(fva.k7.1)
getPlot(fva.k7.2)

fva.k8 <- fva.5 %>%
  filter(kind == 8)
fva.k8.1 <- ft(fva.k8)
fva.k8.2 <- fevdrop(fva.k8.1)
getPlot(fva.k8.2)

fva.k9 <- fva.5 %>%
  filter(kind == 9)
fva.k9.1 <- ft(fva.k9)
fva.k9.2 <- fevdrop(fva.k9.1)
getPlot(fva.k9.2)

fva.k10 <- fva.5 %>%
  filter(kind == 10)
fva.k10.1 <- ft(fva.k10)
fva.k10.2 <- fevdrop(fva.k10.1)
getPlot(fva.k10.2)

fva.k11 <- fva.5 %>%
  filter(kind == 11)
fva.k11.1 <- ft(fva.k11)
fva.k11.2 <- fevdrop(fva.k11.1)
getPlot(fva.k11.2)

fva.k12 <- fva.5 %>%
  filter(kind == 12)
fva.k12.1 <- ft(fva.k12)
fva.k12.2 <- fevdrop(fva.k12.1)
getPlot(fva.k12.2)
lreg(fva.k12.2)

reg <- loess(fever_drop ~ time_pass, data = df,  model = FALSE,
             span = 0.75,degree = 2,
             parametric = FALSE, drop.square = FALSE, normalize = TRUE,
             family = "gaussian",
             method = "loess")
# time base split

# Simple Scatterplot

fva.5<- fva.3 %>%
  filter(Aid %in% fva.4$Aid & baby_id %in% fva.4$baby_id)
fva.5[1,]$cnt = 1

fva.7 <- fva.5 %>%
  filter(time_pass != 0) %>%
  mutate(fdpt = fever_drop/as.numeric(time_pass)*10000)

fva.6 <- fva.7 %>%
  group_by(kind) %>%
  summarise(fd = mean(fever_drop), fpt = mean(fdpt))

# funtions
#filtering fuction for the original fever at the point pill taken (with in 10 min)
ft <- function(df){
  temp <- df %>%
    filter(time_pass <= 600) %>%
    distinct("Aid","baby_id","eat_date")
  df <- df %>%
    filter(Aid %in% temp$Aid & baby_id %in% temp$baby_id & eat_date %in% temp$eat_date)
}

#print fever drop on each row
fevdrop <- function(df){
  cnt <- (nrow(df))
  for(i in (2:nrow(df))){
    cnt[i] = ifelse((df[i,]$time_pass-df[i-1,]$time_pass >= 0), 0 ,1 )
  }
  cnt[1] = 1
  df <- cbind(df,"cnt"=cnt)
  fever_drop = numeric(nrow(df))
  temp = 0
  for(j in (1:nrow(df))){
    temp = ifelse(df[j,]$cnt == 1, df[j,]$fever, temp)
    fever_drop[j] = df[j,]$fever - temp
  }
  df <- cbind(df, "fever_drop" = fever_drop)
}

#getplot
getPlot <- function(df){
  plot(df$time_pass, df$fever_drop, ylim = c(-1.5,1.5), cex = 0.01)
  abline(lm(df$fever_drop~df$time_pass ), col="red") # regression line (y~x) 
  lines(lowess(df$time_pass, df$fever_drop), col="blue") # lowess line (x,y)

}

#lowness regression
lreg <- function(df){ 
  reg <- loess(fever_drop ~ time_pass, data = df,  model = FALSE,
               span = 0.75,degree = 2,
               parametric = FALSE, drop.square = FALSE, normalize = TRUE,
               family = "gaussian",
               method = "loess")
  summary(reg)
}

기본적인 전처리가 완료되어 많은 분석을 했습니다

기본적인 해열제 별 시간당 체온감소
1)을 그룹지어본 성분별, 복용법 별 시간 당 체온감소 그래프와 그로 찾은 인사이트
체중 당 복용량 기준으로 나누어 본 약품 성분별 복용량 대비 체온감소
그리고 그로얻은 인사이트들의 검증
체온저하/(용량/체중), 단위 복용량당 체온이 떨어진량을 결국 복용량 당 약의 효과를 나타내주는 척도로 사용하여 해열제 별 효과 분석
영유아의 나이에 따른 해열제의 효과 (약품별로 묶어서 다시)
질병이 걸린 후, 질병 별 서로 다른 해열제의 작용
8을 통해 알게된 질병 별 특성 해열제 별 체온감소효과.xlsx

모두 엑셀파일안에 정리되어 있습니다. 좀 복잡하지만 대충 정리가 되어 있으니 보시다가 잘 설명되지 않은 부분이 있다면 알려주시기 바랍니다. 피드백 부탁드립니다

정기영

dis <- `colnames<-`(dis[,c(2,3,5,7)], c("Aid","baby_id","kind","date"))

fdt <- fread("merge.csv")
fdt <- `colnames<-`(fdt[,c(-1,-2,-5,-6,-7,-8,-13,-14)], c("Aid","baby_id","fever","kind","volume", "time_pass","fever_drop","B1","B2","B3","B4","B5","B6","B7","B8","B9","B10","B11","B12"))

fdt.formerge <- fdt %>%
  filter(kind != 0 & volume!= 0 & volume <= 700)

dis.1 <- dis %>%
  filter(baby_id < 1000) %>%
  filter(kind %in% 0:20)

baby.formerge <- baby.f %>%
  filter(Aid %in% fdt.formerge$Aid & baby_id %in% fdt.formerge$baby_id)

tmerge <- merge(fdt.formerge, baby.formerge, by = c("Aid", "baby_id"), allow.cartesian=TRUE)

write.table(tmerge, "total.csv")

#graph
fva.k1.1 <- fdt %>%
  filter(kind == 1)

fva.k2.1 <- fdt %>%
  filter(kind == 2)

fva.k3.1 <- fdt %>%
  filter(kind == 3)

fva.k4.1 <- fdt %>%
  filter(kind == 4)

fva.k5.1 <- fdt %>%
  filter(kind == 5)

fva.k6.1 <- fdt %>%
  filter(kind == 6)

fva.k7.1 <- fdt %>%
  filter(kind == 7)

fva.k8.1 <- fdt %>%
  filter(kind == 8)

fva.k9.1 <- fdt %>%
  filter(kind == 9)

fva.k10.1 <- fdt %>%
  filter(kind == 10)

fva.k11.1 <- fdt %>%
  filter(kind == 11)

fva.k12.1 <- fdt %>%
  filter(kind == 12)

plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
lines(lowess(fva.k1.1$time_pass, fva.k1.1$fever_drop), col="green")
lines(lowess(fva.k2.1$time_pass, fva.k2.1$fever_drop), col="green")
lines(lowess(fva.k3.1$time_pass, fva.k3.1$fever_drop), col="red")
lines(lowess(fva.k4.1$time_pass, fva.k4.1$fever_drop), col="blue")
lines(lowess(fva.k5.1$time_pass, fva.k5.1$fever_drop), col="black")
lines(lowess(fva.k6.1$time_pass, fva.k6.1$fever_drop), col="green")
lines(lowess(fva.k7.1$time_pass, fva.k7.1$fever_drop), col="red")
lines(lowess(fva.k8.1$time_pass, fva.k8.1$fever_drop), col="red")
lines(lowess(fva.k9.1$time_pass, fva.k9.1$fever_drop), col="blue")
lines(lowess(fva.k10.1$time_pass, fva.k10.1$fever_drop), col="blue")
lines(lowess(fva.k11.1$time_pass, fva.k11.1$fever_drop), col="black")
lines(lowess(fva.k12.1$time_pass, fva.k12.1$fever_drop), col="black")

#according to baby's weight

#물약
tmerge.r <- tmerge %>%
  filter(as.numeric(weight) >= 2, as.numeric(weight) <= 40)

fdt.k1 <- tmerge.r %>%
  filter(kind == 1) %>%
  filter(as.numeric(volume) <= 100, as.numeric(volume) > 0.1)

fdt.k2 <- tmerge.r %>%
  filter(kind == 2) %>%
  filter(as.numeric(volume) <= 100, as.numeric(volume) > 0.1)

fdt.k6 <- tmerge.r %>%
  filter(kind == 6) %>%
  filter(as.numeric(volume) <= 100, as.numeric(volume) > 0.1)

fdt.k1.1 <- fdt.k1 %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  filter(!is.na(vpw))

fdt.k2.1 <- fdt.k2 %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  filter(!is.na(vpw))

fdt.k6.1 <- fdt.k6 %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  filter(!is.na(vpw))

byVPW_ml(fdt.k6.1)
byVPW_ml(fdt.k1.1)
byVPW_ml(fdt.k2.1)

fdt.k6.1 <- arrange(fdt.k6.1, vpw)
n <- nrow(fdt.k6.1)
fdt.k6.1.low <- fdt.k6.1[1:(0.01*n),]
fdt.k6.1.mid <- fdt.k6.1[(0.01*n+1):(0.9*n),]
fdt.k6.1.hi <- fdt.k6.1 [(0.9*n+1):n,]
plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
lines(lowess(fdt.k6.1.low$time_pass, fdt.k6.1.low$fever_drop), col="darkgreen")
lines(lowess(fdt.k6.1.mid$time_pass, fdt.k6.1.mid$fever_drop), col="darkblue")
lines(lowess(fdt.k6.1.hi$time_pass, fdt.k6.1.hi$fever_drop), col="red")

#가루약

fdt.k3 <- tmerge.r %>%
  filter(kind == 3) %>%
  filter(as.numeric(volume) <= 1000, as.numeric(volume) > 0.1)

fdt.k7 <- tmerge.r %>%
  filter(kind == 7) %>%
  filter(as.numeric(volume) <= 1000, as.numeric(volume) > 0.1)

fdt.k8 <- tmerge.r %>%
  filter(kind == 8) %>%
  filter(as.numeric(volume) <= 1000, as.numeric(volume) > 0.1)

fdt.k3.1 <- fdt.k3 %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  filter(!is.na(vpw))

fdt.k7.1 <- fdt.k7 %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  filter(!is.na(vpw))

fdt.k8.1 <- fdt.k8 %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  filter(!is.na(vpw))

byVPW_ml(fdt.k8.1)
byVPW_ml(fdt.k3.1)
byVPW_ml(fdt.k7.1)

# function
byVPW_ml <- function (df){
  df.1 <- df %>%
    filter(vpw < 0.2)
  df.2 <- df %>%
    filter(vpw >= 0.2, vpw < 0.3)
  df.3 <- df %>%
    filter(vpw >= 0.3, vpw < 0.4)
  df.4 <- df %>%
    filter(vpw >= 0.4, vpw < 0.5)
  df.5 <- df %>%
    filter(vpw >= 0.5, vpw < 0.6)
  df.6 <- df %>%
    filter(vpw >= 0.6, vpw < 0.7)
  df.7 <- df %>%
    filter(vpw >= 0.7, vpw < 0.8)
  df.8 <- df %>%
    filter(vpw >= 0.8)

  plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
  lines(lowess(df.1$time_pass, df.1$fever_drop), col="red")
  lines(lowess(df.2$time_pass, df.2$fever_drop), col="orange")
  lines(lowess(df.3$time_pass, df.3$fever_drop), col="yellow")
  lines(lowess(df.4$time_pass, df.4$fever_drop), col="darkgreen")
  lines(lowess(df.5$time_pass, df.5$fever_drop), col="skyblue")
  lines(lowess(df.6$time_pass, df.6$fever_drop), col="darkblue")
  lines(lowess(df.7$time_pass, df.7$fever_drop), col="darkviolet")
  lines(lowess(df.8$time_pass, df.8$fever_drop), col="black")

}

# function
byVPW_mg <- function (df){
  df.low <- df %>%
    filter(vpw < 0.3)
  df.mid <- df %>%
    filter(vpw >= 0.3, vpw < 0.5)
  df.hi <- df %>%
    filter(vpw >= 0.5)

  plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
  lines(lowess(df.low$time_pass, df.low$fever_drop), col="darkgreen")
  lines(lowess(df.mid$time_pass, df.mid$fever_drop), col="darkblue")
  lines(lowess(df.hi$time_pass, df.hi$fever_drop), col="red")
}

byVPW_qt <- function (df){
  df <- arrange(df, vpw)
  n <- nrow(df)
  df.low <- df[1:(0.01*n),]
  df.mid <- df[(0.01*n+1):(0.99*n),]
  df.hi <- df [(0.99*n+1):n,]
  df.mid
  plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-10,10), cex = 0.01)
  lines(lowess(df.low$time_pass, df.low$fever_drop), col="darkgreen")
  lines(lowess(df.mid$time_pass, df.mid$fever_drop), col="darkblue")
  lines(lowess(df.hi$time_pass, df.hi$fever_drop), col="red")
}

#feverdrop per volume per weight

fdt.r <- tmerge.r %>%
  filter(as.numeric(volume) <= 100, as.numeric(volume) > 0.1) %>%
  mutate(vpw = as.numeric(volume) / as.numeric(weight)) %>%
  mutate(fdpvpw = fever_drop/vpw)

fdt.r.1 <- filter(fdt.r, kind == 1) 
fdt.r.2 <- filter(fdt.r, kind == 2) 
fdt.r.3 <- filter(fdt.r, kind == 3) 
fdt.r.4 <- filter(fdt.r, kind == 4) 
fdt.r.5 <- filter(fdt.r, kind == 5) 
fdt.r.6 <- filter(fdt.r, kind == 6) 
fdt.r.7 <- filter(fdt.r, kind == 7) 
fdt.r.8 <- filter(fdt.r, kind == 8) 
fdt.r.9 <- filter(fdt.r, kind == 9) 
fdt.r.10 <- filter(fdt.r, kind == 10) 
fdt.r.11 <- filter(fdt.r, kind == 11) 
#fdt.r.12 <- filter(fdt.r, kind == 12) 

plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-3,3), cex = 0.01)
lines(lowess(fdt.r.1$time_pass, fdt.r.1$fdpvpw), col="red")
lines(lowess(fdt.r.2$time_pass, fdt.r.2$fdpvpw), col="orange")
lines(lowess(fdt.r.3$time_pass, fdt.r.3$fdpvpw), col="yellow")
lines(lowess(fdt.r.4$time_pass, fdt.r.4$fdpvpw), col="darkgreen")
lines(lowess(fdt.r.5$time_pass, fdt.r.5$fdpvpw), col="skyblue")
lines(lowess(fdt.r.6$time_pass, fdt.r.6$fdpvpw), col="darkblue")
lines(lowess(fdt.r.7$time_pass, fdt.r.7$fdpvpw), col="darkviolet")
lines(lowess(fdt.r.8$time_pass, fdt.r.8$fdpvpw), col="gray")
lines(lowess(fdt.r.9$time_pass, fdt.r.9$fdpvpw), col="black")
lines(lowess(fdt.r.10$time_pass, fdt.r.10$fdpvpw), col="darkred")
lines(lowess(fdt.r.11$time_pass, fdt.r.11$fdpvpw), col="green")
#lines(lowess(fdt.r.12$time_pass, fdt.r.12$fdpvpw), col="pink")

test<- fdt.r.6 %>%
 filter(vpw >= 0.8) 

lo <- loess(fdt.r.5$time_pass ~ fdt.r.5$fdpvpw)
summary(lo)

scatter.smooth(fdt.r.5)
lines(lo$fitted, col="blue")

## @knitr loess_fit
hat <- predict(loess)
plot(y~a)
lines(a[order(a)], hat[order(hat)], col="red")
(r_sq_loess <- cor(y, hat)^2)

dis.1 <- dis %>%
  filter(baby_id < 1000) %>%
  filter(kind %in% 0:20)

fdt <- fread("merge.csv")

fdt <- `colnames<-`(fdt[,c(-1,-2,-13,-14)], c("Aid","baby_id","V5","V6","V7","V8", "fever","m_kind","volume", "time_pass","fever_drop","B1","B2","B3","B4","B5","B6","B7","B8","B9","B10","B11","B12"))

fdt.d <- fdt %>%
  mutate(eat_date = paste(V5,V6)) %>%
  mutate(f_date = paste(V7,V8))
fdt.d1 <- fdt.d[,c(-3:-6)]

dmerge <- merge(fdt.d1, dis.1, by = c("Aid", "baby_id"), allow.cartesian=TRUE)

dfd <- dmerge %>%
  filter(ymd_hm(eat_date) - ymd_hm(date) >= -7200) %>%
  filter(ymd_hm(eat_date) - ymd_hm(date) <= 7200)

dfd.d0 <- dfd %>%
  filter(kind == 0)
dfd.d1 <- dfd %>%
  filter(kind == 1)
dfd.d2 <- dfd %>%
  filter(kind == 2)
dfd.d3 <- dfd %>%
  filter(kind == 3)
dfd.d4 <- dfd %>%
  filter(kind == 4)
dfd.d5 <- dfd %>%
  filter(kind == 5)
dfd.d6 <- dfd %>%
  filter(kind == 6)
dfd.d7 <- dfd %>%
  filter(kind == 7)
dfd.d8 <- dfd %>%
  filter(kind == 8)
dfd.d9 <- dfd %>%
  filter(kind == 9)
dfd.d10 <- dfd %>%
  filter(kind == 10)
dfd.d11 <- dfd %>%
  filter(kind == 11)
dfd.d12 <- dfd %>%
  filter(kind == 12)
dfd.d13 <- dfd %>%
  filter(kind == 13)
dfd.d14 <- dfd %>%
  filter(kind == 14)
dfd.d15 <- dfd %>%
  filter(kind == 15)
dfd.d16 <- dfd %>%
  filter(kind == 16)
dfd.d17 <- dfd %>%
  filter(kind == 17)
dfd.d18 <- dfd %>%
  filter(kind == 18)
dfd.d19 <- dfd %>%
  filter(kind == 19)
dfd.d20 <- dfd %>%
  filter(kind == 20)

getPlot(dfd.d6)
plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
lines(lowess(dfd.d1$time_pass, dfd.d1$fever_drop), col="red")
lines(lowess(dfd.d2$time_pass, dfd.d2$fever_drop), col="orange")
lines(lowess(dfd.d4$time_pass, dfd.d4$fever_drop), col="yellow")
lines(lowess(dfd.d5$time_pass, dfd.d5$fever_drop), col="purple")
lines(lowess(dfd.d6$time_pass, dfd.d6$fever_drop), col="darkred")
lines(lowess(dfd.d7$time_pass, dfd.d7$fever_drop), col="green")
lines(lowess(dfd.d8$time_pass, dfd.d8$fever_drop), col="darkgreen")
lines(lowess(dfd.d11$time_pass, dfd.d11$fever_drop), col="skyblue")
lines(lowess(dfd.d12$time_pass, dfd.d12$fever_drop), col="darkblue")
lines(lowess(dfd.d14$time_pass, dfd.d14$fever_drop), col="brown")
lines(lowess(dfd.d20$time_pass, dfd.d20$fever_drop), col="black")
lines(lowess(dfd.d0$time_pass, dfd.d0$fever_drop), col="gray")

plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
lines(lowess(dfd.d3$time_pass, dfd.d3$fever_drop), col="red")
lines(lowess(dfd.d9$time_pass, dfd.d9$fever_drop), col="orange")
lines(lowess(dfd.d10$time_pass, dfd.d10$fever_drop), col="yellow")
lines(lowess(dfd.d13$time_pass, dfd.d13$fever_drop), col="purple")
lines(lowess(dfd.d15$time_pass, dfd.d15$fever_drop), col="darkred")
lines(lowess(dfd.d18$time_pass, dfd.d18$fever_drop), col="skyblue")

which_med(dfd.d5)
which_med_sum(dfd.d4)
which_med_case(dfd.d7)

which_med <- function(df){
  df.1 <- df %>%
    filter(m_kind == 1)
  df.2 <- df %>%
    filter(m_kind == 2)
  df.3 <- df %>%
    filter(m_kind == 3)
  df.4 <- df %>%
    filter(m_kind == 4)
  df.5 <- df %>%
    filter(m_kind == 5)
  df.6 <- df %>%
    filter(m_kind == 6)
  df.7 <- df %>%
    filter(m_kind == 7)
  df.8 <- df %>%
    filter(m_kind == 8)

  plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
  lines(lowess(df.1$time_pass, df.1$fever_drop), col="red")
  lines(lowess(df.2$time_pass, df.2$fever_drop), col="orange")
  lines(lowess(df.3$time_pass, df.3$fever_drop), col="yellow")
  lines(lowess(df.4$time_pass, df.4$fever_drop), col="darkgreen")
  lines(lowess(df.5$time_pass, df.5$fever_drop), col="skyblue")
  lines(lowess(df.6$time_pass, df.6$fever_drop), col="darkblue")
  lines(lowess(df.7$time_pass, df.7$fever_drop), col="darkviolet")
  lines(lowess(df.8$time_pass, df.8$fever_drop), col="black")
}

which_med_sum <- function(df){
  df.1 <- df %>%
    filter(m_kind == 1 | m_kind == 3| m_kind == 4 | m_kind ==5)
  df.2 <- df %>%
    filter(m_kind == 2 | m_kind == 7| m_kind == 9 | m_kind ==11)
  df.3 <- df %>%
    filter(m_kind == 6 | m_kind == 8| m_kind == 10 | m_kind ==12)

  plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
  lines(lowess(df.1$time_pass, df.1$fever_drop), col="red")
  lines(lowess(df.2$time_pass, df.2$fever_drop), col="darkblue")
  lines(lowess(df.3$time_pass, df.3$fever_drop), col="darkgreen")

}

which_med_case <- function(df){
  df.1 <- df %>%
    filter(m_kind == 1 | m_kind == 2| m_kind == 6 )
  df.2 <- df %>%
    filter(m_kind == 3 | m_kind == 7| m_kind == 8 )
  df.3 <- df %>%
    filter(m_kind == 4 | m_kind == 9| m_kind == 10)
  df.4 <- df %>%
    filter(m_kind == 5 | m_kind == 11| m_kind == 12)

  plot(c(1,2), c(3,4),xlim=c(0,21600), ylim = c(-1.5,1.5), cex = 0.01)
  lines(lowess(df.1$time_pass, df.1$fever_drop), col="red")
  lines(lowess(df.2$time_pass, df.2$fever_drop), col="darkblue")
  lines(lowess(df.3$time_pass, df.3$fever_drop), col="darkgreen")
  lines(lowess(df.4$time_pass, df.4$fever_drop), col="black")

}

와.. 좋은 자료 잘 봤습니다. LOWESS 라는게 있는줄 몰랐는데 덕분에 공부 좀 했네요. 그래프도 이쁘고 좋습니다.

다만 n 수가 많은 자료에서는 scatter plot 말고 heat map 등으로 표현하면 더 좋을 것 같습니다. 정말 좋은 분석 잘 봤어요. insight 도 재밌네요.

scatter plot 을 보면 자료들이 상당히 심하게 흩어져 있는데 우리 outlayer 에 대한 고민을 좀 덜 한것 같아요. 걸러내는 과정을 약간 추가하면 reliability 가 더 좋아질 것 같습니다.

하지만 의학 필드에서는 이정도 N수를 분서간 자료도 거의 없기 때문에 이정도면 엄청 귀한 분석이에요. 이중에 업체에서 가장 눈독 들일 많한 결론이 뭐가 있을까요? 그리고 좌약류가 효과에 비해서 시장점유율이 적은 이유가 무엇일까요? 우리의 결론이 잘못되었을 가능성은 없을까요? 참고로 구강 투여약들이 먹이기도 정말 힘듭니다. ㅠㅠ

그리고 꼭 두가지 이상을 조합하지 않아도, 단일 항목에 대한 인식도 더 있으면 좋을 것 같습니다. Outlayer 걸러낼때 정말 좋아요. 사용자들 행태 분석하기도 좋구요.

이제 슬슬 머신러닝 어느쪽에 써볼지 고민해봐도 되겠네요.

언제 한번 영상통화를 해보죠, 제가 이번 프로젝트는 이쪽 프로젝트가 바빠서 한국시간으로 다음주 화, 수 오전정도면 가능할 것 같아요. 내일 아침도 괜찮겠네요!

다음주 수요일 오전에 회사에 있을 시간에 전화 주시면 감사하겠습니다 outlayer 는 많이 자른다고 필터를 했지만 많이 남아 있는것 같습니다. 정리하고 다시 돌려보도록 하겠습니다

임상적으로 좌약류가 oral에 비해 효과가 떨어진다는 생각이 많았는데, JAMA 논문을 보니 메타분석을 한 결과 효과가 차이가 없다는 결과가 나와서 첨부합니다. http://jamanetwork.com/journals/jamapediatrics/fullarticle/379547

제가 아직 해열제별 기초통계량 이슈를 닫지 않고 있습니다. 그 이유는 아직 하나의 feature 데이터들도 아직 정체를 잘 모르겠어요. 대체 이놈들이 어떤 데이터 인지... 예를들어서

체온 데이터는 우리가 생각하는 아이들의 정말 체온이 맞는지, 어머니들이 입력하는 체온과 우리가 진료를 할때 는 체온과 정말 같은지 등등
해열제는 우리가 의도한대로 어머니들이 입력 하고 있는 건지, 정말 우리 앱에 입력하는 데이터들이 현실을 반영하는지, 실제 시장 점유율과는 얼마나 차이가 나는지, 비슷한지 다른지, 다르면 왜 다른지
진단을 받고 나서 먹이는 해열제와 진단을 받기 전에 먹이는 해열제가 같은지 등등 기본적인 통계로도 알아볼 수 있는 부분이 많아요.

데이터가 정말 기존의 의학계에서 받아들이는 데이터의 특성을 가지고 있어야지만, 기존의 의학계에서 우리 결과를 받아들어 줄 거에요. 그것 뿐 아니라 실제로 그 특성이 없으면 잘못된 데이터일 확률이 매우 높습니다.

또, 아직 Outlayer들을 어떻게 처리했는지 몰라서 그래요. 그리고 outlayer처리가 중요한 것이, 그것이 제대로 되지 않으면 그 뒤에 나오는 결과가 아무리 재미있더라도 신뢰성이 떨어져서 가치를 주기가 어렵습니다. outlayer처리를 제대로 해야 데이터에 신뢰성이 생기고, 그 뒤에 이어지는 분석들도 신뢰성이 생깁니다. 그리고 시장분율, 데이터 샘플링 등등 기본적인 통계기법에서 신뢰할만한 분석있어야, 그 뒤에 2차적으로 데이터를 분석하는것이 그나마 신뢰를 얻을 수 있는 길입니다.

의학계에서는 reliability가 무엇보다 중요합니다. 실제로 아무리 가치있는 연구결과가 나오더라도 실험 설계에서 심지어 사소한 실험설계와 다른 실행이나, 윤리위반등 때문에 그 뒤의 수 많은 노력과 결과들이 전부 휴지통에 들어 갈 수도 있습니다. 이런 부분은 아무래도 의학적인 지식이 평소에 있는것이 좀 유리하긴 하지만, 찬호씨도 옆에 있으니 서로 물어보면서 진행하면 더욱 좋을 것 같아요. 앞쪽에 기본적인 부분에서 신뢰도를 주지 못하면, 멀리 달려나가더라도 헛고생이 될 수가 있으니 조심하셔요. 툴을 다루는 능력에 있어서는 기영씨가 잘 하니까 같이 좀 도와주면서 같은 방향으로 나아갔으면 좋겠습니다.

상세한 피드백에 감사드립니다.

일단 현재 어플에서 받아들이고 있는 정보는 상품명이 아니고 성분명과 제형이라서 분석에 한계가 있을 것 같습니다.
시장점유율에 관하여서는 reference로 삼을 만한 것이 '뉴스에 인용된 의약품정보분석 회사/시장조사 회사'의 자료를 사용할수밖에 없을 것 같은데요, 이의 reliability에 의문이 들기도 합니다. 혹시 더 좋은 reference를 알고 계시는 분 있으시면 알려주시면 감사하겠습니다.
체온 데이터에 관하여서는 어플에서 체온 측정부위를 특정하고 있지는 않지만, 일반적으로 겨드랑이 체온을 잴 것이라고 생각됩니다. 임상현장에서도, 특히 local 진료에서는 항문체온을 잘 재지 않을 것이라고 생각되지만, 이에 대하여 근거로 삼을 수 있는 reference를 찾아보도록 하겠습니다.

어쩔수 없죠 ㅠㅠ
시장점유율 조사하는것도 제대로 하려면 일주일 이상걸립니다. 뉴스에 나온 자료를 찾는것도 좋은 방법이에요. 시장조사는 의학계랑 달라서 완전 신뢰할만한 reference는 드뭅니다. ㅠㅠ.. 조사하는것도 시간소모 엄청 해요.

3.체온을 재는건 옛날에 나온 좋은 논문이 많이 있습니다. 또 체온계 시장 조사를 해보면 좀 알 수 있을거에요. 주로 고막, 입안, 이마(관자놀이), 겨드랑이, 직장 정도가 주로 측정하는 site입니다.

논문용 데이터를 뽑았습니다 아세트 아미노펜이 이부프로펜과 덱시부프로펜에 비하여 해열효과가 작다는 가설에 뒷받임될 초안입니다

기본적으로 각 시간구간 별로 모두 데이터가 있는 약 2만명의 해열제 복용 후 체온을 각 시간대별 평균을 통하여 panel data 형식으로 만들었습니다. 분명 전체 데이터에 비하여 평균 체온이 높은 bias가 있습니다만, 일정 측정 수를 만족하는 고열구간의 individual selection으로 생각할 수 있을 것 같습니다.

기존의 panel data분석을 통하여도 다양한 방법을 사용해 보았지만, 시간 간격이 좁고 초기 체온과 각 구간별 체온의 차이를, 각 해열제 성분의 복용량과 체중당 복용량 기준으로 linear regression을 돌렸고, 결과로 2시간, 3시간 후까지의 체온 저하는 의미있게 약 성분에 따라 달라진다는 점을 파악했습니다 엑셀과 코드 첨부합니다 논문용.xlsx

Myeongchan-Kim / Mobile_Doctor

Data 분석 - 해열제별 효능분석 #10