Sunday, February 28, 2016

Tree based imputation Part 2 of 2


Conditional tree based imputation
Note that formula making command for casting its type.
Generally, ctree performs better than rpart
It is noted that GBM can handle missing value, perhaps GBM can be used to impute. Refer here.

rm(list=ls())
library("partykit") #for ctree

setwd ('C:\\Users\\Ted\\Documents\\MSPA\\2016 Winter\\Pred 411\\Unit_03')
train = read.csv('wine.csv')
str(train); class(train)
colnames(train)[1] = 'INDEX'


apply(apply(train,2,is.na),2,sum)
missCol = names(which(apply(is.na(train),2,any)))


for (i in 1:length(missCol)) {
  var     = missCol[i]
  MIFlag  = paste0(var,'_MIFLAG')
  formula = as.formula(paste0(var, '~.'))

  model.ctree =
    ctree(formula,
          data=train[!is.na(train[,missCol[i]]),
                     !names(train) %in% c('INDEX', 'TARGET_FLAG', 'TARGET_AMT')]
    )

  #assign(paste0('model.ctree.',var), model.ctree)

  train[[MIFlag]] = ifelse(is.na(train[[var]]), 1, 0)
  train[,var]     =
    ifelse(is.na(train[,var]), predict(model.ctree), train[,var])
  rm(model.ctree, formula, i, MIFlag, var)
}

apply(apply(train,2,is.na),2,sum)
Posted by at No comments:

Tree based imputation Part 1 of 2


Missing value imputation via rpart

rm(list=ls())
library(rpart)

setwd ('C:\\Users\\Ted\\Documents\\MSPA\\2016 Winter\\Pred 411\\Unit_03')
train = read.csv('wine.csv')
str(train); class(train)
colnames(train)[1] = 'INDEX'


apply(apply(train,2,is.na),2,sum)
missCol = names(which(apply(is.na(train),2,any)))
# "ResidualSugar"      "Chlorides"          "FreeSulfurDioxide"
# "TotalSulfurDioxide" "pH"                 "Sulphates"        
# "Alcohol"            "STARS"



for (i in 1:length(missCol)) {
  var     = missCol[i]
  MIFlag  = paste0(var,'_MIFLAG')
  formula = paste(var, '~ .')
 
  model.rpart =
    rpart(formula,
          data=train[!is.na(train[,missCol[i]]),
                     !names(train) %in% c('INDEX', 'TARGET')]      
    )
  opt<-which.min(model.rpart$cptable[,'xerror'])
  cp<-model.rpart$cptable[opt,'CP']
  model.rpart.prune <- prune(model.rpart, cp = cp)
  #assign(paste0('model.rpart.prune.',var), model.rpart.prune)
 
  train[[MIFlag]] = ifelse(is.na(train[[var]]), 1, 0)
  train[,var]   =
    ifelse(is.na(train[,var]), predict(model.rpart.prune), train[,var])
}

#check if the missing values have been imputed
apply(apply(train,2,is.na),2,sum) #apply(is.na(train),2,any)

write.table(train, "wine_train.csv", sep=",", row.names=FALSE)

library(rattle)
asRules(model.rpart.prune.STARS)
asRules(model.rpart.prune.ResidualSugar)

## http://stats.stackexchange.com/questions/72251/an-example-lasso-regression-using-glmnet-for-binary-outcome
## http://stats.stackexchange.com/questions/77546/how-to-interpret-glmnet
Posted by at No comments:

Sunday, August 23, 2015

Google Compute Engine - Cloud Computing Setup

Google Compute Engine Cloud Computing Set-ups:
Unix + R Stdudio + WebInterface

gcloud compute images create IMAGE_NAME --source-uri URI

gcloud compute images create rstudio-image --source-uri http://storage.googleapis.com/rstudio-image/rstudio-image.image.tar.gz

gcloud compute images create rstudioz --source-uri http://storage.googleapis.com/rstudio-image/rstudio-image.image.tar.gz


gcloud compute images create IMAGE_NAME --source-uri gs://BUCKET_NAME/IMAGE_NAME.image.tar.gz

gcloud compute images create rstudio-image --source-uri gs://rstudio-image/rstudio-image2.image.tar.tar
gcloud compute images create rstudio-image --source-uri http://storage.googleapis.com/rstudio-image/rstudio-image.tar.gz
gcloud compute images create rstudio-image --source-uri http://storage.googleapis.com/r-gce-sunholo/98789ee2fa89942875b1409a36a3fb8e1e719aae.image.tar.gz

