mecobalamin’s diary

人間万事塞翁が馬

Rで折れ線グラフ

Rで時系列データの折れ線グラフを作る
グラフを書くことよりも日付の処理が面倒だったのでそのメモ

作りたいのは気温と海水温の時系列グラフ
f:id:mecobalamin:20190320223529p:plain
気温と海水温の軸を左右に分けて、日付の軸は共通にする
折れ線グラフの赤が海水温で青が気温を示す

気温と海水温の時系列データは気象庁からダウンロードする
気温:気象庁、過去の気象データ
気象庁|過去の気象データ・ダウンロード
海水温:東京管区気象台
沿岸域の海面水温情報(関東・東海・北陸周辺) | 東京管区気象台

ファイルを見ると日付のフォーマットが違うことがわかる
今回に限らず、データによって日付の書き方が違うことはよくある
まず日付のフォーマットを揃える事から始める

気温のデータはcsv形式でダウンロードできて、
いろいろ情報が入っているが、
日付と気温以外のデータをexcelなどで削って使う
削ったデータをRで取り込んでみるとこんな感じ

data.air <- read.table("airtemp_2017-2019.csv", sep = ",")
>head(data.air)
1 ダウンロードした時刻:2019/03/20 12:34:56                                       
2                                                   羽田         羽田         羽田
3                                    年月日 平均気温(℃) 最高気温(℃) 最低気温(℃)
4                                  2017/1/1          8.6         12.5          3.7
5                                  2017/1/2          8.6         11.9          5.1
6                                  2017/1/3          8.9         13.6          3.7

これだと使いにくいのでヘッダーと何行スキップするかを指定する
また、ラベルを付け直して、一列目を日付のデータ形式に変換する
必要な列だけ取り出してデータの形式を変換する
気温のデータはファイルから読み込んだままだとfactor形式なので、
一度characterに変えてそれからnumericにする
手順についてググるといろいろ出てくる
factor型(2)_因子型(factor)から数値型(numeric)に戻すと数値が変わる? - 一所懸命に手抜きする

それと日付に関連してロケールを指定する必要があるらしい
なぜか?と聞かれると答えられないのだが。。。
コマンドはSys.setlocale()を使う

Sys.setlocale("LC_TIME", "C")
data.air <- read.table("airtemp_2017-2019.csv", header = TURE, skip = 2, sep = ",")
label.air <- c("date", "haneda_ave", "haneda_high", "haneda_low")
colnames(data.air) <- label.air
data.air$date <- as.POSIXct(as.Date(data.air$date, format = "%Y/%m/%d"))
data.air <- data.air[c("date", "haneda_ave")]
data.air[,1] <- as.Date(data.air[,1])
data.air[,2] <- as.numeric(as.character(data.air[,2]))

変換した結果がこれ

>head(data.air)
        date haneda_ave
1 2017-01-01        8.6
2 2017-01-02        8.6
3 2017-01-03        8.9
4 2017-01-04        9.5
5 2017-01-05        7.4
6 2017-01-06        5.8

海水温はテキストデータで手に入るが日付が
年・月・日で別の列になっていて、
ヘッダーと同じ文字列がデータの最後の行にも入っている

  yyyy mm dd areaNo. flag  Temp.
1 2017 01 01     704    R  25.16
2 2017 01 02     704    R  25.41
3 2017 01 03     704    R  25.58

ファイルを読み込んだら最後の行を取り除いて
年・月・日を一つにまとめたあとに日付のデータ形式に変換し、
必要な列だけ取り出す
こっちもfactorをcharacter -> numericの順に変換する

data.sea <- read.table("seatemp_2017-2019.txt", header = T, sep = ",")
data.sea <- data.sea[-nrow(data.sea),]
data.sea$date <- paste(data.sea[,1], data.sea[,2], data.sea[,3], sep = ".")
data.sea$date <- as.POSIXct(as.Date(data.sea$date, format = "%Y.%m.%d"))
data.sea <- data.sea[c("date", "Temp.")]
data.sea[,1] <- as.Date(data.sea[,1])
data.sea[,2] <- as.numeric(as.character(data.sea[,2]))

結果こうなる

        date Temp.
1 2017-01-01 25.16
2 2017-01-02 25.41
3 2017-01-03 25.58
4 2017-01-04 25.66
5 2017-01-05 25.66
6 2017-01-06 25.59

これを次の関数に投げるとグラフが出力される

