複数の変数の可変フレームシフト移動平均

0
Hedgenious 2020-10-28 12:34.

私は次のようなデータセットを持っています

index <- seq(2000,2020)
weight <-seq(50,70)
length <-seq(10,50,2)
data <- cbind(index,weight,length)
row.names(data) <-as.character(seq(1:21))
data
   index weight length
1   2000     50     10
2   2001     51     12
3   2002     52     14
4   2003     53     16
5   2004     54     18
6   2005     55     20
7   2006     56     22
8   2007     57     24
9   2008     58     26
10  2009     59     28
11  2010     60     30
12  2011     61     32
13  2012     62     34
14  2013     63     36
15  2014     64     38
16  2015     65     40
17  2016     66     42
18  2017     67     44
19  2018     68     46
20  2019     69     48
21  2020     70     50

すべての間隔の以前の測定値を表すいくつかの新しい変数を作成する必要があります。

各行(各インデックス)に次の値を設定する必要があります。

  • 測定1日前の体重
  • 測定前1〜2日間の平均体重
  • 測定前1〜3日の平均体重
  • など最大10日[フレームは1から10まで変化し、フレームシフトは1に等しい]

その後:

  • 測定2日前の体重
  • 測定前2〜3日間の平均体重
  • 測定前の2〜4日間の平均体重
  • 11日までなど[フレームは1から10まで変化し、フレームシフトは2に等しい]

そして、30に等しいフレームシフトまでそれを続けます。したがって、フレームは平均1日から10日まで変化し、このフレームは測定の1日前から測定の30日前にシフトします。

また、複数の列(約10)に対してこれを行う必要があります。

ありがとうございました!

2 answers

0
Jeffery Petit 2020-10-28 20:56.

パッケージtidyverseを検討すると、zooこれは提案です:

環境を整える

library(tidyverse)
data <- tibble(
  index = seq(2000,2020),
  weight = seq(50,70),
  length = seq(10,50,2)
)

ジョブを実行します。

すべてのフレームシフトをループし、1から10までのすべての移動平均を計算します。

lapply(1:30, function(frameshift) {
  w <- lag(data$weight, frameshift)
  lapply(1:10, function(k) {
    name <- sprintf("frameshift%i_k%i", frameshift, k)
    tibble("{name}" := zoo::rollmean(x = w, k = k, fill = NA, align = "r"))
  }) %>% bind_cols()
}) %>% bind_cols()

最後に、結果のティブルをデータにバインドする必要があります...

フレームシフトが3、ロール平均が最大5のサンプル

res <- lapply(3, function(frameshift) {
  w <- lag(data$weight, frameshift)
  lapply(1:5, function(k) {
    name <- sprintf("frameshift%i_k%i", frameshift, k)
    tibble("{name}" := zoo::rollmean(x = w, k = k, fill = NA, align = "r"))
  }) %>% bind_cols()
}) %>% bind_cols()

bind_cols(data, res)
A tibble: 21 x 8
  index weight length frameshift3_k1 frameshift3_k2 frameshift3_k3 frameshift3_k4 frameshift3_k5
   <int>  <int>  <dbl>          <dbl>          <dbl>          <dbl>          <dbl>          <dbl>
 1  2000     50     10             NA           NA               NA           NA               NA
 2  2001     51     12             NA           NA               NA           NA               NA
 3  2002     52     14             NA           NA               NA           NA               NA
 4  2003     53     16             50           NA               NA           NA               NA
 5  2004     54     18             51           50.5             NA           NA               NA
 6  2005     55     20             52           51.5             51           NA               NA
 7  2006     56     22             53           52.5             52           51.5             NA
 8  2007     57     24             54           53.5             53           52.5             52
 9  2008     58     26             55           54.5             54           53.5             53
10  2009     59     28             56           55.5             55           54.5             54
1
G. Grothendieck 2020-10-28 19:50.

rollapplyr次のように使用します。2番目のセットoffsets-(2:11)に変更します。

library(zoo)

offsets <- -(1:10)

n <- length(offsets)
means <- function(x) c(cumsum(x) / seq_along(x), NA * offsets)[1:n]
r <- rollapplyr(data[, "weight"], list(offsets), means, partial = TRUE, fill = NA)
colnames(r) <- -offsets
cbind(data, r)

与える:

   index weight length  1    2  3    4  5    6  7    8  9   10