http://storage.googleapis.com/rstudio-image/rstudio-image.tar.gz

==================
http://storage.googleapis.com/r-gce-sunholo/98789ee2fa89942875b1409a36a3fb8e1e719aae.image.tar.gz
================
gcloud compute instances create example-instance \
         --image https://www.googleapis.com/compute/v1/projects/debian-cloud/global/images/debian-7-wheezy-vYYYMMDD

gcloud compute instances create rstudio-image \ --image https://storage.googleapis.com/rstudio-image/rstudio-image.tar.gz
================

tar -Sczf rstudio-image.tar.gz disk.raw




If you don't know your username, try this command using gcloud to see your user details:
$ gcloud auth login
Any users you add to Debian running on the instance will have a user in RStudio - to log into Debian and add new users, see below:
$ ## ssh into the running instance
$ gcloud compute ssh <your-username>@new-instance-name
$ #### It should now tell you that you are logged into your instance #####
$ #### Once logged in, add a user: example with jsmith
$ sudo useradd jsmith
$ sudo passwd jsmith
$ ## give the new user a directory and change ownership to them
$ sudo mkdir /home/jsmith
$ sudo chown jsmith:users /home/jsmith

Posted by at No comments:

Wednesday, December 3, 2014

Avazu CTR Competition

Kaggle Avazu CTR

#This code attempts to utilize the following concepts:
#Gradient Boosting Model, Stochastic Simulation, Learning rate (shrinkage) optimization, bootstraping

rm(list=ls())
setwd("C:/Users/Ted/Documents/Kaggle/Avazu/Data")

library("ff")
library("ffbase")
library("doParallel")
library("data.table")
library(ggplot2)
library(lattice)



csvfile <- file.path(getwd(),'ff.train.pct.sample','train_5pct.csv')
train <- fread(csvfile, header=TRUE, stringsAsFactors=TRUE)


summary(train);str(train);head(train) #stringsASFactors doesn't work
rm(list=ls())


## train.1p[,site_id := as.factor(site_id)]
names_factors<- colnames(train)
for (col in names_factors) set(train, j=col, value=as.factor(train[[col]]))



#### get day & 3hr time zone ####


train$date <- paste('20',substring(train$hour, first = 1, last = 2),
                       substring(train$hour, first=3, last=8), sep='')

train$date <- paste(substring(train$date, first=1, last=4), '-',
                       substring(train$date, first=5, last=6), '-',
                       substring(train$date, first=7, last=8), ' ',
                       substring(train$date, first=9, last=19), sep='')

## train$date <- as.POSIXct(train, strptime(train$date, "%Y-%M-%D %H"))
## train$date <- as.Date(train$date, "%Y-%M-%D %H")

train$day <- weekdays(as.Date(train$date))

train$day1 <- train$day
train$day1 <- gsub("Monday"   , 1 ,train$day1)
train$day1 <- gsub("Tuesday"  , 2, train$day1)
train$day1 <- gsub("Wednesday", 3, train$day1)
train$day1 <- gsub("Thursday" , 4, train$day1)
train$day1 <- gsub("Friday"   , 5, train$day1)
train$day1 <- gsub("Saturday" , 6, train$day1)
train$day1 <- gsub("Sunday"   , 7, train$day1)


train$hour <- substring(train$hour, first=7, last=8)
train$hour <- gsub("00", "Q1", train$hour); train$hour <- gsub("01", "Q1", train$hour); train$hour <- gsub("02", "Q1", train$hour);
train$hour <- gsub("03", "Q1", train$hour); train$hour <- gsub("04", "Q1", train$hour); train$hour <- gsub("05", "Q1", train$hour);
train$hour <- gsub("06", "Q2", train$hour); train$hour <- gsub("07", "Q2", train$hour); train$hour <- gsub("08", "Q2", train$hour);
train$hour <- gsub("09", "Q2", train$hour); train$hour <- gsub("10", "Q2", train$hour); train$hour <- gsub("11", "Q2", train$hour);
train$hour <- gsub("12", "Q3", train$hour); train$hour <- gsub("13", "Q3", train$hour); train$hour <- gsub("14", "Q3", train$hour);
train$hour <- gsub("15", "Q3", train$hour); train$hour <- gsub("16", "Q3", train$hour); train$hour <- gsub("17", "Q3", train$hour);
train$hour <- gsub("18", "Q4", train$hour); train$hour <- gsub("19", "Q4", train$hour); train$hour <- gsub("20", "Q4", train$hour);
train$hour <- gsub("21", "Q4", train$hour); train$hour <- gsub("22", "Q4", train$hour); train$hour <- gsub("23", "Q4", train$hour);


