jiedian <- read.csv("E:\\e-program\\在用数据\\edata综合版-去掉金融业(least).csv")
eco <- read.csv("E:\\e-program\\在用数据\\经济数据-2.csv")
jiedian$年月 <-  seq(as.Date("2016-01-01"),length = 83,by = "1 month" )
eco$年月 <-  seq(as.Date("2016-01-01"),length = 83,by = "1 month" )
library(dplyr)
## Warning: 程辑包'dplyr'是用R版本4.2.1 来建造的
## 
## 载入程辑包:'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(forecast)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(tidyverse)
## Warning: 程辑包'tidyverse'是用R版本4.2.2 来建造的
## -- Attaching packages --------------------------------------- tidyverse 1.3.2 --
## v tibble  3.1.6     v purrr   0.3.5
## v tidyr   1.2.1     v stringr 1.4.1
## v readr   2.1.3     v forcats 0.5.2
## Warning: 程辑包'tidyr'是用R版本4.2.2 来建造的
## Warning: 程辑包'readr'是用R版本4.2.2 来建造的
## Warning: 程辑包'purrr'是用R版本4.2.2 来建造的
## Warning: 程辑包'stringr'是用R版本4.2.1 来建造的
## Warning: 程辑包'forcats'是用R版本4.2.2 来建造的
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(pheatmap)
## Warning: 程辑包'pheatmap'是用R版本4.2.2 来建造的
library(lubridate)
## Warning: 程辑包'lubridate'是用R版本4.2.2 来建造的
## 载入需要的程辑包:timechange
## Warning: 程辑包'timechange'是用R版本4.2.2 来建造的
## 
## 载入程辑包:'lubridate'
## 
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
data_classify <- function(data,i){
  a <- data %>%
    filter(`index1`==i) %>%
    select(`年月`,`业扩类型`,`接电容量`,`申请容量`,`一级行业`)
  return(a)
}
Eco_classify <- function(data,i){
  a <- data %>%
    filter(`index2`==i)%>%
    select(`年月`,`经济数值`,`经济指标`)
  return(a)
}
moving_cor <- function(start_date,data,window_length){
  data %>% 
    filter(between(`年月`,start_date-months(window_length),start_date+months(window_length))) %>%
    select(`接电容量`,`申请容量`,`业扩类型`,`经济数值`) %>%
    group_by(`业扩类型`) %>%
    summarise(
      `年月` = start_date,
      `业扩类型` = first(`业扩类型`),
      `接电相关系数`=cor(`接电容量`,`经济数值`),
      `申请相关系数`=cor(`申请容量`,`经济数值`))
}
mean_pearson <- function(data,window_length){
  start_date <- seq(as.Date("2016-06-01"),length = 78,by = "1 month" )
  b <- map_dfr(start_date,~(moving_cor(.x,data,window_length)))
  b %>%
    group_by(`业扩类型`)%>%
    summarise(
      `业扩类型`=first(`业扩类型`),
      `接电相关系数均值`=mean(`接电相关系数`),
      `申请相关系数均值`=mean(`申请相关系数`)
    )
}
for(j in c(1:7)){
q <- Eco_classify(eco,j)
print(first(q$经济指标))
df <- data.frame()
for(i in c(0:10)){
  p <- data_classify(jiedian,i)
  df[c(1:6) ,i+1] <- mean_pearson(merge(p,q,by="年月",all=T),5)$接电相关系数均值
  df[c(7:12),i+1] <- mean_pearson(merge(p,q,by="年月",all=T),5)$申请相关系数均值
}
colnames(df)<-c("the whole society","agriculture .etc","industry",
                "construction","transportation.etc","information.etc",
                "wholesale&retail'","accommodation&catering",
                "estate","leasing&business",
                "Public Service.etc")
rownames(df)<-c("New-installation(jie)","add-capacity(jie)","reduction(jie)","Close-account(jie)","pause(jie)","recovery(jie)",
                "New-installation","add-capacity","reduction","Close-account","pause","recovery")
 pheatmap(df,cellheight=15,cellwidth=20,display_numbers = T,
         cluster_row =FALSE , cluster_cols = FALSE)

}
## [1] "亏损企业本月末(个)"

## [1] "流动资产合计本月末(亿元)"

## [1] "产成品本月末(亿元)"

## [1] "资产总计本月末(亿元)"

## [1] "负债合计本月末(亿元)"

## [1] "利润总额(亿元)"

## [1] "亏损企业亏损总额(亿元)"

R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00

Including Plots

You can also embed plots, for example:

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.