通过绘图确定支付方式的突破点或转折点

Determine the breaking point or turning point of payment methods with plotting

我有人们如何支付发票的数据。它可以是 'eCheck' 或 'Credit Card'。我想绘制数据并显示是否存在人们如何根据美元金额支付的模式。

我正在考虑使用 ggplot 创建直方图并按 'eCheck' 或 'Credit Card' 对条形进行分组。问题是如何对我的号码进行分类。

我愿意接受任何建议和意见。谢谢!

这是我的数据示例:

PaymentType Dollar Amount
eCheck      114
eCheck      114
Credit Card 39
Credit Card 16
eCheck      16
Credit Card 114
Credit Card 228
Credit Card 228
eCheck      228
Credit Card 16
eCheck      342
Credit Card 114

编辑:对 jlhoward 方法的回应。

密度图未显示 'Credit Cards' 和 'eChecks' 之间的 "breaking point"。他们似乎都遵循相似的分布。

ggplot(df, aes(x = TotTransAmt, fill = PayMethodDesc2)) +
  stat_bin(aes(y = ..density..), position = 'identity', color = 'lightblue') +
  stat_density(alpha = .6, position = 'identity', color = 'blue') +
  xlim(0,500)

系数 'TotTransAmt' 的 p 值非常低,表明它在预测支付类型方面非常重要。该图显示用户更有可能以较低的金额使用信用卡。但是,它并没有显示 echecks 有很高的使用概率。

model <- glm(PayMethodDesc2 ~ TotTransAmt, data = df, family = 'binomial')
summary(model)$coefficients

                 Estimate   Std. Error    z value     Pr(>|z|)
(Intercept) -2.8062540381 5.827325e-03 -481.56817 0.000000e+00
TotTransAmt  0.0006005004 3.196051e-05   18.78882 9.322726e-79


ggplot(df, aes(x=TotTransAmt)) +
  geom_point(aes(y=as.numeric(PayMethodDesc2)-1,color=PayMethodDesc2)) +
  stat_function(fun = function(x)predict(model, newdata=data.frame(TotTransAmt=x), type="response"))+
  labs(y="P(eCheck)")

我用 svm 对我的数据建模。我使用 7% 作为训练数据,5% 作为测试数据,因为 70/30 花费的时间太长了。预测电子支票似乎存在很大的错误。然而,预测信用卡是 100%。这可能是因为我的数据集的大小吗?我有 833749 个信用卡值和 53964 个电子支票值。这又回到了我的问题:我应该对数据进行欠采样还是过采样以使这两个因素的数量相等?

根据我目前的发现,假设没有金额可以创造一个转折点并且这两种方法都是任意使用的,这是否安全?

library(e1071)
train <- df[sample(1:nrow(df),round(nrow(df)*.07)),]
test <- df[sample(1:nrow(df),round(nrow(df)*.05)),]
model <- svm(PayMethodDesc2 ~ TotTransAmt, train)
table(act=train$PayMethodDesc2, pred = predict(model,train))

             pred
act           Credit Card eCheck
  Credit Card       58347      0
  eCheck             3788      5



table(act=test$PayMethodDesc2,  pred=predict(model, test))

             pred
act           Credit Card eCheck
  Credit Card       41646      0
  eCheck             2740      0

"breaking point" 存在的假设——即关系是某种阶跃函数——是一个强有力的假设,我建议你在继续之前先进行实证研究,就好像它是是的。

为此,我将使用带有平滑样条的逻辑回归来检查非线性关系。假设您的数据集名为 data,付款方式列为 payment.method.

library(gam)
data$eCheck.d <- ifelse(data$payment.method=="eCheck", 1, 0)
model <- gam(eCheck.d ~ s(money), data = data)
plot(model, se=TRUE)

对于初学者,我会为每个类别绘制一个箱线图,并比较分布中的视觉差异。

数据

d <- structure(list(PaymentType = structure(c(2L, 2L, 1L, 1L, 2L,
     1L, 1L, 1L, 2L, 1L, 2L, 1L), .Label = c("CreditCard", "eCheck"), 
     class = "factor"), 
     DollarAmount = c(114L, 114L, 39L, 16L, 16L, 114L, 228L, 228L, 228L, 
                      16L, 342L, 114L)), 
     .Names = c("PaymentType", "DollarAmount"), 
     class = "data.frame", row.names = c(NA, -12L))

情节

library(ggplot2)
ggplot(d, aes(x = PaymentType, y = DollarAmount)) + geom_boxplot() + 
    coord_flip()