names_factors<- colnames(train)
for (col in names_factors) set(train, j=col, value=as.factor(train[[col]]))


##final check
summary(train);str(train);head(train)


## save model feed data
csvfile <- file.path(getwd(),'ff.train.pct.modelfeed','train_5pct.csv')
system.time(
  write.table(train, file=csvfile, row.names=FALSE, col.names=TRUE)
)

gc()
help(memory.size);memory.limit();memory.size()


############################################################################
############################################################################

rm(list=ls())

library(data.table)

## load model feed data
setwd("C:/Users/Ted/Documents/Kaggle/Avazu/Data")
csvfile <- file.path(getwd(),'ff.train.pct.modelfeed','train_3pct.csv')
train <- fread(csvfile, header=TRUE)


## find distinct levels in each columns
names_factors<- colnames(train)
for (col in names_factors) set(train, j=col, value=as.factor(train[[col]]))

lvl_cnt <- NULL
for (col in names_factors)  { lvl_cnt[col] <- (length(levels(train[[col]]))) }
lvl_cnt <- as.data.frame(lvl_cnt); lvl_cnt$name <- rownames(lvl_cnt)
colnames(lvl_cnt)[1] <- 'count'; lvl_cnt[with(lvl_cnt, order(count)),]
##xtabs(C21 ~ click, data=train)


## imipact modeling
impactModel = function(xcol, ycol){
  n = length(ycol)
  p = sum(as.numeric(ycol))/n
  #duplicate output for NA (average NA towards grand uniform average)
  x = c(xcol, xcol)
  y = c(ycol, ycol)
  x[(1+n):(2*n)] = NA
  levelcounts = table(x, y, useNA="always")
  condprobmodel = (levelcounts[,2]+p)/(levelcounts[,1]+levelcounts[,2]+1.0)
  # apply model example: applyImpactModel(condprobmodel, data[,varname])
  condprobmodel
}

applyImpactModel = function(condprobmodel, xcol) {
  naval = condprobmodel[is.na(names(condprobmodel))]
  dim = length(xcol)
  condprobvec = numeric(dim) + naval
  for(nm in names(condprobmodel)) {
    if(!is.na(nm)) {
      condprobvec[xcol==nm] = condprobmodel[nm]
    }
  }
  condprobvec
}


impact_c20 = impactModel(train$c20, train$click)
# train <- as.data.frame(train)
train$impact_c20 = applyImpactModel(impact_c20, train$c20)



## randomForest model
library(randomForest)
set.seed(12345)
formula <- click ~ hour + device_type + device_conn_type + C18 + C1 + banner_pos + C15 +
                   C16 + site_category + app_category  + day  ## C21 + C19

formula1 <- click ~ device_type + device_conn_type + C18 + C1 + banner_pos + C15 +
  C16 + site_category * app_category  + day + hour ## C21 + C19


system.time(
model.rf <- randomForest(formula = formula,
                         data = train,
                         ntree=150, importance=T))

##   1pct
##   user  system elapsed
## 249.31    4.13  253.62



print(model.rf)
attributes(model.rf)
importance(model.rf)
varImpPlot(model.rf)
plot(model.rf)
summary(model.rf)

## first formula
table(predict(model.rf), train.1p$click)
###### with hour x1 #######
# 0      1
# 0 334812  67290
# 1    801   1386
###### with hour x2 #######
# 0      1
# 0 334911  67361
# 1    702   1315


## second formula
table(predict(model.rf), train.1p$click)
# 0      1
# 0 334896  67421
# 1    717   1255


# test random forest using test data
irisPred <- predict(rf, newdata=testData)

# check the results
table(irisPred, testData$Species)
plot(margin(rf, testData$Species))


head(train)


names_factors<- colnames(test)
for (col in names_factors) set(test, j=col, value=as.factor(test[[col]]))


