-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathserver.R
152 lines (148 loc) · 5.23 KB
/
server.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
#setwd("C:\\Users\\leroychen\\Documents\\shinydashboard")
load("user_pay_1.RData")
actionuser<-read.csv("actionuser.csv",T,fileEncoding = "UTF-8")
actionuser<-actionuser[,c("用户id","最后一周登录天数","最后一周登录次数","最后一周0.8点登录次数","最后一周8.18点登录次数","最后一周18.24点登录次数","注册至今距离天数","是否付费")]
#数据抽样
#对数据进行分区，90%的数据作为测试集用来建模，10%的数据作为验证集用来验证模型
library(caret)
set.seed(100)
ind<-createDataPartition(actionuser$是否付费,times=1,p=.9,list=FALSE)
traindata<-actionuser[ind,]
testdata<-actionuser[-ind,]
#对类失衡数据进行重新抽样，达到数据平衡
#对付费用户（1）进行重复抽样，将付费人数增加一倍
ind1<-sample(which(traindata$是否付费==1),2*length(which(traindata$是否付费==1)),replace=TRUE)
#对非付费用户（0）进行不放回抽样，将非付费人数减少一半
ind2<-sample(which(traindata$是否付费==0),0.5*length(which(traindata$是否付费==0)),replace=FALSE)
#组合成新数据集newdata
newdata<-traindata[c(ind1,ind2),]
#利用条件推理决策树算法建立分类树模型
# 首先将树的最大深度设置为3
newdata$是否付费<-as.factor(newdata$是否付费)
library(party)
ctree.sol<-ctree(是否付费~.,data=newdata[,-1],control=ctree_control(mincriterion=0.99,maxdepth=2))
function(input, output) {
#####用户分群研究 ######
#计算不同的用户群人数
small <-reactive({user_pay[user_pay$amount<=input$small,]})
middle<-reactive({user_pay[user_pay$amount>input$small&user_pay$amount<=input$middle,]})
big<-reactive({user_pay[user_pay$amount>input$middle & user_pay$amount<=input$big,]})
super<-reactive({user_pay[user_pay$amount>input$big,]})
super<-reactive({user_pay[user_pay$amount>input$big,]})
#统计不同用户群的占比
output$vbox0 <- renderValueBox({
valueBox(
h4(strong("85.08%",style="color:white")),
subtitle =h5(em(paste("非R人数共计",48500,"人"))),
icon=icon("user-md"),
color="aqua",
width=2
)
})
output$small <- renderValueBox({
valueBox(
h4(strong(paste(round(nrow(small())/57000*100,2),"%",sep=""),style="color:white;")),
subtitle = h5(em(paste("小R人数共计",nrow(small()),"人"))),
icon = icon("user-md"),
color="aqua",
width=2
)
})
output$middle <- renderValueBox({
valueBox(
h4(strong(paste(round(nrow(middle())/57000*100,2),"%",sep=""),style="color:white;")),
subtitle = h5(em(paste("中R人数共计",nrow(middle()),"人"))),
icon = icon("user-md"),
color="aqua",
width=2
)
})
output$big <- renderValueBox({
valueBox(
h4(strong(paste(round(nrow(big())/57000*100,2),"%",sep=""),style="color:white;")),
subtitle = h5(em(paste("大R人数共计",nrow(big()),"人"))),
icon = icon("user-md"),
color="aqua",
width=2
)
})
output$super <- renderValueBox({
valueBox(
h4(strong(paste(round(nrow(super())/57000*100,2),"%",sep=""),style="color:white;")),
subtitle = h5(em(paste("超R人数共计",nrow(super()),"人"))),
icon = icon("user-md"),
color="aqua",
width=2
)
})
output$barplot<-renderPlot({
x<-c(0.8589,
round(nrow(small())/57000,4),
round(nrow(middle())/57000,4),
round(nrow(big())/57000,4),
round(nrow(super())/57000,4)
)
y<--x
barplot(x,horiz=T,space = 0,xlim=c(-1,1),axes = F,col = "green")
axis(2,c(0.5,1.5,2.5,3.5,5),labels=c("非R","小R","中R","大R","超R"),tick=FALSE,cex.axis=0.8)
axis(4,c(0.5,1.5,2.5,3.5,5),labels=round(x,3),tick=FALSE,cex.axis=0.75)
barplot(y,horiz = T,space = 0,add = T,col = "green",axes = F)
})
output$barplot1<-renderPlot({
x<-c(
round(nrow(small())/57000,4),
round(nrow(middle())/57000,4),
round(nrow(big())/57000,4),
round(nrow(super())/57000,4)
)
y<--x
barplot(x,horiz=T,space = 0,xlim=c(-0.15,0.15),axes = F,col = "green")
axis(2,c(0.5,1.5,2.5,3.5),labels=c("小R","中R","大R","超R"),tick=FALSE,cex.axis=0.8)
axis(4,c(0.5,1.5,2.5,3.5),labels=round(x,3),tick=FALSE,cex.axis=0.75)
barplot(y,horiz = T,space = 0,add = T,col = "green",axes = F)
})
#查看不同的用户群号码包
output$table<-DT::renderDataTable(
switch(input$dataset,
"1"=small(),
"2"=middle(),
"3"=big(),
"4"=super()),
options=list(pageLength=10)
)
#下载号码包
output$downloadCsv<-downloadHandler(
filename = "userid.csv",
content = function(file){
write.csv(switch(input$dataset,
"1"=small(),
"2"=middle(),
"3"=big(),
"4"=super()
),file,row.names = F)
},
contentType="text/csv"
)
###潜在付费用户挖掘####
# 导出明细数据
output$actionuser<-DT::renderDataTable({
DT::datatable(actionuser)
})
#画出箱线图
output$boxplot1<-renderPlot({
par(mfrow=c(2,3))
for(i in 2:7)
boxplot(actionuser[,i]~actionuser$是否付费,col=c(1,2)*i,outline=FALSE,
main=paste(colnames(actionuser)[i],"箱线图"))
par(mfrow=c(1,1))
})
#画决策树图
output$treeplot<-renderPlot({
plot(ctree.sol)
})
}