1
$\begingroup$

As a first introduction to machine learning and keras, I just finished reading Deep Learning with R by François Chollet with J.J. Allaire. I would like to extend the book's IMDB example of two-class classification to a multi-input version using functional API.

library(keras)

## Keras IMDB example

#load data
imdb <- dataset_imdb(num_words = 10000)
train_data <- imdb$train$x
train_labels <- imdb$train$y
test_data <- imdb$test$x
test_labels <- imdb$test$y

#Encoding the integer sequences into a binary matrix
vectorize_sequences <- function(sequences, dimension = 10000) {
results <- matrix(0, nrow = length(sequences), ncol = dimension)
for (i in 1:length(sequences))
results[i, sequences[[i]]] <- 1
results
}

x_train <- vectorize_sequences(train_data)
x_test <- vectorize_sequences(test_data)
y_train <- as.numeric(train_labels)
y_test <- as.numeric(test_labels)

#Defining the model
model <- keras_model_sequential() %>%
layer_dense(units = 16, activation = "relu", input_shape = c(10000)) %>%
layer_dense(units = 16, activation = "relu") %>%
layer_dense(units = 1, activation = "sigmoid")

#Compiling the model 
model %>% compile(
optimizer = "rmsprop",
loss = "binary_crossentropy",
metrics = c("accuracy")
)

#Training the model
history <- model %>% fit(
partial_x_train,
partial_y_train,
epochs = 20,
batch_size = 512,
validation_data = list(x_val, y_val)
)

#Defining the model using functional API
model <- keras_model_sequential() %>%
layer_embedding(input_dim = 10000, output_dim = 8,
input_length = maxlen) %>%
layer_flatten() %>%
layer_dense(units = 1, activation = "sigmoid")

So, I would like to create a similar model where we predict class A and B based on 1 continuous and 3 categorical input data. In this dummy example, continuous1, categorical1 and categorical2 are 1D tensors while similarly to the IMDB example, categorical3 is a 2D tensor of shape (samples, indices) with length num_index=20 and are one-hot encoded.

Two-class classification multi-input model

#Dummy data
dat <- data.frame(samples=c(rep(paste0("A_",1:9800)),rep(paste0("B_",9801:10000))))
dat$label <- c(rep("A",9800),rep("B",200))
dat$continuous1 <- c(rnorm(9800, 100, 45),rnorm(200, 0, 25)) #may    normalize to unit variance
dat$continuous1[dat$continuous1<0] <- 0
dat$categorical1 <- c(rep(1:100,98),rep(1:100,2))
dat$categorical2 <- c(rep(1:98,100),rep(99:100,100))

pool_A <- factor(1:15,levels=1:20)
pool_B <- factor(16:20,levels=1:20)
dat_categorical3 <- vector("list",10000)
names(dat_categorical3) <- c(as.character(dat[dat$label=="A",]$samples),as.character(dat[dat$label=="B",]$samples))
for(i in 1:9800){
  dat_categorical3[[i]] <- (as.numeric(table(sample(pool_A, 20, replace=T))) > 0) + 0L
}
for(i in 9801:10000){
  dat_categorical3[[i]] <- (as.numeric(table(sample(pool_B, 20, replace=T))) > 0) + 0L
}

As I've never built a Keras model before, I'm a bit confused on how to set up the layers representing the different data inputs using functional API. Any suggestions and feedback are highly appreciated, thanks!

$\endgroup$
  • 2
    $\begingroup$ If you are newly starting I would suggest you use C++ or Python, it will make you much more attractive as a candidate when searching for jobs. $\endgroup$ – JahKnows May 29 '18 at 3:30
  • $\begingroup$ I figure, for the purpose of this model, it shouldn't matter... same same different syntax. $\endgroup$ – jO. May 29 '18 at 23:54
  • 1
    $\begingroup$ Well if you have 2 different sources of features and you want them to go through different types of layers. Then build 2 separate models, then Concatenate their outputs, this merges the 2 models, then you can add more layers from there on towards the output. I wouldn't know the syntax to do that in R sorry. $\endgroup$ – JahKnows May 30 '18 at 3:14
0
$\begingroup$

With the help from a colleague, we came up with this:

set.seed(666)

#Dummy data
dat <- data.frame(samples=c(rep(paste0("A_",1:9800)),rep(paste0("B_",9801:10000))))
dat$label <- c(rep("A",9800),rep("B",200))
dat$continuous1 <- c(rnorm(9800, 100, 45),rnorm(200, 0, 25))
dat$continuous1[dat$continuous1<0] <- 0
dat$categorical1 <- c(rep(1:100,98),rep(1:100,2))
dat$categorical2 <- c(rep(1:98,100),rep(99:100,100))