解读

您看到两种支付类型的中位数非常相似,但 eCheck 人们往往会花费更高的金额。您还可以查看四分位数,并看到 eCheck 第一个四分位数 = 中位数表示等

当您有一个 scale\continuous 自变量和一个二元因变量时,可以使用多种模型。但是,您应该(严格地)指定您的 objective,否则您会迷失在现有的选项中。

逻辑回归是一种选择,当您想要调查变量之间的关系时特别有用,因为输出包括用于解释的系数。

如果您的主要 objective 是发现断点,我建议使用分类树。树不会给你系数,但它们会根据感兴趣的概率对你的变量进行分组:

library(rpart)
library(rpart.plot)

set.seed(121)
payment = c(rep("card",100), rep("check",100))
amount = c(round(rnorm(100,150,30)), round(rnorm(100,230,50)))

# my simple example dataset
dt = data.frame(payment,amount)

# build model
model = rpart(payment~amount, data = dt)

# plot model
prp(model,nn=T,varlen=10,type=4,extra=104)

# get rules (only for the terminal nodes)
path.rpart(model, 
           row.names(model$frame[model$frame$var== "<leaf>",])) 

如果您 运行 此脚本,您会看到该模型根据我们拥有的数据集表明 189 美元是一个转折点。它还告诉您 < 189 导致 87% 的概率用卡支付,13% 的概率用支票支付。同样,您可以解释 >= 189.

我非常喜欢@jhoward 提供的示例,因此为了支持 150 美元左右的断点,您可以 运行 树方法:

library(rpart)
library(rpart.plot)

set.seed(1)     # for reproducible example
DA <- c(rnorm(1000, mean=100, sd=25), rnorm(1000, mean=200, sd=25))
PT <- rep(c("eCheck", "Credit Card"), each=1000)
df <- data.frame(PT,DA)


# build model
model = rpart(PT~DA, data = df)

# plot model
prp(model,nn=T,varlen=10,type=4,extra=104)

# get rules (only for the terminal nodes)
path.rpart(model, 
           row.names(model$frame[model$frame$var== "<leaf>",]))

并以 151 美元的价格获得突破:

如果你想让你的模型在分割方面更多"sensitive",你可以使用rpart.control规范,如:model = rpart(PT~DA, data = df, control = rpart.control(cp = ?, maxdepth = ?)),你可以在其中尝试不同的cp和maxdepth值。

另一种选择是使用包 "party" 或 "partykit" 和命令 "ctree" 创建一个不同的树,以创建一个基于 p 值分裂的树。更多信息:http://www.statmethods.net/advstats/cart.html .

正如其他人所说,有很多方法可以做到这一点。我倾向于从用密度图覆盖分布开始。您的样本案例太少,无法使用,因此下面的代码创建了一个包含 2000 个案例的人工示例。在此示例中,电子支票付款的正态分布均值为 $100 且 sd = $25,信用卡付款的正态分布均值为 $200.

set.seed(1)     # for reproducible example
DA <- c(rnorm(1000, mean=100, sd=25), rnorm(1000, mean=200, sd=25))
PT <- rep(c("eCheck", "Credit Card"), each=1000)
df <- data.frame(PT,DA)

library(ggplot2)
ggplot(df, aes(x=DA, fill=PT)) + 
  stat_bin(aes(y=..density..),position="identity", color="lightblue") +
  stat_density(alpha=0.5,position="identity", color="blue")

您可以看到 "break" 的金额约为 150 美元(不足为奇),但约 2.5% 的电子支票付款超过此金额,而 2.5% 的信用卡付款少于那个。

您在评论中说您不想建模,但评估是否有中断的一种方法是将问题重述为:Dollar Amount 是否对通过 eCheck 或 Credit 付款有重大影响卡片?正如另一个答案中所建议的,您可以使用逻辑回归来做到这一点:

model <- glm(PT ~DA, data=df, family="binomial")
summary(model)$coefficients
#               Estimate Std. Error   z value     Pr(>|z|)
# (Intercept) 22.8205378 1.67587743  13.61707 3.170403e-42
# DA          -0.1526074 0.01115254 -13.68364 1.271643e-42

由于 DA 系数的 p 值约为 10-42,因此毫无疑问 DA 在预测支付类型方面很重要。逻辑模型根据 DA 预测一种或另一种支付类型的概率,我们可以将其可视化如下。