## predict
predict.rf <- predict(model.rf, newdata=test)


#fit the randomforest model
model <- randomForest(Sepal.Length~.,
                      data = training,
                      importance=TRUE,
                      keep.forest=TRUE
)
print(model)

#what are the important variables (via permutation)
varImpPlot(model, type=1)

#predict the outcome of the testing data
predicted <- predict(model, newdata=testing[ ,-1])

# what is the proportion variation explained in the outcome of the testing data?
# i.e., what is 1-(SSerror/SStotal)
actual <- testing$Sepal.Length
rsq <- 1-sum((actual-predicted)^2)/sum((actual-mean(actual))^2)
print(rsq)



# gbm model fitting

library(gbm)
library(dplyr)
library(data.table)

setwd("C:\\Users\\intrepid-honor-803\\Documents\\Kaggle\\Avazu\\Data")
csvfile <- file.path(getwd(),'ff.train.pct.modelfeed','train_50pct.csv')
train <- fread(csvfile, header=TRUE)



## click <- train$click 
click <- as.numeric(train$click)

## train <- select(train, -click)
train <- select(train, 
                device_type, device_conn_type, C18, C1, banner_pos, C15, 
                C16, site_category, app_category, day, hour)


names_factors<- colnames(train)
for (col in names_factors) set(train, j=col, value=as.factor(train[[col]]))

?gbm
model.gbm = gbm.fit(x=train,
                    y=click,      
                    distribution = "bernoulli", 
                    # gaussian for GBM regression or adaboost
                    n.trees=10000,
                    shrinkage=0.05, 
                    # smaller values of shrinkage typically give slighly better performance
                    # the cost is that the model takes longer to run for smaller values
                    interaction.depth=3,
                    #use CV to choose interaction delpth
                    n.minobsinnode=500,
                    # n.minobsinmode has an importnt effect on overfitting!
                    # decrease in this number may result the overfitting
                    nTrain=round(nrow(train) * 0.8),
                    # var.monotone=c(),
                    # can help with overfitting, will smooth bumpy curves
                    verbose=TRUE
)

summary(model.gbm)
gbm.perf(model.gbm) ## gbm.perf(model.gbm, method="test")
save(model.gbm, file="gbm_depth3_minobs500_n10000")
load("C:\\Users\\intrepid-honor-803\\Documents\\Kaggle\\Avazu\\Data\\predicted\\1gbm_depth3_minobs500_n5000\\gbm_depth3_minobs500_n5000.rda")
rm(train)

Posted by at No comments:

R packages


List of R packages updates for tracking

    • ggplot2 / ggvis (interactive)
    • dplyr
    • ff/bigglm
    • reshape2
    • data.table
    • gmb
    • doParallel
    • rattle/caret
    • stringr

http://www-bcf.usc.edu/~gareth/ISL/
http://adv-r.had.co.nz/
http://www.louisaslett.com/RStudio_AMI/
http://www.r-bloggers.com/in-depth-introduction-to-machine-learning-in-15-hours-of-expert-videos/
Posted by at No comments:

Thursday, October 2, 2014

Big data in R

Approaches and packages to handle big data in R
This post is largely credit to this blog.


Data Storage I/O

  • http://blog.revolutionanalytics.com/2009/12/r-tip-save-time-and-space-by-compressing-data-files.html
  • fread
  • data.table
  • http://stackoverflow.com/questions/1727772/quickly-reading-very-large-tables-as-dataframes-in-r
  • http://davetang.org/muse/2013/09/03/handling-big-data-in-r/


Data Manipulation

  • dplyr in plyr package


Data Visualization

  • bigvis
  • ggplot2

Memory

  • ffbase
  • http://www.slideshare.net/EdwindeJonge1/ffbase
Ensemble
http://www.r-bloggers.com/improve-predictive-performance-in-r-with-bagging/
http://vikparuchuri.com/blog/parallel-r-loops-for-windows-and-linux/


Parallelization

  • http://adv-r.had.co.nz/Profiling.html#parallelise
  • http://notjustmath.wordpress.com/2012/01/22/parallel-computing-with-r/
  • http://stackoverflow.com/questions/24335569/in-r-how-to-predict-with-svm-model-in-parallel-using-foreach-snow
  • http://topepo.github.io/caret/parallel.html
  • http://stackoverflow.com/questions/7782501/how-to-interpret-predict-result-of-svm-in-r?rq=1
  • http://www.r-bloggers.com/parallel-r-model-prediction-building-and-analytics/
