바쁜 일정 비율의 R

Question

병원에서 일합니다. 의사는 밤과 저녁 시간에 전화를합니다. 환자가 오지 않아 휴식을 취하는 경우가 있습니다. 다른 시간에 많은 환자들이 한꺼번에 거기에있을 것입니다. 그들은 시작했을 때와 환자 치료를 중단했을 때 기록을 남깁니다. lubridate 패키지를 사용하면 이러한 데이터를 특정 날짜의 간격으로 변환 할 수 있습니다. 이 간격의 길이는 치료가 다소 복잡 할 수 있기 때문에 많이 달라질 것입니다. 또한 많은 일이 발생하면 의사가 환자간에왔다 갔다 할 수 있습니다. 따라서 일반적인 항목은 다음과 같습니다. "2016-06-11 21:45:00 UTC" "2016-06-11 22:35:00 UTC"

보통 매우 바쁜 시간을 확인하고 다소 느린데, 나는이 데이터를 사용하고 싶습니다. 다른 요일에도 가능해야합니다. 모든 것이 평균 일자리가 하루 중 어떤 시간 일지를 보여주는 막대 그래프처럼 보일 것입니다 (예를 들어 100 % 직업은 오후 8 시부 터 오후 9 시까 지 40 %는 1 시부 터 2 시까 지). 내 문제는 어떻게 해야할지 모르겠다는 것입니다. ggplot은 간격을 처리하지 않으며 간격에 대해이 평균 또는 백분율을 수행 할 패키지를 찾지 못했습니다.

내가 무엇이 필요하고 내 문제가 무엇인지 분명히 할 수 있었으면 좋겠다. 나는 경험 많은 프로그래머가 아니지만 배울 수있어서 행복하다.

덕분에 많은

발렌틴

편집 :

미안 해요, 난 그 생각을해야합니다. 그래서 여기까지 내가 온과 같습니다

