I have a Log-likelihood like this,
l(parameter)=\sum_{i=1}^{n} \delta log[1-exp{-t^{\alpha} e^{x'\beta}}]-(1-\delta)t^{\alpha} e^{x'\beta}
I want to optimize in using R. I have tried it this way, but it is showing an error!
#data:
time status x
55 1 1
1 0 1
6 0 0
24 0 0
42 1 0
35 1 1
# log-likelihood
mle.logreg = function(para, data){
alpha <- para[1]
x <- as.matrix(model.matrix(~data$x)[-1])
beta <- as.matrix(rep(para[2],nrow(x)), ncol=1)
delta <- data$status
time <- data$time
l1 <- delta*log(1-exp(-(time^alpha)*exp(t(x)%*%beta)))
l2 <- (1-delta)*((time^alpha)*exp((t(x)%*%beta)))
loglik <- sum(l1-l2)
return(-loglik)
}
fit <- optim(para=c(0.001,0.001),mle.logreg,data=dat1)
Here is the error.
Error in optim(para = c(0.001, 0.001), mle.logreg, data = dat) :
cannot coerce type 'closure' to vector of type 'double'
In addition: Warning message:
In optim(para = c(0.001, 0.001), mle.logreg, data = dat1) :
one-dimensional optimization by Nelder-Mead is unreliable:
use "Brent" or optimize() directly
How can I solve this? Could any body give me solution?
Related
I'm trying to plot roc curve from lasso logistic regression result. so I used predict() using type="response" to get a probability. however, the result was opposite of when I put type = "class"
first of all, this is my dataset. my predictor has 2 levels
selected_data$danger <- factor(selected_data$danger, levels = c(1,0))
lasso_data<-selected_data
str(lasso_data$danger)
# Factor w/ 2 levels "1","0": 1 1 1 1 1 1 1 1 1 1 ...
# partition
input_train <- createDataPartition(y=lasso_data$danger, p=0.8, list=FALSE)
train_dataset <- lasso_data[input_train,]
test_dataset <- lasso_data[-input_train,]
dim(train_dataset)
# [1] 768 62
dim(test_dataset)
# [1] 192 62
I did run both cases(type = class, response) to compare.
lasso_model <- cv.glmnet( x=data.matrix(train_dataset[,-length(train_dataset)]), y = train_dataset[,length(train_dataset)],
family = "binomial" , type.measure = "auc",alpha=1, nfolds=5)
lasso_pred <- predict(lasso_model, newx=data.matrix(test_dataset[,-length(test_dataset)]),
s=lasso_model$lambda.min, type= "class", levels=c(1,0))
lasso_pred_resp <- predict(lasso_model, s="lambda.1se", newx=data.matrix(test_dataset[,-length(test_dataset)]), type="response", levels=c(1,0))
threshold <- 0.5 # or whatever threshold you use
pred <- ifelse(lasso_pred_resp>threshold, 1, 0)
table(lasso_pred, pred)
# pred
# lasso_pred 0 1
# 0 11 95
# 1 76 10
I have no idea why this is happening...
Any help would be greatly appreciated.
For logistic regression in R, the probability or "response" always refers to the probability of being the 2nd level, in your case it is "0".
So you predictions should be:
pred <- ifelse(lasso_pred_resp>threshold, 0, 1)
To avoid confusions, you can also do:
lvl <- levels(lasso_data$danger)
pred <- ifelse(lasso_pred_resp>threshold,lvl[2],lvl[1])
I am currently trying to build a neural network to predict what rank people within the data will place.
The Rank system is: A,B,C,D,E
Everything runs very smoothly until I get to my confusion matrix. I get the error "Error: data and reference should be factors with the same levels.". I have tried many different methods on other posts but none seem to work.
The levels are both the same in NNPredicitions and test$Rank. I checked them both with table().
library(readxl)
library(caret)
library(neuralnet)
library(forecast)
library(tidyverse)
library(ggplot2)
Indirect <-read_excel("C:/Users/Abdulazizs/Desktop/Projects/Indirect/FIltered Indirect.xlsx",
n_max = 500)
Indirect$Direct_or_Indirect <- NULL
Indirect$parentaccount <- NULL
sum(is.na(Indirect))
counts <- table(Indirect$Rank)
barplot(counts)
summary(counts)
part2 <- createDataPartition(Indirect$Rank, times = 1, p = .8, list = FALSE, groups = min(5, length(Indirect$Rank)))
train <- Indirect[part2, ]
test <- Indirect[-part2, ]
set.seed(1234)
TrainingParameters <- trainControl(method = "repeatedcv", number = 10, repeats=10)
as.data.frame(train)
as.data.frame(test)
NNModel <- train(train[,-7], train$Rank,
method = "nnet",
trControl= TrainingParameters,
preProcess=c("scale","center"),
na.action = na.omit
)
NNPredictions <-predict(NNModel, test, type = "raw")
summary(NNPredictions)
confusionMatrix(NNPredictions, test$Rank)
length(NNPredictions)
length(test$Rank)
length(NNPredictions)
[1] 98
length(test$Rank)
[1] 98
table(NNPredictions, test$Rank, useNA="ifany")
NNPredictions A B C D E
A 1 0 0 0 0
B 0 6 0 0 0
C 0 0 11 0 0
D 0 0 0 18 0
E 0 0 0 0 62
Also change method = "prob" to method = "raw"
Table1 <- table(NNPredictions, test$Rank, useNA = "ifany")
cnf1 <- confusionMatrix(Table1)
Answered provided by dclarson
I tried to implement the AdaBoost algorithm of Freund and Schapire as close to the original as possible (see p. 2 here: http://rob.schapire.net/papers/explaining-adaboost.pdf):
library(rpart)
library(OneR)
maxdepth <- 1
T <- 100 # number of rounds
# Given: (x_1, y_1),...,(x_m, y_m) where x_i element of X, y_i element of {-1, +1}
myocarde <- read.table("http://freakonometrics.free.fr/myocarde.csv", head = TRUE, sep = ";")
#myocarde <- read.table("data/myocarde.csv", header = TRUE, sep = ";")
y <- (myocarde[ , "PRONO"] == "SURVIE") * 2 - 1
x <- myocarde[ , 1:7]
m <- nrow(x)
data <- data.frame(x, y)
# Initialize: D_1(i) = 1/m for i = 1,...,m
D <- rep(1/m, m)
H <- replicate(T, list())
a <- vector(mode = "numeric", T)
set.seed(123)
# For t = 1,...,T
for(t in 1:T) {
# Train weak learner using distribution D_t
# Get weak hypothesis h_t: X -> {-1, +1}
data_D_t <- data[sample(m, 10*m, replace = TRUE, prob = D), ]
H[[t]] <- rpart(y ~., data = data_D_t, maxdepth = maxdepth, method = "class")
# Aim: select h_t with low weighted error: e_t = Pr_i~D_t[h_t(x_i) != y_i]
h <- predict(H[[t]], x, type = "class")
e <- sum(h != y) / m
# Choose a_t = 0.5 * log((1-e) / e)
a[t] <- 0.5 * log((1-e) / e)
# Update for i = 1,...,m: D_t+1(i) = (D_t(i) * exp(-a_t * y_i * h_t(x_i))) / Z_t
# where Z_t is a normalization factor (chosen so that Dt+1 will be a distribution)
D <- D * exp(-a[t] * y * as.numeric(h))
D <- D / sum(D)
}
# Output the final hypothesis: H(x) = sign(sum of a_t * h_t(x) for t=1 to T)
newdata <- x
H_x <- sapply(H, function(x) as.numeric(as.character(predict(x, newdata = newdata, type = "class"))))
H_x <- t(a * t(H_x))
pred <- sign(rowSums(H_x))
#H
#a
eval_model(pred, y)
##
## Confusion matrix (absolute):
## Actual
## Prediction -1 1 Sum
## -1 0 1 1
## 1 29 41 70
## Sum 29 42 71
##
## Confusion matrix (relative):
## Actual
## Prediction -1 1 Sum
## -1 0.00 0.01 0.01
## 1 0.41 0.58 0.99
## Sum 0.41 0.59 1.00
##
## Accuracy:
## 0.5775 (41/71)
##
## Error rate:
## 0.4225 (30/71)
##
## Error rate reduction (vs. base rate):
## -0.0345 (p-value = 0.6436)
As can be seen the accuracy of the model is horrible compared to other AdaBoost implementations, e.g.:
library(JOUSBoost)
## JOUSBoost 2.1.0
boost <- adaboost(as.matrix(x), y, tree_depth = maxdepth, n_rounds = T)
pred <- predict(boost, x)
eval_model(pred, y)
##
## Confusion matrix (absolute):
## Actual
## Prediction -1 1 Sum
## -1 29 0 29
## 1 0 42 42
## Sum 29 42 71
##
## Confusion matrix (relative):
## Actual
## Prediction -1 1 Sum
## -1 0.41 0.00 0.41
## 1 0.00 0.59 0.59
## Sum 0.41 0.59 1.00
##
## Accuracy:
## 1 (71/71)
##
## Error rate:
## 0 (0/71)
##
## Error rate reduction (vs. base rate):
## 1 (p-value < 2.2e-16)
My question
Could you please give me a hint what went wrong in my implementation? Thank you
Edit
The final and corrected code can be found in my blog post: Understanding AdaBoost – or how to turn Weakness into Strength
There are quite a few contributing factors as to why your implementation is not working.
You were not using rpart correctly. Adaboost implementation does not mention upsampling with the weights - but rpart itself can accept weights. My example below shows how rpart should be used for this purpose.
Calculation of the weighted error was wrong. You were calculating the error proportion (number of samples calculated incorrectly divided by number of samples). Adaboost uses the sum of the weights that were incorrectly predicted (sum(D[y != yhat])).
Final predictions seemed to be incorrect too, I just ended up doing a simple loop.
Next time I recommend diving into the source code the the other implementations you are comparing against.
https://github.com/cran/JOUSBoost/blob/master/R/adaboost.R uses almost identical code to my below example - and probably would have helped guide you originally.
Additionally using T as a variable could potentially interfere with the logical TRUE and it's shorthand T, so I'd avoid it.
### packages ###
library(rpart)
library(OneR)
### parameters ###
maxdepth <- 1
rounds <- 100
set.seed(123)
### data ###
myocarde <- read.table("http://freakonometrics.free.fr/myocarde.csv", head = TRUE, sep = ";")
y <- (myocarde[ , "PRONO"] == "SURVIE") * 2 - 1
x <- myocarde[ , 1:7]
m <- nrow(x)
dataset <- data.frame(x, y)
### initialisation ###
D <- rep(1/m, m)
H <- list()
a <- vector(mode = "numeric", length = rounds)
for (i in seq.int(rounds)) {
# train weak learner
H[[i]] = rpart(y ~ ., data = dataset, weights = D, maxdepth = maxdepth, method = "class")
# predictions
yhat <- predict(H[[i]], x, type = "class")
yhat <- as.numeric(as.character(yhat))
# weighted error
e <- sum(D[yhat != y])
# alpha coefficient
a[i] <- 0.5 * log((1 - e) / e)
# updating weights (D)
D <- D * exp(-a[i] * y * yhat)
D <- D / sum(D)
}
# predict with each weak learner on dataset
y_hat_final <- vector(mode = "numeric", length = m)
for (i in seq(rounds)) {
pred = predict(H[[i]], dataset, type = "class")
pred = as.numeric(as.character(pred))
y_hat_final = y_hat_final + (a[i] * pred)
}
pred <- sign(y_hat_final)
eval_model(pred, y)
> eval_model(pred, y)
Confusion matrix (absolute):
Actual
Prediction -1 1 Sum
-1 29 0 29
1 0 42 42
Sum 29 42 71
Confusion matrix (relative):
Actual
Prediction -1 1 Sum
-1 0.41 0.00 0.41
1 0.00 0.59 0.59
Sum 0.41 0.59 1.00
Accuracy:
1 (71/71)
Error rate:
0 (0/71)
Error rate reduction (vs. base rate):
1 (p-value < 2.2e-16)
I'm trying to run a bayes model through R using R2WinBugs and BRugs but running into an error which I cannot solve. I've checked that my model is syntactically correct, and this is the output from when I try running (example below):
model is syntactically correct
data loaded
model compiled
Initializing chain 1:
model is initialized
model is already initialized
Sampling has been started ...
Error in handleRes(res) : NA
In addition: Warning message:
running command '"C:/Users/user/Documents/R/win-library/3.0/BRugs/exec/BugsHelper.exe" "C:/Users/user/AppData/Local/Temp/RtmpWweqIM" "C:/Users/user/AppData/Local/Temp/RtmpWweqIM/trash" "file32f44e4c5ab7.bug" "C:/Users/user/AppData/Local/Temp/RtmpWweqIM/cmds.txt" "1"' had status 144
Session info:
> sessionInfo()
R version 3.0.2 (2013-09-25)
Platform: x86_64-w64-mingw32/x64 (64-bit)
RStudio 0.99.441
Windows 7
Here is an example though I wasn't sure how to attach data, if you'd like the full dataset, I can copy it here, please let me know.
library(BRugs)
library(R2WinBUGS)
library(data.table)
> dat
date mth inc ind response
1: Jan-10 1 1 0 100.0000
2: Jan-10 1 2 0 103.1304
3: Jan-10 1 3 0 106.2609
4: Jan-10 1 4 0 109.3913
5: Jan-10 1 5 0 112.5217
---
572: Dec-10 12 44 1 1887.4783
573: Dec-10 12 45 1 1890.6087
574: Dec-10 12 46 1 1893.7391
575: Dec-10 12 47 1 1896.8696
576: Dec-10 12 48 1 1900.0000
# set data values as individual vectors
N <- nrow(dat)
periods <- length(unique(dat$date))
real_response <- dat$response
TT <- dat$mth
P <- dat$inc
ind <- dat$ind
x_dat <- list("real_response"=real_response,"P"=P,"N"=N,"TT"=TT,"periods"=periods, "ind"=ind)
CreateModel <- function(){
for(k in 1:N) {
P2[k] <- P[k]*30+ind[k]*speed
}
for(i in 1:N) {
real_response[i] ~ dnorm(real_responseHat[i],t_response[i])
t_response[i] <- pow(var_response[i],-1)
var_response[i] <- pow(sigma,2)* mu_target * (1 - exp(-pow((P[i]/theta),
omega[TT[i]])))
real_responseHat[i] <- TARGET[TT[i]] * (1 - exp(-pow((P2[i]/theta),
omega[TT[i]])))
}
sigma ~ dgamma(0.5,0.001)
theta ~ dgamma(0.5,0.001)
for(j in 1:periods){
newmu[j] <- mu_target*pow((1+adj_factor), j)
TARGET[j] ~ dnorm(newmu[j],t_target)
omega[j] ~ dgamma(s1,s2)
}
speed ~ dcat(p[])
for(j in 1:15){
p[j] <- 1/15
}
adj_factor ~ dnorm(2, 1.2)
t_target <- pow(s_target,-2)
s_target ~ dgamma(0.5,0.0001)
s1 ~ dgamma(1.5,.5)
s2 ~ dgamma(1.5,.5)
mu_target ~ dnorm(1000,0.0001)
}
mod <- file.path(paste(getwd(), "\\stackex_model.txt", sep=""))
writeModel(CreateModel, mod)
modelCheck(mod)
# file.show(mod)
##
inits <- function() {
list("TARGET" = rep(1000,periods), "sigma" = 5, "theta" = 15, "omega" = rep(0.5,periods),"mu_target"=1000,"s_target"=60, "s1"=1.5, "s2"=1, "speed"=3, "adj_factor"=2)
}
parms <- c("TARGET", "sigma", "theta", "omega","mu_target","s_target","s1","s2", "speed", "adj_factor")
system.time(bmod <- bugs(data=x_dat,
inits=inits, parameters.to.save=parms,
n.iter=100, n.chains=1, n.burnin=50,
n.thin=1, model.file=mod,
debug=TRUE, codaPkg=FALSE,
bugs.directory="C:/Program Files (x86)/OpenBUGS/OpenBUGS323",
program="OpenBUGS"))
I'm continuing to try and debug this problem but if anyone's seen this before or has a clue as to what's happening I'd really appreciate it.
Also, the iterations and thinning are set very low so de-bugging is easier. I plan to increase these (and hopefully parallelize) once I know the model runs.
I am using neuralnet package for training a classifier.
The training data looks like this:
> head(train_data)
mvar_12 mvar_40 v10 mvar_1 mvar_2 Labels
1 136.51551310 6 0 656.78784220 0 0
2 145.10739860 87 0 14.21413596 0 0
3 194.74940330 4 0 196.62888080 0 0
4 202.38663480 2 0 702.27307720 0 1
5 60.14319809 9 0 -1.00000000 -1 0
6 95.46539380 6 0 539.09479640 0 0
The code is as follows:
n <- names(train_data)
f <- as.formula(paste("Labels ~", paste(n[!n %in% "Labels"], collapse = " + ")))
library(neuralnet)
nn <- neuralnet(f, tr_nn, hidden = 4, threshold = 0.01,
stepmax = 1e+05, rep = 1,
lifesign.step = 1000,
algorithm = "rprop+")
The problem arises when I try to make a prediction for a test set:
pred <- compute(nn, cv_data)
Where cv_data looks like:
> head(cv_data)
mvar_12 mvar_40 v10 mvar_1 mvar_2
1 213.84248210 1 9 -1.000000000 -1
2 110.73985680 0 0 -1.000000000 -1
3 152.74463010 14 0 189.521812800 -1
4 64.91646778 7 0 47.854257730 -1
5 141.28878280 12 0 248.557857500 5
6 55.36992840 2 0 4.785425773 -1
To this I get an error saying:
Error in nrow[w] * ncol[w] : non-numeric argument to binary operator
In addition: Warning message:
In is.na(weights) : is.na() applied to non-(list or vector) of type 'NULL'
Why do I get this error and how can I fix it?
I just came up against the very same problem. Checking the source code of the compute function we can see that it assumes one of the resulting attributes (i.e. weights) only defined when the network finishes the training flawless.
> trace("compute",edit=TRUE)
function (x, covariate, rep = 1) {
nn <- x
linear.output <- nn$linear.output
weights <- nn$weights[[rep]]
[...]
}
I think the real problem lies on the fact that neuralnet doesn't save the current network once reached the stepmax value, causing this error later in the compute code.
Edit
It seems you can avoid this reset by commenting lines 65 & 66 of the calculate.neuralnet function
> fixInNamespace("calculate.neuralnet", pos="package:neuralnet")
[...]
#if (reached.threshold > threshold)
# return(result = list(output.vector = NULL, weights = NULL))
[...]
Then everything works as a charm :)
Try adjusting the threshold to a higher than 0.01 value or the stepmax to more than 1e06, or using a threshold of 0.1 and then decreasing it from there. You can also add in the lifesign = "full" argument to observe the model creation performance in increments of 1000 steps to really dial in the threshold. This "resolved" the non-binary error I had, but the accuracy of the model, the mean squared error, and other results were less than satisfying as a direct result.
Do a str(cv_data) and make sure they are all numeric.
Becasue you never set startweights in the function neuralnet()
According to the documentation
neuralnet(formula, data, hidden = 1, threshold = 0.01,
stepmax = 1e+05, rep = 1, startweights = NULL,
learningrate.limit = NULL,
learningrate.factor = list(minus = 0.5, plus = 1.2),
learningrate=NULL, lifesign = "none",
lifesign.step = 1000, algorithm = "rprop+",
err.fct = "sse", act.fct = "logistic",
linear.output = TRUE, exclude = NULL,
constant.weights = NULL, likelihood = FALSE)
startweights a vector containing starting values for the weights. The weights will not be randomly initialized.
Note that the default value is NULL, and it will NOT be randomly initialized. Try to put something there and see if that works.