정보

    • 업무명     : ECMWF Interim 수치 예측 모델로부터 지오포텐셜 고도 (Geopotential Height)를 이용한 주성분 분석 및 가시화

    • 작성자     : 이상호

    • 작성일     : 2020-03-15

    • 설   명      :

    • 수정이력 :

     

     내용

    [개요]

    • 안녕하세요? 기상 연구 및 웹 개발을 담당하고 있는 해솔입니다.

    • 현대 기상 예측에서 수치예보는 40 %로서 큰 비중을 차지합니다. 기상청에 따르면 "수치 예보는 물리학의 방정식에 의해 바람과 기온 등의 기온 변화를 컴퓨터로 계산하여 미래의 대기 상태를 예측하는 방법"이라고 합니다.

    • 즉 컴퓨터를 통해 지구의 상태를 시뮬레이션하여 기상 예측하는 기술입니다. 이러한 시뮬레이션 방법은 여러 종류가 있으나 결과는 "GPV (Grid Point Value)" 형식으로 제공하는 것이 대부분입니다.

    • 기상 예측은 시간과 격자에 대한 여러 기상 정보를 내포하고 "NetCDF" 형식으로 배포하고 있습니다.

    • 이러한 NetCDF 형식은 대기과학에서 자주 사용되기 때문에 프로그래밍 언어 (R, Python, GrADS, NCL)에 따른 자료 처리 및 가시화가 필연입니다. 이와 관련한 정보는 링크를 참조해주시기 바랍니다.

     

    [R] "ncdf4" 패키지 및 NetCDF 형식인 NOAA 최적 내삽 자료를 이용하여 데이터 프레임 (Data Frame)으로 변환 처리 및 가시화 (2)

    정보 업무명 : "ncdf4" 패키지 및 NetCDF 형식인 NOAA 최적 내삽 자료를 이용하여 데이터 프레임 (Data Frame)으로 변환 처리 및 가시화 (2) 작성자 : 이상호 작성일 : 2020-02-13 설 명 : 수정이력 : 내용 [개요]..

    shlee1990.tistory.com

     

     

    [R] "RNetCDF" 패키지 및 NetCDF 형식인 NOAA 최적 내삽 자료를 이용하여 데이터 프레임 (Data Frame)으로 변환 처리 및 가시화 (3)

    정보 업무명 : "RNetCDF" 패키지 및 NetCDF 형식인 NOAA 최적 내삽 자료를 이용하여 데이터 프레임 (Data Frame)으로 변환 처리 및 가시화 (3) 작성자 : 이상호 작성일 : 2020-03-15 설 명 : 수정이력 : 내용 [개..

    shlee1990.tistory.com

     

     

    [Python] 파이썬 NetCDF 형식인 Aqua/CERES 기상위성 자료를 이용한 가시화

    정보 업무명 : NetCDF 형식인 Aqua/CERES 기상위성 자료를 이용한 가시화 작성자 : 이상호 작성일 : 2019-10-22 설 명 : 수정이력 : 2020-02-05 : 소스 코드 명세 추가 내용 [개요] 안녕하세요? 웹 개발 및 연구..

    shlee1990.tistory.com

     

     

    [GrADS, ShellScript] 그라즈 NetCDF 형식인 NOAA 월평균 해수면 온도 자료를 이용한 가시화

    정보 업무명 : 그라즈 NetCDF 형식인 NOAA 월평균 해수면 온도 자료를 이용한 가시화 작성자 : 이상호 작성일 : 2019-09-07 설 명 : 수정이력 : 내용 [특징] NetCDF 결과를 이해하기 위해 가시화 도구가 필요하며..

    shlee1990.tistory.com

     

     

    [NCL] NetCDF 형식 및 NCL 변수 구조

    정보 업무명 : NetCDF 형식 및 NCL 구조 작성자 : 이상호 작성일 : 2020-02-27 설 명 : 수정이력 : 내용 [개요] 안녕하세요? 웹 개발 및 연구 개발을 담당하고 있는 해솔입니다. NCL (NCAR Command Language)은 미..

    shlee1990.tistory.com

     

    • 그리고 주성분 분석은 경험적 직교함수 (Empirical Orthogonal Function, EOF)로서 기상 자료에 자유도를 최소화하면서 원래의 자료 지닌 현상을 간단하게 묘사할 수 있습니다. 이와 관련한 정보는 링크를 참조하시기 바랍니다.

     

    [강릉원주대 대기환경과학과] 2015년 2학기 전필 고급기상통계학 소개 및 과제물

    정보 업무명 : 고급기상통계학 작성자 : 이상호 작성일 : 2019-12-20 설 명 : 수정이력 : 내용 [특징] 고급기상통계학 수업에 대한 이해를 돕기위해 작성 [기능] 소개 주제별 과제물 자료의 특성 자료의 상관성..

    shlee1990.tistory.com

     

    • 따라서 ECMWF Interim 수치 예측 모델 자료로부터 지오포텐셜 고도를 이용한 주성분 분석 및 가시화를 소개해 드리고자 합니다. 

     

    [특징]

    • 주성분 분석을 이해하기 위해서 자료 처리 및 가시화가 요구되며 이 프로그램은 이러한 목적을 달성하기 위한 소프트웨어

     

    [기능]

    • NetCDF 파일 읽기

    • 다중 자료에 대한 데이터 프레임 처리

    • 고유근에 따른 설명력 전처리 및 가시화

    • 1-5번째 주성분에 대한 고유벡터 전처리 및 가시화 

    • 1-5번째 주성분에 대한 지오포텐셜 기압 전처리 및 가시화

    • 1-3번째 주성분 점수 시계열 

     

    [활용 자료]

    • 자료명 : interim_daily_06uvz_200901_15.nc

    • 자료 종류 : 

    • 확장자 : NetCDF

    • 영역 : 전지구

    • 기간 : 2009년 01월 15일 - 2018년 12월 15일 (매월 15일)

    • 시간 해상도 : 일 1개

    • 제공처 : ECMWF

     

     

    [자료 처리 방안 및 활용 분석 기법]

    • 없음

     

    [사용법]

    • 소스 코드 참조

     

    [사용 OS]

    • Windows 10

     

    [사용 언어]

    • R v3.6.3

    • R Studio v1.2.5033

     

     소스 코드

    [명세]

    • 전역 설정

      • 최대 10 자리 설정

      • 메모리 해제

      • 영어 인코딩 설정

      • 폰트 설정

    # Set Option
    memory.limit(size = 9999999999999)
    options(digits = 10)
    Sys.setlocale("LC_TIME", "english")
    font = "Palatino Linotype"
    cbMatlab =  colorRamps::matlab.like(11)

     

    • 라이브러리 읽기

    # Library Load
    library(RNetCDF)
    library(tidyverse)
    library(extrafont)
    library(lubridate)
    library(data.table)
    library(noncompliance)
    library(factoextra)
    library(metR)
    library(ncdf4)
    library(netf4.helpers)
    library(colorRamps)
    library(RColorBrewer)
    library(synoptReg)

     

    • NetCDF 파일 설정 및 열기

      • RNetCDF::open.nc를 통해 파일 열기

    sFileDirName = Sys.glob("INPUT/interim_daily_06uvz_2009_2018_1.5/*.nc")
    
    iCount = 1
    
    oOpenNc = RNetCDF::open.nc(sFileDirName[iCount])

     

     

    • 메타 데이터 이해

      • RNetCDF 패키지에서 print.nc 함수를 사용하여 파일의 메타 데이터를 확인

      • 이러한 메타 데이터에서 dimensions은 위도, 경도 및 시간과 같은 벡터 형식 변수가 포함

      • 추가로 메타 데이터에서 variables마다 세부 정보  포함

    # NetCDF Meta Information
    RNetCDF::print.nc(oOpenNc)

     

    > RNetCDF::print.nc(oOpenNc)
    
    netcdf offset64 {
    dimensions:
    	longitude = 54 ;
    	latitude = 34 ;
    	time = UNLIMITED ; // (31 currently)
    variables:
    	NC_FLOAT longitude(longitude) ;
    		NC_CHAR longitude:units = "degrees_east" ;
    		NC_CHAR longitude:long_name = "longitude" ;
    	NC_FLOAT latitude(latitude) ;
    		NC_CHAR latitude:units = "degrees_north" ;
    		NC_CHAR latitude:long_name = "latitude" ;
    	NC_INT time(time) ;
    		NC_CHAR time:units = "hours since 1900-01-01 00:00:00.0" ;
    		NC_CHAR time:long_name = "time" ;
    		NC_CHAR time:calendar = "gregorian" ;
    	NC_SHORT z(longitude, latitude, time) ;
    		NC_DOUBLE z:scale_factor = 0.092301838863626 ;
    		NC_DOUBLE z:add_offset = 13405.5261147056 ;
    		NC_SHORT z:_FillValue = -32767 ;
    		NC_SHORT z:missing_value = -32767 ;
    		NC_CHAR z:units = "m**2 s**-2" ;
    		NC_CHAR z:long_name = "Geopotential" ;
    		NC_CHAR z:standard_name = "geopotential" ;
    	NC_SHORT u(longitude, latitude, time) ;
    		NC_DOUBLE u:scale_factor = 0.000992487215187029 ;
    		NC_DOUBLE u:add_offset = 1.37864651762288 ;
    		NC_SHORT u:_FillValue = -32767 ;
    		NC_SHORT u:missing_value = -32767 ;
    		NC_CHAR u:units = "m s**-1" ;
    		NC_CHAR u:long_name = "U component of wind" ;
    		NC_CHAR u:standard_name = "eastward_wind" ;
    	NC_SHORT v(longitude, latitude, time) ;
    		NC_DOUBLE v:scale_factor = 0.000970069021761937 ;
    		NC_DOUBLE v:add_offset = 5.54898395962974 ;
    		NC_SHORT v:_FillValue = -32767 ;
    		NC_SHORT v:missing_value = -32767 ;
    		NC_CHAR v:units = "m s**-1" ;
    		NC_CHAR v:long_name = "V component of wind" ;
    		NC_CHAR v:standard_name = "northward_wind" ;
    
    // global attributes:
    		NC_CHAR :Conventions = "CF-1.6" ;
    		NC_CHAR :history = "2019-10-22 07:39:12 GMT by grib_to_netcdf-2.13.0: grib_to_netcdf /data/data03/scratch/34/80/_mars-atls02-a562cefde8a29a7288fa0b8b7f9413f7-5cmpQI.grib -o /data/data02/scratch/55/a1/_grib2netcdf-atls18-a82bacafb5c306db76464bc7e824bb75-5d9XvN.nc -utime" ;
    }

     

    • NetCDF 파일 읽기

      • RNetCDF::read.nc를 통해 파일 읽기

    # NetCDF File Read 
    liReadNc = RNetCDF::read.nc(oOpenNc)

     

    • 속성 정보 가져오기

      • RNetCDF::dim.inq.nc RNetCDF::att.get.nc를 통해 시간 속성 정보 가져오기
      • RNetCDF::att.get.nc를 통해 해수면 온도에 대한 scale_factor, add_offset, _FillValue 가져오기
    # Get Time Unit 
    nFileNumber = RNetCDF::dim.inq.nc(oOpenNc, "time")$length
    sTimeUnits = RNetCDF::att.get.nc(oOpenNc, "time", "units")
    
    # Get Attribute 
    fSCaleFactor = RNetCDF::att.get.nc(oOpenNc, "z", "scale_factor") 
    fAddOffset = RNetCDF::att.get.nc(oOpenNc, "z", "add_offset")
    fFillValue = RNetCDF::att.get.nc(oOpenNc, "z", "_FillValue")

     

     

    • 시간 변수 가져오기

      • lubridate::make_datetime를 통해 숫자형 (year, month, day, hour, minute, second)을 날짜형 (dtDateTime)으로 변환

      • format를 통해 날짜형 (dtDateTime)을 문자형 (sColName)으로 변환

    # Get Time Value
    nTime = RNetCDF::utcal.nc(sTimeUnits, liReadNc$time)
    
    dfDateTime = data.frame(nTime) %>%
       dplyr::mutate(
          dtDateTime = lubridate::make_datetime(year, month, day, hour, minute, second)
          , sColName = format(dtDateTime, "%Y-%m-%d")
       )
    
    dplyr::tbl_df(dfDateTime)

     

     

    • 변수 가져오기

      • 경도 (nLon), 위도 (nLat), 지오포텐셜 고도 (nVal)

      • 지오포텐셜 고도의 경우 Fill Value의 여부에 따라 Scale Factor 및 Add Off Set 그리고 NA로 설정

    # Get Value
    nLon = liReadNc[["longitude"]]
    nLat = liReadNc[["latitude"]]
    nTmpVal = liReadNc[["z"]]
    nVal = ifelse(nTmpVal != fFillValue, (nTmpVal * fScaleFactor) + fAddOffset, NA)
       
    dim(nTime)
    dim(nLon)
    dim(nLat)
    dim(nVal)

     

     

    • 데이터 프레임 (Data Frame) 변환

      • 주성분 분석을 위해 행 (위/경도에 따른 지오포텐셜 고도), 열 (시간)에 대해서 변환

     

    # Convert 2D Matrix to 1D Matrix
    maData = matrix(nVal, nrow = dim(nLon) * dim(nLat), ncol = nFileNumber)
    
    dfData = data.frame(maData)
    colnames(dfData) = c(dfDateTime$sColName)
    
    dplyr::tbl_df(dfData)

     

     

    • 다중 자료를 위한 데이터 프레임 (Data Frame) 열 추가 및 L1 처리

      • 단일 자료 (iCount == 1)의 경우 noncompliance::expand.grid.DT를 통해 위도, 경도에 따른 데이터 프레임을 설정하고 dplyr::bind_cols를 통해 열 추가 (위도, 경도, 시간에 따른 지오포텐셜 고도)

      • 다중 자료에서는 dplyr::bind_cols를통해 시간에 따른 지오포텐셜 고도를 추가 

      • 이는 벡터화를 사용하기 때문에 성능 저하 문제 해결

    # Add Coloum
    if (iCount == 1) {
       dfGeoData = noncompliance::expand.grid.DT(
          nLat, nLon
          , col.names = c("nLat", "nLon")
       )
       
       dfDataL1 = dplyr::bind_cols(dfGeoData, dfData)
    } else {
       dfDataL1 = dplyr::bind_cols(dfDataL1, dfData)
    }
    
    dplyr::tbl_df(dfDataL1)

     

     

    • Data Frame L1을 이용한 L2 전처리 

      • 전체 기간 (2009년 1월 15일 - 2018년 12월 15일)에서 필요한 사례에 대해 선택하는 과정

      • 즉 열 이름 (sColName)으로 필터하기 위해 필요한 사례 데이터셋 (dfFilterData)를 이용하여 날짜형 (dtDateTime) 및 문자형 (sColName)으로 변환

      • dplyr::select를 통해 두 데이터셋 (dtDataL1, dfFilterDataL1)에서 위도, 경도, 특정 사례에 대한 열을 선택 

    # L2 Processing Using Data Frame L1 : Filter Exception Case
    dfFilterData = data.table::fread("INPUT/total_sb_date_step6_gn.csv", header = FALSE, sep = ",")
    
    dfFilterDataL1 = dfFilterData %>%
       dplyr::mutate(
          dtDateTime = lubridate::make_datetime(V1, V2, V3)
          , sColName = format(dtDateTime, "%Y-%m-%d")
       )
    
    dplyr::tbl_df(dfFilterDataL1)
    
    dfDataL2 = dfDataL1 %>%
       dplyr::select(one_of(c("nLon", "nLat", dfFilterDataL1$sColName)))
    
    dplyr::tbl_df(dfDataL2)

     

     

     

    • Data Frame L2을 이용한 L3 전처리

      • dplyr::filter를 통해 동아시아에 대한 위도 (20-50), 경도 (100-140)를 사용 

    # L3 Processing Using Data Frame L2
    dfDataL3 = dfDataL2 %>%
       dplyr::filter(
          dplyr::between(nLon, 100, 140)
          , dplyr::between(nLat, 20, 50)
          )
    
    dplyr::tbl_df(dfDataL3)

     

     

    • Data Frame L3을 이용한 L4 전처리 

      • 주성분 분석을  위해 위도, 경도를 제외한 데이터 셋 구성

    # L4 Processing Using Data Frame L3
    dfDataL4 = dfDataL3[ , -c(1:2)]
    
    dplyr::tbl_df(dfDataL4)

     

     

    • Data Frame L4을 이용한 L5 전처리 

      • 주성분 분석을  위해 전치 행렬로 변환

     

    # L5 Processing Using Data Frame L4
    dfDataL5 = t(dfDataL4) %>%
       as.data.frame()
    
    dplyr::tbl_df(dfDataL5)

     

     

    • 주성분 분석

      • 수행 결과 총 7종 (sdev, loadings, center, scale, n.obs, scores, call)

    liPcaDec = synoptReg::pca_decision(dfDataL5)
    
    summary(liPcaDec)

     

     

    • 고유근에 따른 설명력

      • 수행 결과 총 7종 (sdev, loadings, center, scale, n.obs, scores, call)

    liPcaDec = synoptReg::pca_decision(dfDataL5)
    
    summary(liPcaDec)

     

     

     

    • 가시화

      • 데이터 세트에서 정보는 여전히 숨겨져 있기 때문에 가시화 필요

      • 가시화는 일반적인 정적 탐색 데이터 분석에서 웹 브라우저의 동적 대화식 데이터 시각화에 이르기까지 다양함

      • 특히 R의 기본 plot으로 여러 미학적 측면을 제어 할 수 있으나 Hadley Wickham (2016)이 개발한 ggplot2는 새로운 방법으로 시각화하기 때문에 이를 사용 

     

    • ggplot2를 이용한 고유근에 따른 설명력

    # Eigen Value
    nEigVal  = liPcaDec$PCA$sdev^2  
    
    # Visualization Using ggplot2
    liEof = princomp(dfDataL5, cor = TRUE)
    nEigValPer = (nEigVal / sum(nEigVal, na.rm = TRUE)) * 100.0
    nEigValCumTop10 = cumsum(nEigValPer)[1:10]
    
    factoextra::fviz_screeplot(
       liEof
       , addlabels = TRUE
       , x = "Principal  Components"
       , y = "Percentage of Variance [%]"
       , ncp = 10
       ) + 
       geom_point(aes(y = nEigValCumTop10), col = "red") + 
       geom_line(aes(y = nEigValCumTop10), col = "red") +
       theme_bw() +
       theme(
          plot.title = element_text(face = "bold", size = 18, color = "black")
          , axis.title.x = element_text(face = "bold", size = 18, colour = "black")
          , axis.title.y = element_text(face = "bold", size =18, colour = "black", angle=90)
          , axis.text.x  = element_text(face = "bold", size = 18, colour = "black")
          , axis.text.y  = element_text(face = "bold", size = 18, colour = "black")
          , legend.title = element_text(face = "bold", size = 14, colour = "white")
          , legend.position = c(0, 1)
          , legend.justification = c(0, 0.96)
          , legend.key = element_blank()
          , legend.text = element_text(size = 14, face = "bold", colour = "white")
          , legend.background = element_blank()
          , text = element_text(family = font)
          , plot.margin = unit(c(0, 8, 0, 0), "mm")
       ) +
       ggsave(filename = paste0("FIG/PrinComp1.png"), width = 12, height = 8, dpi = 600)

     

     

    • ggplot2를 이용한 주성분에 따른 고유벡터 가시화

      • 주성분 분석 결과 (liPcaDec)에서 loadings를 이용한 고유벡터 데이터 셋 (nEigVec) 구성

      • 즉 위도, 경도, 1-540번째 주성분에 따른 고유벡터로 구성

    # Eigen Vector
    nEigVec = liPcaDec$PCA$loadings %>%
       as.data.frame.matrix()
    
    dfDataL6 = data.frame(
       nLon = dfDataL3$nLon
       , nLat = dfDataL3$nLat
       , nEigVec
       )
    
    dplyr::tbl_df(dfDataL6)

     

     

    • ggplot2를 이용한 1번째 주성분에 대한 고유벡터

    # Visualization Using ggplot2
    ggplot() +
       theme_bw() +
       geom_raster(data = dfDataL6, aes(x = nLon, y = nLat, fill =  Comp.1), interpolate = TRUE) +
       metR::geom_contour2(data = dfDataL6, aes(x = nLon, y = nLat, z = Comp.1), color = "black", alpha = 0.3) +
       metR::geom_text_contour(data = dfDataL6, aes(x = nLon, y = nLat, z = Comp.1), stroke = 0.2, check_overlap = TRUE, rotate = TRUE, na.rm = TRUE) +
       scale_fill_gradient2(limits=c(-0.1, 0.1), breaks = seq(-0.1, 0.1, 0.05)) +
       geom_path(data = ggplot2::map_data("world2"), aes(long, lat, group = group), color = "black") +
       metR::scale_x_longitude(expand = c(0, 0), breaks = seq(100, 140, 10), limits = c(100, 140)) +
       metR::scale_y_latitude(expand = c(0, 0), breaks = seq(20, 50, 10), limits = c(20, 50)) +
       labs(
          x = ""
          , y = ""
          , fill = "Eigen Vector"
          , colour = ""
          , title  = "ERA Interim Geopotential Height 150 hPa"
          , subtitle = "Period : January 15, 2009 - December 15, 2018"
          , caption = "Source : ECMWF"
       ) +
       theme(
          plot.title = element_text(face = "bold", size = 18, color = "black")
          , axis.title.x = element_text(face = "bold", size = 18, colour = "black")
          , axis.title.y = element_text(face = "bold", size =18, colour = "black", angle=90)
          , axis.text.x  = element_text(face = "bold", size = 18, colour = "black")
          , axis.text.y  = element_text(face = "bold", size = 18, colour = "black")
          , legend.title = element_text(face = "bold", size = 14, colour = "black")
          , legend.position = c(0.01, 0.99)
          , legend.justification = c(0, 0.96)
          , legend.key = element_blank()
          , legend.text = element_text(size = 14, face = "bold", colour = "black")
          , legend.background = element_blank()
          , text = element_text(family = font)
          , plot.margin = unit(c(0, 8, 0, 0), "mm")
       ) +
       ggsave(filename = paste0("FIG/PrinComp2_Comp.1.png"), width = 12, height = 8, dpi = 600)

     

     

    • ggplot2 및 반복문을 이용한 1-5번째 주성분에 대한 고유벡터

    # Visualization Using For Loop and ggplot2
    for (iCount in 1:5) {
     
       sVal = paste0("Comp.", iCount)
       sFigDirName = paste0("FIG/PrinComp2_Comp.", iCount, ".png")
       
       ggplot() +
          theme_bw() +
          geom_raster(data = dfDataL6, aes(x = nLon, y = nLat, fill = !! as.name(sVal)), interpolate = TRUE) +
          metR::geom_contour2(data = dfDataL6, aes(x = nLon, y = nLat, z = !! as.name(sVal)), color = "black", alpha = 0.3) +
          metR::geom_text_contour(data = dfDataL6, aes(x = nLon, y = nLat, z = !! as.name(sVal)), stroke = 0.2, check_overlap = TRUE, rotate = TRUE, na.rm = TRUE) +
          scale_fill_gradient2(limits=c(-0.1, 0.1), breaks = seq(-0.1, 0.1, 0.05)) +
          geom_path(data = ggplot2::map_data("world2"), aes(long, lat, group = group), color = "black") +
          metR::scale_x_longitude(expand = c(0, 0), breaks = seq(100, 140, 10), limits = c(100, 140)) +
          metR::scale_y_latitude(expand = c(0, 0), breaks = seq(20, 50, 10), limits = c(20, 50)) +
          labs(
             x = ""
             , y = ""
             , fill = "Eigen Vector"
             , colour = ""
             , title  = "ERA Interim Geopotential Height 150 hPa"
             , subtitle = "Period : January 15, 2009 - December 15, 2018"
             , caption = "Source : ECMWF"
          ) +
          theme(
             plot.title = element_text(face = "bold", size = 18, color = "black")
             , axis.title.x = element_text(face = "bold", size = 18, colour = "black")
             , axis.title.y = element_text(face = "bold", size =18, colour = "black", angle=90)
             , axis.text.x  = element_text(face = "bold", size = 18, colour = "black")
             , axis.text.y  = element_text(face = "bold", size = 18, colour = "black")
             , legend.title = element_text(face = "bold", size = 14, colour = "black")
             , legend.position = c(0.01, 0.99)
             , legend.justification = c(0, 0.96)
             , legend.key = element_blank()
             , legend.text = element_text(size = 14, face = "bold", colour = "black")
             , legend.background = element_blank()
             , text = element_text(family = font)
             , plot.margin = unit(c(0, 8, 0, 0), "mm")
          ) +
          ggsave(filename = sFigDirName, width = 12, height = 8, dpi = 600)
    }

     

     

    • Data Frame L5를 이용한 주성분에 따른 지오포텐셜 기압 전처리 (1)

      • synoptReg::synoptclas를 통해 종관 분류를 계산

        • 이 과정에서 분류를 위한 임계값 (ncomp)을 -5 < ncomp < 5 설정

      • synoptReg::raster_clas를 통해 raster 형식으로 변환되고 이를 데이터 프레임으로 재 변환

      • 즉 위도, 경도, 1-10번째 주성분에 대한 지오포텐셜 고도

    liPcaCla = synoptReg::synoptclas(dfDataL5, ncomp = 5)
    
    dfTmpDataL7 = synoptReg::raster_clas(
       longitude = unique(dfDataL3$nLon)
       , latitude = unique(dfDataL3$nLat)
       , grouped_data = liPcaCla$grouped_data
       ) %>%
       raster::as.data.frame()
    
    dplyr::tbl_df(dfTmpDataL7)
    
    dfDataL7 = data.frame(
       nLon = dfDataL3$nLon
       , nLat = dfDataL3$nLat
       , dfTmpDataL7
       ) 
    
    dplyr::tbl_df(dfDataL7)

     

     

     

    • Data Frame L7를 이용한 주성분에 따른 지오포텐셜 기압 전처리 (2)

      • dplyr::select를 통해 위도, 경도, 1-5번째 주성분에 대한 지오포텐셜 고도 선택

      • 위도, 경도, 1-5번째 주성분에 대한 키 (sKey) 및 값 (nVal)으로 정제하기 위해 dplyr::gather 이용

      • dplyr::mutate를 통해 지오포텐셜 고도를 기압으로 변환 

    dfDataL8 = dfDataL7 %>%
       dplyr::select(nLon, nLat, CT1:CT5) %>%
       tidyr::gather(key = "sKey", value = "nVal", -nLon, -nLat) %>% 
       dplyr::mutate(nVal = nVal / 100) 
    
    dplyr::tbl_df(dfDataL8)

     

     

    • ggplot2를 이용한 1번째 주성분에 대한 지오포텐셜 기압 가시화

    dfDataL9 = dfDataL8 %>%
       dplyr::filter(sKey == "CT1")
    
    dplyr::tbl_df(dfDataL9)
    
    # Visualization Using ggplot2
    ggplot() +
       theme_bw() +
       geom_raster(data = dfDataL9, aes(x = nLon, y = nLat, fill =  nVal), interpolate = TRUE) +
       metR::geom_contour2(data = dfDataL9, aes(x = nLon, y = nLat, z = nVal), color = "black", alpha = 0.3) +
       metR::geom_text_contour(data = dfDataL9, aes(x = nLon, y = nLat, z = nVal), stroke = 0.2, check_overlap = TRUE, rotate = TRUE, na.rm = TRUE) +
       scale_fill_gradientn(colours = cbMatlab, limits=c(130, 150), breaks = seq(130, 150, 10), na.value = cbMatlab[length(cbMatlab)]) +
       geom_path(data = ggplot2::map_data("world2"), aes(long, lat, group = group), color = "black") +
       metR::scale_x_longitude(expand = c(0, 0), breaks = seq(100, 140, 10), limits = c(100, 140)) +
       metR::scale_y_latitude(expand = c(0, 0), breaks = seq(20, 50, 10), limits = c(20, 50)) +
       labs(
          x = ""
          , y = ""
          , fill = "Perssure [hPa]"
          , colour = ""
          , title  = "ERA Interim Geopotential Height 150 hPa"
          , subtitle = "Period : January 15, 2009 - December 15, 2018"
          , caption = "Source : ECMWF"
       ) +
       theme(
          plot.title = element_text(face = "bold", size = 18, color = "black")
          , axis.title.x = element_text(face = "bold", size = 18, colour = "black")
          , axis.title.y = element_text(face = "bold", size =18, colour = "black", angle=90)
          , axis.text.x  = element_text(face = "bold", size = 18, colour = "black")
          , axis.text.y  = element_text(face = "bold", size = 18, colour = "black")
          , legend.title = element_text(face = "bold", size = 14, colour = "black")
          , legend.position = c(0.01, 0.99)
          , legend.justification = c(0, 0.96)
          , legend.key = element_blank()
          , legend.text = element_text(size = 14, face = "bold", colour = "black")
          , legend.background = element_blank()
          , text = element_text(family = font)
          , plot.margin = unit(c(0, 8, 0, 0), "mm")
       ) +
       ggsave(filename = paste0("FIG/PrinComp3_Comp.1.png"), width = 12, height = 8, dpi = 600)

     

     

     

    • ggplot2 및 facet_wrap을 이용한 1-5번째 주성분에 대한 지오포텐셜 기압 가시화

    # Visualization Using ggplot2
    ggplot() +
       theme_bw() +
       geom_raster(data = dfDataL8, aes(x = nLon, y = nLat, fill =  nVal), interpolate = TRUE) +
       metR::geom_contour2(data = dfDataL8, aes(x = nLon, y = nLat, z = nVal), color = "black", alpha = 0.3) +
       metR::geom_text_contour(data = dfDataL8, aes(x = nLon, y = nLat, z = nVal), stroke = 0.2, check_overlap = TRUE, rotate = TRUE, na.rm = TRUE) +
       scale_fill_gradientn(colours = cbMatlab, limits=c(130, 150), breaks = seq(130, 150, 10), na.value = cbMatlab[length(cbMatlab)]) +
       geom_path(data = ggplot2::map_data("world2"), aes(long, lat, group = group), color = "black") +
       metR::scale_x_longitude(expand = c(0, 0), breaks = seq(100, 140, 10), limits = c(100, 140)) +
       metR::scale_y_latitude(expand = c(0, 0), breaks = seq(20, 50, 10), limits = c(20, 50)) +
       labs(
          x = ""
          , y = ""
          , fill = "Pressure [hPa]"
          , colour = ""
          , title  = "ERA Interim Geopotential Height 150 hPa"
          , subtitle = "Period : January 15, 2009 - December 15, 2018"
          , caption = "Source : ECMWF"
       ) +
       theme(
          plot.title = element_text(face = "bold", size = 18, color = "black")
          , axis.title.x = element_text(face = "bold", size = 18, colour = "black")
          , axis.title.y = element_text(face = "bold", size =18, colour = "black", angle=90)
          , axis.text.x  = element_text(face = "bold", size = 18, colour = "black")
          , axis.text.y  = element_text(face = "bold", size = 18, colour = "black")
          , legend.title = element_text(face = "bold", size = 18, colour = "black")
          , legend.position = c(0.6, 0.15)
          , legend.key = element_blank()
          , legend.text = element_text(size = 18, face = "bold", colour = "black")
          , legend.background = element_blank()
          , text = element_text(family = font)
          , plot.margin = unit(c(0, 8, 0, 0), "mm")
       ) +
       facet_wrap(. ~ sKey, ncol = 2) +
       ggsave(filename = paste0("FIG/PrinComp3_Comp.3.png"), width = 12, height = 12, dpi = 600)

     

     

    • 주성분 결과 (liPcaDec)를 이용한 주성분 점수 시계열

      • tibble::rownames_to_column를 통해 날짜 행을 열로 추가

      • 위도, 경도, 1-3번째 주성분 점수에 대한 키 (sKey) 및 값 (nVal)으로 정제하기 위해 dplyr::selectdplyr::gather 이용

      • dplyr::filter를 통해 2018년 01월 01일 이후 사례 선정 

    dfTmpDataL10 = liPcaDec$PCA$scores %>%
       as.data.frame()
    
    dfDataL10 = dfTmpDataL10 %>%
       tibble::rownames_to_column() %>%
       dplyr::select(Comp.1:Comp.3, rowname) %>%
       tidyr::gather(key = "sKey", value = "nVal", -rowname) %>%
       dplyr::mutate(
          dtDate = readr::parse_date(rowname)
          , nYear = lubridate::year(dtDate)
       ) %>%
       dplyr::filter(dtDate >= lubridate::as_date("2018-01-01"))
    
    dplyr::tbl_df(dfDataL10)

     

     

    • ggplot2를 이용한 주성분 점수 시계열

    # Visualization Using ggplot2
    sMinDate = lubridate::as_date("2018-01-01")
    sMaxDate = lubridate::as_date("2019-01-01")
    
    ggplot(data = dfDataL10, aes(x = dtDate, y = nVal, color = sKey)) +
       theme_bw() +
       geom_point() +
       geom_line() +
       scale_x_date(expand = c(0, 0), date_breaks = "month", date_labels = "%b-%d\n%Y", limits = as.Date(c(sMinDate, sMaxDate))) +
       scale_y_continuous(expand = c(0, 0), breaks = seq(-50, 50, 20), limits=c(-50, 50)) + 
       scale_color_discrete( 
          breaks = c("Comp.1", "Comp.2", "Comp.3") 
          , labels = c("PC1 (40.4 %)", "PC2 (18.3 %)", "PC3 (14.2 %)") 
          ) + 
       labs( 
          x = "Date [Month-Day Year]" 
          , y = "Principal Component Analysis Scores"
          , subtitle = "Period : February 19, 2018 - December 31, 2018"
          , caption = "Source : ECMWF"
          , fill = "" 
          , colour = "" 
       
          ) + 
       theme( 
          plot.title = element_text(face = "bold", size = 18, color = "black") 
          , axis.title.x = element_text(face = "bold", size = 18, colour = "black") 
          , axis.title.y = element_text(face = "bold", size=18, colour = "black", angle = 90) 
          , axis.text.x = element_text(angle = 45, hjust = 1, face = "bold", size=18, colour = "black") 
          , axis.text.y = element_text(face = "bold", size=18, colour = "black") 
          , legend.position = c(0.08, 0.95)
          # , legend.justification = c(0, 0.96)
          , legend.key = element_blank() 
          , legend.text = element_text(size = 14, face = "bold") 
          , legend.title = element_text(face = "bold", size = 14, colour = "black") 
          , legend.background=element_blank() 
          , text=element_text(family = font) 
          , plot.margin = unit(c(0, 8, 0, 0), "mm") 
          ) + 
       ggsave(filename = paste0("FIG/PrinComp4.png"), width = 12, height = 8, dpi = 600)

     

     

    [전체]

     

     참고 문헌

    [논문]

    • 없음

    [보고서]

    • 없음

    [URL]

    • 없음

     

     문의사항

    [기상학/프로그래밍 언어]

    • sangho.lee.1990@gmail.com

    [해양학/천문학/빅데이터]

    • saimang0804@gmail.com
    • 네이버 블러그 공유하기
    • 네이버 밴드에 공유하기
    • 페이스북 공유하기
    • 카카오스토리 공유하기