1   2000     50     10 NA   NA NA   NA NA   NA NA   NA NA   NA
2   2001     51     12 50   NA NA   NA NA   NA NA   NA NA   NA
3   2002     52     14 51 50.5 NA   NA NA   NA NA   NA NA   NA
4   2003     53     16 52 51.5 51   NA NA   NA NA   NA NA   NA
5   2004     54     18 53 52.5 52 51.5 NA   NA NA   NA NA   NA
6   2005     55     20 54 53.5 53 52.5 52   NA NA   NA NA   NA
7   2006     56     22 55 54.5 54 53.5 53 52.5 NA   NA NA   NA
8   2007     57     24 56 55.5 55 54.5 54 53.5 53   NA NA   NA
9   2008     58     26 57 56.5 56 55.5 55 54.5 54 53.5 NA   NA
10  2009     59     28 58 57.5 57 56.5 56 55.5 55 54.5 54   NA
11  2010     60     30 59 58.5 58 57.5 57 56.5 56 55.5 55 54.5
12  2011     61     32 60 59.5 59 58.5 58 57.5 57 56.5 56 55.5
13  2012     62     34 61 60.5 60 59.5 59 58.5 58 57.5 57 56.5
14  2013     63     36 62 61.5 61 60.5 60 59.5 59 58.5 58 57.5
15  2014     64     38 63 62.5 62 61.5 61 60.5 60 59.5 59 58.5
16  2015     65     40 64 63.5 63 62.5 62 61.5 61 60.5 60 59.5
17  2016     66     42 65 64.5 64 63.5 63 62.5 62 61.5 61 60.5
18  2017     67     44 66 65.5 65 64.5 64 63.5 63 62.5 62 61.5
19  2018     68     46 67 66.5 66 65.5 65 64.5 64 63.5 63 62.5
20  2019     69     48 68 67.5 67 66.5 66 65.5 65 64.5 64 63.5
21  2020     70     50 69 68.5 68 67.5 67 66.5 66 65.5 65 64.5

Related questions

MORE COOL STUFF

Reba McEntire は、彼女が息子の Shelby Blackstock と共有する「楽しい」クリスマスの伝統を明らかにしました:「私たちはたくさん笑います」

Reba McEntire は、彼女が息子の Shelby Blackstock と共有する「楽しい」クリスマスの伝統を明らかにしました:「私たちはたくさん笑います」

Reba McEntire が息子の Shelby Blackstock と共有しているクリスマスの伝統について学びましょう。

メーガン・マークルは、自然な髪のスタイリングをめぐってマライア・キャリーと結ばれました

メーガン・マークルは、自然な髪のスタイリングをめぐってマライア・キャリーと結ばれました

メーガン・マークルとマライア・キャリーが自然な髪の上でどのように結合したかについて、メーガンの「アーキタイプ」ポッドキャストのエピソードで学びましょう.

ハリー王子は家族との関係を修復できるという「希望を持っている」:「彼は父親と兄弟を愛している」

ハリー王子は家族との関係を修復できるという「希望を持っている」:「彼は父親と兄弟を愛している」

ハリー王子が家族、特にチャールズ王とウィリアム王子との関係について望んでいると主張したある情報源を発見してください。

ワイノナ・ジャッドは、パニックに陥った休暇の瞬間に、彼女がジャッド家の家長であることを認識しました

ワイノナ・ジャッドは、パニックに陥った休暇の瞬間に、彼女がジャッド家の家長であることを認識しました

ワイノナ・ジャッドが、母親のナオミ・ジャッドが亡くなってから初めての感謝祭のお祝いを主催しているときに、彼女が今では家長であることをどのように認識したかを学びましょう.

セントヘレナのジェイコブのはしごを登るのは、気弱な人向けではありません

セントヘレナのジェイコブのはしごを登るのは、気弱な人向けではありません

セント ヘレナ島のジェイコブズ ラダーは 699 段の真っ直ぐ上る階段で、頂上に到達すると証明書が発行されるほどの難易度です。

The Secrets of Airline Travel Quiz

The Secrets of Airline Travel Quiz

Air travel is far more than getting from point A to point B safely. How much do you know about the million little details that go into flying on airplanes?

Where in the World Are You? Take our GeoGuesser Quiz

Where in the World Are You? Take our GeoGuesser Quiz

The world is a huge place, yet some GeoGuessr players know locations in mere seconds. Are you one of GeoGuessr's gifted elite? Take our quiz to find out!

バイオニック読書はあなたをより速く読むことができますか?

バイオニック読書はあなたをより速く読むことができますか?

BionicReadingアプリの人気が爆発的に高まっています。しかし、それは本当にあなたを速読術にすることができますか?

誰かがこのナンバープレートを取得するために490万ドルを費やした

誰かがこのナンバープレートを取得するために490万ドルを費やした

著者による画像。(グラフィック:パガニ、エミレーツオークション)少数のナンバープレートは、UAEの主要なステータスシンボルです。