>Daten<-read.csv2("Dienstdatum.csv") 
>Beginn<-parse_date_time(Daten$Beginn,"dmy HM“,tz="CET“) 
>Ende<-parse_date_time(Daten$Ende,"dmy HM",tz="CET“) 
##Interval with date information 
>Daten$Intervalle<-interval(Beginn,Ende) 
##Intervals stripped of date 
>Daten$Beg<-as.POSIXct(strftime(Beginn, format="%H:%M:%S"), format="%H:%M:%S") 
> Daten$dur<-as.duration(Daten$Intervall) 
> Daten$Interv<-as.interval(Daten$dur , Daten$Beg) 
## add weekdays 
>Daten$Wochentage<-weekdays(Beginn) 

이 방법은 내가 같은 날짜를 가리키는 시간 간격을 가지고 내가하여 데이터를 정렬하는 평일있다. 내가 붙어있는 곳은 일정한 간격의 히스토그램을 알 수 없기 때문입니다. 나는 시작 날짜를 사용할 수 있지만 간격이 5 분에서 2 시간 사이 일 수 있으므로 크게 비뚤어 질 것입니다.

코드가 도움이되기를 바랍니다. 모범적 인 데이터가 필요하다면 알려주세요.

EDIT (2)

: 다음은 원시 데이터 https://www.dropbox.com/s/tok32wzt9wjmjih/Dienstdatum.csv?dl=0

및 dput의 출력은 다음과 같습니다 데이터뿐만 아니라 수로 구성되지 않은 내가 두려워 https://www.dropbox.com/s/wgtw68rw9n0ksct/Output%20Dput.rtf?dl=0

하지만해야 여전히 작동합니다. 출력을 인라인으로 게시하는 것이 좋은지 확실하지 않으므로 파일을 제공했습니다.

Answer 1

그래서 주위를 파고 다른 일을 시도한 후에, 내가 생각해 내고 나에게 맞는 것은 여기 있습니다. salution은 다소 뒤얽힌 다. 그리고 장황한 버스는 명백하게 정확한 결과를 준다. 대답을 찾으려고 할 때 벡터화 된 코드를 생성하면 약 96 분 후에 계산을 중단하기 전에 결과를 약 3 분으로 계산하는 데 걸리는 시간을 줄이기 때문에 vectorisation (내 독일어 액센트를 용서하십시오)에 대한 어려움에 대해 배웠습니다.

문서화 된 날짜 목록 (모든 의사가 그의 근무 기록을 완료하지는 않음)은 간단한 날짜가있는 Excel 시트입니다. 문서화 된 시간 작업 간격 목록은 누군가가 한 열의 환자를보기 시작하고 다른 환자의 환자를 보는 것을 중지 한 날짜와 시간입니다. 다음 행은 비슷한 시작 및 중지 시간 및 날짜입니다.

텍스트의 모든 변수는 독일어로되어 있거나 독일어 단어의 약어입니다.하지만 내 의견이 무슨 일이 벌어지고 있는지 이해하기에 충분할 것으로 기대합니다. 또한 많은 코드가 내 상황과 관련된 문제에 대한 것입니다.

솔루션의 다양한 측면에서 저를 도운 사용자 PhiSeu와 user3507085에게 감사드립니다.

#read dates 
package(lubridate) 
Daten<-read.csv2(„file.csv") 
#convert start dates to POSIX 
Daten$Beginn<-parse_date_time(Daten$Beginn,"dmy HM",tz="CET") 
#prevent overlap by adding one second 
Daten$Beginn<-Daten$Beginn+1 
#convert end dates to POSIX 
Daten$Ende<-parse_date_time(Daten$Ende,"dmy HM",tz="CET") 
#remove empty rows 
Daten<-na.omit(Daten) 
#create intervals in which people worked 
Daten$Intervall<-interval(Daten$Beginn,Daten$Ende) 
#read dates on which people worked 
doku<-read.csv2(„dates.csv“,header=FALSE) 
doku<-parse_date_time(doku$V1,"%d.%m.%Y",tz="cet") 

#create a start time of 09 A.M. for shifts 
doku<-data.frame(cbind(doku,doku+32400)) 
#add column names 
names(doku)<-c("Datum","Beginn") 
#convert to POSIX 
doku$Datum<-as.POSIXct(doku$Datum,origin="1970-01-01",tz="cet") 
doku$Beginn<-as.POSIXct(doku$Beginn,origin="1970-01-01",tz="cet") 

#Loop to create 15 min intervals for each documented shift spanning 24 hour against which actual working hours will be checked 

begin <- as.POSIXct(doku$Beginn) 

# copy begin time for loop 
begin_new <- begin 

# create duration object 
aufl <- duration(15, "mins") 

# count times for loop 
times <- 24*60/15 

# create dataframe with begin time 
Intervall <- data.frame(begin,stringsAsFactors = FALSE) 

for (i in 1:times){ 

    cat("test",i,"\n") 

    # save old time for interval calculation 
    begin_start <- begin_new 
    # add 15 Minutes to original time 
    begin_new <- begin_new + aufl 

    cat(begin_new,"\n") 

    # create an interval object between 
    new_dur <- interval(begin_start,begin_new) 

    # bind to original dataframe 
    Intervall <- cbind(Intervall,new_dur) 

} 

# Add column names 
vec_names <- paste0("v",c(1:(times+1))) 
colnames(Intervall) <- vec_names 


#create a matrix of the number of seconds worked in each of the above 15 intervals by checking the amount of intersection between 15 intervals and documented intervals of work 

test<-vector() 
Tabelle<-matrix(nrow=length(doku$Beginn),ncol=times) 
Tabelle[is.na(Tabelle)]<-0 
for (j in 1:length(doku$Beginn)){ 
for (k in 1:times){ 
test<-as.duration(intersect(Daten$Intervall,Intervall[j,k+1])) 
test[is.na(test)]<-0 
test<-sum(test) 
Tabelle[j,k]<-test}} 


#cadd start time to the above matrix 
Ausw<-data.frame(cbind(Tabelle,begin)) 
#convert to POSIX 
Ausw$begin<-as.POSIXct(Ausw$begin,origin="1970-01-01",tz="cet") 

##analysis of data 
#common to all days of the week 
#create labels for 15 min intervals 
Labels<-c("09","09:15","09:30","09:45","10","10:15","10:30","10:45","11","11:15","11:30","11:45","12","12:15","12:30","12:45","13","13:15","13:30","13:45","14","14:15","14:30","14:45","15","15:15","15:30","15:45","16","16:15","16:30","16:45","17","17:15","17:30","17:45","18","18:15","18:30","18:45","19","19:15","19:30","19:45","20","20:15","20:30","20:45","21","21:15","21:30","21:45","22","22:15","22:30","22:45","23","23:15","23:30","23:45","00","00:15","00:30","00:45","01","01:15","01:30","01:45","02","02:15","02:30","02:45","03","03:15","03:30","03:45","04","04:15","04:30","04:45","05","05:15","05:30","05:45","06","06:15","06:30","06:45","07","07:15","07:30","07:45","08","08:15","08:30","08:45") 

##analysis for weekends 
#how many percent people worked on average in any of the 15 min intervals on a saturday or sunday 
Wochenende<-apply(Ausw[Ausw$wtag==c(1,7),1:times],MARGIN=2,FUN=sum) 
Prozent<-Wochenende/length(Ausw$begin[Ausw$wtag==c(1,7)]) /as.numeric(aufl)*100 

#add labels 
names(Prozent)<-Labels 
#plot as barplot and add axis labels 
b=barplot(Prozent,axes = F,axisnames=F,main="Durchschnittliche Arbeitsbelastung am Wochenende",sub="über 100%: Übergabezeiten",xlab="Uhrzeit",ylab="Prozent") 
axis(1,at=c(b[seq(1,length(Labels),4)],b[length(b)]+diff(b)[1]),labels = c(Labels[seq(1,length(Labels),4)],"09")) 
axis(2,at=seq(0,160,25),las=2) 


##analysos monday to friday 
Woche<-apply(Ausw[Ausw$wtag==c(2,3,4,5,6),1:times],MARGIN=2,FUN=sum) 
Prozent2<-Woche/length(Ausw$begin[Ausw$wtag==c(2,3,4,5,6)]) /as.numeric(aufl)*100 
#add labels 
names(Prozent2)<-Labels 
#plot as barplot and add axis labels 
b2=barplot(Prozent2,axes = F,axisnames=F,main="Durchschnittliche Arbeitsbelastung Montag - Freitag",,xlab="Uhrzeit",ylab="Prozent“,ylim=c(0,100)) 
axis(1,at=c(b2[seq(1,length(Labels),4)],b2[length(b2)]+diff(b2)[1]),labels = c(Labels[seq(1,length(Labels),4)],"09")) 
axis(2,at=seq(0,160,25),las=2)