rm(list = ls())
library(HMM)
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.0.1
Normalize <- function(TM) {
NRow <- nrow(TM)
for (i in 1:NRow - 1) {
TM[i, ] <- TM[i, ]/(sum(TM[i, ]))
}
return(TM)
}
MakeTM <- function(feature_vec, TM_Pars) {
States_Num <- ncol(TM_Pars)
TM <- matrix(0, States_Num, States_Num)
for (i in 1:(States_Num - 1)) {
Sum <- 0
feat_par <- exp(feature_vec %*% TM_Pars[, , i])
if (i == 1) {
feat_par[, States_Num] <- 0
}
denom <- (1 + sum(feat_par))
TM[i, ] <- feat_par/denom
TM[i, i] <- 1/denom
}
TM[1, States_Num] <- 0
TM[States_Num, ] <- 0
return(TM)
}
# MAKING A DIAGONAL EM MATRIX
MakeEM <- function(feature_vec, EM_Pars, nactivity, Conv, States_Num) {
EM <- matrix(0, States_Num, States_Num) # EM IS A DIAGONAL MATRIX
Channel_Num <- length(feature_vec)
nactivity_vec <- rep(nactivity, Channel_Num)
Activity_vec <- feature_vec + t(nactivity_vec)
Y <- vector()
# Make Gamma Matrix
gamma <- matrix(0, States_Num, Channel_Num)
zeta <- matrix(0, States_Num, Channel_Num)
PV <- rep(0, States_Num)
lambda <- rep(0, States_Num)
eta <- rep(0, States_Num)
M <- rep(0, States_Num)
L <- length(EM_Pars)
for (i in 2:(States_Num - 1)) {
gamma[i, ] <- EM_Pars[((i - 2) * Channel_Num + 1):((i - 1) * Channel_Num)]
zeta[i, ] <- EM_Pars[(L - ((i - 2) * Channel_Num)):(L - ((i - 1) * Channel_Num) +
1)]
}
alpha <- rep(0, States_Num)
alpha_ind <- ((States_Num - 2) * Channel_Num) + 1
alpha[2:(States_Num - 1)] <- EM_Pars[alpha_ind:(alpha_ind + (States_Num -
2) - 1)]
alpha[States_Num - 1] <- exp(alpha[States_Num - 1]) + alpha[States_Num -
2]
actvec <- Activity_vec %*% t(gamma)
denom <- exp(alpha + actvec)
M <- denom/(1 + denom)
M[1] <- 0
M[States_Num] <- 0
eta_ind <- (L - ((States_Num - 2) * Channel_Num))
eta <- c(0, EM_Pars[eta_ind:(eta_ind - (States_Num - 2) + 1)], 0)
eta[States_Num - 1] <- exp(eta[States_Num - 1]) + eta[States_Num - 2]
fvec <- feature_vec %*% t(zeta)
lambda <- fvec + eta
pow <- exp(-lambda)
pow[1] <- 0
pow[States_Num] <- 0
coef <- lambda^nactivity
Prob <- (coef * pow)/(factorial(nactivity))
Prob[1] <- 0
Prob[States_Num] <- 0
prob_act <- (M^Conv) * ((1 - M)^(1 - Conv)) * Prob
EM <- diag(as.vector(prob_act))
return(EM)
}
setwd("c:/Users/mesmaeili/Desktop/Markovian")
newdata <- read.table("./fakeData.txt", sep = "\t", header = TRUE)
newdata <- newdata[order(-newdata$Video), ]
users <- unique(newdata$ip, incomparables = FALSE)
users <- as.vector(users)
parameters <- c(-4.8242722, -1.3260686, -5.3591656, 1.3018282, -0.6716662, 2.1590487,
-5.5852372, 0.5165629, 0.7044188, 2.4762785, 3.3226567, 7.2477987, 4.1480874,
2.3555206, 5.8955518, -6.6695473, -4.2444272, -3.1604858, -1.8572911, 2.6664793,
6.2220106, -4.220811, 4.5476897, -7.5527476, 3.4746726, 7.160219, 0.1831164,
-6.1930255, 0.5147417, 1.7674443, 9.5553433, 6.5850626, 0.5218815, 0.4882509)
States_Num <- 4
State <- c("Dormant", "Awareness", "Consideration", "Conversion")
PI <- matrix(0, 1, States_Num)
PI[1] <- 1
PI[2] <- 0
PI[3] <- 0
max <- 0
index = 0
len <- length(users)
for (i in len:len) {
print(i)
data <- newdata[which(newdata$ip == as.character(users[i])), ]
data <- data[order(data$ip, data$imp_act_time), ]
data$imp_Display <- cumsum(data$Display)
data$imp_Mobile <- cumsum(data$Mobile)
data$imp_Video <- cumsum(data$Video)
Tim <- length(data$act_feature)
result_conv_dis <- vector()
result_cons_dis <- vector()
result_Awareness_dis <- vector()
result_Dor_dis <- vector()
Conversion_state <- matrix(0, Tim, 1)
Consideration_state <- matrix(0, Tim, 1)
Dormant_state <- matrix(0, Tim, 1)
Awareness_state <- matrix(0, Tim, 1)
result_dis <- matrix(0, Tim, 4)
res <- diag(c(1, 1, 1, 1))
observation <- c("notpv")
t <- 1
k <- 1
End <- length(parameters)
while (t < Tim) {
print(t)
conversion <- 0
feature_vec <- c(data$imp_Display[t], data$imp_Video[t])
Conv <- data$Conversion[t + 1]
nactivity <- data$act_feature[t + 1]
Num_Channel <- length(feature_vec)
dims <- (States_Num * States_Num * Num_Channel)
TM_Pars <- array(rep(0, dims), c(Num_Channel, States_Num, States_Num -
1))
TM_Pars[, 1:States_Num - 1, 1] <- parameters[1:((States_Num - 1) * (Num_Channel))]
SECOND_STATE_PAR <- ((States_Num - 1) * (Num_Channel)) + 1
THIRD_STATE_PAR <- (Num_Channel * States_Num) * (States_Num - 2) + SECOND_STATE_PAR -
1
TM_Pars[, , 2:(States_Num - 1)] <- parameters[SECOND_STATE_PAR:THIRD_STATE_PAR]
EM_PAR_START <- THIRD_STATE_PAR + 1
EM_Pars <- parameters[EM_PAR_START:End]
EM <- MakeEM(feature_vec, EM_Pars, nactivity, Conv, States_Num)
TM <- MakeTM(feature_vec, TM_Pars)
TM <- Normalize(TM)
Emi <- matrix(c(EM[1, 1], EM[2, 2], EM[3, 3], EM[4, 4], 1 - EM[1, 1],
1 - EM[2, 2], 1 - EM[3, 3], 1 - EM[4, 4]), 2)
HMM <- initHMM(c("Dormant", "Awareness", "Consideration", "Conversion"),
c("pv", "notpv"), transProbs = TM, emissionProb = Emi)
# print( feature_vec)
print(HMM)
# print(EM)
if (nactivity > 0) {
observation = c(observation, "pv")
t <- t + 1
}
if (nactivity == 0) {
observation = c(observation, "notpv")
}
pos = posterior(HMM, observation)
forward_prob = forward(HMM, observation)
L <- length(pos[1, ])
result_conv_dis[k] <- pos[4, L]
result_cons_dis[k] <- pos[3, L]
result_Awareness_dis[k] <- pos[2, L]
result_Dor_dis[k] <- pos[1, L]
Conversion_state[k] <- as.numeric(sum(TM[, 4]/2))
Consideration_state[k] <- as.numeric(sum(TM[, 3]/4))
Dormant_state[k] <- as.numeric(sum(TM[, 1]/4))
Awareness_state[k] <- as.numeric(sum(TM[, 2]/4))
t <- t + 1
k <- k + 1
}
print(Conversion_state[k - 1])
d <- "Display :"
disprint <- c(d, data$Display)
cat(disprint)
vidprint <- c("\nVideo Ad:", data$Video)
cat(vidprint)
Conv_State1 <- Conversion_state[1:k - 1]
Cons_State1 <- Consideration_state[1:k - 1]
Dorm_State1 <- Dormant_state[1:k - 1]
Aw_state1 <- Awareness_state[1:k - 1]
result_conv_dis[1:k - 1] <- result_conv_dis[1:k - 1]/sum(result_conv_dis[1:k -
1])
Result_Dis <- matrix(c(result_Dor_dis[1:k - 1], result_Awareness_dis[1:k -
1], result_cons_dis[1:k - 1], result_conv_dis[1:k - 1]), nrow = k -
1, ncol = 4)
# mypath=file.path('C:', 'Desktop', 'Markovian', paste('myplot_', i,
# '.jpg', sep=''))
print(result_conv_dis[1:k - 1])
plot(result_conv_dis[1:(k - 2)], type = "o", col = "green", main = "Value of Each Ad",
xlab = "Ad trail ", ylab = "Value of each Ad ", pch = 19, lwd = 2.5)
matplot(Result_Dis, pch = 1:4, type = "o", col = rainbow(ncol(Result_Dis)))
plot(Conv_State1, main = "Conversion probability", type = "o", xlab = "Ad Frequency ",
ylab = "Conversion Probability ", ylim = c(0, 1), col = "blue", pch = 19)
plot(Cons_State1, main = "Consideration probability", type = "o", xlab = "Ad Frequency ",
ylab = "Consideration Probability ", ylim = c(0, 1), col = "green",
pch = 19)
conv_cons <- cbind(Conv_State1, Cons_State1, Aw_state1, Dorm_State1)
conv_cons <- cbind(Conv_State1, Cons_State1, Dorm_State1, Aw_state1)
matplot(conv_cons, pch = 1:3, type = "o", col = rainbow(ncol(conv_cons)),
lwd = 2)
legend("topleft", c("Conversion", "Consideration", "Awareness", "Dormant"),
lty = c(1, 1, 1, 1), lwd = c(2.5, 2.5, 2.5, 2.5), col = rainbow(ncol(conv_cons)))
matplot(conv_cons, pch = 1:3, type = "o", col = rainbow(ncol(conv_cons)),
lwd = 2, xlab = "Ad Frequency ", ylab = "Consideration/Conversion Probability ")
legend("topleft", c("Conversion", "Consideration"), lty = c(1, 1, 1, 1),
lwd = c(2.5, 2.5), col = rainbow(ncol(conv_cons)))
rm(data)
}
## [1] 4
## [1] 1
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 6.598e-01 3.104e-03 0.337074 0.0000
## Awareness 4.077e-05 1.086e-02 0.301290 0.6878
## Consideration 4.186e-01 1.652e-05 0.001152 0.5802
## Conversion 0.000e+00 0.000e+00 0.000000 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1.0000
## Awareness 9.162e-04 0.9991
## Consideration 1.110e-06 1.0000
## Conversion 0.000e+00 1.0000
##
## [1] 2
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 7.930e-01 1.755e-05 2.070e-01 0.0000
## Awareness 2.947e-09 2.093e-04 1.610e-01 0.8388
## Consideration 3.423e-01 5.333e-10 2.592e-06 0.6577
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1
## Awareness 6.007e-06 1
## Consideration 4.866e-11 1
## Conversion 0.000e+00 1
##
## [1] 3
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 8.824e-01 9.189e-08 1.176e-01 0.0000
## Awareness 1.921e-13 3.635e-06 7.754e-02 0.9225
## Consideration 2.730e-01 1.679e-14 5.688e-09 0.7270
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1
## Awareness 3.905e-08 1
## Consideration 2.083e-15 1
## Conversion 0.000e+00 1
##
## [1] 4
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 9.362e-01 4.587e-10 6.376e-02 0.0000
## Awareness 1.191e-17 6.002e-08 3.551e-02 0.9645
## Consideration 2.132e-01 5.174e-19 1.222e-11 0.7868
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1
## Awareness 2.538e-10 1
## Consideration 8.908e-20 1
## Conversion 0.000e+00 1
##
## [1] 5
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 9.664e-01 2.228e-12 3.362e-02 0.0000
## Awareness 7.201e-22 9.674e-10 1.587e-02 0.9841
## Consideration 1.635e-01 1.566e-23 2.579e-14 0.8365
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.00e+00 1
## Awareness 1.65e-12 1
## Consideration 3.81e-24 1
## Conversion 0.00e+00 1
##
## [1] 6
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 9.825e-01 1.066e-14 1.746e-02 0.0000
## Awareness 4.307e-26 1.542e-11 7.016e-03 0.9930
## Consideration 1.236e-01 4.673e-28 5.365e-17 0.8764
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1
## Awareness 1.073e-14 1
## Consideration 1.629e-28 1
## Conversion 0.000e+00 1
##
## [1] 7
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 9.910e-01 5.057e-17 8.998e-03 0.0000
## Awareness 2.563e-30 2.445e-13 3.085e-03 0.9969
## Consideration 9.236e-02 1.378e-32 1.103e-19 0.9076
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1
## Awareness 7.297e-15 1
## Consideration 8.434e-36 1
## Conversion 0.000e+00 1
##
## [1] 9
## $States
## [1] "Dormant" "Awareness" "Consideration" "Conversion"
##
## $Symbols
## [1] "pv" "notpv"
##
## $startProbs
## Dormant Awareness Consideration Conversion
## 0.25 0.25 0.25 0.25
##
## $transProbs
## to
## from Dormant Awareness Consideration Conversion
## Dormant 9.910e-01 5.057e-17 8.998e-03 0.0000
## Awareness 2.563e-30 2.445e-13 3.085e-03 0.9969
## Consideration 9.236e-02 1.378e-32 1.103e-19 0.9076
## Conversion 0.000e+00 0.000e+00 0.000e+00 0.0000
##
## $emissionProbs
## symbols
## states pv notpv
## Dormant 0.000e+00 1.0000
## Awareness 5.599e-03 0.9944
## Consideration 3.067e-22 1.0000
## Conversion 0.000e+00 1.0000
##
## [1] 0.9523
## Display : 1 1 1 1 1 1 1 0 0 0
## Video Ad: 0 0 0 0 0 0 0 0 0 0[1] 0.240791 0.091772 0.046581 0.028186 0.015935 0.008702 0.000000 0.568033