Posted by at No comments:

Thursday, May 1, 2014

Neural Network - Single & Multiple output nodes

##### AllState Prediction Model using Neural Network Algorithm
##### Working in progress

rm(list=ls())

###### read in file
setwd('C:\\Users\\Ted\\Desktop\\Kaggle\\AllState')
dat1 <- read.csv(file="train.csv", header=T)
test1 <- read.csv(file="test_v2.csv", header=T)

##### overview of data
str(dat1);summary(dat1);nrow(dat1);head(dat1,2)
apply(apply(dat1,2,is.na),2,sum)


##### dat2 is for only purchase record
dat1$p <- apply(dat1[,c("A", "B", "C", "D", "E", "F", "G")],1,paste, collapse='')

##### convert factors into numbers #dat1$st <- NULL
a <- data.frame(sort(unique(dat1$state)), order(sort(unique(dat1$state))))
colnames(a) <- c("state","state_no")
b <- data.frame(sort(unique(dat1$p)), order(sort(unique(dat1$p))))
colnames(b) <- c("p","p_no")
dat1 <- merge(dat1,a, by='state');rm(a)
dat1 <- merge(dat1,b, by="p");rm(b)


##### binarize car value
cat <- levels(dat1$car_value)
cat[1] <- c("u")
#for (i in cat) {cat[i] <- paste("car_value",i, collapse=" ")};cat

binarize <- function(x) {return(dat1$car_value == x)}
newcols <- --sapply(cat, binarize)
colnames(newcols) <- cat
dat1 <- cbind(dat1, newcols)
rm(cat);rm(newcols);rm(binarize)



##### do the same manipulation on test set
apply(apply(test1,2,is.na),2,sum)
test1$p <- apply(test1[,c("A", "B", "C", "D", "E", "F", "G")], 1, paste, collapse='')

a <- data.frame(sort(unique(test1$state)), order(sort(unique(test1$state))))
colnames(a) <- c("state","state_no")
b <- data.frame(sort(unique(test1$p)), order(sort(unique(test1$p))))
colnames(b) <- c("p","p_no")
test1 <- merge(test1,a, by='state');rm(a)
test1 <- merge(test1,b, by="p");rm(b)

cat <- levels(test1$car_value)
cat[1] <- c("u")
binarize <- function(x) {return(test1$car_value == x)}
newcols <- --sapply(cat, binarize)
colnames(newcols) <- cat
test1 <- cbind(test1, newcols)
rm(cat);rm(newcols);rm(binarize)






##### final cut for record type = 1
dat2 <- dat1[dat1$record_type==1,]






##### graph data distribution
hist(dat2$p_no)





##### random forest model
library(randomForest)
formula <- p ~ day + state + location + group_size + homeowner + car_age + car_value + age_oldest +
               age_youngest + married_couple + cost # + risk_factor +  c_previous + duration_previous
model.rf <- randomForest(formula = formula, data=dat2, ntree=100, importance=T)


head(dat2)
##### neural network model
library(neuralnet); args(neuralnet)
model.nn <- neuralnet(p_no ~ day + state_no + location + group_size + homeowner + car_age + car_value + age_oldest +
                        age_youngest + married_couple + cost # + risk_factor +  c_previous + duration_previous
                      , data=dat2, hidden=3, act.fct="logistic",rep = 3, linear.output = F)


m <- model.matrix( ~ p_no + day + state_no + location + group_size + homeowner + car_age +
                     u + a + b + c + d + e + f + g + h + i + age_oldest +
                    age_youngest + married_couple + cost # + risk_factor +  c_previous + duration_previous
                   ,data = dat2)

model.nn <- neuralnet(p_no ~ day + state_no + location + group_size + homeowner + car_age +
                        u + a + b + c + d + e + f + g + h + i + age_oldest +
                        age_youngest + married_couple + cost # + risk_factor +  c_previous + duration_previous
                      ,data=m , hidden = 2, threshold=0.01, linear.output=F)


pred.bin <- prediction(model.nn)
pred.bin$rep1
plot(model.nn, rep="best")





Posted by at No comments:
Subscribe to: Posts (Atom)