7

私は R を初めて使用しますが、入門コースを受講して少し遊んだ後、1​​) モデリングの目的を (私のバックアップ計画である Excel と比較して) よりエレガントに解決し、2) できることを期待しています。このプロジェクトから奪うのに役立つスキル。

タスク/目的:

運転日誌データを使用して、電気自動車のポテンシャル エネルギーと GHG 排出量をシミュレートおよびモデル化しようとしています。具体的には：

  1. 運転日誌データ (開始と終了のタイム スタンプ、および何千ものドライバーのその他のデータ - 以下の基本的なサンプル) を次のように変換したいと考えています。
  2. 24 時間の時系列データ。24 時間の 1 分ごとに、誰が車両を運転しているか、どの「トリップ」に属しているか (そのドライバーの場合) を正確に把握できます。ここでの私の問題は、この問題に焦点を当てています。

希望する出力のタイプ: 注: この出力は、以下に示すサンプル データとは関係ありません。例として、特定の日の最初の 10 分間をいくつかの理論的な旅行で使用しました

ここに画像の説明を入力

この問題には必須ではありませんが、知っておくと役立つ場合があります。上記の出力を使用して、他のドライバー固有のデータを相互参照し、その旅行に関連するものに基づいてガソリン (または電気) の分単位の消費量を計算します。駐車場所や走行距離など。Rでこれをやりたいのですが、このステップに進む前に、まず上記の問題を理解する必要があります。

私がこれまでに持っている解決策は、以下に基づいています。

問題：

単純化されたデータの例:

a <- c("A","A","A","B","B","B","C","C","C")
b <- c(1, 2, 3, 1, 2, 3, 1, 2, 3)
c <- as.POSIXct(c(0.29167, 0.59375, 0.83333, 0.45833, 0.55347, 0.27083, 0.34375, 0.39236, 0.35417)*24*3600 + as.POSIXct("2013-1-1 00:00") )
d <- as.POSIXct(c(0.334027778, 0.614583333, 0.875, 0.461805556, 0.563888889, 0.295138889, 0.375, 0.503472222, 0.364583333)*24*3600 + as.POSIXct("2013-1-1 00:00"))
e <- c(2, 8, 2, 5, 5, 2, 5, 5, 2)
f <- as.POSIXct(c(0, 0.875, 0, 0.479166666666667, 0.580555555555556, 0.489583333333333, 0.430555555555556, 0.541666666666667, 0.711805555555555)*24*3600 + as.POSIXct("2013-1-1 00:00"))
g <- as.POSIXct(c(0, 0.885, 0, 0.482638888888889, 0.588194444444444, 0.496527777777778, 0.454861111111111, 0.559027777777778, 0.753472222222222)*24*3600 + as.POSIXct("2013-1-1 00:00"))
h <- c(0, 1, 0, 1, 4, 8, 8, 1, 5)
i <- as.POSIXct(c(0, 0, 0, 0.729166666666667, 0.595833333333333, 0.534722222222222, 0.59375, 0.779861111111111, 0.753472222222222)*24*3600 + as.POSIXct("2013-1-1 00:00"))
j <- as.POSIXct(c(0, 0, 0, 0.736111111111111, 0.605555555555556, 0.541666666666667, 0.611111111111111, 0.788194444444445, 0.75625)*24*3600 + as.POSIXct("2013-1-1 00:00"))
k <- c(0, 0, 0, 4, 4, 2, 5, 8,1)
testdata <- data.frame(a,b,c,d,e,f,g,h,i,j,k)
names(testdata) <- c("id", "Day", "trip1_start", "trip1_end", "trip1_purpose", "trip2_start", "trip2_end", "trip2_purpose", "trip3_start", "trip3_end", "trip3_purpose")

このサンプル データでは、3 人のドライバー (id = A、B、C) がいて、それぞれが 3 つの異なる日 (日 = 1、2、3) に運転します。一部のドライバーは、乗車回数が異なる場合があることに注意してください。タイム スタンプは、運転活動の開始時刻と終了時刻を示します。

次に、1 日分の間隔を作成します (2013 年 1 月 1 日)

start.min <- as.POSIXct("2013-01-01 00:00:00 PST")
end.max <- as.POSIXct("2013-01-01 23:59:59 PST")
tinterval <- seq.POSIXt(start.min, end.max, na.rm=T, by = "mins")

特定のユーザーが運転している分に「1」を挿入します。

