lgb.prepare_rules.R 5.21 KB
Newer Older
James Lamb's avatar
James Lamb committed
1
2
#' Data preparator for LightGBM datasets with rules (numeric)
#'
3
4
5
#' Attempts to prepare a clean dataset to prepare to put in a \code{lgb.Dataset}.
#' Factors and characters are converted to numeric. In addition, keeps rules created
#' so you can convert other datasets using this converter.
6
#'
James Lamb's avatar
James Lamb committed
7
8
#' @param data A data.frame or data.table to prepare.
#' @param rules A set of rules from the data preparator, if already used.
9
#'
10
11
12
#' @return A list with the cleaned dataset (\code{data}) and the rules (\code{rules}).
#'         The data must be converted to a matrix format (\code{as.matrix}) for input
#'         in \code{lgb.Dataset}.
13
#'
James Lamb's avatar
James Lamb committed
14
15
16
#' @examples
#' library(lightgbm)
#' data(iris)
17
#'
James Lamb's avatar
James Lamb committed
18
#' str(iris)
19
#'
James Lamb's avatar
James Lamb committed
20
21
#' new_iris <- lgb.prepare_rules(data = iris) # Autoconverter
#' str(new_iris$data)
22
#'
James Lamb's avatar
James Lamb committed
23
24
#' data(iris) # Erase iris dataset
#' iris$Species[1] <- "NEW FACTOR" # Introduce junk factor (NA)
25
#'
James Lamb's avatar
James Lamb committed
26
27
28
#' # Use conversion using known rules
#' # Unknown factors become 0, excellent for sparse datasets
#' newer_iris <- lgb.prepare_rules(data = iris, rules = new_iris$rules)
29
#'
James Lamb's avatar
James Lamb committed
30
31
#' # Unknown factor is now zero, perfect for sparse datasets
#' newer_iris$data[1, ] # Species became 0 as it is an unknown factor
32
#'
James Lamb's avatar
James Lamb committed
33
#' newer_iris$data[1, 5] <- 1 # Put back real initial value
34
#'
James Lamb's avatar
James Lamb committed
35
36
#' # Is the newly created dataset equal? YES!
#' all.equal(new_iris$data, newer_iris$data)
37
#'
James Lamb's avatar
James Lamb committed
38
39
#' # Can we test our own rules?
#' data(iris) # Erase iris dataset
40
#'
James Lamb's avatar
James Lamb committed
41
42
43
44
45
46
#' # We remapped values differently
#' personal_rules <- list(Species = c("setosa" = 3,
#'                                    "versicolor" = 2,
#'                                    "virginica" = 1))
#' newest_iris <- lgb.prepare_rules(data = iris, rules = personal_rules)
#' str(newest_iris$data) # SUCCESS!
47
#'
James Lamb's avatar
James Lamb committed
48
49
50
#' @importFrom data.table set
#' @export
lgb.prepare_rules <- function(data, rules = NULL) {
51

James Lamb's avatar
James Lamb committed
52
53
  # data.table not behaving like data.frame
  if (inherits(data, "data.table")) {
54

James Lamb's avatar
James Lamb committed
55
56
    # Must use existing rules
    if (!is.null(rules)) {
57

James Lamb's avatar
James Lamb committed
58
59
      # Loop through rules
      for (i in names(rules)) {
60

James Lamb's avatar
James Lamb committed
61
62
        data.table::set(data, j = i, value = unname(rules[[i]][data[[i]]]))
        data[[i]][is.na(data[[i]])] <- 0 # Overwrite NAs by 0s
63

James Lamb's avatar
James Lamb committed
64
      }
65

James Lamb's avatar
James Lamb committed
66
    } else {
67

James Lamb's avatar
James Lamb committed
68
69
      # Get data classes
      list_classes <- vapply(data, class, character(1))
70

James Lamb's avatar
James Lamb committed
71
72
73
      # Map characters/factors
      is_fix <- which(list_classes %in% c("character", "factor"))
      rules <- list()
74

James Lamb's avatar
James Lamb committed
75
76
      # Need to create rules?
      if (length(is_fix) > 0) {
77

James Lamb's avatar
James Lamb committed
78
79
        # Go through all characters/factors
        for (i in is_fix) {
80

James Lamb's avatar
James Lamb committed
81
82
          # Store column elsewhere
          mini_data <- data[[i]]
83

James Lamb's avatar
James Lamb committed
84
85
86
87
88
89
90
91
92
          # Get unique values
          if (is.factor(mini_data)) {
            mini_unique <- levels(mini_data) # Factor
            mini_numeric <- numeric(length(mini_unique))
            mini_numeric[seq_along(mini_unique)] <- seq_along(mini_unique) # Respect ordinal if needed
          } else {
            mini_unique <- as.factor(unique(mini_data)) # Character
            mini_numeric <- as.numeric(mini_unique) # No respect of ordinality
          }
93

James Lamb's avatar
James Lamb committed
94
95
96
97
          # Create rules
          indexed <- colnames(data)[i] # Index value
          rules[[indexed]] <- mini_numeric # Numeric content
          names(rules[[indexed]]) <- mini_unique # Character equivalent
98

James Lamb's avatar
James Lamb committed
99
100
          # Apply to real data column
          data.table::set(data, j = i, value = unname(rules[[indexed]][mini_data]))
101

James Lamb's avatar
James Lamb committed
102
        }
103

James Lamb's avatar
James Lamb committed
104
      }
105

James Lamb's avatar
James Lamb committed
106
    }
107

James Lamb's avatar
James Lamb committed
108
  } else {
109

James Lamb's avatar
James Lamb committed
110
111
    # Must use existing rules
    if (!is.null(rules)) {
112

James Lamb's avatar
James Lamb committed
113
114
      # Loop through rules
      for (i in names(rules)) {
115

James Lamb's avatar
James Lamb committed
116
117
        data[[i]] <- unname(rules[[i]][data[[i]]])
        data[[i]][is.na(data[[i]])] <- 0 # Overwrite NAs by 0s
118

James Lamb's avatar
James Lamb committed
119
      }
120

James Lamb's avatar
James Lamb committed
121
    } else {
122

James Lamb's avatar
James Lamb committed
123
124
      # Default routine (data.frame)
      if (inherits(data, "data.frame")) {
125

James Lamb's avatar
James Lamb committed
126
127
        # Get data classes
        list_classes <- vapply(data, class, character(1))
128

James Lamb's avatar
James Lamb committed
129
130
131
        # Map characters/factors
        is_fix <- which(list_classes %in% c("character", "factor"))
        rules <- list()
132

James Lamb's avatar
James Lamb committed
133
134
        # Need to create rules?
        if (length(is_fix) > 0) {
135

James Lamb's avatar
James Lamb committed
136
137
          # Go through all characters/factors
          for (i in is_fix) {
138

James Lamb's avatar
James Lamb committed
139
140
            # Store column elsewhere
            mini_data <- data[[i]]
141

James Lamb's avatar
James Lamb committed
142
143
144
145
146
147
148
149
150
            # Get unique values
            if (is.factor(mini_data)) {
              mini_unique <- levels(mini_data) # Factor
              mini_numeric <- numeric(length(mini_unique))
              mini_numeric[seq_along(mini_unique)] <- seq_along(mini_unique) # Respect ordinal if needed
            } else {
              mini_unique <- as.factor(unique(mini_data)) # Character
              mini_numeric <- as.numeric(mini_unique) # No respect of ordinality
            }
151

James Lamb's avatar
James Lamb committed
152
153
154
155
            # Create rules
            indexed <- colnames(data)[i] # Index value
            rules[[indexed]] <- mini_numeric # Numeric content
            names(rules[[indexed]]) <- mini_unique # Character equivalent
156

James Lamb's avatar
James Lamb committed
157
158
            # Apply to real data column
            data[[i]] <- unname(rules[[indexed]][mini_data])
159

James Lamb's avatar
James Lamb committed
160
          }
161

James Lamb's avatar
James Lamb committed
162
        }
163

James Lamb's avatar
James Lamb committed
164
      } else {
165

James Lamb's avatar
James Lamb committed
166
        # What do you think you are doing here? Throw error.
167
168
169
170
171
        stop(
          "lgb.prepare: you provided "
          , paste(class(data), collapse = " & ")
          , " but data should have class data.frame"
        )
172

James Lamb's avatar
James Lamb committed
173
      }
174

James Lamb's avatar
James Lamb committed
175
    }
176

James Lamb's avatar
James Lamb committed
177
  }
178

James Lamb's avatar
James Lamb committed
179
  return(list(data = data, rules = rules))
180

James Lamb's avatar
James Lamb committed
181
}