第2小组作业
巩雪米-2150520106-43 邱韬仪-2150520115-49 孙霏-2150520118-51
基于R语言进行电话营销中定期存款购入情况的数据分析
1. 研究背景
通过分析客户的个人信息和交易数据构建预测模型，预测客户是否会通过银行电话购买定期存款，从而指导营销活动和资源分配。
2. 研究问题
data <- read.csv("r课程设计数据.csv")
names(data) ## [1] "age" "job" "marital" "education" "default" "balance"
## [7] "housing" "loan" "day" "month" "duration" "campaign"
## [13] "pdays" "previous" "y"# 将分类变量转换为哑变量矩阵
dummy_vars <- model.matrix(~ y - 1, data)
# 将哑变量矩阵转换为数据框并设置列名
dummy_vars_df <- as.data.frame(dummy_vars)
# 将原始数据框中的分类变量列删除
original_data <- data[ , !names(data) %in% "y"]
names(original_data)## [1] "age" "job" "marital" "education" "default" "balance"
## [7] "housing" "loan" "day" "month" "duration" "campaign"
## [13] "pdays" "previous"# 将转换后的数据框与原始数据框按行连接
final_data <- cbind(original_data, dummy_vars_df)
# 输出结果
head(final_data)## age job marital education default balance housing loan day month
## 1 41 admin. divorced secondary no 270 yes no 5 may
## 2 57 technician divorced secondary no 63 yes no 5 may
## 3 36 admin. divorced secondary no 506 yes no 5 may
## 4 44 services divorced secondary no 2586 yes no 5 may
## 5 55 technician divorced secondary no 0 no no 5 may
## 6 48 management divorced tertiary no -244 yes no 5 may
## duration campaign pdays previous y
## 1 222 1 -1 0 0
## 2 242 1 -1 0 0
## 3 577 1 -1 0 0
## 4 160 1 -1 0 0
## 5 160 1 -1 0 0
## 6 253 1 -1 0 0names(final_data)## [1] "age" "job" "marital" "education" "default" "balance"
## [7] "housing" "loan" "day" "month" "duration" "campaign"
## [13] "pdays" "previous" "y"# 移除重复行
data <- unique(final_data)
names(final_data)## [1] "age" "job" "marital" "education" "default" "balance"
## [7] "housing" "loan" "day" "month" "duration" "campaign"
## [13] "pdays" "previous" "y"# 定义异常值上下限，将超出范围的值替换为NA
upper_limit <- quantile(data$balance, 0.95, na.rm = TRUE) # 添加参数 na.rm = TRUE
lower_limit <- quantile(data$balance, 0.05, na.rm = TRUE)
final_data$balance[final_data$balance > upper_limit | final_data$balance < lower_limit] <- NA
# 2. 计算卡方值和p-value
chi2_scores <- c()
p_values <- c()
for (feature in c("age", "job", "marital", "education", "default","balance","housing","loan","day","month","duration","campaign","pdays","previous")) {
contingency_table <- table(data[[feature]], data$y)
chi2_result <- fisher.test(contingency_table, simulate.p.value=TRUE)
chi2_scores <- c(chi2_scores, chi2_result$statistic)
p_values <- c(p_values, chi2_result$p.value)
}
# 3. 判断显著性
significance_level <- 0.05
significant_features <- c()
for (i in 1:length(c("age", "job", "marital", "education", "default","balance","housing","loan","day","month","duration","campaign","pdays","previous"))) {
if (p_values[i] < significance_level) {
significant_features <- c(significant_features, c("age", "job", "marital", "education", "default","balance","housing","loan","day","month","duration","campaign","pdays","previous")[i])
}
}
# 4. 输出显著变量（去除NA值）
significant_features <- unique(significant_features[!is.na(significant_features)])
significant_features <- sort(significant_features)
print(significant_features)## [1] "age" "balance" "campaign" "day" "default" "duration"
## [7] "education" "housing" "job" "loan" "marital" "month"
## [13] "pdays" "previous"# 过滤数据，只包含重要的特征
data_filtered <- data %>% select("age","balance","duration","housing","loan","pdays","education", y)
# 将数据分成训练集和测试集
set.seed(123) # for reproducibility
train_indices <- sample(1:nrow(data_filtered), 0.8 * nrow(data_filtered)) # 80% training data
train_data <- data_filtered[train_indices, ]
test_data <- data_filtered[-train_indices, ]
#建立逻辑回归模型
logistic_model <- glm(y ~ ., data = train_data, family = "binomial")
#查看模型
summary(logistic_model)##
## Call:
## glm(formula = y ~ ., family = "binomial", data = train_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.436e+00 1.061e-01 -32.384 < 2e-16 ***
## age 2.495e-03 1.713e-03 1.457 0.145191
## balance 1.961e-05 5.106e-06 3.840 0.000123 ***
## duration 3.909e-03 6.682e-05 58.504 < 2e-16 ***
## housingyes -1.228e+00 4.122e-02 -29.782 < 2e-16 ***
## loanyes -6.916e-01 6.318e-02 -10.947 < 2e-16 ***
## pdays 4.071e-03 1.594e-04 25.547 < 2e-16 ***
## educationsecondary 3.472e-01 6.264e-02 5.542 2.99e-08 ***
## educationtertiary 6.614e-01 6.513e-02 10.156 < 2e-16 ***
## educationunknown 4.269e-01 1.019e-01 4.190 2.80e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 25966 on 36167 degrees of freedom
## Residual deviance: 20000 on 36158 degrees of freedom
## AIC: 20020
##
## Number of Fisher Scoring iterations: 6#对测试数据进行预测
predictions <- predict(logistic_model, newdata = test_data, type = "response")
#将概率转换为二元预测值
binary_predictions <- ifelse(predictions > 0.5, 1, 0)
#评估模型
conf_matrix <- table(test_data$y, binary_predictions)
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
precision <- conf_matrix[2, 2] / sum(conf_matrix[, 2])
recall <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.885104500718788"print(paste("Precision:", precision))## [1] "Precision: 0.568123393316195"print(paste("Recall:", recall))## [1] "Recall: 0.202380952380952"# 计算 ROC 曲线
roc_curve <- roc(test_data$y, as.numeric(predictions))## Setting levels: control = 0, case = 1## Setting direction: controls < cases# 绘制 ROC 曲线
par(mar=c(2, 2, 2, 2))
plot(roc_curve, main = "ROC Curve", col = "blue", lwd = 2)
3. 研究方法及分析
数据来源：https://archive.ics.uci.edu/dataset/222/bank+marketing
研究方法
1. 数据预处理:
包括数据读取、处理缺失值、处理异常值、将分类变量转换为哑变量等。
2. 特征选择:
使用卡方检验等方法选择与目标变量相关性显著的特征。
3. 建立决策树模型:
使用逻辑斯蒂回归建立模型，以预测客户购买行为。在建模过程中，选择了年龄、账户余额、联系持续时间、住房贷款、个人贷款、上次联系持续时间、教育程度等特征作为预测变量。
4. 模型评估:
使用测试数据集评估模型性能，包括计算准确率、精确率、召回率以及绘制ROC曲线等。
5. 适用性
①.
通过计算卡方值和p-value，筛选出与目标变量显著相关的特征，这种方法适用于较小规模的数据集和较少的特征。
②.
逻辑斯蒂回归是一种易于解释的机器学习算法，在理解和解释模型方面具有优势。此外，它也适用于处理混合数据类型的数据集，例如数值型和分类型特征的组合。
6. 结论
电话营销属于银行直接营销活动，建立此模型可以优化筛选目标客户的环节，将资源和精力精准投入到目标客户上。通过召回率等指标，我们可以看出模型仍需要进一步优化，例如，可以尝试使用更复杂的模型、调整模型参数、增加更多的特征等来提高模型的预测能力。根据不断优化的模型的预测结果指导实际的营销活动和业务决策，以提高客户购买转化率和业务效益。
多元统计分析基本理论的R语言实现
1. 参数估计和假设检验
运行如下程序：
X <- c(78.1, 72.4, 76.2, 74.3, 77.4, 78.4, 76.0, 75.5, 76.7,
77.3)
Y <- c(79.1, 81.0, 77.3, 79.1, 80.0, 79.1, 79.1, 77.3, 80.2,
82.1)
t.test(X, Y, var.equal = T, alternative = “less”)
问题：求解t.test输出的所有结果。
要求：基于数据X和数据Y使用R语言的基础命令进行求解。
R代码
X <- c(78.1, 72.4, 76.2, 74.3, 77.4, 78.4, 76.0, 75.5, 76.7, 77.3)
Y <- c(79.1, 81.0, 77.3, 79.1, 80.0, 79.1, 79.1, 77.3, 80.2, 82.1)
# 样本均值
mean_X <- mean(X)
mean_Y <- mean(Y)
# 合并方差（等方差假设）
pooled_var <- (var(X) + var(Y)) / 2
# 计算样本大小
n_X <- length(X)
n_Y <- length(Y)
# t值:
t<- (mean_X - mean_Y) / (sqrt(pooled_var) * sqrt(1/n_X + 1/n_Y))
# 自由度：
df <- n_X + n_Y - 2
# p 值（单侧检验）
p <- 1-pt(t, df, lower.tail = FALSE)
# 计算标准误
M <- (pooled_var * (1/n_X + 1/n_Y))^0.5
# 计算t分布的临界值
tH <- qt(0.95, df)
# 计算置信区间
H <- mean_X - mean_Y + tH *M求解过程
cat('t','=', t , '(t值)')## t = -4.295743 (t值)cat('df','=', df , '(自由度)')## df = 18 (自由度)cat('p-value','=', p , '(p值)')## p-value = 0.0002175927 (p值)cat('95 percent confidence interval:', '-Inf' , H, '(区间估计)')## 95 percent confidence interval: -Inf -1.908255 (区间估计)cat('sample estimates:', 'mean of X','=',mean_X, 'mean of Y','=',mean_Y, '(参数估计)')## sample estimates: mean of X = 76.23 mean of Y = 79.43 (参数估计)2. 回归分析
运行如下程序:
load(“data2_wage.RData”)
results <- lm(lwage ~ educ + exper + tenure, data = data)
summary(results)
问题：求解summary(results)中的所有结果。
要求：基于data2_wage.RData中的变量lwage, educ, exper,
tenure，使用R语言的基础命令进行求解。
R代码
load("data2_wage.RData")
results <- lm(lwage ~ educ + exper + tenure, data = data)
# 构造设计矩阵 X，包括截距项（一列全为1）和解释变量
X <- model.matrix(lwage ~ educ + exper + tenure, data = data)
# 响应变量 Y
Y <- data$lwage
# 计算最小二乘估计量
beta_hat <- solve(t(X) %*% X) %*% t(X) %*% Y
# 计算预测值
Y_hat <- X %*% beta_hat
# 计算残差
residuals <- Y - Y_hat
# 计算残差的统计描述
Min = min(residuals)
Q1 = quantile(residuals, probs = 0.25)
Median = median(residuals)
Q3 = quantile(residuals, probs = 0.75)
Max = max(residuals)
# 计算均方误差MSE
MSE <- sum(residuals^2) / (nrow(data) - ncol(X))
# 计算(X'X)^(-1)的对角线元素
inv_XtX_diag <- diag(solve(t(X) %*% X))
# 计算标准误差的估计值
se_estimates <- sqrt(MSE * inv_XtX_diag)
# 计算t值
t <- beta_hat / se_estimates
# 计算p值，使用pt函数，并考虑双尾检验（每个p值乘以2）
# 自由度是n-k，其中n是样本大小，k是包括截距在内的参数数量
n <- nrow(data)
k <- ncol(X)
df <- n - k
p_values <- 2 * (1 - pt(abs(t), df))
# 计算残差平方和
residual_sum_of_squares <- sum(residuals^2)
# 计算自由度
df <- nrow(data) - length(beta_hat)
# 计算残差的标准误差
residual_standard_error <- sqrt(residual_sum_of_squares / df)
# 计算R平方
Y_hat <- X %*% beta_hat # 预测值
# 计算残差平方和
SS_res <- sum((Y - Y_hat)^2)
# 计算总平方和
SS_tot <- sum((Y - mean(Y))^2)
R_squared <- 1 - (SS_res / SS_tot)
#计算调整后的 R平方
adjusted_R_squared <- 1 - ((1 - R_squared) * ((n - 1) / (n - k -1 )))
# 解释变量（不包括截距项）的数量
k <- ncol(X) - 1
# 计算 F 统计量
F_stat <- ((SS_tot - SS_res) / k) / (SS_res/ (n - k - 1))
# 计算 p 值
F_p_value <- pf(F_stat, df1 = k, df2 = n - k - 1, lower.tail = FALSE) 求解过程
cat('Min','=', Min , '(残差最小值)')## Min = -2.058016 (残差最小值)cat('1Q','=', Q1 , '(第一四分位数)')## 1Q = -0.2964507 (第一四分位数)cat('Median','=', Median , '(中位数)')## Median = -0.03264533 (中位数)cat('3Q','=', Q3 , '(第三四分位数)')## 3Q = 0.2878765 (第三四分位数)cat('Max','=', Max , '(残差最大值)')## Max = 1.428092 (残差最大值)cat('Estimate','=', beta_hat , '(估计值)')## Estimate = 0.2843595 0.09202899 0.004121109 0.02206722 (估计值)cat('Std.Error','=', se_estimates , '(标准误差)')## Std.Error = 0.1041904 0.007329923 0.001723277 0.003093649 (标准误差)cat('t value','=', t , '(t值)')## t value = 2.72923 12.55525 2.391437 7.13307 (t值)cat('Pr(>|t|)','=', p_values , '(t值对应的p值)')## Pr(>|t|) = 0.006562466 0 0.01713562 3.294254e-12 (t值对应的p值)cat('Residual standard error','=', residual_standard_error , 'on', df, 'degrees of freedom' , '(残差标准差)')## Residual standard error = 0.440862 on 522 degrees of freedom (残差标准差)cat('Multiple R-squared','=', R_squared ,'( R方)', 'Adjusted R-squared','=', adjusted_R_squared ,'(调整R方)')## Multiple R-squared = 0.3160133 ( R方) Adjusted R-squared = 0.310762 (调整R方)cat('F-statistic','=', F_stat ,'(F统计量)','p-value','=', F_p_value , '(F统计量对应的p值)')## F-statistic = 80.39092 (F统计量) p-value = 9.12996e-43 (F统计量对应的p值)3. 典型相关分析
运行 Charpter 4 如下程序： d11.2 <-
read_excel(‘data1_mvstats5.xlsx’, ‘d11.2’)
d11.2 <- scale(d11.2)
x <- d11.2[, 1:4]
y <- d11.2[, 5:10]
ca1 <- cc(x, y)
问题：求解 ca1\(cor, ca1\)xcoef,
ca1$ycoef 输出的结果。 要求：基于数据 d11.2 使用 R
语言的基础命令进行求解。
R代码
d11.2 <- read_excel('data1_mvstats5.xlsx', 'd11.2')
d11.2 <- scale(d11.2)
x <- d11.2[, 1:4]
y <- d11.2[, 5:10]
# 矩阵 A = C_XX^{-1} C_XY C_YY^{-1} C_YX
A <- solve(cov(x)) %*% cov(x, y) %*% solve(cov(y)) %*% cov(y, x)
# 计算 A 的特征值和特征向量
eigen_result <- eigen(A)
eigen_values <- eigen_result$values
eigen_vectors <- eigen_result$vectors
# 典型相关系数是特征值的平方根
r <- sqrt(eigen_values)
# 计算典型变量系数
a <- eigen_vectors#ka1/a1=-1.5262
b <- solve(cov(y)) %*% cov(y,x) %*% a#kb1/b1=-1.5247求解过程
cat('ca1$cor','=',r,'(典型相关系数)')## ca1$cor = 0.9990222 0.9549215 0.7372625 0.4267113 (典型相关系数)cat('ca1$xcoef]','=')## ca1$xcoef] =print(a)## [,1] [,2] [,3] [,4]
## [1,] -0.09054677 0.2815859 -0.07357566 -0.03869388
## [2,] 0.76971505 0.4672034 0.68159829 -0.01424693
## [3,] 0.58508951 -0.8174865 -0.72250965 -0.67914652
## [4,] 0.23876828 0.1847867 0.08938788 0.73284365cat('(x与典型变量系数)')## (x与典型变量系数)cat('ca1$ycoef]','=')## ca1$ycoef] =print(b)## [,1] [,2] [,3] [,4]
## y1 -0.3817140 1.8127371 0.35090987 0.47090893
## y2 -1.4867140 -5.1989196 1.23531922 0.47098619
## y3 0.3761879 1.2479385 0.03044796 0.27645562
## y4 2.1168304 4.5749415 -0.73468249 -0.06314336
## y5 0.5554264 -0.3875742 0.31682668 -0.25762736
## y6 0.3518713 -1.9652933 -1.19370187 -0.88093949cat('(y与典型变量系数)')## (y与典型变量系数)4. 主成分分析
运行 Charpter 4 如下程序： data <-
read_excel(‘data1_mvstats5.xlsx’, ‘d3.1’)
d3.1 <- data.frame(data, row.names = 1) head(d3.1)
pc <- princomp(d3.1, cor = T)
问题：求解 pc\(loadings[ ,1:2],
pc\)scores[ ,1:2]输出的结果。 要求：基于数据 d3.1 使用 R
语言的基础命令进行求解。
R代码
# 读取数据
data <- read_excel('data1_mvstats5.xlsx', sheet = 'd3.1')
d3.1 <- data.frame(data, row.names = 1)
# 对数据进行标准化处理
scaled_data <- scale(d3.1)
# 计算相关系数矩阵
cor_matrix <- cor(scaled_data)
# 对相关系数矩阵进行特征值分解
eigen_result <- eigen(cor_matrix)
eigen_values <- eigen_result$values
eigen_vectors <- eigen_result$vectors
#碎石图绘制;
plot(eigen_values,
type="b",
cex=2,
cex.lab=2,
cex.axis=2,
lty=2,
lwd=2,
xlab="主成分编号",
ylab="特征值(主成分方差)" )
# 提取前两个特征向量作为主成分#ka2/a2=-1
loadings <- eigen_vectors[, 1:2]
# 计算主成分得分矩阵#ks1/s1= 0.9837
scores <- scaled_data %*% loadings求解过程
cat('pc$loadings[ ,1:2]','=')## pc$loadings[ ,1:2] =print(loadings)## [,1] [,2]
## [1,] 0.3530160 -0.42913372
## [2,] 0.2494594 0.67707366
## [3,] 0.3738401 -0.08881424
## [4,] 0.3016294 0.47157654
## [5,] 0.3760539 -0.32423582
## [6,] 0.4040134 -0.06946256
## [7,] 0.3709635 -0.05611496
## [8,] 0.3743738 0.11849177cat('pc$scores[ ,1:2]','=')## pc$scores[ ,1:2] =print(scores)## [,1] [,2]
## 北京 6.02274607 1.4977627
## 天津 2.96115828 0.5280553
## 河北 -0.87306960 0.6810867
## 山西 -1.08579949 0.5915946
## 内蒙古 0.52467609 1.8176806
## 辽宁 0.09284191 0.6445003
## 吉林 -0.32175584 1.4015172
## 黑龙江 -1.66115278 0.9796895
## 上海 6.96946517 -1.0519318
## 江苏 1.12275488 -0.4463169
## 浙江 3.75897083 0.1693347
## 安徽 -1.10511258 -0.3460854
## 福建 1.15266449 -1.3552068
## 江西 -1.64223622 -0.5395645
## 山东 0.47328821 0.7953144
## 河南 -1.25645857 0.6373676
## 湖北 -0.99303892 -0.1146098
## 湖南 -0.35913254 0.1974682
## 广东 3.96639124 -2.4401516
## 广西 -1.60092834 -1.2105598
## 海南 -1.84265618 -2.3145599
## 重庆 0.38762452 0.4548143
## 四川 -1.13500148 -0.5096478
## 贵州 -1.98128033 -0.6487463
## 云南 -2.38999332 -0.4109714
## 西藏 -2.67612880 -0.9941148
## 陕西 -0.87353770 0.1150517
## 甘肃 -1.30298299 0.1421495
## 青海 -1.73969881 0.2055362
## 宁夏 -1.29590895 0.4879663
## 新疆 -1.29670824 1.03557705. 判别分析
运行如下程序
data(“iris”) lda(Species ~ ., iris, prior = c(1,1,1)/3) # Fisher
discriminant
问题：求解输出的 Coefficients of linear discriminants 和 Proportion of
trace。
要求：基于数据 iris 使用 R 语言的基础命令进行求解。
R代码
# 载入iris数据集
data("iris")
# 因子化处理Species列
iris$Species <- as.factor(iris$Species)
# 分离特征变量（X）和目标变量（Y）
X <- iris[, -5] # 提取所有行，但不包括最后一列（Species列）
Y <- iris$Species # 提取Species列作为目标变量Y
# 计算各类别的均值
class_means <- tapply(X, Y, colMeans) # 按照Y的不同取值计算X的均值
# 初始化类别内散布矩阵（SW）和类别间散布矩阵（SB）
SW <- matrix(0, ncol = ncol(X), nrow = ncol(X)) # 创建一个全零矩阵，维度与X相同
SB <- matrix(0, ncol = ncol(X), nrow = ncol(X)) # 创建一个全零矩阵，维度与X相同
# 计算类别内散布矩阵（SW）和类别间散布矩阵（SB）
for (i in unique(Y)) {
Xi <- X[Y == i, ] # 从X中提取出属于当前类别i的所有行
# 计算类别内散布矩阵（SW）
Xi_centered <- t(apply(Xi, 1, function(x) x - colMeans(Xi))) # 中心化处理每个类别数据
SW <- SW + t(Xi_centered) %*% Xi_centered # 累加每个类别的数据矩阵的乘积，转置乘以自身
Xi_mean <- colMeans(Xi) # 计算当前类别i的特征均值
# 计算类别间散布矩阵（SB）
SB <- SB + nrow(Xi) * (Xi_mean - colMeans(X)) %*% t(Xi_mean - colMeans(X)) # 累加类别间的散布矩阵
}
# 解广义特征值问题
eigen_res <- eigen(solve(SW) %*% SB) # 解广义特征值问题，得到特征值和特征向量
eigenvalues <- eigen_res$values # 特征值
eigenvectors <- eigen_res$vectors # 特征向量
# 提取两个最大特征值对应的特征向量作为线性判别系数矩阵
ld1 <- eigenvectors[, 1] # 提取第一个特征向量作为LD1
ld2 <- eigenvectors[, 2] # 提取第二个特征向量作为LD2
# 将LD1和LD2的线性判别系数矩阵放在一起展示
linear_discriminant_coefficients <- cbind(ld1, ld2)
# 将LD1和LD2按列合并为一个矩阵
# 添加行名的自变量
rownames(linear_discriminant_coefficients) <- colnames(X)[-5]
# 使用特征变量X的列名作为行名
# 计算LD1和LD2对应的投影数据方差比例
proportion_ld1 <- eigenvalues[1] / sum(eigenvalues)
# 计算LD1对应的投影数据方差比例
proportion_ld2 <- eigenvalues[2] / sum(eigenvalues)
# 计算LD2对应的投影数据方差比例求解过程
# 输出结果
print("LD1和LD2的线性判别系数矩阵：")#ka/a=0.2517## [1] "LD1和LD2的线性判别系数矩阵："print(linear_discriminant_coefficients)## ld1 ld2
## Sepal.Length 0.2087418+0i -0.006531964+0i
## Sepal.Width 0.3862037+0i -0.586610553+0i
## Petal.Length -0.5540117+0i 0.252561540+0i
## Petal.Width -0.7073504+0i -0.769453092+0iprint("LD1对应的投影数据方差比例：")## [1] "LD1对应的投影数据方差比例："print(proportion_ld1)## [1] 0.9912126+0iprint("LD2对应的投影数据方差比例：")## [1] "LD2对应的投影数据方差比例："print(proportion_ld2)## [1] 0.008787395+0i6. 聚类分析
运行如下程序
x1 <- c(2.5, 3.0, 6.0, 6.6, 7.2, 4.0, 4.7, 4.5, 5.5)
x2 <- c(2.1, 2.5, 2.5, 1.5, 3.0, 6.4, 5.6, 7.6, 6.9)
X <- cbind(x1, x2)
dist(X, method = “euclidean”)
dist(X, method = “canberra”)
问题：求解欧式距离和兰氏距离下的距离矩阵。
要求：基于数据 X 使用 R 语言的基础命令进行求解。
R代码
# 数据
x1 <- c(2.5, 3.0, 6.0, 6.6, 7.2, 4.0, 4.7, 4.5, 5.5)
x2 <- c(2.1, 2.5, 2.5, 1.5, 3.0, 6.4, 5.6, 7.6, 6.9)
X <- cbind(x1, x2)
# 计算欧式距离，定义了一个名为euclidean_dist的函数，用于计算欧式距离
#它接受两个向量x1和x2作为输入，并返回它们之间的欧式距离。
#欧式距离的计算公式是每个对应元素差值的平方和的平方根。
euclidean_dist <- function(x1, x2){
sqrt(sum((x1 - x2)^2))
}
#创建了一个名为euclidean_matrix的矩阵，用于存储欧式距离的距离矩阵。
#它的行数和列数都与向量x1的长度相同，初始值都设置为0。
euclidean_matrix <- matrix(0, nrow = length(x1), ncol = length(x1))
#使用两个嵌套的for循环来计算欧式距离矩阵的每个元素。
#变量i和j分别代表矩阵的行索引和列索引。
#通过调用euclidean_dist函数，并传入X[i,]和X[j,]作为参数
#计算得到的欧式距离被赋值给euclidean_matrix的对应位置。
for(i in 1:length(x1)){
for(j in 1:length(x2)){
euclidean_matrix[i, j] <- euclidean_dist(X[i,], X[j,])
}
}
# 计算兰氏距离
#定义了一个名为canberra_dist的函数，用于计算兰氏距离。
#它接受两个向量x1和x2作为输入，并返回它们之间的兰氏距离。
#兰氏距离的计算公式是每个对应元素差值的绝对值除以对应元素绝对值之和的总和。
canberra_dist <- function(x1, x2){
sum(abs(x1 - x2) / (abs(x1) + abs(x2)))
}
#创建了一个名为canberra_matrix的矩阵，用于存储兰氏距离的距离矩阵。
#它的行数和列数都与向量x1的长度相同，初始值都设置为0。
canberra_matrix <- matrix(0, nrow = length(x1), ncol = length(x1))
#使用两个嵌套的for循环来计算兰氏距离矩阵的每个元素。
#变量i和j分别代表矩阵的行索引和列索引。
#通过调用canberra_dist函数，并传入X[i,]和X[j,]作为参数，
#计算得到的兰氏距离被赋值给canberra_matrix的对应位置。
for(i in 1:length(x1)){
for(j in 1:length(x2)){
canberra_matrix[i, j] <- canberra_dist(X[i,], X[j,])
}
}求解过程
print("欧氏距离:")## [1] "欧氏距离:"print(euclidean_matrix)## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 0.0000000 0.6403124 3.522783 4.143670 4.785394 4.554119 4.134005 5.852350
## [2,] 0.6403124 0.0000000 3.000000 3.736308 4.229657 4.026164 3.535534 5.316014
## [3,] 3.5227830 3.0000000 0.000000 1.166190 1.300000 4.382921 3.361547 5.316014
## [4,] 4.1436699 3.7363083 1.166190 0.000000 1.615549 5.547071 4.518849 6.451356
## [5,] 4.7853944 4.2296572 1.300000 1.615549 0.000000 4.669047 3.606938 5.333854
## [6,] 4.5541190 4.0261644 4.382921 5.547071 4.669047 0.000000 1.063015 1.300000
## [7,] 4.1340053 3.5355339 3.361547 4.518849 3.606938 1.063015 0.000000 2.009975
## [8,] 5.8523500 5.3160135 5.316014 6.451356 5.333854 1.300000 2.009975 0.000000
## [9,] 5.6603887 5.0606324 4.428318 5.510898 4.254409 1.581139 1.526434 1.220656
## [,9]
## [1,] 5.660389
## [2,] 5.060632
## [3,] 4.428318
## [4,] 5.510898
## [5,] 4.254409
## [6,] 1.581139
## [7,] 1.526434
## [8,] 1.220656
## [9,] 0.000000print("兰氏距离:")## [1] "兰氏距离:"print(canberra_matrix)## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] 0.0000000 0.1778656 0.4987212 0.6172161 0.6610067 0.7366516 0.7601010
## [2,] 0.1778656 0.0000000 0.3333333 0.6250000 0.5026738 0.5810594 0.6034953
## [3,] 0.4987212 0.3333333 0.0000000 0.2976190 0.1818182 0.6382022 0.5042114
## [4,] 0.6172161 0.6250000 0.2976190 0.0000000 0.3768116 0.8655362 0.7456064
## [5,] 0.6610067 0.5026738 0.1818182 0.3768116 0.0000000 0.6474164 0.5124096
## [6,] 0.7366516 0.5810594 0.6382022 0.8655362 0.6474164 0.0000000 0.1471264
## [7,] 0.7601010 0.6034953 0.5042114 0.7456064 0.5124096 0.1471264 0.0000000
## [8,] 0.8527246 0.7049505 0.6478076 0.8595189 0.6647315 0.1445378 0.1732543
## [9,] 0.9083333 0.7622028 0.5115634 0.7337662 0.5277977 0.1954887 0.1824314
## [,8] [,9]
## [1,] 0.8527246 0.9083333
## [2,] 0.7049505 0.7622028
## [3,] 0.6478076 0.5115634
## [4,] 0.8595189 0.7337662
## [5,] 0.6647315 0.5277977
## [6,] 0.1445378 0.1954887
## [7,] 0.1732543 0.1824314
## [8,] 0.0000000 0.1482759
## [9,] 0.1482759 0.0000000