out1 <- xts(,align.time(tinterval,60))
# loop over each user
for(i in 1:NROW(testdata)) {
  # paste the start / end times into an xts-style range
  timeRange <- paste(format(testdata[i,c("trip1_start","trip1_end")]),collapse="/")
  # add the minute "by parameter" for timeBasedSeq
  timeRange <- paste(timeRange,"M",sep="/")
  # create the by-minute sequence and align to minutes to match "out"
  timeSeq <- align.time(timeBasedSeq(timeRange),60)
  # create xts object with "1" entries for times between start and end
  temp1 <- xts(rep(1,length(timeSeq)),timeSeq)
  # merge temp1 with out and fill non-matching timestamps with "0"
  out1 <- merge(out1, temp1, fill=0)
}
# add column names
colnames(out1) <- paste(testdata[,1], testdata[,2], sep = ".")

次に、out2、out3 などの各トリップでこれを繰り返すという考え方です。ここで、運転期間を「2」、「3」などで埋め、結果の out xデータフレームをすべて合計/マージします。そして最終的に望ましい結果を得る。

残念ながら、これをout2で繰り返そうとすると...

out2 <- xts(,align.time(tinterval,60))
for(i in 1:NROW(testdata)) {
  timeRange2 <- paste(format(testdata[i,c("trip2_start","trip2_end")]),collapse="/")
  timeRange2 <- paste(timeRange2,"M",sep="/")
  timeSeq2 <- align.time(timeBasedSeq(timeRange2),60)
  temp2 <- xts(rep(2,length(timeSeq2)),timeSeq2)
  out2 <- merge(out2, temp2, fill=0)
}
colnames(out2) <- paste(testdata[,1], testdata[,2], sep = ".")
head(out2)

