# Author: Grzegorz Sionkowski
# Last update: 2018-04-20


library(data.table) 

##### FUNCTION #################################
data.table2libFFM <- function(dt, labels=c(),numerical_features=c(), trainname='tr.ffm', testname='te.ffm', digits=5,verbosity=1) {
# ATTENTION: The method does not use any kind of dictionary or hashing,
# so it is necessary to connect  train and test files before the transformation
# and then separate it into two parts. 
# Transformations performed separately give proper results only if the sequence of 
# features as well as the unique values of all categorical features in train 
# and test datasets are exactly the same.   
   
   maxFeat <- 0
   ii <- 0
   features <- names(dt)
   flibFFM <- setnames(data.table(matrix('',nrow = nrow(dt), ncol = 1)),c('label'))
   #-----------------------------------
   if (verbosity==1) cat("Labeling train. \n")
   labelX <- as.data.frame(labels)
   if (nrow(labelX)>nrow(flibFFM)) {
      labelX<-labelX[1:nrow(flibFFM),]
	  if (verbosity==1) {
	     print("Warning: The number of labels is equal or higher than the number of rows of dt. \n")
		 print("         No test libFFM file will be created and saved, just train. \n")
	  
	  }	 
   }
   if (nrow(labelX)>0) {
       flibFFM[1:nrow(labelX),label:= paste0(labelX[[1]],' ')]
	}else{
      if (verbosity==1) {
	      cat("Warning: The number of labels is equal 0. \n")
		  cat("         No train libFFM file will be created and saved, just test. \n")
	  }
    }   
   #-----------------------------------
   if (verbosity==1) cat("\nTransforming the features into libFFM format. \n")
   #-----------------------------------
   for (featname in features) {
      ii <- ii+1
      if (featname %in% numerical_features) {
         #dt[[featname]] <- as.numeric(dt[[featname]])
         flibFFM[,label := paste0(label,ii,':',1+maxFeat,':',round(dt[[featname]],digits),' ')]
         maxFeat <- maxFeat+1
         if (verbosity==1) cat(ii,featname,"- numerical\n")
      }else{
         dt[[featname]] <- as.numeric(as.factor(dt[[featname]]))
         flibFFM[,label := paste0(label,ii,':',dt[[featname]]+maxFeat,':1 ')]
         maxii <- max(dt[[featname]])
         maxFeat <- maxFeat+maxii
         if (verbosity==1) cat(ii,featname,"- categorical,",maxii,"unique values\n")
      }
    }
	if (verbosity==1) cat("\nSplitting on labeled and unlabeled datafiles.\n")
	trainOK <- FALSE
	testOK  <- FALSE
	if (nrow(labelX)>0) {
	   trainLibFFM <- flibFFM[1:nrow(labelX),]
	   trainOK <- TRUE
	} 
    if (nrow(labelX)<nrow(dt)) {
	   testLibFFM <- flibFFM[(nrow(labelX)+1):nrow(dt),]
	   testOK <- TRUE
	} 
	#-----------------------------------
    if (verbosity==1) {
      cat("\nSaving labeled train libFFM file: ", trainname,"\n")
      if (trainOK) {
	     print(head(trainLibFFM))
	  }	 
    }	  
    if (trainOK) {
      fwrite(trainLibFFM, file=trainname, quote=FALSE, row.names = FALSE, col.names = FALSE)
    }else{
      if (verbosity==1) cat("Warning: Labeled libFFM file is empty.\n")
    }
    #-----------------------------------
    if (verbosity==1) {
      cat("\nSaving unlabeled test libFFM file: ", testname,"\n")
	  if (testOK) {
	     print(head(testLibFFM))
	  }	 
	}
    if (testOK) {
      fwrite(testLibFFM, file=testname, quote=FALSE, row.names = FALSE, col.names = FALSE)
	}else{
	  if (verbosity==1) cat("Warning: Unlabeled libFFM file is empty.\n")
    }  
   #-----------------------------------
   if (verbosity==1) cat("\nFinished.\n")
return(0) 
} 


###### EXAMPLE ################################

# creating train (categorical features)
train_path <- "../input/train_sample.csv"
train <- fread(train_path)
labelY <- train[,.(is_attributed)]
train[,attributed_time:=NULL]
train[,click_time:=NULL]
train[,is_attributed:=NULL]

#artificial test
test <- copy(train)

# connecting train and test datasets
dt <- rbind(train,test)

# creating numerical features (just for example)
dt[,num1 := log1p(os)]
num_feat <- c("num1")

# Moving numerical columns and categorical ones of many unique values to the end.
# It is not needed, but it minimizes the size of the libFFM format file
# and probably increases the spead of paste function
dt <- dt[,.(os,device,channel,app,ip,num1)]

# using the function
result <- data.table2libFFM(dt, labels=labelY, numerical_features=num_feat)