ggplot(df, aes(x=DA)) +
  geom_point(aes(y=as.numeric(PT)-1,color=PT)) +
  stat_function(fun = function(x)predict(model, newdata=data.frame(DA=x), type="response"))+
  labs(y="P(eCheck)")

所以在这个人为的例子中,支付 < ~$125 几乎可以肯定是由 eCheck 支付的,而支付 > ~$175 几乎可以肯定是由 CC 支付的。在这些限制之间,不确定性会增加。支付约 150 美元,两种方式都可以,概率大致相同。

最后,您可以将此视为一个变量中的双向分类问题(这很简单)。解决这些问题的一种方法是使用所谓的支持向量机 (SVM)。这类似于 rpart 方法,但至少 one reference 比较这两种方法声称 SVM 更可靠。

library(e1071)      # for svm(...)
indx  <- sample(1:nrow(df),200)        # 200 random row numbers
train <- df[indx,]                     # training set
test  <- df[-indx,]                    # test set
model <- svm(PT~DA, train)             # build model with training set
table(act=train$PT, pred=predict(model,train))     # test model against training set
#              pred
# act           Credit Card eCheck
#   Credit Card          91      4
#   eCheck                4    101

所以在训练集中,在 95 个实际上是 CC 交易的案例中,91 个被正确预测;在 105 笔电子支票交易中,有 101 笔被正确预测。同样,将模型应用于测试集:

table(act=test$PT,  pred=predict(model, test))     # test model against test set  
#              pred
# act           Credit Card eCheck
#   Credit Card         884     21
#   eCheck               23    872

因此,在测试模型(基于训练集创建)时,针对测试集,在 905 笔 CC 交易中,884 笔被正确预测;在 895 笔电子支票交易中,有 872 笔被正确预测。


编辑:对 OP 评论的回应。

"break point" 的概念不是一个是非命题。问题是:边界值如何区分类别(eCheck 与 CC)?在上面的示例中,我们可以在整个数据集上 运行 SVM。

model <- svm(PT~DA, df)
prop.table(table(act=df$PT,pred=predict(model,df)),margin=1)
#              pred
# act           Credit Card eCheck
#   Credit Card       0.974  0.026
#   eCheck            0.026  0.974

因此,信用卡和电子支票交易的预测准确率为 97.4%(因为我们是这样设置的)。

现在假设分布显示出更多的重叠:

set.seed(1)    # for reproducibility
DA <- c(rnorm(1000, mean=100, sd=25), rnorm(1000, mean=110, sd=25))
df <- data.frame(PT,DA)
model <- svm(PT~DA, df)
prop.table(table(act=df$PT,pred=predict(model,df)),margin=1)
#              pred
# act           Credit Card eCheck
#   Credit Card       0.615  0.385
#   eCheck            0.457  0.543

所以在这种情况下,eCheck 的平均金额为 100 美元,CC 的平均金额为 110 美元,分布几乎完全重叠。然而 CC 交易的正确预测率为 62%,eCheck 交易的正确预测率为 54%。

如果重点是绘图,那么我会建议@jlhoward 的回答中提出的想法的另一种变体。这显示了 "dollar amount" (DA) 给定 "payment type" (PT) 的条件分布,使用直方图或密度。 @thothal 提出的箱线图也是如此,它显示了给定 PT.

的条件分布 DA

但潜在的问题是相反的:PT 的分布是什么以 DA 为条件。有许多统计模型用于分析这种联系,可以再次可视化,正如其他回复中所建议的那样(例如,使用逻辑回归、分类树等)

此外,还可以选择以完全探索的方式执行此操作。 Base R 为这种情况提供了所谓的 spineplots/spinograms (spineplot()) 和条件密度图 (cdplot())。这个想法是通过 P(x | y) * P(y) / P(x) 简单地可视化 P(y | x),其中直方图或核密度可用于 P(.)。

使用@jlhoward 的人工示例:

set.seed(1)
DA <- c(rnorm(1000, mean=100, sd=25), rnorm(1000, mean=200, sd=25))
PT <- rep(c("eCheck", "Credit Card"), each=1000)
df <- data.frame(PT,DA)

然后我可以做

plot(PT ~ DA, data = df) ## internally calls spineplot()
plot(PT ~ DA, data = df, breaks = seq(0, 300, by = 50)) ## custom breaks for hist()
cdplot(PT ~ DA, data = df)
cdplot(PT ~ DA, data = df, bw = 2) ## custom bandwidth for density()

有关更多详细信息和示例,请参阅 ?spineplot?cdplot