R中間隔的繁忙百分比

Question

我在醫院工作。我們的醫生在夜間和傍晚工作。可能有些時候沒有病人來，所以他們可以休息。在其他時候，許多患者會立即在那裏。 他們在開始時以及停止治療患者時記下。使用lubridate軟件包，我可以將這些數據轉換爲具有特定日期的間隔。這些時間間隔的長短可能會有很大的變化，因爲治療可能多少有些複雜。此外，當很多事情發生時，醫生可能會在患者之間來回走動。因此，典型的條目將如下所示：「2016-06-11 21:45:00 UTC」「2016-06-11 22:35:00 UTC」

要查看哪一天的時間通常非常繁忙，這很慢，我想用這些數據。這也應該可以在一週中的不同日子。 整個事情應該看起來像條形圖，顯示平均職業在一天中的任何時間（例如，在晚上8點到晚上9點之間100％佔用，在1點到凌晨2點之間佔40％）。 我的問題是，我不知道該怎麼做。 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

因此，經過挖掘並嘗試不同的事情，這裏是我想出了什麼和對我有用。這個提示有點令人費解，而詳細的巴士顯然給出了確切的結果。在試圖找到答案時，我學習了矢量化的想法（赦免我的德語口音），因爲生成矢量化代碼可以將計算結果的時間縮短到大約3分鐘，而在大約96小時之後我停止計算而沒有完成。

請注意，記錄日期列表（並非每個醫生都會完成他的班次記錄）是一個簡單日期的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)