次のエラーが表示されます。

  • UseMethod("align.time") のエラー: クラス "Date" のオブジェクトに適用された 'align.time' に適用可能なメソッドがありません
  • colnames<-(のエラー*tmp*、値 = c("A.1", "A.2", "A.3", "B.1", "B.2", : オブジェクトに 'colnames' を設定しようとしています。二次元より

out2 のコードの何が問題になっていますか?

私が学ぶことができる他のより良いソリューションやパッケージはありますか?

これはおそらく、目的の出力に到達するための非常に迂遠な方法であることに気付きました。

どんな助けでも大歓迎です。

4

2 に答える 2

1

このソリューションでは、元のデータを読み取り、それをフォーマットして、以前の回答の生成データを取得します。提供されるデータはドライバーごとに 22 回の乗車に制限されていますが、ここでの再形成は乗車回数に制限されません。この考え方は、サンプル データの生成に使用される考え方と似ています。data.tableグループごとにデータを操作するのに便利なので使っています。

したがって、（日、ドライバー）ごとに、次のことを行います。

  1. 長さが分数のゼロのベクトルを作成する
  2. XXXstrip_start と XXXstrip_end を使用して開始位置と終了位置を読み取ります。
  3. シーケンス seq(start,end) を作成する
  4. このシーケンスを使用して、数字のシーケンスでゼロを変更します

ここに私のコード：

start.min <- as.POSIXct("2013-01-01 00:00:00 PST")
hours.min <- format(seq(start.min, 
                        length.out=24*60, by = "mins"),
                    '%H:%M')
library(data.table)
diary <- read.csv("samplediary.csv",
                  stringsAsFactors=FALSE)
DT <- data.table(diary,key=c('id','veh_assigned','day'))

dat <- DT[, as.list({ .SD;nb.trip=sum_trips
           tripv <- vector(mode='integer',length(hours.min))
           if(sum_trips>0){
             starts = mget(paste0('X',seq(nb.trip),'_trip_start'))
             ends = mget(paste0('X',seq(nb.trip),'_trip_end'))
             ids <- mapply(function(x,y){
                                        seq(as.integer(x),as.integer(y))},
                           starts,ends,SIMPLIFY = FALSE)
             for (x in seq_along(ids))tripv[ids[[x]]] <- x
             }
            tripv
           }),
   by=c('id','day')]
setnames(x=dat,old=paste0('V',seq(hours.min)),hours.min)

最初の 10 個の変数をサブセット化すると、次のようになります。

dat[1:10,1:10,with=FALSE]


       id day 00:00 00:01 00:02 00:03 00:04 00:05 00:06 00:07
 1: 3847339   1     0     0     0     0     0     0     0     0
 2: 3847384   1     0     0     0     0     0     0     0     0
 3: 3847436   1     0     0     0     0     0     0     0     0
 4: 3847439   1     0     0     0     0     0     0     0     0
 5: 3847510   1     0     0     0     0     0     0     0     0
 6: 3847536   1     0     0     0     0     0     0     0     0
 7: 3847614   1     0     0     0     0     0     0     0     0
 8: 3847683   1     0     0     0     0     0     0     0     0
 9: 3847841   1     0     0     0     0     0     0     0     0
10: 3847850   1     0     0     0     0     0     0     0     0

1 つのアイデアは、データのヒートマップ (少なくとも 1 日あたり) を作成して直感を得て、たとえば重複するドライバーを確認することです。latticeこれを使用してこれを行う2つの方法がありますggplot2が、最初に使用して長い形式でデータを再形成しますreshape2

library(reshape2)
dat.m <- melt(dat,id.vars=c('id','day'))

次に、ヒートマップをプロットして、たとえばどのドライバーが他のドライバーと重複しているかを確認します。

library(lattice)
levelplot(value~as.numeric(variable)*factor(id),data=dat.m)

ここに画像の説明を入力

library(ggplot2)
ggplot(dat.m, aes(x=as.numeric(variable),y=factor(id)))+ 
        geom_tile(aes(fill = value)) +
  scale_fill_gradient(low="grey",high="blue")

ここに画像の説明を入力

于 2013-06-29T04:01:13.890 に答える
0

これはあなたの問題に対する答えではありません。正直なところ、画像に表示されているデータとデータの例の間の移行が明確ではありません。このデータを再現することはできないようです。だからここに、データの再現可能な例を生成する関数があります。モデルを検証するには、少なくとも役立つと思います。

データをサンプリングする関数

library(reshape2)
start.min <- as.POSIXct("2013-01-01 00:00:00 PST")
hours.min <- format(seq(start.min, 
                        length.out=24*60, by = "mins"),
                    '%H:%M')

## function to generate a trip sample
## min.dur : minimal duration of a trip
## max.dur : maximal duration of a trip
## min.trip : minimal number of trips that a user can do 

gen.Trip <- function(min.dur=3,max.dur=10,min.trip=100){
  ## gen number of trip
  n.trip <- sample(seq(min.trip,20),1)
  ## for each trip generate the durations
  durations <- rep(seq(1,n.trip),
                   times=sample(seq(min.dur,max.dur),
                                max(min.dur,n.trip),rep=TRUE))
  ## generate a vector of positions
  rr <- rle(durations)
  mm <- cumsum(rr$lengths)
  ## idrty part here
  pos <- sort(sample(seq(1,length(hours.min)-2*max(mm)),
              n.trip,rep=FALSE)) + mm
  ## assign each trip to each posistion  
  val <- vector(mode='integer',length(hours.min))
  for(x in seq_along(pos))
    val[seq(pos[x],length.out=rr$len[x])] <- rr$val[x]
  val
}

100 人のドライバーの乗車を生成する

set.seed(1234)
nb.drivers <- 100
res <- replicate(nb.drivers,gen.Trip(),simplify=FALSE)
res <- do.call(rbind,res)
colnames(res) <- hours.min
rownames(res) <- paste0('driv',seq(nb.drivers))

ワイドフォーマット

head(res[,10:30])
  ##       00:09 00:10 00:11 00:12 00:13 00:14 00:15 00:16 00:17 00:18 00:19
## driv1     0     0     0     0     0     0     1     1     1     1     1
## driv2     0     1     1     1     1     1     1     2     2     2     1
## driv3     0     0     0     0     0     0     0     0     0     0     0
## driv4     1     1     1     0     0     0     0     0     0     0     0
## driv5     0     0     0     0     0     0     0     0     0     0     1
## driv6     0     0     0     0     0     0     0     0     0     0     0
##       00:20 00:21 00:22 00:23 00:24 00:25 00:26 00:27 00:28 00:29
## driv1     1     1     0     0     2     2     2     2     2     2
## driv2     0     0     0     0     0     0     3     3     3     3
## driv3     0     0     0     0     0     0     0     0     0     0
## driv4     0     0     0     0     0     0     0     0     0     0
## driv5     1     1     1     1     1     1     1     1     0     0
## driv6     0     0     0     0     0     0     0     0     0     0

ロングフォーマット

res.m <- melt(res)
head(res.m)
##    Var1  Var2 value
## 1 driv1 00:00     0
## 2 driv2 00:00     0
## 3 driv3 00:00     0
## 4 driv4 00:00     0
## 5 driv5 00:00     0
## 6 driv6 00:00     0
于 2013-06-28T16:56:59.657 に答える