課題名：相関分析
a0 <- read.csv("https://stats.dip.jp/01_ds/data/heart.data.csv", header = TRUE)
a <- a0[ ,-1]
library(DT)
datatable(a)
x <- a$biking
y <- a$smoking
z <- a$heart.disease
cor(x,y)
## [1] 0.01513618
cor
## function (x, y = NULL, use = "everything", method = c("pearson",
## "kendall", "spearman"))
## {
## na.method <- pmatch(use, c("all.obs", "complete.obs", "pairwise.complete.obs",
## "everything", "na.or.complete"))
## if (is.na(na.method))
## stop("invalid 'use' argument")
## method <- match.arg(method)
## if (is.data.frame(y))
## y <- as.matrix(y)
## if (is.data.frame(x))
## x <- as.matrix(x)
## if (!is.matrix(x) && is.null(y))
## stop("supply both 'x' and 'y' or a matrix-like 'x'")
## if (!(is.numeric(x) || is.logical(x)))
## stop("'x' must be numeric")
## stopifnot(is.atomic(x))
## if (!is.null(y)) {
## if (!(is.numeric(y) || is.logical(y)))
## stop("'y' must be numeric")
## stopifnot(is.atomic(y))
## }
## Rank <- function(u) {
## if (length(u) == 0L)
## u
## else if (is.matrix(u)) {
## if (nrow(u) > 1L)
## apply(u, 2L, rank, na.last = "keep")
## else row(u)
## }
## else rank(u, na.last = "keep")
## }
## if (method == "pearson")
## .Call(C_cor, x, y, na.method, FALSE)
## else if (na.method %in% c(2L, 5L)) {
## if (is.null(y)) {
## .Call(C_cor, Rank(na.omit(x)), NULL, na.method, method ==
## "kendall")
## }
## else {
## nas <- attr(na.omit(cbind(x, y)), "na.action")
## dropNA <- function(x, nas) {
## if (length(nas)) {
## if (is.matrix(x))
## x[-nas, , drop = FALSE]
## else x[-nas]
## }
## else x
## }
## .Call(C_cor, Rank(dropNA(x, nas)), Rank(dropNA(y,
## nas)), na.method, method == "kendall")
## }
## }
## else if (na.method != 3L) {
## x <- Rank(x)
## if (!is.null(y))
## y <- Rank(y)
## .Call(C_cor, x, y, na.method, method == "kendall")
## }
## else {
## if (is.null(y)) {
## ncy <- ncx <- ncol(x)
## if (ncx == 0)
## stop("'x' is empty")
## r <- matrix(0, nrow = ncx, ncol = ncy)
## for (i in seq_len(ncx)) {
## for (j in seq_len(i)) {
## x2 <- x[, i]
## y2 <- x[, j]
## ok <- complete.cases(x2, y2)
## x2 <- rank(x2[ok])
## y2 <- rank(y2[ok])
## r[i, j] <- if (any(ok))
## .Call(C_cor, x2, y2, 1L, method == "kendall")
## else NA
## }
## }
## r <- r + t(r) - diag(diag(r))
## rownames(r) <- colnames(x)
## colnames(r) <- colnames(x)
## r
## }
## else {
## if (length(x) == 0L || length(y) == 0L)
## stop("both 'x' and 'y' must be non-empty")
## matrix_result <- is.matrix(x) || is.matrix(y)
## if (!is.matrix(x))
## x <- matrix(x, ncol = 1L)
## if (!is.matrix(y))
## y <- matrix(y, ncol = 1L)
## ncx <- ncol(x)
## ncy <- ncol(y)
## r <- matrix(0, nrow = ncx, ncol = ncy)
## for (i in seq_len(ncx)) {
## for (j in seq_len(ncy)) {
## x2 <- x[, i]
## y2 <- y[, j]
## ok <- complete.cases(x2, y2)
## x2 <- rank(x2[ok])
## y2 <- rank(y2[ok])
## r[i, j] <- if (any(ok))
## .Call(C_cor, x2, y2, 1L, method == "kendall")
## else NA
## }
## }
## rownames(r) <- colnames(x)
## colnames(r) <- colnames(y)
## if (matrix_result)
## r
## else drop(r)
## }
## }
## }
## <bytecode: 0x0000026c7a663dd8>
## <environment: namespace:stats>
cor(y,z)
## [1] 0.309131
r <- cor(a)
r
## biking smoking heart.disease
## biking 1.00000000 0.01513618 -0.9354555
## smoking 0.01513618 1.00000000 0.3091310
## heart.disease -0.93545547 0.30913098 1.0000000
library(kableExtra)
kable(round(r,2),caption = '相関表') |> kable_classic('striped',full_width = F)
相関表
|
|
biking
|
smoking
|
heart.disease
|
|
biking
|
1.00
|
0.02
|
-0.94
|
|
smoking
|
0.02
|
1.00
|
0.31
|
|
heart.disease
|
-0.94
|
0.31
|
1.00
|
#☆相関分析図
library(psych)
cor.plot(a)
#☆corrplot パッケージを利用したグラフ
library(corrplot)
## corrplot 0.92 loaded
corrplot.mixed(r,lower = 'ellips',upper = 'number')
library(plotly)
## 要求されたパッケージ ggplot2 をロード中です
##
## 次のパッケージを付け加えます: 'ggplot2'
## 以下のオブジェクトは 'package:psych' からマスクされています:
##
## %+%, alpha
##
## 次のパッケージを付け加えます: 'plotly'
## 以下のオブジェクトは 'package:ggplot2' からマスクされています:
##
## last_plot
## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter
## 以下のオブジェクトは 'package:graphics' からマスクされています:
##
## layout
kyokasho <- list(size = 11,color = 'blue',family = 'UD Digi Kyokasho NK-R')
plot_ly(x = rownames(r),
y = colnames(r),
z = as.matrix(r),
text = paste(r),
type = 'heatmap') |>
layout(font = kyokasho,
title = '主タイトル',
xaxis = list(title = 'x軸カテゴリラベル'),
yaxis = list(title = 'y軸カテゴリラベル'))