間隔のビジーパーセンテージが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はいくぶん複雑で、冗長バスは明らかに正確な結果を与えます。答えを見つけようとすると、ベクタライズされたコードを生成すると、結果を約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)