pool_A <- factor(1:15,levels=1:20)
pool_B <- factor(16:20,levels=1:20)
dat_categorical3 <- vector("list",10000)
names(dat_categorical3) <- c(as.character(dat[dat$label=="A",]$samples),as.character(dat[dat$label=="B",]$samples))
for(i in 1:9800){
  dat_categorical3[[i]] <- (as.numeric(table(sample(pool_A, 20, replace=T))) > 0) + 0L
}
for(i in 9801:10000){
  dat_categorical3[[i]] <- (as.numeric(table(sample(pool_B, 20, replace=T))) > 0) + 0L
}
dat_categorical3_tensor <- do.call(rbind,dat_categorical3)


## Split data for training-validating-testing

# As we have much fewer Bs than As, each partition has to have a more or less equal number of Bs(?)
training_Bs <- sample(x=as.character(dat[dat$label=="B",]$samples), size=67, replace=F)
validating_Bs <- sample(x=setdiff(as.character(dat[dat$label=="B",]$samples),training_Bs), size=67, replace=F)
testing_Bs <- setdiff(as.character(dat[dat$label=="B",]$samples),c(training_Bs,validating_Bs))

# We also parition the data containing As equally, though this could probably be done in e.g., 80-10-10
training_As <- sample(x=as.character(dat[dat$label=="A",]$samples), size=3267, replace=F)
validating_As <- sample(x=setdiff(as.character(dat[dat$label=="A",]$samples),training_As), size=3267, replace=F)
testing_As <- setdiff(as.character(dat[dat$label=="A",]$samples),c(training_As,validating_As))

# Put together
training_dat <- dat[dat$samples %in% c(training_As,training_Bs),]
training_categorical3_tensor <- dat_categorical3_tensor[rownames(dat_categorical3_tensor) %in% c(training_As,training_Bs),]
training_labels <- ifelse(training_dat$label=="A",0,1)
training_dat2 <- as.matrix(training_dat[,c(3:5)]) #use this

validating_dat <- dat[dat$samples %in% c(validating_As,validating_Bs),]
validating_categorical3_tensor <- dat_categorical3_tensor[rownames(dat_categorical3_tensor) %in% c(validating_As,validating_Bs),]
validating_labels <- ifelse(validating_dat$label=="A",0,1) 
validating_dat2 <- as.matrix(validating_dat[,c(3:5)]) #use this

testing_dat <- dat[dat$samples %in% c(testing_As,testing_Bs),]
testing_categorical3_tensor <- dat_categorical3_tensor[rownames(dat_categorical3_tensor) %in% c(testing_As,testing_Bs),]
testing_labels <- ifelse(testing_dat$label=="A",0,1)
testing_dat2 <- as.matrix(testing_dat[,c(3:5)]) #use this


## Keras model

# Input layers
all_dat_input <- layer_input(shape = 3, dtype = 'float32', name = 'all_dat_input')
categorical3_indices_input <- layer_input(shape = 20, dtype = 'float32', name = 'categorical3_input')
input_tensor <- c(all_dat_input, categorical3_indices_input)

# Output layers
all_dat_out <- all_dat_input %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.5) %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.5)

categorical3_indices_out <- categorical3_indices_input %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.5) %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.5)

output_tensor <- layer_concatenate(c(all_dat_out, categorical3_indices_out)) %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.5) %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.5) %>%
  layer_dense(units=1, activation="sigmoid")

model <- keras_model(inputs=input_tensor, outputs=output_tensor)

# Compile
model %>% compile(
  optimizer = "rmsprop",
  loss = "binary_crossentropy",
  metrics = "accuracy"
)

# Fit
history <- model %>% fit(
  x=list(training_dat2,training_categorical3_tensor),
  y=training_labels,
  batch_size=256,
  epochs=20,
  validation_data=list(list(validating_dat2,validating_categorical3_tensor),validating_labels)
)

enter image description here

# Compare with put aside testing data
results <- model %>% evaluate(list(testing_dat2,testing_categorical3_tensor),testing_labels)

results
$loss
[1] 0.0000001584833
$acc
[1] 1

# Using the trained network to generate predictions on new data
predictions <- model %>% predict(list(testing_dat2,testing_categorical3_tensor))

head(predictions[3267:3332])
[1] 0.9999921 0.9999992 0.9999999 0.9999996 0.9999999 0.9999542    
# the network correctly identifies Bs as Bs with a confidence between >99%

(Remember that this is dummy data!)

I'm currently looking into feature importance to see which data inputs contributed more than others to the prediction. lime seems to be made for this!

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.