PlotLineChart <- function(data.air, data.sea){
  # 日付の最小値と最大値を取得する
  Date.All <- as.Date(unique(append(data.air$date, data.sea$date)))
  Date.Range <- c(min(Date.All), max(Date.All))

  # マージンの調整、下、左、上、右の順
  par(mar = c(5, 5, 1, 5))

  # 1つ目のデータのプロット、軸を書かない
  # lは折れ線グラフ
  plot(data.air[,1], data.air[,2],
    xlab = "",
    ylab = "",
    xlim = Date.Range, # x軸の最小と最大
    ylim = c(-15, 35), # y軸の最小と最大
    type = "l",
    col = "gray",
    axes = FALSE
  )

  # 1つ目のデータのプロット、点を描く
  points(data.air[,1], data.air[,2], pch = 16, cex = 1, lwd = 1, col = "blue")

  # 軸ラベルを書く、4=右、3行目
  mtext("Air Temperature (Deg C)", side = 4, line = 3, cex = 1)
  axis(4, lwd = 1)

  # 重ね書きをする
  par(new = TRUE)

  # 軸だけ表示, type = "n"で指定する
  par(xaxt = "n")
  plot(0, 0,
    xlab = "Date (Year)",
    ylab = "Sea Temperature (Deg C)",
    type = "n",
    xlim = Date.Range, # x軸の最小と最大
    ylim = c(-15, 35), # y軸の最小と最大
    cex.lab = 1, # ラベルの文字の拡大率
    cex.axis = 1, # 軸の文字の拡大率
  )

  # x軸の表示
  par(xaxt = "s")
  axis.Date(1, at=seq(min(Date.All), max(Date.All), by = "years"), format = "%Y", cex.axis = 1)

  # 2つ目のデータのプロット、折れ線グラフで描く
  lines(data.sea[,1], data.sea[,2],
    cex = 1,
    col = "gray"
  )
  # 2つ目のデータのプロット、点を描く
  points(data.sea[,1], data.sea[,2],
    pch = 16,
    cex = 1,
    col = "red"
  )
}

グラフをファイルに出力するにはこうする

png.name <- sprintf("temperature.png")
png(png.name, width = 600, height = 400)
PlotLineChart(data.air, data.sea)
dev.off()

カラーパレットを作って月毎にマーカーの色を変える事もできる
まずは関数を作る

AddColorCode <- function(d, n, p){
  # カラーパレットを作る。並びを逆にしている
  Func.Col.Pal <- colorRampPalette(rev(RColorBrewer::brewer.pal(8, p)))
  # 12色のカラーコードを取り出して、輝度値をnにする
  Col.Pal <- Func.Col.Pal(12)
  for(i in 1:length(Col.Pal)){
    Col.Pal[i] <- paste(Col.Pal[i], n, sep = "")
  }

  tmp.name <- colnames(d)

  # 月の列を追加
  tmp.month <- as.numeric(substring(d$date, 6, 7))
  d <- cbind(d, tmp.month)

  # カラーコードの作成
  tmp.col <- c()
  for(i in 1:nrow(d)){
    tmp.col <- append(tmp.col, Col.Pal[tmp.month[i]])
  }
  d <- cbind(d, tmp.col)

  tmp.add.name <- c("month", "color")
  colnames(d) <- append(tmp.name, tmp.add.name)

  return(d)
}

データの前処理のときにAddColorCode()を呼び出して
データにカラーコードを追加する
3番目の引数はRColorBrewer::display.brewer.all()で表示される
カラーパレットの名前を使う
なおRColorBrewerはパッケージなので使う前にインストールが必要

data.air <- AddColorCode(data.air, 20, "Paired")
data.air <- data.air[c("date", "haneda_ave", "color")]
data.air[,1] <- as.Date(data.air[,1])
data.air[,2] <- as.numeric(as.character(data.air[,2]))
data.air[,3] <- as.character(data.air[,3])

data.sea <- AddColorCode(data.sea, 80, "Spectral")
data.sea <- data.sea[c("date", "Temp.", "color")]
data.sea[,1] <- as.Date(data.sea[,1])
data.sea[,2] <- as.numeric(as.character(data.sea[,2]))
data.sea[,3] <- as.character(data.sea[,3])

PlotLineChart()で色を指定するcolの引数を2ヶ所修正する
ここと

  points(data.air[,1], data.air[,2], pch = 16, cex = 1, lwd = 1, col = data.air$color)

ここ

  points(data.sea[,1], data.sea[,2],
    pch = 16,
    cex = 1,
    col = data.sea$color
  )

修正後にPlotLineChart()でグラフを表示させるとこんな結果になる
f:id:mecobalamin:20190320225337p:plain
見やすくなったとは言えないが。。。。
同じ色が同じ月なのでグラフによっては比較しやすくなるかな。