ドナルド・トランプは、攻撃用武器ではなく、シリア人に対する禁止案でオーランド銃乱射事件に対応します

ドナルド・トランプは、攻撃用武器ではなく、シリア人に対する禁止案でオーランド銃乱射事件に対応します

ドナルド・トランプは、「過激なイスラムテロに正直である」ことをすぐに祝福した後、トゥデイのショーに呼びかけ、日曜日の早朝に50人が死亡したような大量射殺を防ぐために何をすべきかについて話し合った。オーランドのパルスナイトクラブ。トランプは、情報収集の改善の必要性を強調しました(「何らかの理由で、彼らはこれらの人々を報告しておらず、間違っていることがたくさん起こっていることを知っています」と彼は言い、「彼ら」が誰であるかを明確にしませんでした)。

それにふたを置きます。実際、すべてに蓋をしてください。14ドルで12個のシリコンストレッチキッチン蓋を手に入れよう. [エクスクルーシブ]

それにふたを置きます。実際、すべてに蓋をしてください。14ドルで12個のシリコンストレッチキッチン蓋を手に入れよう. [エクスクルーシブ]

Tomorrow's Kitchen シリコンストレッチ蓋 12個パック | $14 | アマゾン | プロモーション コード 20OFFKINJALids は基本的にキッチンの靴下です。常に迷子になり、二度と閉じられない孤立したコンテナーが残ります。しかし、蓋が伸びて、残った容器、鍋、フライパン、さらには大きなスライスされた果物のすべてに適合するとしたらどうでしょうか? その非常に特殊な蓋を失うことを二度と心配する必要はありません。

あなたの最高のワシントン DC ハックを教えてください

あなたの最高のワシントン DC ハックを教えてください

このコラムでは、ロサンゼルスやラスベガスなど、いくつかの産業都市をハッキングしました。今こそ、軍産複合都市の時代です。

米国のフィギュア スケートは、チーム イベントでの最終決定の欠如に「苛立ち」、公正な裁定を求める

米国のフィギュア スケートは、チーム イベントでの最終決定の欠如に「苛立ち」、公正な裁定を求める

ロシアのフィギュアスケーター、カミラ・バリエバが関与したドーピング事件が整理されているため、チームは2022年北京冬季オリンピックで獲得したメダルを待っています。

Amazonの買い物客は、わずか10ドルのシルクの枕カバーのおかげで、「甘やかされた赤ちゃんのように」眠れると言っています

Amazonの買い物客は、わずか10ドルのシルクの枕カバーのおかげで、「甘やかされた赤ちゃんのように」眠れると言っています

何千人ものAmazonの買い物客がMulberry Silk Pillowcaseを推奨しており、現在販売中. シルクの枕カバーにはいくつかの色があり、髪を柔らかく肌を透明に保ちます。Amazonで最大46%オフになっている間にシルクの枕カバーを購入してください

パデュー大学の教授が覚醒剤を扱った疑いで逮捕され、女性に性的好意を抱かせる

パデュー大学の教授が覚醒剤を扱った疑いで逮捕され、女性に性的好意を抱かせる

ラファイエット警察署は、「不審な男性が女性に近づいた」という複数の苦情を受けて、12 月にパデュー大学の教授の捜査を開始しました。

コンセプト ドリフト: AI にとって世界の変化は速すぎる

コンセプト ドリフト: AI にとって世界の変化は速すぎる

私たちの周りの世界と同じように、言語は常に変化しています。以前の時代では、言語の変化は数年または数十年にわたって発生していましたが、現在では数日または数時間で変化する可能性があります。

SF攻撃で91歳のアジア人女性が殴られ、コンクリートに叩きつけられた

犯罪擁護派のオークランドが暴力犯罪者のロミオ・ロレンゾ・パーハムを釈放

SF攻撃で91歳のアジア人女性が殴られ、コンクリートに叩きつけられた

認知症を患っている 91 歳のアジア人女性が最近、47 番街のアウター サンセット地区でロメオ ロレンゾ パーハムに襲われました。伝えられるところによると、被害者はサンフランシスコの通りを歩いていたところ、容疑者に近づき、攻撃を受け、暴行を受けました。

ℝ

“And a river went out of Eden to water the garden, and from thence it was parted and became into four heads” Genesis 2:10. ? The heart is located in the middle of the thoracic cavity, pointing eastward.

メリック・ガーランドはアメリカに失敗しましたか?

バイデン大統領の任期の半分以上です。メリック・ガーランドは何を待っていますか?

メリック・ガーランドはアメリカに失敗しましたか?

人々にチャンスを与えることは、人生で少し遅すぎると私は信じています。寛大に。

Language