init research

tech.ml.dataset/src/tech/v3/dataset/bzip2.clj

@@ -0,0 +1,67 @@
+(ns tech.v3.dataset.bzip2
+  "API for reading/writing a single dataset to/from a bzip2 file.  File must
+  only contain one entry.
+
+  You must have apache commons-compress included as part of your project to
+  load this namespace.  Many projects already include commons-compress so manually
+  including it may not be necessary for your system.
+
+  Also note that version before 1.21 have several known vulnerabilities.
+
+```clojure
+  org.apache.commons/commons-compress {:mvn/version \"1.21\"}
+```
+
+### Usage
+
+```clojure
+user> (require '[tech.v3.dataset :as ds])
+nil
+user> (require '[tech.v3.dataset.bzip2])
+nil
+user> (def stocks (ds/->dataset \"test/data/stocks.csv\"))
+#'user/stocks
+user> (ds/write! stocks \"test/data/stocks.csv.bz2\")
+nil
+user> (ds/head (ds/->dataset \"test/data/stocks.csv.bz2\"))
+test/data/stocks.csv.bz2 [5 3]:
+
+| symbol |       date | price |
+|--------|------------|------:|
+|   MSFT | 2000-01-01 | 39.81 |
+|   MSFT | 2000-02-01 | 36.35 |
+|   MSFT | 2000-03-01 | 43.22 |
+|   MSFT | 2000-04-01 | 28.37 |
+|   MSFT | 2000-05-01 | 25.45 |
+```
+  "
+  (:require [tech.v3.dataset.io :as ds-io]
+            [tech.v3.dataset.io.univocity :as univocity]
+            [tech.v3.dataset.io.mapseq-colmap :as parse-mapseq-colmap]
+            [tech.v3.io :as io])
+  (:import [org.apache.commons.compress.compressors.bzip2 BZip2CompressorInputStream
+            BZip2CompressorOutputStream]
+           [java.io InputStream]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defmethod ds-io/data->dataset :bz2
+  [data options]
+  (let [ftype (-> (ds-io/str->file-info (.substring (str data) 0
+                                                    (- (count data) 4)))
+                  (get :file-type))]
+    (with-open [is (-> (apply io/input-stream data (apply concat (seq options)))
+                       (BZip2CompressorInputStream.))]
+      (ds-io/data->dataset is (assoc options :file-type ftype)))))
+
+
+(defmethod ds-io/dataset->data! :bz2
+  [data output options]
+  (let [ftype (-> (ds-io/str->file-info (.substring (str output) 0
+                                                    (- (count output) 4)))
+                  (get :file-type))]
+    (with-open [os (-> (apply io/output-stream! output (apply concat (seq options)))
+                       (BZip2CompressorOutputStream.))]
+      (ds-io/dataset->data! data os (assoc options :file-type ftype)))))

tech.ml.dataset/src/tech/v3/dataset/categorical.clj

@@ -0,0 +1,334 @@
+(ns tech.v3.dataset.categorical
+  "Conversions of categorical values into numbers and back.  Two forms of conversions
+  are supported, a straight value->integer map and one-hot encoding.
+
+  The functions in this namespace manipulate the metadata on the columns of the dataset, wich can be inspected  via `clojure.core/meta`"
+
+  (:require [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.impl.column :as col-impl]
+            [tech.v3.dataset.impl.column-base :as col-base]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [ham-fisted.lazy-noncaching :as lznc]
+            [ham-fisted.set :as set]
+            [ham-fisted.defprotocol :refer [extend-type]])
+  (:refer-clojure :exclude [extend-type]))
+
+
+(defn- indiscrete-mapping
+  [[k v]]
+  (let [v (double v)
+        vv (double (Math/round (double v)))]
+    (not (== v vv))))
+
+
+;;This file uses categorical-map loosely.  Really they are lookup tables
+;;from categorical object value to integer.
+(defn- make-categorical-map-from-table-args
+  "Make a mapping of value->index from a list of either string values or [valname idx]
+  pairs.
+  Returns map of value->index."
+  [table-value-list]
+  ;; First, any explicit mappings are respected.
+  (let [[str-table value-list]
+        (reduce (fn [[str-table value-list] item]
+                  (if (sequential? item)
+                    [(assoc str-table
+                            (first item)
+                            (second item))
+                     value-list]
+                    [str-table (conj value-list item)]))
+                [{} []]
+                table-value-list)
+        ;;Finally, auto-generate values for anything not mapped yet.
+        cat-map (->> value-list
+                     (reduce (fn [str-table item]
+                               (assoc str-table item
+                                      (first (remove (set (vals str-table))
+                                                     (range)))))
+                             str-table))
+        bad-mappings (->> cat-map
+                          (filter indiscrete-mapping)
+                          seq)]
+    ;;;  just to be sure
+    (assert (= (clojure.set/map-invert (clojure.set/map-invert cat-map))
+               cat-map)
+            "The categorical mapping calculated is not bijective")
+
+    (when-not (nil? bad-mappings)
+      (throw (Exception. (str "Categorical map values must be integers.
+Non integers found: " (vec bad-mappings)))))
+    cat-map))
+
+
+(defrecord ^:private CategoricalMap [lookup-table src-column result-datatype])
+
+
+(defn ^:no-doc create-categorical-map
+  [lookup-table src-colname result-datatype]
+  (map->CategoricalMap
+   {:lookup-table lookup-table
+    :src-column src-colname
+    :result-datatype result-datatype}))
+
+
+(defn fit-categorical-map
+  "Given a column, map it into an numeric space via a discrete map of values
+  to integers.  This fits the categorical transformation onto the column and returns
+  the transformation.
+
+  If `table-args` is not given, the distinct column values will be mapped into 0..x without any specific order.
+
+  'table-args` allows to specify the precise mapping as a sequence of pairs of [val idx] or as a sorted seq of values.
+"
+
+    ^CategoricalMap [dataset colname & [table-args res-dtype]]
+    (let [m      (make-categorical-map-from-table-args table-args)
+          closed (atom (set (vals m)))
+          idx    (atom 0)
+          nxt    (fn ^long [n]
+                   (if (@closed n)
+                     (do (swap! closed disj n)
+                         (recur (swap! idx inc)))
+                     (let [res @idx
+                           _ (swap! idx inc)]
+                       (long res))))]
+      (create-categorical-map
+       (reduce (fn [categorical-map col-val]
+                 (if (get categorical-map col-val)
+                   categorical-map
+                   (assoc categorical-map col-val (nxt @idx))))
+               m
+               (set/unique (ds-base/column dataset colname)))
+       colname
+       (or res-dtype :int64))))
+
+
+
+(defn transform-categorical-map
+  "Apply a categorical mapping transformation fit with fit-categorical-map."
+  [dataset fit-data]
+  (let [colname (:src-column fit-data)
+        result-datatype (or (:result-datatype fit-data) :int64)
+        lookup-table (:lookup-table fit-data)
+        column (ds-base/column dataset colname)
+        missing (ds-proto/missing column)
+        col-meta (meta column)
+        missing-value (col-base/datatype->missing-value result-datatype)]
+    (assoc dataset colname
+           (col-impl/new-column
+            (:name col-meta)
+            (dtype/emap (fn [col-val]
+                          (if-not (nil? col-val)
+                            (let [numeric (get lookup-table col-val)]
+                              (errors/when-not-errorf
+                               numeric
+                               "Failed to find label entry for column value %s"
+                               col-val)
+                              numeric)
+                            missing-value))
+                        result-datatype
+                        column)
+            (assoc col-meta :categorical-map fit-data)
+            missing))))
+
+
+(extend-type CategoricalMap
+  ds-proto/PDatasetTransform
+  (transform [t dataset]
+    (transform-categorical-map dataset t)))
+
+
+(defn dataset->categorical-maps
+  "Given a dataset, return a sequence of categorical map entries.
+
+```clojure
+user> (ds-cat/dataset->categorical-maps catds)
+({:lookup-table {:a 0, :b 1, :c 2, :d 3},
+  :src-column :x,
+  :result-datatype :float64}
+ {:lookup-table {:a 0, :b 1, :c 2, :d 3},
+  :src-column :y,
+  :result-datatype :float64})
+```"
+  [dataset]
+  (->> (vals dataset)
+       (map (comp :categorical-map meta))
+       (remove nil?)))
+
+
+(defn invert-categorical-map
+  "Invert a categorical map returning the column to the original set of values."
+  [dataset {:keys [src-column lookup-table] :as opts}]
+  (let [column (ds-base/column dataset src-column)
+        res-dtype (reduce casting/widest-datatype
+                          (map dtype/datatype (keys lookup-table)))
+        inv-map (set/map-invert lookup-table)
+        missing-val (col-base/datatype->missing-value res-dtype)]
+    (assoc dataset src-column
+           (col-impl/new-column
+            (:name src-column)
+            (dtype/emap (fn [col-val]
+                          (if-not (nil? col-val)
+                            (let [src-val (get inv-map (long col-val))]
+                              (errors/when-not-errorf
+                                  src-val
+                                "Unable to find src value for numeric value %s"
+                                col-val)
+                              src-val)
+                            missing-val))
+                        res-dtype
+                        column)
+            (-> (meta column)
+                (dissoc :categorical-map)
+                (assoc :categorical? true))
+            (ds-proto/missing column)))))
+
+
+(defn- safe-str
+  [data]
+  (if (keyword? data) (name data)
+      (.replace (str data) " " "-")))
+
+
+(defrecord OneHotMap [one-hot-table src-column result-datatype])
+
+
+(defn fit-one-hot
+  "Fit a one hot transformation to a column.  Returns a reusable transformation.
+  Maps each unique value to a column with 1 every time the value appears in the
+  original column and 0 otherwise."
+  ^OneHotMap [dataset colname & [table-args res-dtype]]
+  (let [{:keys [lookup-table result-datatype]}
+        (fit-categorical-map dataset colname table-args res-dtype)
+        column (ds-base/column dataset colname)
+        src-meta (meta column)
+        src-name (:name src-meta)
+        name-fn (if (= (dtype/datatype src-name) :keyword)
+                  (let [src-name (name src-name)]
+                    #(keyword (str src-name "-" (safe-str %))))
+                  #(str src-name "-" (safe-str %)))
+        one-hot-map (->> lookup-table
+                         (map (fn [[k _v]]
+                                [k (name-fn k)]))
+                         (into {}))]
+    (map->OneHotMap
+     {:one-hot-table one-hot-map
+      :src-column src-name
+      :result-datatype result-datatype})))
+
+
+(defn transform-one-hot
+  "Apply a one-hot transformation to a dataset"
+  [dataset one-hot-fit-data]
+  (let [{:keys [one-hot-table src-column result-datatype]}
+        one-hot-fit-data
+        column (ds-base/column dataset src-column)
+        missing (ds-proto/missing column)
+        dataset (dissoc dataset src-column)
+        n-elems (dtype/ecount column)
+        op-space (casting/simple-operation-space (dtype-proto/operational-elemwise-datatype column))]
+    (merge dataset
+           (->> one-hot-table
+                (lznc/map
+                 (fn [[k v]]
+                   (col-impl/new-column
+                    v
+                    (case op-space
+                      :int64
+                      (let [buf (dtype/->reader column :int64)
+                            k (long k)]
+                        (reify tech.v3.datatype.LongBuffer
+                          (elemwiseDatatype [this] :int8)
+                          (lsize [this] n-elems)
+                          (readLong [this idx]
+                            (if (== k (.readLong buf idx))
+                              1 0))))
+                      :float64
+                      (let [buf (dtype/->reader column :float64)
+                            k (double k)]
+                        (reify tech.v3.datatype.LongBuffer
+                          (elemwiseDatatype [this] :int8)
+                          (lsize [this] n-elems)
+                          (readLong [this idx]
+                            (if (== k (.readDouble buf idx))
+                              1 0))))
+                      (dtype/emap
+                       #(if (= % k)
+                          1
+                          0)
+                       :int8
+                       column))
+                    (assoc (meta column)
+                           :one-hot-map one-hot-fit-data)
+                    missing)))
+                (ds-impl/new-dataset)))))
+
+
+(extend-type OneHotMap
+  ds-proto/PDatasetTransform
+  (transform [t dataset]
+    (transform-one-hot dataset t)))
+
+
+(defn ^:no-doc dataset->one-hot-maps
+  "Given a dataset, return a sequence of applied on-hot transformations."
+  [dataset]
+  (->> (vals dataset)
+       (map (comp :one-hot-map meta))
+       (remove nil?)
+       (distinct)))
+
+
+(defn invert-one-hot-map
+  "Invert a one-hot transformation removing the one-hot columns and adding back the
+  original column."
+  [dataset {:keys [one-hot-table src-column] :as opts}]
+  (let [cast-fn (get @casting/*cast-table* :boolean)
+        invert-map (set/map-invert one-hot-table)
+        colnames (vec (keys invert-map))
+        one-hot-ds (ds-base/select-columns dataset colnames)
+        rev-mapped-cols (->> invert-map
+                             (map (fn [[colname colval]]
+                                    (dtype/emap #(if (cast-fn %)
+                                                   colval
+                                                   nil)
+                                                :object
+                                                (ds-base/column one-hot-ds colname)))))
+        dataset (apply dissoc dataset colnames)
+        missing (bitmap/reduce-union (map ds-proto/missing (vals one-hot-ds)))
+        res-dtype (reduce casting/widest-datatype
+                          (map dtype/datatype (keys one-hot-table)))]
+    (assoc dataset
+           src-column
+           (col-impl/new-column
+            src-column
+            (apply dtype/emap (fn [& colvals]
+                                (first (remove nil? colvals)))
+                   res-dtype
+                   rev-mapped-cols)
+            (-> (meta (first (vals one-hot-ds)))
+                (dissoc :one-hot-map)
+                (assoc :categorical? true))
+            missing))))
+
+(defn reverse-map-categorical-xforms
+  "Given a dataset where we have converted columns from a categorical representation
+  to either a numeric reprsentation or a one-hot representation, reverse map
+  back to the original dataset given the reverse mapping of label->number in
+  the column's metadata."
+  [dataset]
+  (->> (concat (map vector
+                    (dataset->categorical-maps dataset)
+                    (repeat invert-categorical-map))
+               (map vector
+                    (dataset->one-hot-maps dataset)
+                    (repeat invert-one-hot-map)))
+       (reduce (fn [dataset [cat-map invert-fn]]
+                 (invert-fn dataset cat-map))
+               dataset)))

tech.ml.dataset/src/tech/v3/dataset/clipboard.clj

@@ -0,0 +1,56 @@
+(ns tech.v3.dataset.clipboard
+  "Optional namespace that copies a dataset to the clipboard for pasting into
+  applications such as excel or google sheets.
+
+  Reading defaults to 'csv' format while writing defaults to 'tsv' format."
+  (:require [tech.v3.dataset :as ds]
+            [tech.v3.datatype.errors :as errors])
+  (:import [java.io ByteArrayInputStream ByteArrayOutputStream]
+           [java.awt.datatransfer Clipboard DataFlavor StringSelection]
+           [java.nio.charset StandardCharsets]
+           [java.awt Toolkit]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn clipboard
+  "Get the system clipboard."
+  ^Clipboard []
+  (.getSystemClipboard (Toolkit/getDefaultToolkit)))
+
+
+(defn clipboard->dataset
+  "Copy from the clipboard to a dataset.  Options are passed into ->dataset,
+  and `:file-type` is defaulted to `:csv`."
+  [& [{:keys [file-type]
+       :or {file-type :csv}
+       :as options}]]
+  (try
+    (-> (.getTransferData (.getContents (clipboard) nil)
+                          (DataFlavor/stringFlavor))
+        (str)
+        (.getBytes  StandardCharsets/UTF_8)
+        (ByteArrayInputStream.)
+        (ds/->dataset (assoc options :file-type file-type)))
+    (catch Exception e
+      (errors/throwf "Failed to copy dataset from the clipboard,
+This can happen with headless JDK installations:
+%s" e))))
+
+
+(defn dataset->clipboard
+  "Copy a dataset to the clipboard.  File type is defaulted to 'tsv' as this appears
+  to have  wider compatibility across various spreadsheet toolkits."
+  [x & [{:keys [file-type]
+         :or {file-type :tsv}}]]
+  (try
+    (let [os (ByteArrayOutputStream.)
+          _ (ds/write! x os {:file-type file-type})
+          selection (StringSelection. (String. (.toByteArray os)
+                                               StandardCharsets/UTF_8))]
+      (.setContents (clipboard) selection selection))
+    (catch Exception e
+      (errors/throwf "Failed to copy dataset to the clipboard,
+This can happen with headless JDK installations:
+%s" e))))

tech.ml.dataset/src/tech/v3/dataset/column.clj

@@ -0,0 +1,248 @@
+(ns tech.v3.dataset.column
+  (:require [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.impl.column :as col-impl]
+            [tech.v3.dataset.impl.column-base :as col-base]
+            [tech.v3.dataset.string-table :as str-table]
+            [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.datatype.statistics :as stats]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.argtypes :as argtypes]
+            [tech.v3.datatype.protocols :as dt-proto]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [ham-fisted.set :as set]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.lazy-noncaching :as lznc])
+  (:import [tech.v3.dataset.impl.column Column]
+           [org.roaringbitmap RoaringBitmap]
+           [tech.v3.datatype Buffer LongReader DoubleReader ObjectReader]
+           [clojure.lang IFn$LL IFn$LLL IFn$LLLL
+            IFn$DD IFn$DDD IFn$DDDD]))
+
+
+(declare new-column)
+
+
+(defn is-column?
+  "Return true if this item is a column."
+  [item]
+  (when item
+    (ds-proto/is-column? item)))
+
+
+(defn column-name
+  [col]
+  (ds-proto/column-name col))
+
+
+(defn set-name
+  "Return a new column."
+  [col name]
+  (ds-proto/set-name col name))
+
+
+(defn supported-stats
+  "List of available stats for the column"
+  [col]
+  stats/all-descriptive-stats-names)
+
+
+(defn missing
+  "Indexes of missing values.  Both iterable and reader."
+  ^RoaringBitmap [col]
+  (ds-proto/missing col))
+
+
+(defn is-missing?
+  "Return true if this index is missing."
+  [col ^long idx]
+  (when-let [^RoaringBitmap bmp (missing col)]
+    (.contains bmp idx)))
+
+
+(defn set-missing
+  "Set the missing indexes for a column.  This doesn't change any values in the
+  underlying data store."
+  [col idx-seq]
+
+  (Column. (-> (when idx-seq
+                 (case (argtypes/arg-type idx-seq)
+                   :scalar [idx-seq]
+                   :iterable (hamf/take (dtype/ecount col) idx-seq)
+                   idx-seq))
+               (bitmap/->bitmap)
+               (set/intersection (bitmap/->bitmap 0 (dtype/ecount col))))
+           (ds-proto/column-buffer col) (meta col) nil))
+
+
+(defn unique
+  "Set of all unique values"
+  [col]
+  (set/unique col))
+
+
+(defn stats
+  "Return a map of stats.  Stats set is a set of the desired stats in keyword
+form.  Guaranteed support across implementations for :mean :variance :median :skew.
+Implementations should check their metadata before doing calculations."
+  [col stats-set]
+  (stats/descriptive-statistics col stats-set))
+
+
+(defn correlation
+  "Correlation coefficient for given 2 columns.  Available correlation types
+  are:
+  :pearson
+  :spearman
+  :kendall
+
+  Returns floating point number between [-1 1]"
+  [lhs rhs correlation-type]
+  (case correlation-type
+    :pearson (stats/pearsons-correlation lhs rhs)
+    :spearman (stats/spearmans-correlation lhs rhs)
+    :kendall (stats/kendalls-correlation lhs rhs)))
+
+
+(defn select
+  "Return a new column with the subset of indexes based on the provided `selection`.
+  `selection` can be a list of indexes to select or boolean values where the index
+  position of each true element indicates a index to select. When supplying a list
+  of indices, duplicates are possible and will select the specified position more
+  than once."
+  [col selection]
+  (ds-proto/select-rows col selection))
+
+(defn clone
+  "Clone this column not changing anything."
+  [col]
+  (dtype/clone col))
+
+
+(defn string-table-keyset
+  "Get the string table for this column.  Returns nil if this isn't a string column.
+  This doesn't necessarily tell you the unique set of the column unless you have just
+  parsed a file.  It is, when non-nil, a strict superset of the strings in the
+  columns."
+  [col]
+  (when (and (= :string (dtype/get-datatype col))
+             (instance? Column col))
+    (try
+      (->> (str-table/get-str-table (.data ^Column col))
+           :str->int
+           (keys)
+           (set))
+      (catch Throwable _e
+        nil))))
+
+;; TODO - match inference expectations
+(defn parse-column
+  "parse a text or a str column, returning a new column with the same name but with
+  a different datatype.  This method is single-threaded.
+
+  parser-fn-or-kwd is nil by default and can the keyword :relaxed?  or a function that
+  must return one of parsed-value, :tech.v3.dataset/missing in which case a
+  missing value will be added or :tech.v3.dataset/parse-failure in which case the
+  a missing index will be added and the string value will be recorded in the metadata's
+  :unparsed-data, :unparsed-indexes entries.
+
+  Options:
+
+  Same options roughly as ->dataset, specifically of interest may be `:text-temp-file`.
+  "
+  ([datatype col options]
+   (let [colname (column-name col)
+         col-reader (dtype/emap #(when % (str %)) :string col)
+         col-parser (column-parsers/make-fixed-parser colname datatype options)
+         n-elems (dtype/ecount col-reader)]
+     (dotimes [iter n-elems]
+       (column-parsers/add-value! col-parser iter (col-reader iter)))
+     (new-column (assoc (column-parsers/finalize! col-parser n-elems)
+                        :tech.v3.dataset/name colname))))
+  ([datatype col]
+   (parse-column datatype col nil)))
+
+
+(defn new-column
+  "Create a new column.  Data will scanned for missing values
+  unless the full 4-argument pathway is used."
+  ([name data]
+   (col-impl/new-column name data))
+  ([name data metadata]
+   (col-impl/new-column name data metadata))
+  ([name data metadata missing]
+   (col-impl/new-column name data metadata missing))
+  ([data-or-data-map]
+   (col-impl/new-column data-or-data-map)))
+
+
+(defn extend-column-with-empty
+  [column n-empty]
+  (col-impl/extend-column-with-empty column n-empty))
+
+
+(defn prepend-column-with-empty
+  [column n-empty]
+  (col-impl/prepend-column-with-empty column n-empty))
+
+
+(defn to-double-array
+  "Convert to a java primitive array of a given datatype.  For strings,
+  an implicit string->double mapping is expected.  For booleans, true=1 false=0.
+  Finally, any missing values should be indicated by a NaN of the expected type."
+  ^doubles [col & [error-on-missing?]]
+  (when (and error-on-missing? (not (== 0 (dtype/ecount (ds-proto/missing col)))))
+    (throw (RuntimeException. (str "Missing value detected on column: "
+                                   (ds-proto/column-name col)))))
+  (hamf/double-array (dtype/->reader col :float64)))
+
+
+(defn column-map
+  "Map a scalar function across one or more columns.
+  This is the semi-missing-set aware version of tech.v3.datatype/emap.  This function
+  is never lazy.
+
+  If res-dtype is nil then the result is scanned to infer datatype and
+  missing set.  res-dtype may also be a map of options:
+
+  Options:
+
+  * `:datatype` - Set the dataype of the result column.  If not given result is scanned
+  to infer result datatype and missing set.
+  * `:missing-fn` - if given, columns are first passed to missing-fn as a sequence and
+  this dictates the missing set.  Else the missing set is by scanning the results
+  during the inference process.  See `tech.v3.dataset.column/union-missing-sets` and
+  `tech.v3.dataset.column/intersect-missing-sets` for example functions to pass in
+  here."
+  [map-fn res-dtype & args]
+  (let [res-opt-map (if (keyword? res-dtype)
+                      {:datatype res-dtype}
+                      (or res-dtype {}))
+        ;;object readers get scanned to infer datatype
+        res-dtype (res-opt-map :datatype)
+        missing-fn (res-opt-map :missing-fn)
+        ^RoaringBitmap missing (when missing-fn
+                                 (bitmap/->bitmap (missing-fn args)))
+        ^Buffer data (apply dtype/emap map-fn res-dtype args)
+        data (if (or (nil? missing) (.isEmpty missing))
+               ;;data will be scanned by the dataset to ascertain datatype and/or missing
+               (dtype/clone data)
+               (-> (col-impl/make-column-buffer missing data res-dtype res-dtype)
+                   (dtype/clone)))]
+    (col-impl/new-column
+     #:tech.v3.dataset{:name :_unnamed
+                       :data data
+                       :force-datatype (boolean missing)
+                       :missing missing})))
+
+
+(defn union-missing-sets
+  "Union the missing sets of the columns returning a roaring bitmap"
+  [col-seq]
+  (apply set/reduce-union (lznc/map ds-proto/missing col-seq)))
+
+
+(defn intersect-missing-sets
+  "Intersect the missing sets of the columns returning a roaring bitmap"
+  [col-seq]
+  (apply set/reduce-intersection (lznc/map ds-proto/missing col-seq)))

tech.ml.dataset/src/tech/v3/dataset/column_filters.clj

@@ -0,0 +1,149 @@
+(ns tech.v3.dataset.column-filters
+  "Queries to select column subsets that have various properites such as all numeric
+  columns, all feature columns, or columns that have a specific datatype.
+
+  Further a few set operations (union, intersection, difference) are provided
+  to further manipulate subsets of columns.
+
+  All functions are transformations from dataset to dataset.
+
+  The functions in this namespace use the metadata on the columns of the dataset, wich can be inspected  via `clojure.core/meta`"
+  (:require [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.column :as ds-col])
+  (:refer-clojure :exclude [boolean update]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn column-filter
+  "Return a dataset with only the columns for which the filter function returns a truthy
+  value."
+  [dataset filter-fn]
+  (->> (ds-base/columns dataset)
+       (filter filter-fn)
+       (map (comp :name meta))
+       (ds-base/select-columns dataset)
+       (ds-base/check-empty)))
+
+
+(defn metadata-filter
+    "Return a dataset with only the columns for which, given the column metadata,
+  the filter function returns a truthy value."
+  [dataset filter-fn]
+  (->> (map meta (ds-base/columns dataset))
+       (filter filter-fn)
+       (map :name)
+       (ds-base/select-columns dataset)
+       (ds-base/check-empty)))
+
+
+(defn categorical
+  "Return a dataset containing only the categorical columns."
+  [dataset]
+  (metadata-filter dataset :categorical?))
+
+
+(defn numeric
+  "Return a dataset containing only the numeric columns."
+  [dataset]
+  (metadata-filter dataset (comp casting/numeric-type?
+                                 packing/unpack-datatype
+                                 :datatype)))
+
+(defn of-datatype
+  "Return a dataset containing only the columns of a specific datatype."
+  [dataset datatype]
+  (metadata-filter dataset #(= datatype (:datatype %))))
+
+
+(defn boolean
+  "Return a dataset containing only the boolean columns."
+  [dataset]
+  (of-datatype dataset :boolean))
+
+
+(defn string
+  "Return a dataset containing only the string columns."
+  [dataset]
+  (of-datatype dataset :string))
+
+
+(defn target
+  "Return a dataset containing only the columns that have been marked as inference
+  targets."
+  [dataset]
+  (metadata-filter dataset :inference-target?))
+
+
+(defn probability-distribution
+  "Return the columns of the dataset that comprise the probability distribution
+  after classification."
+  [dataset]
+  (metadata-filter dataset #(= :probability-distribution (:column-type %))))
+
+
+(defn prediction
+  "Return the columns of the dataset marked as predictions."
+  [dataset]
+  (metadata-filter dataset #(= :prediction (:column-type %))))
+
+
+(defn feature
+  "Return a dataset container only the columns which have not been marked as inference
+  columns."
+  [dataset]
+  (metadata-filter dataset (complement :inference-target?)))
+
+
+(defn missing
+  "Return a dataset with only columns have have missing values"
+  [dataset]
+  (column-filter dataset #(not (.isEmpty (ds-col/missing %)))))
+
+
+(defn no-missing
+  "Return a dataset with only columns that have no missing values."
+  [dataset]
+  (column-filter dataset #(.isEmpty (ds-col/missing %))))
+
+
+(defn datetime
+  "Return a dataset containing only the datetime columns."
+  [dataset]
+  (metadata-filter dataset (comp  dtype-dt/datetime-datatype? :datatype)))
+
+
+(defn intersection
+  "Return only columns for rhs for which an equivalently named column exists in lhs."
+  [lhs-ds rhs-ds]
+  (if (or (nil? lhs-ds)
+          (nil? rhs-ds))
+    nil
+    (let [lhs-names (set (map (comp :name meta) (ds-base/columns lhs-ds)))]
+      (metadata-filter rhs-ds (comp lhs-names :name)))))
+
+
+(defn union
+  "Return all columns of lhs along with any columns in rhs which have names that
+  do not exist in lhs."
+  [lhs-ds rhs-ds]
+  (let [lhs-names (set (map (comp :name meta) (ds-base/columns lhs-ds)))]
+    (reduce (fn [lhs-ds rhs-col]
+              (if (lhs-names (:name (meta rhs-col)))
+                lhs-ds
+                (ds-base/add-column lhs-ds rhs-col)))
+            lhs-ds
+            (ds-base/columns rhs-ds))))
+
+
+(defn difference
+  "Return the columns in lhs which do not have an equivalently named column in
+  rhs."
+  ([lhs-ds rhs-ds]
+   (apply dissoc lhs-ds (map (comp :name meta) (ds-base/columns rhs-ds))))
+  ([lhs-ds]
+   lhs-ds))

tech.ml.dataset/src/tech/v3/dataset/dynamic_int_list.clj

@@ -0,0 +1,131 @@
+(ns tech.v3.dataset.dynamic-int-list
+  "An int-list implementation that resizes its backing store as it is required to hold
+  wider data."
+  (:require [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.base :as dtype-base]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.array-buffer :as abuf]
+            [tech.v3.datatype.list :as dtype-list]
+            [tech.v3.parallel.for :as parallel-for]
+            [clj-commons.primitive-math :as pmath])
+  (:import [tech.v3.datatype LongBuffer]
+           [ham_fisted IMutList Casts]))
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(defmacro ^:private byte-range?
+  [number]
+  `(and (<= ~number Byte/MAX_VALUE)
+        (>= ~number Byte/MIN_VALUE)))
+
+
+(defmacro ^:private short-range?
+  [number]
+  `(and (<= ~number Short/MAX_VALUE)
+        (>= ~number Short/MIN_VALUE)))
+
+
+(deftype DynamicIntList [^:unsynchronized-mutable ^IMutList backing-store
+                         ^:unsynchronized-mutable ^long int-width]
+  dtype-proto/PClone
+  (clone [_item] (dtype-proto/clone backing-store))
+  dtype-proto/PToArrayBuffer
+  (convertible-to-array-buffer? [_item]
+    (dtype-proto/convertible-to-array-buffer? backing-store))
+  (->array-buffer [_item]
+    (dtype-proto/->array-buffer backing-store))
+  dtype-proto/PToNativeBuffer
+  (convertible-to-native-buffer? [_item]
+    (dtype-proto/convertible-to-native-buffer? backing-store))
+  (->native-buffer [_item]
+    (dtype-proto/->native-buffer backing-store))
+  LongBuffer
+  (elemwiseDatatype [_this] (dtype-proto/elemwise-datatype backing-store))
+  (clear [this]
+    (set! backing-store (abuf/as-growable-list (dtype/make-list :int8 1500) 0))
+    (set! int-width 8))
+  (lsize [_this] (.size backing-store))
+  (size [_this] (.size backing-store))
+  (subBuffer [this sidx eidx]
+    (dtype/->buffer (.subList backing-store sidx eidx)))
+  (cloneList [this] (DynamicIntList. (.cloneList backing-store) int-width))
+  (addLong [_this value]
+    ;;perform container conversion
+    (cond
+      (byte-range? value)
+      nil
+      (short-range? value)
+      (when (pmath/< int-width 16)
+        (set! backing-store (dtype/make-list :int16 backing-store))
+        (set! int-width 16))
+
+      (pmath/< int-width 32)
+      (do
+        (set! backing-store (dtype/make-list :int32 backing-store))
+        (set! int-width 32)))
+    (.addLong backing-store value))
+  (add [this idx ct value]
+    (when-not (== idx (.size this))
+      (throw (RuntimeException. "Insertion other than at end is not supported.")))
+    (let [lv (Casts/longCast value)]
+      (dotimes [c ct]
+        (.addLong this lv))))
+  (getLong [_this idx]
+    (.getLong backing-store idx))
+  (readLong [_this idx]
+    (.getLong backing-store idx))
+  ;;Writing is serialized.
+  (writeLong [this idx value]
+    (locking this
+      (cond
+        (byte-range? value)
+        nil
+        (short-range? value)
+        (when (pmath/< int-width 16)
+          (set! backing-store (dtype/make-list :int16 backing-store))
+          (set! int-width 16))
+
+        (< int-width 32)
+        (do
+          (set! backing-store (dtype/make-list :int32 backing-store))
+          (set! int-width 32)))
+      (.setLong backing-store idx value)))
+  (reduce [this rfn init]
+    (.reduce backing-store rfn init)))
+
+
+(defn dynamic-int-list
+  "Create a dynamic int list from a sequence of numbers or from a
+  single integer n-elems argument."
+  (^IMutList [num-or-item-seq]
+   (if (number? num-or-item-seq)
+     (DynamicIntList. (dtype/make-list :int8 (long num-or-item-seq))
+                      8)
+     (let [retval (DynamicIntList. (dtype/make-list :int8 0)
+                                   8)]
+       (.addAllReducible retval num-or-item-seq)
+       retval)))
+  (^IMutList [] (dynamic-int-list 0)))
+
+
+(defn make-from-container
+  "Make a dynamic int list from something convertible to a byte, short,
+  or integer list.  Shares backing data."
+  ^IMutList [container]
+  (let [container-datatype (dtype/elemwise-datatype container)]
+    (errors/when-not-errorf
+     (and (casting/integer-type? container-datatype)
+          (<= (casting/int-width container-datatype) 32))
+     "Container datatype must be integer and 32 bits or less: %s"
+     container-datatype)
+    (errors/when-not-errorf
+     (dtype-base/as-buffer container)
+     "Container must be convertible to either an array buffer or native buffer: %s"
+     (type container))
+    (let [list-data (dtype-base/as-buffer container)]
+      (DynamicIntList. (abuf/as-growable-list container (dtype/ecount container))
+                       (casting/int-width container-datatype)))))

tech.ml.dataset/src/tech/v3/dataset/file_backed_text.clj

@@ -0,0 +1,123 @@
+(ns tech.v3.dataset.file-backed-text
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.mmap-writer :as mmap-writer]
+            [tech.v3.datatype.protocols :as dtype-proto])
+  (:import [java.nio.charset Charset]
+           [ham_fisted IMutList ChunkedList]
+           [tech.v3.datatype DataWriter Buffer]
+           [tech.v3.dataset Text]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* true)
+
+
+(defn- read-text-object
+  [^IMutList offsets ^Buffer byte-io ^Charset encoding ^long idx]
+    (let [start-offset (.getLong offsets idx)
+          end-offset (if (== idx (unchecked-dec (.size offsets)))
+                       (.lsize byte-io)
+                       (.getLong offsets (unchecked-inc idx)))
+          byte-data (-> (dtype/sub-buffer byte-io
+                                          start-offset
+                                          (- end-offset start-offset))
+                        (dtype/->byte-array))
+          str-data (String. byte-data encoding)]
+      (Text. str-data)))
+
+
+(defn- reduce-text-builder
+  [^IMutList offsets ^Buffer byte-io ^Charset encoding
+   rfn acc sidx eidx]
+  (let [sidx (long sidx)
+        eidx (long eidx)]
+    (loop [sidx sidx
+           acc acc]
+      (if (and (< sidx eidx) (not (reduced? acc)))
+        (recur (unchecked-inc sidx)
+               (rfn acc (read-text-object offsets byte-io encoding sidx)))
+        acc))))
+
+
+(deftype FileBackedTextBuilder [^Charset encoding
+                                ^DataWriter writer
+                                ^IMutList offsets
+                                cached-io]
+  dtype-proto/PClone
+  (clone [this]
+    (->> (dtype/make-container :text (.lsize this))
+         (dtype/copy! this)))
+  Buffer
+  (lsize [_this] (.size offsets))
+  (elemwiseDatatype [_this] :text)
+  (subBuffer [this sidx eidx]
+    (ChunkedList/sublistCheck sidx eidx (.size offsets))
+    (if (and (== 0 sidx) (== eidx (.size offsets)))
+      this
+      (let [^Buffer byte-io (swap! cached-io
+                                   (fn [old-io]
+                                     (if old-io old-io (dtype/->buffer writer))))
+            ^IMutList offsets offsets
+            ^Charset encoding encoding
+            ne (- eidx sidx)]
+        (if (== ne 0)
+          (reify Buffer (elemwiseDatatype [rdr] 0) (lsize [rdr] 0))
+          (reify Buffer
+            (elemwiseDatatype [rdr] :text)
+            (lsize [rdr] ne)
+            (subBuffer [rdr ssidx seidx]
+              (ChunkedList/sublistCheck ssidx seidx ne)
+              (.subBuffer this (+ sidx ssidx) (+ sidx seidx)))
+            (readObject [rdr idx]
+              (read-text-object offsets
+                                byte-io
+                                encoding
+                                (+ sidx idx)))
+            (reduce [rdr rfn init]
+              (reduce-text-builder offsets byte-io encoding rfn init sidx eidx)))))))
+  (add [_this data]
+    (reset! cached-io nil)
+    (let [data (str data)]
+      (if (empty? data)
+        (.addLong offsets (.lsize writer))
+        (let [bytes (.getBytes ^String data encoding)]
+          (.addLong offsets (.lsize writer))
+          (.writeBytes writer bytes))))
+    true)
+  (readObject [_this idx]
+    (read-text-object offsets
+                      (swap! cached-io
+                             (fn [old-io]
+                               (if old-io old-io (dtype/->buffer writer))))
+                      encoding
+                      idx))
+  (reduce [this rfn init]
+    (reduce-text-builder offsets (swap! cached-io
+                                        (fn [old-io]
+                                          (if old-io old-io (dtype/->buffer writer))))
+                         encoding rfn init 0 (.size offsets))))
+
+
+(defn file-backed-text
+  "Create a file-backed text store.  Texts are written to disk but retrievable
+  (as Text objects) when ->reader is called on the return value."
+  (^Buffer [{:keys [mmap-file-path]
+                    :as options}]
+   (let [mmap-writer (if mmap-file-path
+                       (mmap-writer/mmap-writer mmap-file-path options)
+                       (mmap-writer/temp-mmap-writer options))
+         encoding (if-let [encoding (:encoding options)]
+                    (cond
+                      (string? encoding)
+                      (Charset/forName encoding)
+                      (instance? Charset encoding)
+                      encoding
+                      :else
+                      (errors/throwf "Unrecognized encoding: %s" encoding))
+                    (Charset/forName "UTF-8"))
+         offsets (dtype/make-list :int64)
+         cached-io (atom nil)]
+     ;;Force failure here before we get going - not all platforms support mmap.
+     (FileBackedTextBuilder. encoding mmap-writer offsets cached-io)))
+  (^Buffer [] (file-backed-text nil)))

tech.ml.dataset/src/tech/v3/dataset/format_sequence.clj

@@ -0,0 +1,144 @@
+(ns ^:no-doc tech.v3.dataset.format-sequence
+  "This code provided initial by genmeblog after careful consideration
+  of R print code"
+  (:import [java.text DecimalFormat]))
+
+
+;;CN - I removed cl-format as a required dependency so that graal native executables would
+;;both compile faster and be much smaller.
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+;; maximum double power for precise calculations
+(def ^:private ^:const ^long kp-max 22)
+
+;; powers for scientific notation
+(def ^:private tbl [1e-1,
+                    1e00, 1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09,
+                    1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
+                    1e20, 1e21, 1e22])
+
+(defn- left
+  "What is the power of number"
+  ^long [^double x]
+  (-> x Math/log10 Math/floor unchecked-long inc))
+
+(defn- find-nsig
+  "Shift decimal places until non-zero value is found"
+  ^long [^double alpha ^long digits]
+  (loop [a alpha
+         d digits]
+    (let [a- (/ a 10.0)]
+      (if (= a- (Math/floor a-))
+        (recur a- (dec d))
+        (max 1 d)))))
+
+(defn- right
+  "Calculate maximum digits on the right side of the dot."
+  ^long [^double x ^long digits]
+  (let [alpha (Math/round (* x ^double (tbl (inc digits))))]
+    (if (zero? alpha)
+      1
+      (find-nsig alpha digits))))
+
+(defn- fix-left
+  "Fix number of digits on the left side. For scientific notations and non-positive exponent (lft) it should be leading digits + sign."
+  [^double x ^long lft e?]
+  (let [sgn (if (neg? x) 1 0)]
+    (if (or e? (not (pos? lft)))
+      (+ sgn 1)
+      (+ sgn lft))))
+
+(defn- precision
+  [^double x ^long digits ^long threshold]
+  (if (zero? x)
+    [false 0 1 1] ;; zero is reprezented as 0.0
+    (let [digits (max 1 (min 10 digits)) ;; constrain digits to 1-10 range
+          r (Math/abs x)
+          lft (left r) ;; digits on the left side of dot
+          alft (Math/abs lft)
+          e? (>= alft threshold)
+          r-prec (cond
+                   (< alft threshold) r ;; normal number
+                   (< alft kp-max) (if (neg? lft) ;; scientific number (using table to shift values)
+                                     (* r ^double (tbl (inc (- lft))))
+                                     (/ r ^double (tbl (inc lft))))
+                   :else (/ r (Math/pow 10.0 (dec lft)))) ;; very big or very small case
+          rght (right r-prec digits) ;; desired precision on the right side
+          exp (if (> alft 100) 3 2) ;; size of the exponent
+          lft (fix-left x lft e?)]
+      [e? exp lft rght])))
+
+
+(defn- fit-precision
+  "Find best matching presision for given sequence."
+  [xs ^long digits ^long threshold]
+  (reduce (fn [[ce? ^long cexp ^long clft ^long crght ^long non-finite-len] x]
+            (let [^double x (if (instance? Float x)
+                              (Double/valueOf (str x))
+                              (or x ##NaN))]
+              (if (Double/isFinite x)
+                (let [[e? ^long exp ^long lft ^long rght] (precision x digits threshold)]
+                  (if (and e? (pos? threshold))
+                    (reduced (fit-precision xs digits 0)) ;; switch to scientific notation
+                    [(or e? ce?)
+                     (max exp cexp)
+                     (max lft clft)
+                     (max rght crght)
+                     non-finite-len]))
+                [ce? cexp clft crght (max non-finite-len (if (= x ##-Inf) 4 3))])))
+          [false Integer/MIN_VALUE Integer/MIN_VALUE Integer/MIN_VALUE 0] xs))
+
+;; public functions
+
+(defn formatter
+  "Create formatter for given:
+  * `xs` - sequence of doubles
+  * `digits` - maximum precision
+  * `threshold` - what is absolute power to switch to scientific notation
+  Returns formatter."
+  ([xs] (formatter xs 8))
+  ([xs ^long digits] (formatter xs digits 8))
+  ([xs ^long digits ^long threshold]
+   (let [[e? ^long exp ^long lft ^long rght ^long non-finite-len] (fit-precision xs digits threshold)
+         w (max non-finite-len (if e?
+                                 (+ lft rght exp 3) ;; 3 = "." + sign of E + "E"
+                                 (+ lft rght 1))) ;; 1 for "."
+
+         deci-format-str (apply str (concat ["0."]
+                                            (repeat rght "0")
+                                            (when e?
+                                              ["E"])
+                                            (when e?
+                                              (repeat exp "0"))))
+         deci-format (DecimalFormat. deci-format-str)
+         non-finite-format (str "%" w "s")]
+     (fn [x]
+       (let [^double x (or x ##NaN)
+             finite? (Double/isFinite x)
+             ^String unspaced (if (Double/isFinite x)
+                                (.format deci-format x)
+                                (cond
+                                  (== ##Inf x) "Inf"
+                                  (== ##-Inf x) "-Inf"
+                                  :else "NaN"))]
+         (String/format non-finite-format
+                        (object-array [(if (and e? finite?
+                                                (== -1 (.lastIndexOf unspaced "E-")))
+                                           ;;Insert the + sign
+                                         (.replace unspaced "E" "E+")
+                                         unspaced)])))))))
+
+(defn format-sequence
+  "Format sequence of double for given:
+  * `xs` - sequence of doubles
+  * `digits` - maximum precision
+  * `threshold` - what is absolute power to switch to scientific notation
+  Returns sequence of strings."
+  ([xs] (format-sequence xs 8))
+  ([xs ^long digits] (format-sequence xs digits 8))
+  ([xs ^long digits ^long threshold]
+   (let [fmt (formatter xs digits threshold)]
+     (map fmt xs))))

tech.ml.dataset/src/tech/v3/dataset/impl/column.clj

@@ -0,0 +1,549 @@
+(ns ^:no-doc tech.v3.dataset.impl.column
+  (:require [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.unary-pred :as un-pred]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.functional :as dfn]
+            [tech.v3.datatype.statistics :as stats]
+            [tech.v3.datatype.pprint :as dtype-pp]
+            [tech.v3.datatype.bitmap :refer [->bitmap] :as bitmap]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.argops :as argops]
+            [tech.v3.tensor :as dtt]
+            [tech.v3.dataset.impl.column-base :as column-base]
+            [tech.v3.dataset.impl.column-data-process :as column-data-process]
+            [ham-fisted.lazy-noncaching :as lznc]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.set :as set]
+            [ham-fisted.protocols :as hamf-proto])
+  (:import [java.util Arrays]
+           [ham_fisted Reductions Casts ChunkedList IMutList]
+           [org.roaringbitmap RoaringBitmap]
+           [clojure.lang IPersistentMap Counted IFn IObj Indexed ILookup IFn$OLO IFn$ODO Named]
+           [tech.v3.datatype Buffer LongBuffer]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(declare new-column construct-column)
+
+
+(defn ->persistent-map
+  ^IPersistentMap [item]
+  (if (instance? IPersistentMap item)
+    item
+    (into {} item)))
+
+
+(defn- reduce-column-buffer
+  [rfn acc src missing primitive-missing-value sidx eidx]
+  (let [sidx (long sidx)
+        eidx (long eidx)
+        ^RoaringBitmap missing missing
+        ^Buffer src (dtype-proto/->buffer src)
+        int-iter (.getIntIterator ^RoaringBitmap
+                                  (if (and (== 0 sidx) (== (.lsize src) eidx))
+                                    missing
+                                    (RoaringBitmap/and missing (bitmap/->bitmap sidx eidx))))
+        ^java.util.function.LongBinaryOperator next-missing
+        (hamf-fn/long-binary-operator
+         sidx next-missing-idx
+         (if (== sidx next-missing-idx)
+           (long (if (.hasNext int-iter) (Integer/toUnsignedLong (.next int-iter)) -1))
+           next-missing-idx))
+        missing-idx (.applyAsLong next-missing 0 0)]
+    (cond
+      (instance? IFn$OLO rfn)
+      (let [primitive-missing-value (Casts/longCast primitive-missing-value)]
+        (loop [sidx sidx
+               acc acc
+               missing-idx missing-idx]
+          (if (< sidx eidx)
+            (let [acc (.invokePrim ^IFn$OLO rfn acc (if (== sidx missing-idx)
+                                                      primitive-missing-value
+                                                      (.readLong src sidx)))]
+              (if (reduced? acc)
+                (deref acc)
+                (recur (unchecked-inc sidx) acc (.applyAsLong next-missing sidx missing-idx))))
+            acc)))
+      (instance? IFn$ODO rfn)
+      (let [primitive-missing-value (Casts/doubleCast primitive-missing-value)]
+        (loop [sidx sidx
+               acc acc
+               missing-idx missing-idx]
+          (if (< sidx eidx)
+            (let [acc (.invokePrim ^IFn$ODO rfn acc (if (== sidx missing-idx)
+                                                      primitive-missing-value
+                                                      (.readDouble src sidx)))]
+              (if (reduced? acc)
+                (deref acc)
+                (recur (unchecked-inc sidx) acc (.applyAsLong next-missing sidx missing-idx))))
+            acc)))
+      :else
+      (loop [sidx sidx
+             acc acc
+             missing-idx missing-idx]
+        (if (< sidx eidx)
+          (let [acc (rfn acc (if (== sidx missing-idx)
+                               nil
+                               (.readObject src sidx)))]
+            (if (reduced? acc)
+              (deref acc)
+              (recur (unchecked-inc sidx) acc (.applyAsLong next-missing sidx missing-idx))))
+          acc)))))
+
+(defn- kv-reduce-column-buffer
+  [rfn acc src missing primitive-missing-value sidx eidx]
+  (let [sidx (long sidx)
+        eidx (long eidx)
+        ^RoaringBitmap missing missing
+        ^Buffer src (dtype-proto/->buffer src)
+        int-iter (.getIntIterator ^RoaringBitmap
+                                  (if (and (== 0 sidx) (== (.lsize src) eidx))
+                                    missing
+                                    (RoaringBitmap/and missing (bitmap/->bitmap sidx eidx))))
+        ^java.util.function.LongBinaryOperator next-missing
+        (hamf-fn/long-binary-operator
+         sidx next-missing-idx
+         (if (== sidx next-missing-idx)
+           (long (if (.hasNext int-iter) (Integer/toUnsignedLong (.next int-iter)) -1))
+           next-missing-idx))
+        missing-idx (.applyAsLong next-missing 0 0)]
+    (loop [sidx sidx
+           acc acc
+           missing-idx missing-idx]
+      (if (< sidx eidx)
+        (let [acc (if (not (== sidx missing-idx))
+                    (rfn acc sidx (.readObject src sidx))
+                    acc)]
+          (if (reduced? acc)
+            (deref acc)
+            (recur (unchecked-inc sidx) acc (.applyAsLong next-missing sidx missing-idx))))
+        acc))))
+
+
+(defn ^:no-doc make-column-buffer
+  (^Buffer [^RoaringBitmap missing data dtype op-dtype]
+   (let [^Buffer src (dtype-proto/->buffer data)
+         missing-value (column-base/datatype->missing-value dtype)
+         primitive-missing-value (column-base/datatype->packed-missing-value dtype)]
+     ;;Sometimes we can utilize a pure passthrough.
+     (if (.isEmpty missing)
+       src
+       (reify
+         dtype-proto/POperationalElemwiseDatatype
+         (operational-elemwise-datatype [this] op-dtype)
+         dtype-proto/PElemwiseReaderCast
+         (elemwise-reader-cast [this new-dtype]
+           (make-column-buffer
+            missing
+            (dtype-proto/elemwise-reader-cast data new-dtype)
+            new-dtype
+            new-dtype))
+         Buffer
+         (elemwiseDatatype [this] dtype)
+         (lsize [this] (.lsize src))
+         (allowsRead [this] (.allowsRead src))
+         (allowsWrite [this] (.allowsWrite src))
+         (subBuffer [this sidx eidx]
+           (ChunkedList/sublistCheck sidx eidx (.lsize src))
+           (cond
+             (and (== sidx 0) (== eidx (.lsize src)))
+             this
+             (not (set/intersects-range? missing sidx eidx))
+             (.subBuffer src sidx eidx)
+             :else
+             (let [ec (- eidx sidx)]
+               (reify Buffer
+                 (elemwiseDatatype [rdr] dtype)
+                 (lsize [rdr] ec)
+                 (subBuffer [rdr ssidx seidx]
+                   (ChunkedList/sublistCheck ssidx seidx ec)
+                   (.subBuffer this (+ sidx ssidx) (+ sidx seidx)))
+                 (readLong [rdr idx] (.readLong this (+ idx sidx)))
+                 (readDouble [rdr idx] (.readDouble this (+ idx sidx)))
+                 (readObject [rdr idx] (.readObject this (+ idx sidx)))
+                 (reduce [this rfn acc]
+                   (reduce-column-buffer rfn acc src missing
+                                         primitive-missing-value sidx eidx))
+                 (kvreduce [this rfn acc]
+                   (kv-reduce-column-buffer rfn acc src missing primitive-missing-value sidx eidx))))))
+         (readLong [this idx]
+           (if (.contains missing idx)
+             (Casts/longCast primitive-missing-value)
+             (.readLong src idx)))
+         (readDouble [this idx]
+           (if (.contains missing idx)
+             Double/NaN
+             (.readDouble src idx)))
+         (readObject [this idx]
+           (when-not (.contains missing idx)
+             (.readObject src idx)))
+         (writeLong [this idx val]
+           (.remove missing (unchecked-int idx))
+           (.writeLong src idx val))
+         (writeDouble [this idx val]
+           (.remove missing (unchecked-int idx))
+           (.writeDouble src idx val))
+         (writeObject [this idx val]
+           (if val
+             (do
+               (.remove missing (unchecked-int idx))
+               (.writeObject src idx val))
+             (.add missing (unchecked-int idx))))
+         (reduce [this rfn acc]
+           (reduce-column-buffer rfn acc src missing primitive-missing-value
+                                 0 (.lsize src)))
+         (kvreduce [this rfn acc]
+           (kv-reduce-column-buffer rfn acc src missing primitive-missing-value
+                                    0 (.lsize src))))))))
+
+
+(defmacro cached-buffer!
+  []
+  `(or ~'buffer
+       (do (set! ~'buffer (make-column-buffer ~'missing ~'data
+                                              (.elemwise-datatype ~'this)
+                                              (.operational-elemwise-datatype ~'this)))
+           ~'buffer)))
+
+
+(defn- neg-access-reader
+  [^long n-elems data]
+  (let [m (meta data)
+        data (dtype/->reader data)]
+    (with-meta
+     (reify LongBuffer
+       (lsize [rdr] (.lsize data))
+       (readLong [rdr idx]
+         (let [v (.readLong data idx)]
+           (if (< v 0)
+             (+ v n-elems)
+             v)))
+       (subBuffer [rdr sidx eidx]
+         (neg-access-reader n-elems (.subBuffer data sidx eidx))))
+      (assoc m :min 0 :max (unchecked-dec n-elems)))))
+
+
+(defn- wrap-negative-access
+  [^long n-elems data]
+  (if (== 0 (dtype/ecount data))
+    data
+    (if (dtype-proto/has-constant-time-min-max? data)
+      (let [minv (long (dtype-proto/constant-time-min data))]
+        (if (>= minv 0)
+          data
+          (neg-access-reader n-elems data)))
+      (neg-access-reader n-elems data))))
+
+
+(defn simplify-row-indexes
+  [^long n-elems selection]
+  (if (:simplified? (meta selection))
+    selection
+    (do
+      (vary-meta
+       (cond
+         (nil? selection) (hamf/range 0)
+         ;;Cannot possibly be negative
+         (and (sequential? selection) (boolean? (first selection)))
+         (un-pred/bool-reader->indexes (dtype/ensure-reader selection))
+         (set/bitset? selection)
+         (set/->integer-random-access selection)
+         (hamf-proto/set? selection)
+         (->> (set/->integer-random-access selection)
+              (wrap-negative-access n-elems))
+         (keyword? selection)
+         (case selection
+           :all (hamf/range n-elems)
+           :lla (hamf/range (dec n-elems) -1 -1))
+         (number? selection)
+         (let [selection (long selection)
+               selection (if (< selection 0)
+                           (+ n-elems selection)
+                           selection)]
+           (with-meta [selection] {:min selection :max selection :scalar? true}))
+         :else
+         ;;Ensure the selection object has metadata
+         (let [minv (long (if (dtype-proto/has-constant-time-min-max? selection)
+                            (long (dtype-proto/constant-time-min selection))
+                            -1))]
+           (if (< (long minv) 0)
+             (->> (hamf-rf/preduce-reducer (un-pred/index-reducer n-elems) selection)
+                  (wrap-negative-access n-elems))
+             ;;if the data indicates it has no negative values
+             (dtype/->reader selection))))
+       assoc :simplified? true))))
+
+
+(deftype Column
+    [^RoaringBitmap missing
+     data
+     ^IPersistentMap metadata
+     ^:unsynchronized-mutable ^Buffer buffer]
+
+  dtype-proto/PToArrayBuffer
+  (convertible-to-array-buffer? [_this]
+    (and (.isEmpty missing)
+         (dtype-proto/convertible-to-array-buffer? data)))
+  (->array-buffer [_this]
+    (dtype-proto/->array-buffer data))
+  dtype-proto/PToNativeBuffer
+  (convertible-to-native-buffer? [_this]
+    (and (.isEmpty missing)
+         (dtype-proto/convertible-to-native-buffer? data)))
+  (->native-buffer [_this]
+    (dtype-proto/->native-buffer data))
+  dtype-proto/PElemwiseDatatype
+  (elemwise-datatype [_this] (dtype-proto/elemwise-datatype data))
+  dtype-proto/POperationalElemwiseDatatype
+  (operational-elemwise-datatype [this]
+    (if (.isEmpty missing)
+      (dtype-proto/elemwise-datatype this)
+      (let [ewise-dt (dtype-proto/elemwise-datatype data)]
+        (cond
+          (packing/packed-datatype? ewise-dt)
+          (packing/unpack-datatype ewise-dt)
+          (casting/numeric-type? ewise-dt)
+          (casting/widest-datatype ewise-dt :float64)
+          (identical? :boolean ewise-dt)
+          :object
+          :else
+          ewise-dt))))
+  dtype-proto/PElemwiseCast
+  (elemwise-cast [_this new-dtype]
+    (let [new-data (dtype-proto/elemwise-cast data new-dtype)]
+      (Column. missing
+               new-data
+               metadata
+               nil)))
+  dtype-proto/PElemwiseReaderCast
+  (elemwise-reader-cast [this new-dtype]
+    (if (= new-dtype (dtype-proto/elemwise-datatype data))
+      (cached-buffer!)
+      (make-column-buffer missing (dtype-proto/elemwise-reader-cast data new-dtype)
+                          new-dtype new-dtype)))
+  dtype-proto/PECount
+  (ecount [this] (dtype-proto/ecount data))
+  dtype-proto/PToBuffer
+  (convertible-to-buffer? [_this] true)
+  (->buffer [this]
+    (cached-buffer!))
+  dtype-proto/PToReader
+  (convertible-to-reader? [_this]
+    (dtype-proto/convertible-to-reader? data))
+  (->reader [this]
+    (dtype-proto/->buffer this))
+  dtype-proto/PToWriter
+  (convertible-to-writer? [_this]
+    (dtype-proto/convertible-to-writer? data))
+  (->writer [this]
+    (dtype-proto/->buffer this))
+  dtype-proto/PSubBuffer
+  (sub-buffer [this offset len]
+    (let [offset (long offset)
+          len (long len)
+          eidx (+ offset len)]
+      (ChunkedList/sublistCheck offset (+ offset len) (dtype/ecount data))
+      (if (and (== offset 0) (== len (dtype/ecount this)))
+        this
+        ;;TODO - use bitmap operations to perform this calculation
+        (let [new-missing (-> (RoaringBitmap/and
+                               missing
+                               (doto (RoaringBitmap.)
+                                 (.add offset (+ offset len))))
+                              (RoaringBitmap/addOffset (- offset)))
+              new-data  (dtype-proto/sub-buffer data offset len)]
+          (Column. new-missing
+                   new-data
+                   metadata
+                   nil)))))
+  dtype-proto/PClone
+  (clone [_col]
+    (let [new-data (if (or (dtype/writer? data)
+                           (= :string (dtype/get-datatype data))
+                           (= :encoded-text (dtype/get-datatype data)))
+                     (dtype/clone data)
+                     ;;It is important that the result of this operation be writeable.
+                     (dtype/make-container :jvm-heap
+                                           (dtype/get-datatype data) data))
+          cloned-missing (dtype/clone missing)]
+      (Column. cloned-missing
+               new-data
+               metadata
+               nil)))
+  ds-proto/PRowCount
+  (row-count [this] (dtype/ecount data))
+  ds-proto/PMissing
+  (missing [this] missing)
+  (num-missing [this] (dtype/ecount missing))
+  (any-missing? [this] (boolean (not (.isEmpty missing))))
+  ds-proto/PValidRows
+  (valid-rows [this] (.xor (->bitmap (hamf/range (dtype/ecount this))) missing))
+  ds-proto/PSelectRows
+  (select-rows [this rowidxs]
+    (let [rowidxs (simplify-row-indexes (dtype/ecount this) rowidxs)
+          new-missing (if (== 0 (set/cardinality missing))
+                        (bitmap/->bitmap)
+                        (argops/argfilter (set/contains-fn missing)
+                                          {:storage-type :bitmap}
+                                          rowidxs))
+          new-data (dtype/indexed-buffer rowidxs data)]
+      (Column. new-missing
+               new-data
+               metadata
+               nil)))
+  ds-proto/PColumn
+  (is-column? [_this] true)
+  (column-buffer [_this] data)
+  (empty-column? [this] (== (dtype/ecount this) (dtype/ecount missing)))
+  (column-data [_this] data)
+  (with-column-data [this new-data] (construct-column missing new-data metadata))
+  ds-proto/PColumnName
+  (column-name [this] (get metadata :name))
+  IMutList
+  (size [this] (.size (cached-buffer!)))
+  (get [this idx] (.get (cached-buffer!) idx))
+  (set [this idx v] (.set (cached-buffer!) idx v))
+  (getLong [this idx] (.getLong (cached-buffer!) idx))
+  (setLong [this idx v] (.setLong (cached-buffer!) idx v))
+  (getDouble [this idx] (.getDouble (cached-buffer!) idx))
+  (setDouble [this idx v] (.setDouble (cached-buffer!) idx v))
+  (valAt [this idx] (.valAt (cached-buffer!) idx))
+  (valAt [this idx def-val] (.valAt (cached-buffer!) idx def-val))
+  (invoke [this idx] (.invoke (cached-buffer!) idx))
+  (invoke [this idx def-val] (.invoke (cached-buffer!) idx def-val))
+  (meta [this] (assoc metadata
+                      :datatype (dtype-proto/elemwise-datatype this)
+                      :n-elems (dtype-proto/ecount this)))
+  (withMeta [_this new-meta] (Column. missing
+                                     data
+                                     new-meta
+                                     buffer))
+  (nth [this idx] (nth (cached-buffer!) idx))
+  (nth [this idx def-val] (nth (cached-buffer!) idx def-val))
+  ;;should be the same as using hash-unorded-coll, effectively.
+  (hasheq [this]   (.hasheq (cached-buffer!)))
+  (equiv [this o] (if (identical? this o) true (.equiv (cached-buffer!) o)))
+  (empty [this]
+    (Column. (->bitmap)
+             (column-base/make-container (dtype-proto/elemwise-datatype this) 0)
+             {}
+             nil))
+  (reduce [this rfn init] (.reduce (cached-buffer!) rfn init))
+  (kvreduce [this rfn init] (.kvreduce (cached-buffer!) rfn init))
+  (parallelReduction [this init-val-fn rfn merge-fn options]
+    (.parallelReduction (cached-buffer!) init-val-fn rfn merge-fn options))
+  Object
+  (toString [item]
+    (let [n-elems (dtype/ecount data)
+          format-str (if (> n-elems 20)
+                       "#tech.v3.dataset.column<%s>%s\n%s\n[%s...]"
+                       "#tech.v3.dataset.column<%s>%s\n%s\n[%s]")]
+      (format format-str
+              (name (dtype/elemwise-datatype item))
+              [n-elems]
+              (ds-proto/column-name item)
+              (-> (dtype-proto/sub-buffer item 0 (min 20 n-elems))
+                  (dtype-pp/print-reader-data)))))
+
+  ;;Delegates to ListPersistentVector, which caches results for us.
+  (hashCode [this] (.hasheq (cached-buffer!)))
+  (equals [this o] (.equiv this o)))
+
+
+(dtype-pp/implement-tostring-print Column)
+
+
+(defn construct-column
+  "Low level column construction.  No analysis is done of the data to detect
+  datatype or missing values - the onus is on you.  The column name should
+  be provided as the `:name` member of the metadata.  Data must have a
+  conversion to a buffer - [tech.v3.datatype.protocols/PToBuffer](https://github.com/cnuernber/dtype-next/blob/master/src/tech/v3/datatype/protocols.clj#L131)."
+  ^Column [missing data metadata]
+  (Column. (bitmap/->bitmap missing) data metadata nil))
+
+
+(defn new-column
+  "Given a map of (something convertible to a long reader) missing indexes,
+  (something convertible to a reader) data
+  and a (string or keyword) name, return an implementation of enough of the
+  column and datatype protocols to allow efficient columnwise operations of
+  the rest of tech.ml.dataset"
+  ([name data metadata missing]
+   (new-column #:tech.v3.dataset{:name name
+                                 :data data
+                                 :metadata metadata
+                                 :missing missing}))
+  ([name data metadata]
+   (new-column name data metadata nil))
+  ([name data]
+   (new-column name data {} nil))
+  ([data-or-column-data-map]
+   (let [coldata (column-data-process/prepare-column-data data-or-column-data-map)
+         data (coldata :tech.v3.dataset/data)
+         metadata (coldata :tech.v3.dataset/metadata)
+         name (coldata :tech.v3.dataset/name)
+         ;;Unless overidden, we now set the categorical? flag
+         metadata (if (and (not (contains? metadata :categorical?))
+                           (column-base/column-datatype-categorical?
+                            (dtype/elemwise-datatype data)))
+                    (assoc metadata :categorical? true)
+                    metadata)
+         missing (bitmap/->bitmap (coldata :tech.v3.dataset/missing))]
+     ;;compress bitmaps
+     (.runOptimize missing)
+     (let [new-meta (assoc metadata :name name)]
+       (Column. missing
+                data
+                new-meta
+                nil)))))
+
+
+(defn ensure-column-seq
+  [coldata-seq]
+  (->> coldata-seq
+       (column-data-process/prepare-column-data-seq)
+       ;;mapv so we get a real stacktrace when things go south.
+       (mapv new-column)))
+
+
+(defn extend-column-with-empty
+  [column ^long n-empty]
+  (if (== 0 (long n-empty))
+    column
+    (let [^Column column column
+          col-dtype (packing/unpack-datatype (dtype/elemwise-datatype column))
+          n-elems (dtype/ecount column)
+          container (dtype/make-container col-dtype (+ n-elems n-empty))]
+      (dtype/copy! (.data column) (dtype/sub-buffer container 0 n-elems))
+      (dtype/set-constant! container n-elems n-empty (get column-base/dtype->missing-val-map
+                                                          col-dtype))
+      (Column. (set/union (ds-proto/missing column)
+                          (bitmap/->bitmap (hamf/range n-elems (+ n-elems n-empty))))
+               container
+               (meta column)
+               nil))))
+
+
+(defn prepend-column-with-empty
+  [column ^long n-empty]
+  (if (== 0 (long n-empty))
+    column
+    (let [^Column column column
+          col-dtype (packing/unpack-datatype (dtype/elemwise-datatype column))
+          n-elems (dtype/ecount column)
+          container (dtype/make-container col-dtype (+ n-elems n-empty))]
+      (dtype/copy! (.data column) (dtype/sub-buffer container n-empty n-elems))
+      (dtype/set-constant! container 0 n-empty (get column-base/dtype->missing-val-map
+                                                    col-dtype))
+      (Column. (set/union (bitmap/->bitmap (hamf/range n-empty))
+                          (bitmap/offset (.missing column) n-empty))
+               container
+               (meta column)
+               nil))))

tech.ml.dataset/src/tech/v3/dataset/impl/column_base.clj

@@ -0,0 +1,108 @@
+(ns tech.v3.dataset.impl.column-base
+  (:require [tech.v3.dataset.string-table :as str-table]
+            [tech.v3.dataset.file-backed-text :as file-backed-text]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype :as dtype]
+            [clojure.tools.logging :as log])
+  (:import [java.util Map]
+           [ham_fisted IMutList]
+           [tech.v3.dataset Text]))
+
+
+(defn- pack-nil
+  ^long [unpacked-datatype]
+  (let [unpacked-container (dtype/make-container unpacked-datatype [nil])
+        packed-container (packing/pack unpacked-container)]
+    (-> (dtype/as-buffer packed-container)
+        (.readLong 0))))
+
+
+(def ^Map dtype->missing-val-map
+  {:boolean false
+   :int8 Byte/MIN_VALUE
+   :int16 Short/MIN_VALUE
+   :int32 Integer/MIN_VALUE
+   :int64 Long/MIN_VALUE
+   :float32 Float/NaN
+   :float64 Double/NaN
+   :packed-instant (pack-nil :instant)
+   :packed-local-date (pack-nil :local-date)
+   :packed-duration (pack-nil :duration)
+   :instant nil
+   :zoned-date-time nil
+   :local-date-time nil
+   :local-date nil
+   :local-time nil
+   :duration nil
+   :string ""
+   :text nil
+   :keyword nil
+   :symbol nil})
+
+
+(casting/add-object-datatype! :text Text)
+
+
+(defn datatype->missing-value
+  [dtype]
+  (let [packed? (packing/packed-datatype? dtype)
+        dtype (if packed?
+                (packing/unpack-datatype dtype)
+                (casting/un-alias-datatype dtype))]
+    (get dtype->missing-val-map dtype
+         (when (casting/numeric-type? dtype)
+           (casting/cast 0 dtype)))))
+
+
+(defn datatype->packed-missing-value
+  [dtype]
+  (get dtype->missing-val-map dtype
+       (when (casting/numeric-type? dtype)
+         (casting/cast 0 dtype))))
+
+
+(defonce ^:private warn-atom* (atom false))
+(defonce file-backed-text-enabled* (atom true))
+
+(defn set-file-backed-text-enabled
+  [enabled]
+  (reset! file-backed-text-enabled* enabled)
+  enabled)
+
+(defn make-container
+  (^IMutList [dtype options]
+   (if-let [rv (get-in options [:datatype-parsers dtype])]
+     (rv dtype options)
+     (case dtype
+       :string (str-table/fast-string-container)
+       :text
+       (let [^IMutList list-data
+             (try
+               (if (and (not= false (get options :text-temp-dir false))
+                        @file-backed-text-enabled*)
+                 (let [tmp-dir (:text-temp-dir options)]
+                   (file-backed-text/file-backed-text (merge
+                                                       {:suffix ".txt"}
+                                                       (when tmp-dir
+                                                         {:temp-dir tmp-dir}))))
+                 (dtype/make-list :text))
+               (catch Throwable e
+                 (when-not @warn-atom*
+                   (reset! warn-atom* true)
+                   (log/warn e "File backed text failed.  Falling back to in-memory"))
+                 (dtype/make-list :text)))]
+         list-data)
+       (dtype/make-list dtype))))
+  (^IMutList [dtype]
+   (make-container dtype nil)))
+
+
+(defn column-datatype-categorical?
+  "Anything where we don't know the conversion to a scalar double or integer
+  number is considered automatically categorical."
+  [col-dtype]
+  (and (not (casting/numeric-type? col-dtype))
+       (not (identical? col-dtype :boolean))
+       (not (dtype-dt/datetime-datatype? col-dtype))))

tech.ml.dataset/src/tech/v3/dataset/impl/column_data_process.clj

@@ -0,0 +1,136 @@
+(ns tech.v3.dataset.impl.column-data-process
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.parallel.for :as pfor]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.dataset.impl.column-base :as column-base])
+  (:import [org.roaringbitmap RoaringBitmap]
+           [java.util Map Objects]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(defmacro missing-value?
+  "Is this a missing value given the datatype-specific column missing value"
+  [missing-value obj]
+  `(and (not (instance? Boolean ~obj))
+        (or (nil? ~obj)
+            (Objects/equals ~missing-value ~obj)
+            (identical? :tech.v3.dataset/missing ~obj)
+            (identical? :tech.v3.dataset/parse-failure ~obj))))
+
+
+(defn scan-missing
+  "Scan a (potentially primitive) reader for missing values.  This simply scans every
+  value in the reader."
+  ^RoaringBitmap [rdr]
+  (let [rdr (dtype/->reader rdr)
+        missing (column-base/datatype->missing-value (dtype/elemwise-datatype rdr))]
+    (pfor/indexed-map-reduce
+     (.lsize rdr)
+     (fn [^long start-idx ^long group-len]
+       (let [bmp (bitmap/->bitmap)]
+         (dotimes [group-idx group-len]
+           (let [idx (+ group-idx start-idx)
+                 obj (.readObject rdr idx)]
+             (when (missing-value? missing obj)
+               (.add bmp idx))))
+         bmp))
+     (fn [bmps]
+       (let [^RoaringBitmap bmp (first bmps)]
+         (doseq [^RoaringBitmap other-bmp (rest bmps)]
+           (.or bmp other-bmp))
+         bmp)))))
+
+
+(defn scan-data
+  [obj-data missing]
+  (let [obj-data-datatype (dtype/elemwise-datatype obj-data)]
+    (if (and (dtype/reader? obj-data)
+             (not= :object obj-data-datatype))
+      ;;If the user knows the datatype they want, then we just scan for missing if it
+      ;;wasn't provided.
+      #:tech.v3.dataset{:data obj-data
+                        :force-datatype? true
+                        ;;integer types don't have meaningful data indicators of missing.
+                        :missing (or missing
+                                     (if (or (casting/integer-type? obj-data-datatype)
+                                             (identical? :boolean obj-data-datatype))
+                                       (bitmap/->bitmap)
+                                       (scan-missing obj-data)))}
+      (let [obj-meta (meta obj-data)
+            parser (column-parsers/promotional-object-parser
+                    (:name obj-meta) obj-meta)
+            ;;At this point either you are convertible to a reader or you are
+            ;;iterable.
+            obj-data (or (dtype/as-reader obj-data) obj-data)
+            missing (bitmap/->bitmap missing)]
+        (if-let [rdr (dtype/as-reader obj-data)]
+          (dotimes [idx (.lsize rdr)]
+            (column-parsers/add-value! parser idx
+                                       (when-not (.contains missing idx)
+                                         (.readObject rdr idx))))
+          ;;serially consume the data promoting the container when necessary.
+          (pfor/indexed-consume!
+           ;;Do not read from a missing entry if missing is provided
+           #(column-parsers/add-value! parser %1
+                                       (when-not (.contains missing (unchecked-int %1))
+                                         %2))
+           obj-data))
+        (column-parsers/finalize! parser (dtype/ecount parser))))))
+
+
+(defn prepare-column-data
+  "Scan data for missing values and to infer storage datatype.  Returns
+   a map of least #tech.v3.dataset{:data :missing :force-datatype?}."
+  [obj-data]
+  (cond
+    (map? obj-data)
+    (do
+      (errors/when-not-errorf
+       (contains? ^Map obj-data :tech.v3.dataset/data)
+       "Map constructors must contain at least :tech.v3.dataset/data")
+      ;;ensure we do not re-scan this object
+      (let [{:keys [tech.v3.dataset/data
+                    tech.v3.dataset/missing
+                    tech.v3.dataset/force-datatype?]} obj-data
+            obj-data (if (nil? missing)
+                       (dissoc obj-data :tech.v3.dataset/missing)
+                       obj-data)]
+        (merge
+         (if (and (dtype/reader? data) force-datatype?)
+           ;;skip scan of the data, but potentially still scan for missing
+           {:tech.v3.dataset/data data
+            :tech.v3.dataset/missing (if missing missing (scan-missing data))}
+           (scan-data data missing))
+         ;;allow missing/metadata to make it through so user can override
+         (dissoc obj-data :tech.v3.dataset/data)
+         #:tech.v3.dataset{:force-datatype? true})))
+    (ds-proto/is-column? obj-data)
+    (let [cm (meta obj-data)]
+      #:tech.v3.dataset{:name (:name cm)
+                        :missing (ds-proto/missing obj-data)
+                        :force-datatype? true
+                        :data (ds-proto/column-buffer obj-data)
+                        :metadata cm})
+    :else
+    (scan-data obj-data nil)))
+
+
+(defn prepare-column-data-seq
+  [column-seq]
+  (pfor/pmap (fn [idx item]
+               (-> (if (map? item)
+                     (update item :tech.v3.dataset/name
+                             #(if (nil? %)
+                                idx %))
+                     item)
+                   (prepare-column-data)
+                   ))
+             (range) column-seq))

tech.ml.dataset/src/tech/v3/dataset/impl/dataset.clj

@@ -0,0 +1,579 @@
+(ns ^:no-doc tech.v3.dataset.impl.dataset
+  (:require [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.impl.column :as col-impl]
+            [tech.v3.dataset.print :as ds-print]
+            [tech.v3.datatype.pprint :as dtype-pp]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.argtypes :as argtypes]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype.unary-pred :as unary-pred]
+            [tech.v3.dataset.impl.column-data-process :as column-data-process]
+            [tech.v3.dataset.impl.column-base :as column-base]
+            [tech.v3.datatype.graal-native :as graal-native]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.lazy-noncaching :as lznc]
+            [ham-fisted.protocols :as hamf-proto]
+            [ham-fisted.set :as set])
+  (:import [clojure.lang IPersistentMap IObj IFn Counted MapEntry IFn$LO
+            IFn$LOO]
+           [java.util Map List LinkedHashSet LinkedHashMap HashSet]
+           [tech.v3.datatype ObjectReader FastStruct Buffer]
+           [org.roaringbitmap RoaringBitmap]
+           [java.util.concurrent ConcurrentHashMap]
+           [java.util.function BiConsumer]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* true)
+
+
+(declare new-dataset map-entries empty-dataset)
+
+;;ported from clojure.lang.APersistentMap
+(defn- map-equiv [this o]
+  (cond (not (instance? java.util.Map o)) false
+        (and (instance? clojure.lang.IPersistentMap o)
+             (not (instance? clojure.lang.MapEquivalence o))) false
+        :else (let [^java.util.Map m o]
+                (and (= (.size m) (count this))
+                     (every? (fn [k]
+                               (and (.containsKey m k)
+                                    (= (this k) (.get m k)))) (keys this))))))
+
+
+(defn- shorten-or-extend
+  [^long n-rows reader]
+  (let [reader-dtype (dtype/elemwise-datatype reader)
+        reader-ecount (dtype/ecount reader)]
+    (cond
+      (== reader-ecount n-rows)
+      reader
+      (< reader-ecount n-rows)
+      (dtype/concat-buffers (dtype/elemwise-datatype reader)
+                            [reader (dtype/const-reader (column-base/datatype->missing-value
+                                                         reader-dtype)
+                                                        (- n-rows reader-ecount))])
+      ;;Else the number of elements is greater than the number of rows
+      :else
+      (dtype/sub-buffer reader 0 n-rows))))
+
+
+(defn- coldata->column
+  [^long n-cols ^long n-rows col-name new-col-data]
+  (let [argtype (argtypes/arg-type new-col-data)
+        n-rows (if (== 0 n-cols)
+                 (cond
+                   (dtype/reader? new-col-data)
+                   (dtype/ecount new-col-data)
+                   (map? new-col-data)
+                   (if (contains? new-col-data :tech.v3.dataset/data)
+                     (dtype/ecount (new-col-data :tech.v3.dataset/data))
+                     1)
+                   :else
+                   (count (take Integer/MAX_VALUE new-col-data)))
+                 n-rows)]
+    (cond
+      (ds-proto/is-column? new-col-data)
+      (vary-meta new-col-data assoc :name col-name)
+      ;;maps are scalars in dtype-land but you can pass in column data maps
+      ;;so this next check is a bit hairy
+      (or (identical? argtype :scalar)
+           ;;This isn't a column data map.  Maps are
+          (and (instance? Map new-col-data)
+               (not (.containsKey ^Map new-col-data :tech.v3.dataset/data))))
+      (col-impl/new-column col-name (dtype/const-reader new-col-data n-rows))
+      :else
+      (let [map-data
+            (if (or (= argtype :iterable)
+                    (map? new-col-data))
+              (column-data-process/prepare-column-data
+               (if (map? new-col-data)
+                 new-col-data
+                 (take n-rows new-col-data)))
+              ;;Else has to be reader or tensor.
+              (let [data-ecount (dtype/ecount new-col-data)
+                    new-col-data (if (> data-ecount n-rows)
+                                   (dtype/sub-buffer new-col-data 0 n-rows)
+                                   new-col-data)]
+                (column-data-process/prepare-column-data new-col-data)))
+            new-c (col-impl/new-column (assoc map-data :tech.v3.dataset/name col-name))
+            c-len (dtype/ecount new-c)]
+        (cond
+          (< c-len n-rows)
+          (col-impl/extend-column-with-empty new-c (- n-rows c-len))
+          (> c-len n-rows)
+          (dtype/sub-buffer new-c 0 n-rows)
+          :else
+          new-c)))))
+
+
+(defn- map-entries
+  ^List [^List columns]
+  (reify ObjectReader
+    (lsize [rdr] (.size columns))
+    (readObject [rdr idx]
+      (let [col (.get columns idx)]
+        (MapEntry. (:name (meta col)) col)))))
+
+
+(defmacro ^:private row-vec-copying
+  [n-cols]
+  `(let ~(->> (range n-cols)
+              (mapcat (fn [cidx]
+                        [(with-meta (symbol (str "c" cidx))
+                           {:tag 'Buffer}) `(~'readers ~cidx)]))
+              (vec))
+     (hamf-fn/long->obj ~'row-idx
+                        (hamf/vector ~@(->> (range n-cols)
+                                            (map (fn [cidx]
+                                                   `(.readObject ~(symbol (str "c" cidx))
+                                                                 ~'row-idx))))))))
+
+
+
+(deftype Dataset [^List columns
+                  colmap
+                  ^IPersistentMap metadata
+                  ^{:unsynchronized-mutable true :tag 'int}  _hash
+                  ^{:unsynchronized-mutable true :tag 'int}  _hasheq]
+  java.util.Map
+  (size [this]    (.count this))
+  (isEmpty [this] (not (pos? (.count this))))
+  (containsValue [_this v] (some #(= % v) columns))
+  (get [this k] (.valAt this k))
+  (put [_this _k _v]  (throw (UnsupportedOperationException.)))
+  (remove [_this _k] (throw (UnsupportedOperationException.)))
+  (putAll [_this _m] (throw (UnsupportedOperationException.)))
+  (clear [_this]    (throw (UnsupportedOperationException.)))
+  (keySet [_this] (.keySet ^Map colmap))
+  (values [_this] columns)
+  (entrySet [_this]
+    (let [retval (LinkedHashSet.)]
+      (.addAll retval (map #(clojure.lang.MapEntry. (:name (meta %)) %)
+                           columns))
+      retval))
+
+  clojure.lang.ILookup
+  (valAt [_this k]
+    (when-let [idx (colmap k)]
+      (.get columns idx)))
+  (valAt [this k not-found]
+    (if-let [res (.valAt this k)]
+      res
+      not-found))
+
+  clojure.lang.MapEquivalence
+
+  clojure.lang.IPersistentMap
+  (assoc [this k v]
+    (let [n-cols (ds-proto/column-count this)
+          c (coldata->column n-cols
+                             (ds-proto/row-count this)
+                             k v)
+          cidx (get colmap k n-cols)]
+      (Dataset. (assoc (or columns []) cidx c) (assoc colmap k cidx) metadata 0 0)))
+  (assocEx [this k v]
+    (if-not (colmap k)
+      (.assoc this k v)
+      (throw (ex-info "Key already present" {:k k}))))
+  ;;without implements (dissoc pm k) behavior
+  (without [this k]
+    (if-let [cidx (get colmap k)]
+      (let [cols (hamf/concatv (hamf/subvec columns 0 cidx) (hamf/subvec columns (inc cidx)))]
+        (Dataset. cols
+                  (into {} (map-indexed #(vector (:name (meta %2)) %1)) cols)
+         metadata 0 0))
+      this))
+  (entryAt [this k]
+    (when-let [v (.valAt this k)]
+      (clojure.lang.MapEntry. k v)))
+  ;;No idea if this is correct behavior....
+  (empty [_this] (empty-dataset))
+  ;;ported from clojure java impl.
+  (cons [this e]
+    (cond (instance? java.util.Map$Entry e)
+            (.assoc this (key e) (val e))
+          (vector? e)
+            (let [^clojure.lang.PersistentVector e e]
+              (when-not (== (.count e) 2)
+                (throw (ex-info "Vector arg to map conj must be a pair" {})))
+              (.assoc this (.nth e 0) (.nth e 1)))
+          :else
+            (reduce (fn [^clojure.lang.Associative acc entry]
+                      (.assoc acc (key entry) (val entry))) this e)))
+
+  (containsKey [_this k] (.containsKey ^Map colmap k))
+
+  ;;MAJOR DEVIATION
+  ;;This conforms to clojure's idiom and projects the dataset onto a
+  ;;seq of [column-name column] entries.  Legacy implementation defaulted
+  ;;to using iterable, which was a seq of column.
+  (seq [_this]
+    ;;Do not reorder column data if possible.
+    (when (pos? (count columns))
+      (map #(clojure.lang.MapEntry. (:name (meta %)) %)  columns)))
+
+  ;;Equality is likely a rat's nest, although we should be able to do it
+  ;;if we wanted to!
+  (hashCode [this]
+    (when (== _hash 0)
+      (set! _hash (clojure.lang.APersistentMap/mapHash  this)))
+    _hash)
+
+  clojure.lang.IHashEq
+  ;;intentionally using seq instead of iterator for now.
+  (hasheq [this]
+    (when (== _hasheq 0)
+      (set! _hasheq (hash-unordered-coll (or (.seq this)
+                                             []))))
+    _hasheq)
+
+  ;;DOUBLE CHECK equals/equiv semantics...
+  (equals [this o] (or (identical? this o)
+                       (clojure.lang.APersistentMap/mapEquals this o)))
+
+  (equiv [this o] (or (identical? this o)
+                      (map-equiv this o)))
+
+
+  ds-proto/PRowCount
+  (row-count [this]
+    (if (== 0 (.size columns))
+      0
+      (dtype/ecount (.get columns 0))))
+
+
+  ds-proto/PColumnCount
+  (column-count [this]
+    (.size columns))
+
+
+  ds-proto/PMissing
+  (missing [this]
+    (RoaringBitmap/or (.iterator ^Iterable (lznc/map ds-proto/missing (.values this)))))
+  (num-missing [this]
+    (dtype/ecount (ds-proto/missing this)))
+  (any-missing? [this]
+    (boolean (some ds-proto/any-missing? (.values this))))
+
+  ds-proto/PValidRows
+  (valid-rows [this]
+    (RoaringBitmap/or (.iterator ^Iterable (lznc/map (comp bitmap/->bitmap ds-proto/valid-rows)
+                                                     (.values this)))))
+
+  ds-proto/PSelectRows
+  (select-rows [dataset rowidxs]
+    (let [rowidxs (col-impl/simplify-row-indexes (ds-proto/row-count dataset) rowidxs)]
+      (when (== 0 (long (ds-proto/row-count dataset)))
+        (when-not (== 0 (dtype/ecount rowidxs))
+          (throw (IndexOutOfBoundsException. "Cannot select rows of empty dataset"))))
+      (->> columns
+           ;;select may be slower if we have to recalculate missing values.
+           (lznc/map #(ds-proto/select-rows % rowidxs))
+           (new-dataset (ds-proto/dataset-name dataset)
+                        (if-not (identical? :all (get metadata :print-index-range))
+                          (dissoc metadata :print-index-range)
+                          metadata)))))
+
+
+  ds-proto/PSelectColumns
+  (select-columns [dataset colnames]
+    ;;Conversion to a reader is expensive in some cases so do it here
+    ;;to avoid each column doing it.
+    (let [map-selector? (instance? Map colnames)]
+      (->> (cond
+             (identical? :all colnames)
+             columns
+             map-selector?
+             (->> colnames
+                  (lznc/map (fn [[old-name new-name]]
+                              (if-let [col-idx (get colmap old-name)]
+                                (vary-meta (.get columns (unchecked-int col-idx))
+                                           assoc :name new-name)
+                                (throw (Exception.
+                                        (format "Failed to find column %s" old-name)))))))
+             :else
+             (let [idx-set (HashSet.)]
+               (->> colnames
+                    (lznc/map (fn [colname]
+                                (if-let [col-idx (get colmap colname)]
+                                  (when-not (.contains idx-set col-idx)
+                                    (.add idx-set col-idx)
+                                    (.get columns (unchecked-int col-idx)))
+                                  (throw (Exception.
+                                          (format "Failed to find column %s" colname))))))
+                    (lznc/remove nil?))))
+           (new-dataset (ds-proto/dataset-name dataset) metadata))))
+
+  ds-proto/PDataset
+  (is-dataset? [item] true)
+  (column [ds cname]
+    (if-let [retval (.get ds cname)]
+      retval
+      (throw (RuntimeException. (str "Column not found: " cname)))))
+
+  (rowvecs [ds options]
+    (let [readers (hamf/object-array-list
+                   (lznc/map dtype/->reader columns))
+          n-cols (count readers)
+          n-rows (long (ds-proto/row-count ds))
+          copying? (get options :copying? true)
+          ^IFn$LO row-fn
+          (if copying?
+            (case n-cols
+              0 (hamf-fn/long->obj row-idx [])
+              1 (row-vec-copying 1)
+              2 (row-vec-copying 2)
+              3 (row-vec-copying 3)
+              4 (row-vec-copying 4)
+              5 (row-vec-copying 5)
+              6 (row-vec-copying 6)
+              7 (row-vec-copying 7)
+              8 (row-vec-copying 8)
+              (let [crange (hamf/range n-cols)]
+                (hamf-fn/long->obj
+                 row-idx
+                 (->> crange
+                      (lznc/map (hamf-fn/long->obj
+                                 col-idx (.readObject ^Buffer (.get readers col-idx) row-idx)))
+                      (hamf/vec)))))
+            ;;Non-copying in-place reader
+            (let [crange (hamf/range n-cols)]
+              (hamf-fn/long->obj
+               row-idx
+               (reify ObjectReader
+                 (lsize [this] n-cols)
+                 (readObject [this col-idx]
+                   (.readObject ^Buffer (.get readers col-idx) row-idx))
+                 (reduce [this rfn acc]
+                   (reduce (hamf-rf/long-accumulator
+                            acc col-idx (rfn acc ((.get readers col-idx) row-idx)))
+                           acc
+                           crange))))))]
+      (reify ObjectReader
+        (lsize [rdr] n-rows)
+        (readObject [rdr row-idx] (.invokePrim row-fn row-idx))
+        (subBuffer [rdr sidx eidx]
+          (-> (ds-proto/select-rows ds (hamf/range sidx eidx))
+              (ds-proto/rowvecs options)))
+        (reduce [rdr rfn acc]
+          (reduce (hamf-rf/long-accumulator
+                   acc row-idx
+                   (rfn acc (.invokePrim row-fn row-idx)))
+                  acc (hamf/range n-rows))))))
+
+
+  (rows [ds options]
+    (let [^Buffer rvecs (.rowvecs ds options)
+          colnamemap (LinkedHashMap.)
+          _ (reduce (hamf-rf/indexed-accum
+                     acc idx cname
+                     (.put colnamemap cname idx)
+                     colnamemap)
+                    colnamemap
+                    (lznc/map #(ds-proto/column-name %) columns))
+          n-rows (dtype/ecount rvecs)
+          nil-missing? (get options :nil-missing?)
+          ^RoaringBitmap ds-missing (when (not nil-missing?) (ds-proto/missing ds))
+          constant-cmap? (or nil-missing? (.isEmpty ds-missing))
+          ^IFn$LO cmap-fn (if constant-cmap?
+                            (fn [^long v] colnamemap)
+                            (let [col-fns
+                                  (->> (vals ds)
+                                       (lznc/map (fn [col]
+                                                   (let [^RoaringBitmap col-missing (ds-proto/missing col)]
+                                                     (when-not (.isEmpty col-missing)
+                                                       (let [ckey (ds-proto/column-name col)]
+                                                         (fn [^long row-idx ^Map colnamemap]
+                                                           (when (.contains col-missing (unchecked-int row-idx))
+                                                             (.remove colnamemap ckey))
+                                                           colnamemap))))))
+                                       (lznc/remove nil?)
+                                       (hamf/object-array))
+                                  n-fns (alength col-fns)]
+                              (fn [^long row-idx]
+                                (if (.contains ds-missing (unchecked-int row-idx))
+                                  (let [colnamemap (.clone colnamemap)]
+                                    (dotimes [idx n-fns]
+                                      (.invokePrim ^IFn$LOO (aget col-fns idx) row-idx colnamemap))
+                                    colnamemap)
+                                  colnamemap))))]
+      (reify ObjectReader
+        (lsize [rdr] n-rows)
+        (readObject [rdr idx]
+          (FastStruct. (.invokePrim cmap-fn idx) (.readObject rvecs idx)))
+        (subBuffer [rdr sidx eidx]
+          (-> (ds-proto/select-rows ds (hamf/range sidx eidx))
+              (ds-proto/rows options)))
+        (reduce [rdr rfn acc]
+          (reduce (if constant-cmap?
+                    (fn [acc vv]
+                      (rfn acc (FastStruct. colnamemap vv)))
+                    (hamf-rf/indexed-accum
+                     acc row-idx vv
+                     (rfn acc (FastStruct. (.invokePrim cmap-fn row-idx) vv))))
+                  acc
+                  rvecs)))))
+
+
+  dtype-proto/PShape
+  (shape [ds]
+    [(count columns) (ds-proto/row-count ds)])
+
+  dtype-proto/PCopyRawData
+  (copy-raw->item! [_raw-data ary-target target-offset options]
+    (dtype-proto/copy-raw->item! columns ary-target target-offset options))
+  dtype-proto/PClone
+  (clone [item]
+    (new-dataset (ds-proto/dataset-name item)
+                 metadata
+                 (mapv dtype/clone columns)))
+
+  Counted
+  (count [_this] (count columns))
+
+  IFn
+  ;;NON-OBVIOUS SEMANTICS
+  ;;Legacy implementation of invoke differs from clojure idioms for maps,
+  ;;and instead of performing a lookup, we have effectively an assoc.
+  ;;Is this necessary, or can we better conform to clojure idioms?
+  ;; (invoke [item col-name new-col]
+  ;;   (ds-proto/add-column item (ds-col-proto/set-name new-col col-name)))
+
+  (invoke [this k]
+    (.valAt this k))
+  (invoke [this k not-found]
+    (.valAt this k not-found))
+  (applyTo [this arg-seq]
+    (case (count arg-seq)
+      1 (.invoke this (first arg-seq))
+      2 (.invoke this (first arg-seq) (second arg-seq))))
+
+  IObj
+  (meta [_this] metadata)
+  (withMeta [_this metadata] (Dataset. columns colmap metadata _hash _hasheq))
+
+  Iterable
+  (iterator [_item]
+    (.iterator (map-entries columns)))
+
+  Object
+  (toString [item]
+    (ds-print/dataset->str item)))
+
+
+(defn construct-dataset
+  "Low-level construct a new dataset.
+
+  * 'columns' - java.util.List of [[tech.v3.dataset.impl.column.Column]] objects.
+  * 'colmap' - java.util.Map of column name to index in columns.
+  * 'metadata' - extra metadata for the dataset.  Dataset name is store as `:name`."
+  (^Dataset [columns colmap metadata]
+   ;;quick sanity check
+   (assert (== (count colmap) (count columns)))
+   (Dataset. columns colmap metadata 0 0))
+  (^Dataset [columns metadata]
+   (Dataset. columns (persistent!
+                      (reduce (hamf-rf/indexed-accum
+                               acc idx col
+                               (.put ^Map acc (or (:name (meta col)) idx) idx)
+                               acc)
+                              (hamf/mut-map)
+                              columns))
+             metadata 0 0)))
+
+(defn new-dataset
+  "Create a new dataset from a sequence of columns.  Data will be converted
+  into columns using ds-col-proto/ensure-column-seq.  If the column seq is simply a
+  collection of vectors, for instance, columns will be named ordinally.
+  options map -
+    :dataset-name - Name of the dataset.  Defaults to \"_unnamed\".
+    :key-fn - Key function used on all column names before insertion into dataset.
+
+  The return value fulfills the dataset protocols."
+  ([options ds-metadata column-seq]
+   (let [;;Options was dataset-name so have to keep that pathway going.
+         dataset-name (or (if (map? options)
+                            (:dataset-name options)
+                            options)
+                          (:name ds-metadata)
+                          "_unnamed")
+         column-seq (hamf/vec column-seq)]
+     (if-not (seq column-seq)
+       (Dataset. [] {}
+                 (assoc (col-impl/->persistent-map ds-metadata)
+                        :name
+                        dataset-name) 0 0)
+       (let [column-seq (hamf/vec column-seq)
+             sizes (->> column-seq
+                        (lznc/map (fn [data]
+                                    (let [data (if (map? data)
+                                                 (get data :tech.v3.dataset/data data)
+                                                 data)
+                                          argtype (argtypes/arg-type data)]
+                                      ;;nil return expected
+                                      (if (or (identical? argtype :scalar)
+                                              (identical? argtype :iterable))
+                                        1
+                                        (dtype/ecount data)))))
+                        (lznc/remove nil?)
+                        (hamf/immut-set))
+             n-rows (long (if (== 0 (count sizes))
+                            0
+                            (apply max sizes)))
+             n-cols (count column-seq)
+             key-fn (or (when (map? options)
+                          (get options :key-fn identity))
+                        identity)
+             column-seq (->> column-seq
+                             (lznc/map-indexed
+                              (fn [idx column]
+                                (let [cname (ds-proto/column-name column)
+                                      cname (if (or (nil? cname)
+                                                    (and (string? cname)
+                                                         (== 0 (.length ^String cname))))
+                                              (key-fn idx)
+                                              (key-fn cname))]
+                                  (coldata->column n-cols n-rows cname column))))
+                             (hamf/vec))]
+         (Dataset. column-seq
+                   (do
+                     (let [hs (hamf/mut-map)]
+                       (reduce (hamf-rf/indexed-accum
+                                acc idx col
+                                (.put hs (ds-proto/column-name col) idx))
+                               nil
+                               column-seq)
+                       (persistent! hs)))
+                   (assoc (col-impl/->persistent-map ds-metadata)
+                          :name
+                          dataset-name)
+                   0 0)))))
+  ([options column-seq]
+   (new-dataset options {} column-seq))
+  ([column-seq]
+   (new-dataset {} {} column-seq)))
+
+
+(dtype-pp/implement-tostring-print Dataset)
+
+
+;;pprint and graal native do not play nice with each other.
+(graal-native/when-not-defined-graal-native
+ (require '[clojure.pprint :as pprint])
+ (defmethod pprint/simple-dispatch
+   tech.v3.dataset.impl.dataset.Dataset [f] (pr f)))
+
+
+(defn dataset?
+  [ds]
+  (instance? Dataset ds))
+
+
+(def ^:private EMPTY (new-dataset "_unnamed" nil))
+
+
+(defn empty-dataset [] EMPTY)

tech.ml.dataset/src/tech/v3/dataset/impl/missing_values.clj

@@ -0,0 +1 @@
+(ns tech.v3.dataset.impl.missing-values)

tech.ml.dataset/src/tech/v3/dataset/impl/sparse_column.clj

@@ -0,0 +1,419 @@
+(ns tech.v3.dataset.impl.sparse-column
+  (:require [tech.v3.datatype :as dt]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.protocols :as dt-proto]
+            [tech.v3.datatype.pprint :as dtype-pp]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.impl.column :as col-impl]
+            [tech.v3.dataset.string-table :as str-t]
+            [tech.v3.dataset.dynamic-int-list :as int-list]
+            [ham-fisted.set :as set]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.iterator :as hamf-iter])
+  (:import [ham_fisted IMutList ArrayLists ITypedReduce ChunkedList]
+           [tech.v3.datatype Buffer ObjectReader ElemwiseDatatype LongReader DoubleReader]
+           [java.util Arrays Iterator Map List]
+           [tech.v3.dataset.string_table StringTable]))
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+(declare scol->reader reduce-scol kv-reduce-scol construct-sparse-col)
+
+(defn- index-bin-search
+  ^clojure.lang.IFn$LL [^IMutList indexes]
+  (let [idx-ary (.toNativeArray indexes)
+        nrc (- (long (.size indexes)))]
+    (case (dt/elemwise-datatype idx-ary)
+      :int8 (hamf-fn/long-unary-operator
+                idx (Arrays/binarySearch ^bytes idx-ary (unchecked-byte idx)))
+      :int16 (hamf-fn/long-unary-operator
+                 idx (Arrays/binarySearch ^shorts idx-ary (unchecked-short idx)))
+      :int32 (hamf-fn/long-unary-operator
+                 idx (Arrays/binarySearch ^ints idx-ary (unchecked-int idx)))
+      (hamf-fn/long-unary-operator
+          idx (Arrays/binarySearch ^longs idx-ary (unchecked-long idx))))))
+
+;; Column wrapping csr format.
+(deftype SparseCol [^IMutList indexes ;;sorted indexes
+                    ^IMutList data ^long rc metadata
+                    ^:unsynchronized-mutable msng ;;missing
+                    ^:unsynchronized-mutable rdr]
+  ElemwiseDatatype
+  (elemwiseDatatype [this] (dt/elemwise-datatype data))
+  dt-proto/POperationalElemwiseDatatype
+  (operational-elemwise-datatype [this]
+    (let [ewise-dt (dt-proto/elemwise-datatype data)]
+      (cond
+        (packing/packed-datatype? ewise-dt)
+        (packing/unpack-datatype ewise-dt)
+        (casting/numeric-type? ewise-dt)
+        (casting/widest-datatype ewise-dt :float64)
+        (identical? :boolean ewise-dt)
+        :object
+        :else
+        ewise-dt)))
+  tech.v3.datatype.ECount
+  (lsize [this] rc)
+  dt-proto/PToBuffer
+  (convertible-to-buffer? [this] true)
+  (->buffer [this]
+    (if rdr
+      rdr
+      (let [rv (scol->reader this)]
+        (set! rdr rv)
+        rv)))
+  dt-proto/PSubBuffer
+  (sub-buffer [this offset len]
+    (let [offset (long offset)
+          len (long len)
+          eidx (+ offset len)]
+      (ChunkedList/sublistCheck offset (+ offset len) (dt/ecount data))
+      (if (and (== offset 0) (== len rc))
+        this
+        (let [sidx offset
+              new-indexes (.subList indexes sidx eidx)
+              new-data (.subList data sidx eidx)
+              new-rc (- eidx sidx)]
+          (SparseCol. new-indexes new-data new-rc metadata nil nil)))))
+  dt-proto/PClone
+  (clone [_col]
+    (SparseCol. (dt/clone indexes) (dt/clone data) rc metadata nil nil))
+  ds-proto/PMissing
+  (missing [this]
+    (if (.-msng this)
+      (.-msng this)
+      (do
+        (let [miss-data (set/difference (bitmap/->bitmap (hamf/range rc)) (bitmap/->bitmap indexes))]
+          (set! (.-msng this) miss-data)
+          miss-data))))
+  (num-missing [this] (- rc (.size indexes)))
+  (any-missing? [this] (not (== rc (.size indexes))))
+  ds-proto/PValidRows
+  (valid-rows [this] indexes)
+  ds-proto/PColumn
+  (is-column? [this] true)
+  (column-buffer [this] [indexes data])
+  (empty-column? [this] (.isEmpty indexes))
+  (column-data [this] data)
+  (with-column-data [this new-data] (construct-sparse-col indexes new-data rc metadata))
+  ds-proto/PColumnName
+  (column-name [this] (get metadata :name))
+  ds-proto/PRowCount
+  (row-count [this] (dt/ecount data))
+  ds-proto/PSelectRows
+  (select-rows [this rowidxs]
+    (let [rowidxs (col-impl/simplify-row-indexes rc rowidxs)
+          res-rc (dt/ecount rowidxs)
+          ^IMutList res-ixs (cond
+                              (<= res-rc Byte/MAX_VALUE)
+                              (hamf/byte-array-list)
+                              (<= res-rc Short/MAX_VALUE)
+                              (hamf/short-array-list)
+                              (<= res-rc Integer/MAX_VALUE)
+                              (hamf/int-array-list)
+                              :else
+                              (hamf/long-array-list))
+          ^IMutList res-vals (dt/make-list (dt/elemwise-datatype data))
+          local-indexes indexes
+          bin-search (index-bin-search indexes)
+          last-data (long-array [-1 (.getLong local-indexes 0) 0])
+          dnidxs (dec (.size local-indexes))]
+      (reduce (hamf-rf/indexed-long-accum
+                  acc rel-idx row-idx
+                (let [last-row-idx (aget last-data 0)
+                      next-row-idx (aget last-data 1)
+                      v (long (if (> row-idx last-row-idx)
+                                (cond
+                                  (== row-idx next-row-idx)
+                                  (aget last-data 2)
+                                  (< row-idx next-row-idx)
+                                  -1
+                                  :else
+                                  (.invokePrim bin-search row-idx))
+                                (.invokePrim bin-search row-idx)))]
+                  (when (>= v 0)
+                    (let [next-v (inc v)]
+                      (aset last-data 0 row-idx)
+                      (if (<= next-v dnidxs)
+                        (do 
+                          (aset last-data 1 (.getLong local-indexes next-v))
+                          (aset last-data 2 next-v))
+                        (do
+                          (aset last-data 1 Long/MAX_VALUE)
+                          (aset last-data 2 -1))))
+                    (.add res-ixs rel-idx)
+                    (.add res-vals (.get data v)))))
+              nil rowidxs)
+      (SparseCol. res-ixs res-vals res-rc metadata nil nil)))
+  IMutList
+  (size [this] (.size (dt-proto/->buffer this)))
+  (get [this idx] (.get (dt-proto/->buffer this) idx))
+  (getLong [this idx] (.getLong (dt-proto/->buffer this) idx))
+  (getDouble [this idx] (.getDouble (dt-proto/->buffer this) idx))
+  (valAt [this idx] (.valAt (dt-proto/->buffer this) idx))
+  (valAt [this idx def-val] (.valAt (dt-proto/->buffer this) idx def-val))
+  (invoke [this idx] (.invoke (dt-proto/->buffer this) idx))
+  (invoke [this idx def-val] (.invoke (dt-proto/->buffer this) idx def-val))
+  (meta [this] (assoc metadata
+                      :datatype (dt-proto/elemwise-datatype data)
+                      :n-elems rc))
+  (withMeta [_this new-meta] (SparseCol. indexes data rc new-meta msng rdr))
+  (nth [this idx] (nth (dt-proto/->buffer this) idx))
+  (nth [this idx def-val] (nth (dt-proto/->buffer this) idx def-val))
+  ;;should be the same as using hash-unorded-coll, effectively.
+  (hasheq [this]   (.hasheq (dt-proto/->buffer this)))
+  (equiv [this o] (if (identical? this o) true (.equiv (dt-proto/->buffer this) o)))
+  (empty [this]
+    (let [ba (ArrayLists/toList (byte-array 0))]
+      (SparseCol. ba ba 0 {} nil nil)))
+  ITypedReduce
+  (reduce [this rfn acc] (reduce-scol this rfn acc 0 rc))
+  (parallelReduction [this init-val-fn rfn merge-fn options]
+    (.parallelReduction (dt-proto/->buffer this) init-val-fn rfn merge-fn options))
+  clojure.lang.IKVReduce
+  (kvreduce [this rfn acc]
+    (kv-reduce-scol this rfn acc 0 rc))
+  Object
+  (toString [this]
+    (let [format-str (if (> rc 20)
+                       "#tech.v3.dataset.sparse-column<%s>%s\n%s\n[%s...]"
+                       "#tech.v3.dataset.sparse-column<%s>%s\n%s\n[%s]")]
+      (format format-str
+              (name (dt/elemwise-datatype this))
+              [rc]
+              (ds-proto/column-name this)
+              (-> (dt-proto/sub-buffer this 0 (min 20 rc))
+                  (dtype-pp/print-reader-data)))))
+  (hashCode [this] (.hasheq (dt-proto/->buffer this)))
+  (equals [this o] (.equiv this o)))
+
+(defn- maybe-next-long
+  ^long [^Iterator iter ^long not-found]
+  (if (.hasNext iter)
+    (long (.next iter))
+    not-found))
+
+(defn- maybe-next
+  [^Iterator iter]
+  (when (.hasNext iter) (.next iter)))
+
+(defn scol-iter
+  ^Iterator [^SparseCol scol ^long sidx ^long eidx]
+  (let [src-idx-iter (.iterator ^Iterable (.-indexes scol))
+        src-val-iter (.iterator ^Iterable (.-data scol))
+        idx (long-array [sidx (maybe-next-long src-idx-iter Long/MAX_VALUE)])]
+    (reify Iterator
+      (hasNext [this] (< (aget idx 0) eidx))
+      (next [this]
+        (let [ii (aget idx 0)]
+          (aset idx 0 (inc ii))
+          (if (< ii eidx)
+            (let [iv (aget idx 1)]
+              (if (== iv ii)
+                (do
+                  (aset idx 1 (maybe-next-long src-idx-iter Long/MAX_VALUE))
+                  (maybe-next src-val-iter))
+                nil))
+            (throw (java.util.NoSuchElementException.))))))))
+
+(defn- reduce-scol
+  [^SparseCol scol rfn acc sidx eidx]
+  (let [^Iterator si (scol-iter scol sidx eidx)]
+    (if (.hasNext si)
+      (loop [acc (rfn acc (.next si))]
+        (cond
+          (reduced? acc) (deref acc)
+          (.hasNext si) (recur (rfn acc (.next si)))
+          :else acc))
+      acc)))
+
+(defn kv-reduce-scol
+  [^SparseCol scol rfn acc sidx eidx]
+  (let [^IMutList idxs (.-indexes scol)
+        cmp (case (dt/elemwise-datatype idxs)
+              :int8 it.unimi.dsi.fastutil.bytes.ByteComparators/NATURAL_COMPARATOR
+              :int16 it.unimi.dsi.fastutil.shorts.ShortComparators/NATURAL_COMPARATOR
+              :int32 it.unimi.dsi.fastutil.ints.IntComparators/NATURAL_COMPARATOR
+              it.unimi.dsi.fastutil.longs.LongComparators/NATURAL_COMPARATOR)
+        local-sidx (.binarySearch idxs sidx cmp)
+        local-eidx (.binarySearch idxs eidx cmp)
+        ^IMutList idxs (.subList idxs local-sidx local-eidx)
+        ^IMutList data (.subList ^IMutList (.-data scol) local-sidx local-eidx)
+        src-idx-iter (.iterator ^Iterable idxs)
+        src-val-iter (.iterator ^Iterable data)]
+    (if (.hasNext src-idx-iter)
+      (let [next-i (maybe-next-long src-idx-iter Long/MAX_VALUE)]
+        
+        (loop [acc (rfn acc next-i (.next src-val-iter))]
+          (cond
+            (reduced? acc) (deref acc)
+            (.hasNext src-val-iter) (let [next-i (maybe-next-long src-idx-iter Long/MAX_VALUE)]
+                                      (recur (rfn acc next-i (.next src-val-iter))))
+            :else acc)))
+      acc)))
+
+(defn ^:no-doc construct-sparse-col
+  ^SparseCol [indexes data ^long rc metadata]
+  (SparseCol. indexes data rc metadata nil nil))
+
+(defn- as-string-table
+  ^StringTable [d] (when (and (instance? StringTable d)
+                              (.-str->int ^StringTable d))
+                     d))
+
+(defn ->scol
+  ^SparseCol [col]
+  (cond
+    (nil? col) (throw (RuntimeException. "Cannot create scol from nil."))
+    (instance? SparseCol col) col
+    :else
+    (let [rc (dt/ecount col)
+          valid-indexes (set/difference (bitmap/->bitmap (hamf/range rc)) (ds-proto/missing col))
+          valid-indexes (ArrayLists/toList
+                         (cond
+                           (<= rc Byte/MAX_VALUE)
+                           (hamf/byte-array valid-indexes)
+                           (<= rc Short/MAX_VALUE)
+                           (hamf/short-array valid-indexes)
+                           (<= rc Integer/MAX_VALUE)
+                           (hamf/int-array valid-indexes)
+                           :else
+                           (hamf/long-array valid-indexes)))
+          col-dt (dt/elemwise-datatype col)
+          buf-rdr (dt/->reader (ds-proto/column-data col))
+          ^IMutList data (if (identical? :string col-dt)
+                           (if-let [^StringTable strt (as-string-table (ds-proto/column-data col))]
+                             (StringTable. (.-int->str strt)
+                                           (.-str->int strt)
+                                           (int-list/dynamic-int-list (dt/ecount valid-indexes)))
+                             (str-t/make-string-table))
+                           (dt/make-list col-dt (.size valid-indexes)))]
+      (reduce (case (tech.v3.datatype.casting/simple-operation-space col-dt)
+                :int64 (fn [_acc ^long src-idx]
+                         (.addLong data (.readLong buf-rdr src-idx)))
+                :float64 (fn [_acc ^long src-idx]
+                           (.addDouble data (.readDouble buf-rdr src-idx)))
+                (fn [_acc ^long src-idx]
+                  (.add data (.readObject buf-rdr src-idx))))
+              nil valid-indexes)
+      (SparseCol. valid-indexes data rc (meta col) nil nil))))
+
+(defn scol->reader
+  (^Buffer [^SparseCol scol] (scol->reader scol 0 (.-rc scol)))
+  (^Buffer [^SparseCol scol ^long sidx ^long eidx]
+   (let [rc (- eidx sidx)
+         ^IMutList data (.-data scol)
+         ^clojure.lang.IFn$LL idx-bin-search (index-bin-search (.-indexes scol))]
+     (case (casting/simple-operation-space (dt/elemwise-datatype data))
+       :int64
+       (reify LongReader
+         (lsize [this] rc)
+         (readLong [this idx]
+           (let [vidx (.invokePrim idx-bin-search (+ idx sidx))]
+             (if (neg? vidx)
+               Long/MIN_VALUE
+               (.getLong data vidx))))
+         (readObject [this idx]
+           (let [vidx (.invokePrim idx-bin-search (+ idx sidx))]
+             (if (neg? vidx)
+               nil
+               (.get data vidx))))
+         (subBuffer [this ssidx seidx] (scol->reader scol (+ ssidx sidx) (+ seidx sidx)))
+         (reduce [this rfn acc] (reduce-scol scol rfn acc sidx eidx)))
+       :float64
+       (reify DoubleReader
+         (lsize [this] rc)
+         (readDouble [this idx]
+           (let [vidx (.invokePrim idx-bin-search (+ idx sidx))]
+             (if (neg? vidx)
+               Double/NaN
+               (.getDouble data vidx))))
+         (readObject [this idx]
+           (let [vidx (.invokePrim idx-bin-search (+ idx sidx))]
+             (if (neg? vidx)
+               nil
+               (.get data vidx))))
+         (subBuffer [this ssidx seidx] (scol->reader scol (+ ssidx sidx) (+ seidx sidx)))
+         (reduce [this rfn acc] (reduce-scol scol rfn acc sidx eidx)))
+       (reify ObjectReader
+         (lsize [this] rc)
+         (readObject [this idx]
+           (let [vidx (.invokePrim idx-bin-search (+ idx sidx))]
+             (if (neg? vidx)
+               nil
+               (.get data vidx))))
+         (subBuffer [this ssidx seidx] (scol->reader scol (+ ssidx sidx) (+ seidx sidx)))
+         (reduce [this rfn acc] (reduce-scol scol rfn acc sidx eidx)))))))
+
+(defn sparse-rows
+  "Optimized implementation of ds/rows specifically assuming sparse columns"
+  (^Buffer [ds] (sparse-rows ds 0 (ds-proto/row-count ds)))
+  (^Buffer [ds ^long sidx ^long eidx]
+   (let [rc (- eidx sidx)
+         col-fns (mapv (fn [col]
+                         (let [cbuf (dt/->buffer col)
+                               cbuf (if (and (== sidx 0) (== eidx rc))
+                                      cbuf
+                                      (.subBuffer cbuf sidx eidx))
+                               cname (ds-proto/column-name col)]
+                           (fn [res  ^long row-idx]
+                             (when-let [rv (.readObject cbuf row-idx)]
+                               (.put ^Map res cname rv))
+                             res)))
+                       (.values ^Map ds))]
+     (reify ObjectReader
+       (lsize [this] rc)
+       (readObject [this idx]
+         (reduce (fn [acc cfn]
+                   (.invokePrim ^clojure.lang.IFn$OLO cfn acc idx))
+                 (hamf/linked-hashmap) col-fns))
+       (subBuffer [this ssidx seidx]
+         (ChunkedList/sublistCheck ssidx seidx rc)
+         (sparse-rows ds (+ sidx ssidx) (+ sidx seidx)))))))
+
+(defn ->sparse-ds
+  ([ds] (->sparse-ds ds 0.5))
+  ([ds missing-frac]
+   (let [rc (long (ds-proto/row-count ds))
+         missing-cutoff (long (* rc (double missing-frac)))]
+     (reduce (fn [ds col]
+               (if (>= (dt/ecount (ds-proto/missing col)) missing-cutoff)
+                 (assoc ds (ds-proto/column-name col) (->scol col))
+                 ds))
+             ds (.values ^java.util.Map ds)))))
+
+(defn is-sparse? [col] (instance? SparseCol col))
+
+(comment
+  (require '[tech.v3.dataset :as ds])
+  (require '[tech.v3.libs.arrow])
+  (def ds (ds/->dataset "../../nubank/dcm/mbrainz-big-final/6823d81f-ad0d-450e-90f9-efb1237575e8.arrow" {:key-fn keyword}))
+  (def test-col (ds :release/name))
+  (def test-scol (->scol test-col))
+  (def sds (ds->sparse-ds ds))
+
+  (def rr (ds/rows sds))
+  (def sr (sparse-rows sds))
+  (require '[criterium.core :as crit])
+  (crit/quick-bench (reduce (fn [acc _] (inc acc)) 0 (ds/rows sds)))     ;;26ms
+  (crit/quick-bench (reduce (fn [acc _] (inc acc)) 0 (ds/rows ds)))      ;;44ms
+  (crit/quick-bench (reduce (fn [acc _] (inc acc)) 0 (sparse-rows sds))) ;;19ms
+
+  (crit/quick-bench (-> (ds/select-rows ds (ds-proto/valid-rows (ds :release/name)))
+                        (ds/remove-empty-columns)))
+  (crit/quick-bench (-> (ds/select-rows sds (ds-proto/valid-rows (sds :release/name)))
+                        (ds/remove-empty-columns)))
+
+  (require '[clj-async-profiler.core :as prof])
+  (prof/profile (dotimes [idx 10]
+                  (-> (ds/select-rows sds (ds-proto/valid-rows (sds :release/name)))
+                      (ds/remove-empty-columns))))
+  (prof/serve-ui 8080)
+  (dotimes [idx 1000]
+    )
+  
+  )

tech.ml.dataset/src/tech/v3/dataset/io.clj

@@ -0,0 +1,301 @@
+(ns tech.v3.dataset.io
+  (:require [tech.v3.io :as io]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [charred.api :as charred]
+            [tech.v3.dataset.io.mapseq-colmap :as parse-mapseq-colmap]
+            [tech.v3.dataset.readers :as readers])
+  (:import [java.io InputStream File Reader]
+           [java.util Map]))
+
+
+(defn str->file-info
+  [^String file-str]
+  (let [file-str (.toLowerCase ^String file-str)
+        gzipped? (.endsWith file-str ".gz")
+        file-str (if gzipped?
+                   (.substring file-str 0 (- (count file-str) 3))
+                   file-str)
+        last-period (.lastIndexOf file-str ".")
+        file-type (if-not (== -1 last-period)
+                    (keyword (.substring file-str (inc last-period)))
+                    :unknown)]
+    {:gzipped? gzipped?
+     :file-type file-type}))
+
+
+(defn input-stream-or-reader
+  [input-data]
+  (if (instance? Reader input-data)
+    input-data
+    (io/input-stream input-data)))
+
+
+(defn wrap-stream-fn
+  [dataset gzipped? open-fn]
+  (with-open [^java.lang.AutoCloseable istream (if (instance? InputStream dataset)
+                                                 (if gzipped?
+                                                   (io/gzip-input-stream dataset)
+                                                   dataset)
+                                                 (if gzipped?
+                                                   (io/gzip-input-stream dataset)
+                                                   (input-stream-or-reader dataset)))]
+    (open-fn istream)))
+
+
+(defmulti data->dataset
+  (fn [_data options]
+    (:file-type options)))
+
+
+(defmethod data->dataset :default
+  [_data options]
+  (errors/throwf "Unrecognized read file type: %s"
+                 (:file-type options)))
+
+
+(defmethod data->dataset :json
+  [data options]
+  (with-open [is (if (get options :gzipped?)
+                   (io/gzip-input-stream data)
+                   (input-stream-or-reader data))]
+    ;;Use mixed json parse profile as we don't care if the input is immutable or mutable and
+    ;;mixed has the best performance.
+
+    (let [options (-> (assoc options :profile :mutable)
+                      ;; the charred read-json call has another interpretation of parser-fn
+                      ;; that is incompatible with the tmd one.
+                      (dissoc :parser-fn))]
+      (->> (apply charred/read-json is (apply concat (seq options)))
+           (parse-mapseq-colmap/mapseq->dataset options)))))
+
+
+(defmethod data->dataset :edn
+  [data options]
+  (with-open [is (if (get options :gzipped?)
+                   (io/gzip-input-stream data)
+                   (io/input-stream data))]
+    (->> (apply io/get-edn is (apply concat (seq options)))
+         (parse-mapseq-colmap/mapseq->dataset options))))
+
+
+(defmulti dataset->data!
+  (fn [_ds _output options]
+    (:file-type options)))
+
+
+(defmethod dataset->data! :json
+  [data output options]
+  (with-open [os (if (get options :gzipped?)
+                   (io/gzip-output-stream! output)
+                   (io/output-stream! output))]
+    (apply charred/write-json os
+           (readers/mapseq-reader data)
+           (apply concat (seq options)))))
+
+
+(defmethod dataset->data! :edn
+  [data output options]
+  (with-open [os (if (get options :gzipped?)
+                     (io/gzip-output-stream! output)
+                     (io/output-stream! output))]
+    (apply io/put-edn! os
+           (readers/mapseq-reader data)
+           (apply concat (seq options)))))
+
+(defmethod data->dataset :nippy
+  [data options]
+  ((requiring-resolve 'tech.v3.dataset.io.nippy/load-nippy) data options))
+
+(defmethod dataset->data! :nippy
+  [dataset output options]
+  ((requiring-resolve 'tech.v3.dataset.io.nippy/write-nippy!) dataset output options))
+
+
+(defmethod dataset->data! :default
+  [_ds _output options]
+  (errors/throwf "Unrecognized write file type: %s"
+                 (:file-type options)))
+
+
+
+(defn ->dataset
+  "Create a dataset from either csv/tsv or a sequence of maps.
+
+   * A `String` be interpreted as a file (or gzipped file if it
+     ends with .gz) of tsv or csv data.  The system will attempt to autodetect if this
+     is csv or tsv and then engineering around detecting datatypes all of which can
+     be overridden.
+
+  * InputStreams have no file type and thus a `file-type` must be provided in the
+    options.
+
+  * A sequence of maps may be passed in in which case the first N maps are scanned in
+    order to derive the column datatypes before the actual columns are created.
+
+  Parquet, xlsx, and xls formats require that you require the appropriate libraries
+  which are `tech.v3.libs.parquet` for parquet, `tech.v3.libs.fastexcel` for xlsx,
+  and `tech.v3.libs.poi` for xls.
+
+
+  Arrow support is provided via the tech.v3.libs.Arrow namespace not via a file-type
+  overload as the Arrow project current has 3 different file types and it is not clear
+  what their final suffix will be or which of the three file types it will indicate.
+  Please see documentation in the `tech.v3.libs.arrow` namespace for further information
+  on Arrow file types.
+
+  Options:
+
+  - `:dataset-name` - set the name of the dataset.
+  - `:file-type` - Override filetype discovery mechanism for strings or force a particular
+      parser for an input stream.  Note that parquet must have paths on disk
+      and cannot currently load from input stream.  Acceptible file types are:
+      #{:csv :tsv :xlsx :xls :parquet}.
+  - `:gzipped?` - for file formats that support it, override autodetection and force
+     creation of a gzipped input stream as opposed to a normal input stream.
+  - `:column-allowlist` - either sequence of string column names or sequence of column
+     indices of columns to allowlist. This is preferred to `:column-whitelist`
+  - `:column-blocklist` - either sequence of string column names or sequence of column
+     indices of columns to blocklist. This is preferred to `:column-blacklist`
+  - `:num-rows` - Number of rows to read
+  - `:header-row?` - Defaults to true, indicates the first row is a header.
+  - `:key-fn` - function to be applied to column names.  Typical use is:
+     `:key-fn keyword`.
+  - `:separator` - Add a character separator to the list of separators to auto-detect.
+  - `:csv-parser` - Implementation of univocity's AbstractParser to use.  If not
+     provided a default permissive parser is used.  This way you parse anything that
+     univocity supports (so flat files and such).
+  - `:bad-row-policy` - One of three options: :skip, :error, :carry-on.  Defaults to
+     :carry-on.  Some csv data has ragged rows and in this case we have several
+     options. If the option is :carry-on then we either create a new column or add
+     missing values for columns that had no data for that row.
+  - `:skip-bad-rows?` - Legacy option.  Use :bad-row-policy.
+  - `:disable-comment-skipping?` - As default, the `#` character is recognised as a
+     line comment when found in the beginning of a line of text in a CSV file,
+     and the row will be ignored. Set `true` to disable this behavior.
+  - `:max-chars-per-column` - Defaults to 4096.  Columns with more characters that this
+     will result in an exception.
+  - `:max-num-columns` - Defaults to 8192.  CSV,TSV files with more columns than this
+     will fail to parse.  For more information on this option, please visit:
+     https://github.com/uniVocity/univocity-parsers/issues/301
+  - `:text-temp-dir` - The temporary directory to use for file-backed text.  Setting
+    this value to boolean 'false' turns off file backed text which is the default.  If a
+    tech.v3.resource stack context is opened the file will be deleted when the context
+    closes else it will be deleted when the gc cleans up the dataset.  A shutdown hook is
+    added as a last resort to ensure the file is cleaned up.
+  - `:n-initial-skip-rows` - Skip N rows initially.  This currently may include the
+     header row.  Works across both csv and spreadsheet datasets.
+  - `:parser-type` - Default parser to use if no parser-fn is specified for that column.
+     For csv files, the default parser type is `:string` which indicates a promotional
+     string parser.  For sequences of maps, the default parser type is :object.  It can
+     be useful in some contexts to use the `:string` parser with sequences of maps or
+     maps of columns.
+  - `:parser-fn` -
+  v      - `keyword?` - all columns parsed to this datatype. For example:
+        `{:parser-fn :string}`
+      - `map?` - `{column-name parse-method}` parse each column with specified
+        `parse-method`.
+        The `parse-method` can be:
+          - `keyword?` - parse the specified column to this datatype. For example:
+            `{:parser-fn {:answer :boolean :id :int32}}`
+          - tuple - pair of `[datatype parse-data]` in which case container of type
+            `[datatype]` will be created. `parse-data` can be one of:
+              - `:relaxed?` - data will be parsed such that parse failures of the standard
+                 parse functions do not stop the parsing process.  :unparsed-values and
+                 :unparsed-indexes are available in the metadata of the column that tell
+                 you the values that failed to parse and their respective indexes.
+              - `fn?` - function from str-> one of `:tech.v3.dataset/missing`,
+                 `:tech.v3.dataset/parse-failure`, or the parsed value.
+                 Exceptions here always kill the parse process.  :missing will get marked
+                 in the missing indexes, and :parse-failure will result in the index being
+                 added to missing, the unparsed the column's :unparsed-values and
+                 :unparsed-indexes will be updated.
+              - `string?` - for datetime types, this will turned into a DateTimeFormatter via
+                 DateTimeFormatter/ofPattern.  For `:text` you can specify the backing file
+                 to use.
+              - `DateTimeFormatter` - use with the appropriate temporal parse static function
+                 to parse the value.
+
+   - `map?` - the header-name-or-idx is used to lookup value.  If not nil, then
+           value can be any of the above options.  Else the default column parser
+           is used.
+
+  Returns a new dataset"
+  ([dataset
+    {:keys [table-name dataset-name]
+     :as options}]
+   (let [dataset (if (instance? File dataset)
+                   (.toString ^File dataset)
+                   dataset)
+         ;;Unify table-name and dataset name with dataset-name
+         ;;taking precedence.
+         dataset-name (or dataset-name
+                          table-name
+                          (when (string? dataset)
+                            dataset))
+         options (if dataset-name
+                   (assoc options :dataset-name dataset-name)
+                   options)
+         dataset
+         (cond
+           (ds-proto/is-dataset? dataset)
+           dataset
+           (or (string? dataset)
+               (instance? InputStream dataset)
+               (instance? Reader dataset))
+           (let [options (if (string? dataset)
+                           (merge (str->file-info dataset)
+                                  options)
+                           options)]
+             (data->dataset dataset options))
+           (instance? Map dataset)
+           (parse-mapseq-colmap/column-map->dataset options dataset)
+           :else
+           (let [rv (parse-mapseq-colmap/mapseq->dataset options dataset)]
+             (if (tech.v3.dataset.impl.dataset/dataset? rv)
+               rv
+               (ds-impl/empty-dataset))))]
+     (if dataset-name
+       (vary-meta dataset assoc :name dataset-name)
+       dataset)))
+  ([dataset]
+   (->dataset dataset {})))
+
+
+(defn ->>dataset
+  "Please see documentation of ->dataset.  Options are the same."
+  ([options dataset]
+   (->dataset dataset options))
+  ([dataset]
+   (->dataset dataset)))
+
+
+(defn write!
+  "Write a dataset out to a file.  Supported forms are:
+
+```clojure
+(ds/write! test-ds \"test.csv\")
+(ds/write! test-ds \"test.tsv\")
+(ds/write! test-ds \"test.tsv.gz\")
+(ds/write! test-ds \"test.nippy\")
+(ds/write! test-ds out-stream)
+```
+
+Options:
+
+  * `:max-chars-per-column` - csv,tsv specific, defaults to 65536 - values longer than this will
+     cause an exception during serialization.
+  * `:max-num-columns` - csv,tsv specific, defaults to 8192 - If the dataset has more than this number of
+     columns an exception will be thrown during serialization.
+  * `:quoted-columns` - csv specific - sequence of columns names that you would like to always have quoted.
+  * `:file-type` - Manually specify the file type.  This is usually inferred from the filename but if you
+     pass in an output stream then you will need to specify the file type.
+  * `:headers?` - if csv headers are written, defaults to true."
+  ([dataset output-path options]
+   (let [options (merge (when (string? output-path)
+                          (str->file-info output-path))
+                        options)]
+     (dataset->data! dataset output-path options)))
+  ([dataset output-path]
+   (write! dataset output-path nil)))

tech.ml.dataset/src/tech/v3/dataset/io/column_parsers.clj

@@ -0,0 +1,568 @@
+(ns tech.v3.dataset.io.column-parsers
+  "Per-column parsers."
+  (:require [tech.v3.dataset.io.datetime :as parse-dt]
+            [tech.v3.dataset.impl.column-base :as column-base]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.argops :as argops]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [ham-fisted.api :as hamf])
+  (:import [java.util UUID List]
+           [tech.v3.dataset Text]
+           [tech.v3.datatype Buffer]
+           [ham_fisted IMutList Casts]
+           [org.roaringbitmap RoaringBitmap]
+           [clojure.lang IFn Indexed]
+           [java.time.format DateTimeFormatter]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+;;For sequences of maps and spreadsheets
+;; 1. No parser specified -  do not change datatype, do not change input value.
+;; Promote container as necessary; promotion requires a static cast when possible or
+;; all the way to object.
+;; 2. datatype,parser specified - if input value is correct datatype, add to container.
+;;    if input is incorrect datatype, call parse fn.
+
+
+;;For string-based pathways
+;; 1. If no parser is specified, try-parse where ::parse-failure means
+;; 2. If parse is specified, use parse if
+
+
+(def parse-failure :tech.v3.dataset/parse-failure)
+(def missing :tech.v3.dataset/missing)
+
+
+(defmacro make-safe-parser
+  [name parse-code]
+  `(fn ~name [~'v]
+     (try
+       ~parse-code
+       (catch Throwable _e#
+         parse-failure))))
+
+
+(def default-coercers
+  (merge
+   {:bool #(if (string? %)
+             (let [^String data %]
+               (cond
+                 (.equals "true" data) true
+                 (.equals "false" data) false
+                 :else parse-failure))
+             (boolean %))
+    :boolean #(if (string? %)
+                (let [^String data %]
+                  (cond
+                    (or (.equalsIgnoreCase "t" data)
+                        (.equalsIgnoreCase "y" data)
+                        (.equalsIgnoreCase "yes" data)
+                        (.equalsIgnoreCase "True" data)
+                        (.equalsIgnoreCase "positive" data))
+                    true
+                    (or (.equalsIgnoreCase "f" data)
+                        (.equalsIgnoreCase "n" data)
+                        (.equalsIgnoreCase "no" data)
+                        (.equalsIgnoreCase "false" data)
+                        (.equalsIgnoreCase "negative" data))
+                    false
+                    :else
+                    parse-failure))
+                (boolean %))
+    :int16 (make-safe-parser int16
+                  (if (string? v)
+                    (Short/parseShort v)
+                    (short v)))
+    :int32 (make-safe-parser int32 (if (string? v)
+                                     (Integer/parseInt v)
+                                     (int v)))
+    :int64 (make-safe-parser int64 (if (string? v)
+                                       (Long/parseLong v)
+                                       (long v)))
+    :float32 (make-safe-parser float32 (if (string? v)
+                                         (let [fval (Float/parseFloat v)]
+                                           (if (Float/isNaN fval)
+                                             missing
+                                             fval))
+                                         (float v)))
+    :float64 (make-safe-parser float64 (if (string? v)
+                                         (let [dval (Double/parseDouble v)]
+                                           (if (Double/isNaN dval)
+                                             missing
+                                             dval))
+                                         (double v)))
+    :uuid (make-safe-parser uuid (if (string? v)
+                                   (UUID/fromString v)
+                                   (if (instance? UUID v)
+                                     v
+                                     parse-failure)))
+    :keyword #(if-let [retval (keyword %)]
+                retval
+                parse-failure)
+    :symbol #(if-let [retval (symbol %)]
+               retval
+               parse-failure)
+    :string #(let [str-val (if (string? %)
+                             %
+                             (str %))]
+               (if (< (count str-val) 1024)
+                 str-val
+                 parse-failure))
+    :text #(Text. (str %))}
+   (->> parse-dt/datatype->general-parse-fn-map
+        (mapcat (fn [[k vv]]
+                  (let [unpacked-parser (make-safe-parser packed
+                                         (if (= k (dtype/elemwise-datatype v))
+                                            v
+                                            (vv v)))]
+                    ;;packing is now done at the container level.
+                    (if (packing/unpacked-datatype? k)
+                      [[k unpacked-parser]
+                       [(packing/pack-datatype k) unpacked-parser]]
+                      [[k unpacked-parser]]))))
+        (into {}))))
+
+
+(definterface PParser
+  (addValue [^long idx value])
+  (finalize [^long rowcount]))
+
+(defn add-value!
+  [^PParser p ^long idx value]
+  (.addValue p idx value))
+
+
+(defn finalize!
+  [^PParser p ^long rowcount]
+  (.finalize p rowcount))
+
+
+(defn add-missing-values!
+  ^long [^IMutList container ^RoaringBitmap missing
+         missing-value ^long idx]
+  (let [n-elems (.size container)]
+    (when (< n-elems idx)
+      (.add missing (long n-elems) idx)
+      (.add container n-elems (- idx n-elems) missing-value))
+    (- idx n-elems)))
+
+
+(defn finalize-parser-data!
+  [container missing failed-values failed-indexes
+   missing-value rowcount]
+  (add-missing-values! container missing missing-value rowcount)
+  (merge
+   #:tech.v3.dataset{:data (or (dtype/as-array-buffer container)
+                               (dtype/as-native-buffer container)
+                               (if (instance? clojure.lang.IDeref container)
+                                 @container
+                                 container))
+                     :missing missing
+                     :force-datatype? true}
+   (when (and failed-values
+              (not= 0 (dtype/ecount failed-values)))
+     #:tech.v3.dataset{:metadata {:unparsed-data failed-values
+                                  :unparsed-indexes failed-indexes}})))
+
+
+(defn- missing-value?
+  "Is this a missing value coming from a CSV file"
+  [value disable-na-as-missing?]
+  ;;fastpath for numbers
+  (cond
+    (or (instance? Double value) (instance? Float value))
+    (Double/isNaN (Casts/doubleCast value))
+    (not (instance? Number value))
+    (or (nil? value)
+        (identical? value :tech.v3.dataset/missing)
+        (and (string? value)
+             (or (.equals "" value)
+                 (and (not disable-na-as-missing?)
+                      (.equalsIgnoreCase ^String value "na")))))))
+
+
+(deftype FixedTypeParser [^IMutList container
+                          container-dtype
+                          missing-value parse-fn
+                          ^RoaringBitmap missing
+                          ^IMutList failed-values
+                          ^RoaringBitmap failed-indexes
+                          column-name
+                          ^:unsynchronized-mutable ^long max-idx
+                          disable-na-as-missing?]
+  dtype-proto/PECount
+  (ecount [_this] (inc max-idx))
+  Indexed
+  (nth [this idx] (.nth this idx nil))
+  (nth [this idx dv]
+    (let [cec (.size container)]
+      (if (or (>= idx cec)
+              (.contains missing idx))
+        nil
+        (.get container idx))))
+  PParser
+  (addValue [_this idx value]
+    (let [idx (unchecked-long idx)]
+      (set! max-idx (max idx max-idx))
+      ;;First pass is to potentially parse the value.  It could already
+      ;;be in the space of the container or it could require the parse-fn
+      ;;to make it.
+      (let [parsed-value (cond
+                           (missing-value? value disable-na-as-missing?)
+                           :tech.v3.dataset/missing
+                           (and (identical? (dtype/datatype value) container-dtype)
+                                (not (instance? String value)))
+                           value
+                           :else
+                           (parse-fn value))]
+        (cond
+          ;;ignore it; we will add missing when we see the first valid value
+          (identical? :tech.v3.dataset/missing parsed-value)
+          nil
+          ;;Record the original incoming value if we are parsing in relaxed mode.
+          (identical? :tech.v3.dataset/parse-failure parsed-value)
+          (if failed-values
+            (do
+              (.add failed-values value)
+              (.add failed-indexes (unchecked-int idx)))
+            (errors/throwf "Failed to parse value %s as datatype %s on row %d"
+                           value container-dtype idx))
+          :else
+          (do
+            (add-missing-values! container missing missing-value idx)
+            (.add container parsed-value))))))
+  (finalize [_p rowcount]
+    (finalize-parser-data! container missing failed-values failed-indexes
+                           missing-value rowcount)))
+
+
+(defn- find-fixed-parser
+  [kwd]
+  (if (= kwd :string)
+    str
+    (if-let [retval (get default-coercers kwd)]
+      retval
+      identity)))
+
+
+(defn- datetime-formatter-parser-fn
+  [parser-datatype formatter]
+  (let [unpacked-datatype (packing/unpack-datatype parser-datatype)
+        parser-fn (parse-dt/datetime-formatter-parse-str-fn
+                   unpacked-datatype formatter)]
+    [(make-safe-parser datetime (parser-fn v)) false]))
+
+
+(defn parser-entry->parser-tuple
+  [parser-kwd]
+  (if (vector? parser-kwd)
+    (do
+      (assert (= 2 (count parser-kwd)))
+      (let [[parser-datatype parser-fn] parser-kwd]
+        (assert (keyword? parser-datatype))
+        [parser-datatype
+         (cond
+           (= :relaxed? parser-fn)
+           [(find-fixed-parser parser-datatype) true]
+           (instance? IFn parser-fn)
+           [parser-fn true]
+           (and (dtype-dt/datetime-datatype? parser-datatype)
+                (string? parser-fn))
+           (datetime-formatter-parser-fn parser-datatype
+                                         (DateTimeFormatter/ofPattern parser-fn))
+           (and (dtype-dt/datetime-datatype? parser-datatype)
+                (instance? DateTimeFormatter parser-fn))
+           (datetime-formatter-parser-fn parser-datatype parser-fn)
+           (= :text parser-datatype)
+           [(find-fixed-parser parser-datatype)]
+           :else
+           (errors/throwf "Unrecoginzed parser fn type: %s" (type parser-fn)))]))
+    [parser-kwd [(find-fixed-parser parser-kwd) false]]))
+
+
+(defn make-fixed-parser
+  ^PParser [cname parser-kwd options]
+  (let [[dtype [parse-fn relaxed?]] (parser-entry->parser-tuple parser-kwd)
+        [failed-values failed-indexes] (when relaxed?
+                                         [(dtype/make-container :list :object 0)
+                                          (bitmap/->bitmap)])
+        container (column-base/make-container dtype options)
+        missing-value (column-base/datatype->missing-value dtype)
+        missing (bitmap/->bitmap)]
+    (FixedTypeParser. container dtype missing-value parse-fn
+                      missing failed-values failed-indexes
+                      cname -1
+                      (get options :disable-na-as-missing?))))
+
+(defn parser-kwd-list->parser-tuples
+  [kwd-list]
+  (mapv parser-entry->parser-tuple kwd-list))
+
+(def default-parser-datatype-sequence
+  [:bool :int16 :int32 :int64 :float64 :uuid
+   :packed-duration :packed-local-date
+   :zoned-date-time :string :text :boolean])
+
+(defn- promote-container
+  ^IMutList [old-container ^RoaringBitmap missing new-dtype options]
+  (let [n-elems (dtype/ecount old-container)
+        container (column-base/make-container new-dtype options)
+        missing-value (column-base/datatype->missing-value new-dtype)
+        ;;Ensure we unpack a container if we have to promote it.
+        old-container (packing/unpack old-container)]
+    (dotimes [idx n-elems]
+      (if (.contains missing idx)
+        (.add container missing-value)
+        (.add container (casting/cast
+                               (old-container idx)
+                               new-dtype))))
+    container))
+
+
+(defn- find-next-parser
+  ^long [value container-dtype ^List promotion-list]
+  (let [start-idx (argops/index-of (mapv first promotion-list) container-dtype)
+        n-elems (.size promotion-list)]
+    (if (== start-idx -1)
+      -1
+      (long (loop [idx (inc start-idx)]
+              (if (< idx n-elems)
+                (let [[_container-datatype parser-fn]
+                      (.get promotion-list idx)
+                      parsed-value (parser-fn value)]
+                  (if (= parsed-value parse-failure)
+                    (recur (inc idx))
+                    idx))
+                -1))))))
+
+
+(defn- resolve-parser-index
+  "Resolve the next parser index returning a tuple of [parser-datatype new-parser-fn]"
+  [next-idx ^List container container-dtype missing ^List promotion-list]
+  (let [next-idx (long next-idx)]
+    (if (== -1 next-idx)
+      [:object nil]
+      (let [n-missing (dtype/ecount missing)
+            n-valid (- (dtype/ecount container) n-missing)
+            parser-data (.get promotion-list next-idx)
+            parser-datatype (first parser-data)]
+        ;;Figure out if our promotion process will result in a valid container.
+        (cond
+          (== 0 n-valid)
+          parser-data
+          (and (or (identical? :bool container-dtype)
+                   (identical? :boolean container-dtype)
+                   (casting/numeric-type? container-dtype))
+               (casting/numeric-type? (packing/unpack-datatype parser-datatype)))
+          parser-data
+          :else
+          [:string (default-coercers :string)])))))
+
+
+(defn- fast-dtype
+  [value]
+  (if (string? value)
+    :string
+    (dtype/datatype value)))
+
+
+(deftype PromotionalStringParser [^{:unsynchronized-mutable true
+                                    :tag IMutList} container
+                                  ^{:unsynchronized-mutable true} container-dtype
+                                  ^{:unsynchronized-mutable true} missing-value
+                                  ^{:unsynchronized-mutable true} parse-fn
+                                  ^RoaringBitmap missing
+                                  ;;List of datatype,parser-fn tuples
+                                  ^List promotion-list
+                                  column-name
+                                  ^:unsynchronized-mutable ^long last-idx
+                                  options
+                                  disable-na-as-missing?]
+  dtype-proto/PECount
+  (ecount [_this] (inc last-idx))
+  Indexed
+  (nth [this idx] (.nth this idx nil))
+  (nth [this idx dv]
+    (let [cec (.size container)]
+      (if (or (>= idx cec)
+              (.contains missing idx))
+        nil
+        (.get container idx))))
+  PParser
+  (addValue [_p idx value]
+    (let [parsed-value
+          (cond
+            (missing-value? value disable-na-as-missing?)
+            :tech.v3.dataset/missing
+
+
+            (identical? (fast-dtype value) container-dtype)
+            value
+
+            ;;If we have a function to parse the data
+            parse-fn
+            (let [parsed-value (parse-fn value)]
+              ;;If the value parsed successfully
+              (if (not (identical? :tech.v3.dataset/parse-failure parsed-value))
+                parsed-value
+                ;;else Perform column promotion
+                (let [next-idx (find-next-parser value container-dtype promotion-list)
+                      [parser-datatype new-parser-fn]
+                      (resolve-parser-index next-idx container container-dtype
+                                            missing promotion-list)
+                      parsed-value (if new-parser-fn
+                                     (new-parser-fn value)
+                                     value)
+                      new-container (promote-container container missing
+                                                       parser-datatype
+                                                       options)
+                      new-missing-value (column-base/datatype->missing-value
+                                         parser-datatype)]
+                  ;;Update member variables based on new parser
+                  (set! container new-container)
+                  (set! container-dtype parser-datatype)
+                  (set! missing-value new-missing-value)
+                  (set! parse-fn new-parser-fn)
+                  parsed-value)))
+            ;;Else, nothing to parse with, just return string value
+            :else
+            value)]
+      (cond
+        ;;Promotional parsers should not have parse failures.
+        (identical? :tech.v3.dataset/parse-failure parsed-value)
+        (errors/throwf "Parse failure detected in promotional parser - Please file issue.")
+        (identical? :tech.v3.dataset/missing parsed-value)
+        nil ;;Skip, will add missing on next valid value
+        :else
+        (do
+          (when (> (- idx last-idx) 1)
+            (add-missing-values! container missing missing-value idx))
+          (set! last-idx idx)
+          (try
+            (.add container parsed-value)
+            (catch Exception e
+              (throw (RuntimeException. (str "Parse failure of datatype: "
+                                             (dtype/elemwise-datatype container))
+                                        e))))))))
+  (finalize [_p rowcount]
+    (finalize-parser-data! container missing nil nil missing-value rowcount)))
+
+
+(defn promotional-string-parser
+  (^PParser [column-name parser-datatype-sequence options]
+   (let [first-dtype (first parser-datatype-sequence)]
+     (PromotionalStringParser. (column-base/make-container
+                                (if (= :bool first-dtype)
+                                  :boolean
+                                  first-dtype)
+                                options)
+                               first-dtype
+                               false
+                               (default-coercers first-dtype)
+                               (bitmap/->bitmap)
+                               (mapv (juxt identity default-coercers)
+                                     parser-datatype-sequence)
+                               column-name
+                               -1
+                               options
+                               (get options :disable-na-as-missing?))))
+  (^PParser [column-name options]
+   (promotional-string-parser column-name default-parser-datatype-sequence options)))
+
+
+(deftype PromotionalObjectParser [^{:unsynchronized-mutable true
+                                    :tag IMutList} container
+                                  ^{:unsynchronized-mutable true} container-dtype
+                                  ^{:unsynchronized-mutable true} missing-value
+                                  ^RoaringBitmap missing
+                                  column-name
+                                  ^:unsynchronized-mutable ^long last-idx
+                                  ^:unsynchronized-mutable ^long max-idx
+                                  ^:unsynchronized-mutable ^long mc
+                                  disable-na-as-missing?
+                                  options]
+  dtype-proto/PECount
+  (ecount [_this] (inc max-idx))
+  Indexed
+  (nth [this idx] (.nth this idx nil))
+  (nth [this idx dv]
+    (let [cec (.size container)]
+      (if (or (>= idx cec)
+              (.contains missing idx))
+        nil
+        (.get container idx))))
+  ds-proto/PClearable
+  (ds-clear [this]
+    (.clear container)
+    (.clear missing)
+    (set! last-idx -1)
+    (set! max-idx -1)
+    (set! mc 0))
+  PParser
+  (addValue [_p idx value]
+    (set! max-idx idx)
+    (when-not (missing-value? value disable-na-as-missing?)
+      (let [val-dtype (fast-dtype value)]
+        ;;setup container for new data
+        (when-not (identical? container-dtype val-dtype)
+          (let [;;Avoid the pack call if possible
+                packed-dtype (packing/pack-datatype val-dtype)
+                container-ecount (.size container)
+                logical-ecount (- container-ecount mc)]
+            ;;Setup container
+            (if (== 0 logical-ecount)              
+              (do
+                (set! container (column-base/make-container (if (identical? container-dtype :boolean)
+                                                              packed-dtype
+                                                              (casting/widest-datatype container-dtype
+                                                                                       packed-dtype))
+                                                            options))
+                (set! container-dtype val-dtype)
+                (set! missing-value (column-base/datatype->missing-value packed-dtype)))
+              ;;boolean present a problem here.  We generally want to keep them as booleans
+              ;;and not promote them to full numbers.
+              (let [widest-datatype (if (identical? val-dtype :boolean)
+                                      (if (identical? container-dtype :boolean)
+                                        :boolean
+                                        :object)
+                                      (casting/widest-datatype
+                                       (packing/unpack-datatype container-dtype)
+                                       val-dtype))]
+                (when-not (= widest-datatype container-dtype)
+                  (let [new-container (promote-container container
+                                                         missing widest-datatype
+                                                         options)]
+                    (set! container new-container)
+                    (set! container-dtype widest-datatype)
+                    (set! missing-value (column-base/datatype->missing-value
+                                         widest-datatype))))))))
+        (when (> (- idx last-idx) 1)
+          (set! mc (+ mc (add-missing-values! container missing missing-value idx))))
+        (set! last-idx idx)
+        (.add container value))))
+  (finalize [_p rowcount]
+    (finalize-parser-data! container missing nil nil
+                           missing-value rowcount)))
+
+
+(defn promotional-object-parser
+  ^PParser [column-name options]
+  (PromotionalObjectParser. (dtype/make-list :boolean)
+                            :boolean
+                            false
+                            (bitmap/->bitmap)
+                            column-name
+                            -1
+                            -1
+                            0
+                            (get options :disable-na-as-missing?)
+                            options))

tech.ml.dataset/src/tech/v3/dataset/io/context.clj

@@ -0,0 +1,151 @@
+(ns tech.v3.dataset.io.context
+  (:require [clojure.string :as str]
+            [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.utils :as utils]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.impl.column :as col-impl]
+            [ham-fisted.api :as hamf])
+  (:import [java.util.function Function]
+           [java.util Map Arrays]
+           [tech.v3.datatype ObjectBuffer ArrayHelpers]
+           [tech.v3.dataset.impl.dataset Dataset]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn options->parser-fn
+  "Given the (beast of an) options map used for parsing, run through it
+  and created the specific parse context.  A parse context is a function
+  that produces a column parser for a given column name or index.
+  parse-type is either :string or :object."
+  [options parse-type]
+  (let [default-parse-fn (case (get options :parser-type parse-type)
+                           :object column-parsers/promotional-object-parser
+                           :string column-parsers/promotional-string-parser
+                           nil (constantly nil))
+        key-fn (or (:key-fn options) identity)
+        parser-descriptor (:parser-fn options)]
+    (fn [cname-or-index]
+      (let [cname (if (number? cname-or-index)
+                      (long cname-or-index)
+                      (key-fn cname-or-index))]
+        (cond
+          (nil? parser-descriptor)
+          (default-parse-fn cname options)
+          (map? parser-descriptor)
+          (if-let [col-parser-desc (or (get parser-descriptor cname)
+                                       (get parser-descriptor cname-or-index))]
+            (column-parsers/make-fixed-parser cname col-parser-desc options)
+            (default-parse-fn cname options))
+          :else
+          (column-parsers/make-fixed-parser cname parser-descriptor options))))))
+
+
+(defn- make-colname
+  [rd]
+  (if (number? rd)
+    (str "column-" rd)
+    rd))
+
+
+(deftype ObjectArrayList [^{:unsynchronized-mutable true
+                            :tag 'objects} data
+                          ^{:unsynchronized-mutable true
+                            :tag 'long} datalen]
+  ObjectBuffer
+  (lsize [_this] (alength ^objects data))
+  (writeObject [_this idx value]
+    (when (>= idx datalen)
+      (let [old-len datalen
+            new-len (* 2 idx)
+            new-data (Arrays/copyOf ^objects data new-len)]
+        (set! data new-data)
+        (set! datalen (alength new-data))))
+    (ArrayHelpers/aset ^objects data idx value))
+  (readObject [_this idx]
+    (when (< idx datalen)
+      (aget ^objects data idx))))
+
+(defrecord ^:private ParseRecord [^long col-idx
+                                  column-name
+                                  column-parser])
+
+(defn options->col-idx-parse-context
+  "Given an option map and a parse type, return a map of parsers
+  and a function to get a parser from a given column idx.
+  returns:
+  {:parsers - parsers
+   :col-idx->parser - given a column idx, get a parser.  Mutates parsers."
+  [{:keys [ensure-unique-column-names? unique-column-name-fn]
+    :or {unique-column-name-fn utils/rand-str-column-name-postfix}
+    :as options}
+   parse-type col-idx->colname]
+  (let [parse-context (options->parser-fn options parse-type)
+        parsers (ObjectArrayList. (object-array 16) 16)
+        key-fn (:key-fn options identity)
+        colname->idx (java.util.HashMap.)
+        colparser-compute-fn (reify Function
+                               (apply [this col-idx]
+                                 (let [colname (col-idx->colname col-idx)
+                                       colname (cond
+                                                 (nil? colname) (make-colname col-idx)
+                                                 (string? colname) (if (empty? colname)
+                                                                     (make-colname col-idx)
+                                                                     (utils/remove-zero-width-spaces colname))
+                                                 (sequential? colname) (if (empty? colname)
+                                                                         (make-colname colname)
+                                                                         colname)
+                                                 :else colname)
+                                       colname (if (and ensure-unique-column-names?
+                                                        (get colname->idx colname))
+                                                 (unique-column-name-fn col-idx colname)
+                                                 colname)]
+                                   (when (.containsKey colname->idx colname)
+                                     (let [prev-idx (.get colname->idx colname)]
+                                       (throw (RuntimeException. (format "Duplicate colname detected: \"%s\" is used on columns %d, %d"
+                                                                         colname prev-idx col-idx)))))
+                                   (.put colname->idx colname col-idx)
+                                   (ParseRecord. col-idx (key-fn colname) (parse-context colname)))))
+        col-idx->parser (fn cidx->parser [^long col-idx]
+                          (if-let [^ParseRecord parser (.readObject parsers col-idx)]
+                            (.-column-parser parser)
+                            (let [^ParseRecord parser (.apply colparser-compute-fn col-idx)]
+                              (.writeObject parsers col-idx parser)
+                              (.-column-parser parser))))]
+    {:parsers parsers
+     :col-idx->parser col-idx->parser}))
+
+
+(defn parsers->dataset
+  "Parsers are a sequence of maps of :column-name :column-parser; :columns-parser is an object that implement
+  tech.v3.dataset.io.column-parser.PParser/finalize! which returns the column data in map form
+  preferrably with :force-datatype? to avoid rescanning any data."
+  ([options parsers row-count]
+   (let [row-count (long row-count)
+         columns (hamf/mut-list)
+         cmap (hamf/mut-map)
+         dname (or (get options :name)
+                   (get options :dataset-name)
+                   "_unnamed")]
+     (transduce (remove nil?)
+                (fn
+                  ([] nil)
+                  ([acc] acc)
+                  ([acc ^Map parse-map]
+                   (let [column-name (.get parse-map :column-name)
+                         column-parser (.get parse-map :column-parser)]
+                     (.put cmap column-name (.size columns))
+                     (.add columns (-> (assoc (column-parsers/finalize! column-parser row-count)
+                                              :tech.v3.dataset/name column-name)
+                                       (col-impl/new-column))))))
+             (if (instance? Map parsers)
+               (vals parsers)
+               parsers))
+     (Dataset. (persistent! columns) (persistent! cmap) {:name dname} 0 0)))
+  ([options parsers]
+   (parsers->dataset options parsers
+                     (apply max 0 (map (comp dtype/ecount :column-parser)
+                                       parsers)))))

tech.ml.dataset/src/tech/v3/dataset/io/csv.clj

@@ -0,0 +1,333 @@
+(ns tech.v3.dataset.io.csv
+  "CSV parsing based on [charred.api/read-csv](https://cnuernber.github.io/charred/)."
+  (:require [charred.api :as charred]
+            [charred.bulk :as bulk]
+            [charred.coerce :as coerce]
+            [tech.v3.dataset.io :as ds-io]
+            [tech.v3.parallel.for :as pfor]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.io :as io]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.dataset.io.context :as parse-context]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.lazy-noncaching :as lznc])
+  (:import [tech.v3.datatype ArrayHelpers]
+           [clojure.lang IReduceInit]
+           [java.lang AutoCloseable]
+           [java.util Iterator]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(defn rows->dataset-fn
+  "Create an efficiently callable function to parse row-batches into datasets.
+  Returns function from row-iter->dataset.  Options passed in here are the
+  same as ->dataset."
+  [{:keys [header-row?]
+    :or {header-row? true}
+    :as options}]
+  (fn [row-iter]
+    (let [row-iter (coerce/->iterator row-iter)
+          header-row (if (and header-row? (.hasNext row-iter))
+                       (vec (.next row-iter))
+                       [])
+          n-header-cols (count header-row)
+          {:keys [parsers col-idx->parser]}
+          (parse-context/options->col-idx-parse-context
+           options :string (fn [^long col-idx]
+                             (when (< col-idx n-header-cols)
+                               (header-row col-idx))))
+          n-records (get options :n-records (get options :num-rows))]
+      ;;initialize parsers so if there are no more rows we get a dataset with
+      ;;at least column names
+      (dotimes [idx n-header-cols]
+        (col-idx->parser idx))
+
+      (if n-records
+        (let [n-records (long n-records)]
+          (loop [continue? (.hasNext row-iter)
+                 row-idx 0]
+            (if continue?
+              (do
+                (reduce (hamf-rf/indexed-accum
+                         acc col-idx field
+                         (-> (col-idx->parser col-idx)
+                             (column-parsers/add-value! row-idx field)))
+                        nil
+                        (.next row-iter))
+                (recur (and (.hasNext row-iter)
+                            (< (inc row-idx) n-records))
+                       (unchecked-inc row-idx)))
+              (parse-context/parsers->dataset options parsers))))
+        (loop [continue? (.hasNext row-iter)
+               row-idx 0]
+          (if continue?
+            (do
+              (reduce (hamf-rf/indexed-accum
+                       acc col-idx field
+                       (-> (col-idx->parser col-idx)
+                           (column-parsers/add-value! row-idx field)))
+                      nil
+                      (.next row-iter))
+              (recur (.hasNext row-iter) (unchecked-inc row-idx)))
+            (parse-context/parsers->dataset options parsers)))))))
+
+
+
+(defn csv->dataset-seq
+  "Read a csv into a lazy sequence of datasets.  All options of [[tech.v3.dataset/->dataset]]
+  are suppored aside from `:n-initial-skip-rows` with an additional option of
+  `:batch-size` which defaults to 128000.
+
+  Options are passed through to
+  [charred.bulk/batch-csv-rows](https://cnuernber.github.io/charred/charred.bulk.html#var-batch-csv-rows)
+  renaming where necessary.  This method defaults to using a load thread - see above method
+  for more options.  To disable the load thread use `:csv-load-thread-name nil`.
+
+  When using multithreaded loading, options are also passed through to
+  [ham-fisted.api/pmap-opts](https://cnuernber.github.io/ham-fisted/ham-fisted.api.html#var-pmap-opts)
+  so you can change the amount of `:n-lookahead` the pmap opteration uses when submitting jobs
+  to the thread pool.  By default this is set to 4 to decrease possible OOM sitations.
+
+  The input will only be closed once the entire sequence is realized.
+
+  Options:
+
+  * :load-tfn - dataset->x transformation function to be performed on
+    in the same thread context just after dataset is loaded.  Doing some operations
+    in this transform function can be considerably more efficient than only loading
+    the dataset when using multithreaded loading."
+  [input & [options]]
+  (let [options (merge {:profile :mutable
+                        :csv-load-thread-name "TMD CSV load thread"}
+                       options)
+        load-fn (rows->dataset-fn options)
+        threaded? (boolean (get options :csv-load-thread-name))
+        batches (->> (charred/read-csv-supplier (ds-io/input-stream-or-reader input) options)
+                     (bulk/batch-csv-rows (get options :batch-size 128000) options))
+        load-fn (if-let [tfn (get options :load-tfn)]
+                  #(tfn (load-fn %))
+                  load-fn)]
+    (if threaded?
+      (hamf/pmap-opts (merge {:n-lookahead (get options :csv-load-queue-size 4)}
+                             options)
+                      load-fn
+                      batches)
+      (lznc/map load-fn batches))))
+
+
+(defn csv->dataset
+  "Read a csv into a dataset.  Same options as [[tech.v3.dataset/->dataset]]."
+  [input & [options]]
+  (let [s (charred/read-csv-supplier (ds-io/input-stream-or-reader input)
+                                     (merge {:profile :mutable} options))
+        iter (if-let [n-initial-skip-rows (get options :n-initial-skip-rows)]
+               (let [iter (coerce/->iterator s)]
+                 (dotimes [idx n-initial-skip-rows]
+                   (when (.hasNext iter) (.next iter)))
+                 iter)
+               s)
+        retval ((rows->dataset-fn options) iter)]
+    (when (instance? AutoCloseable s)
+      (.close ^AutoCloseable s))
+    retval))
+
+
+(defn- load-csv
+  [data options]
+  (ds-io/wrap-stream-fn
+   data (:gzipped? options)
+   #(csv->dataset %1 options)))
+
+
+(defmethod ds-io/data->dataset :csv
+  [data options]
+  (load-csv data options))
+
+
+(defmethod ds-io/data->dataset :tsv
+  [data options]
+  (load-csv data (merge {:separator \tab} options)))
+
+
+(defmethod ds-io/data->dataset :txt
+  [data options]
+  (load-csv data options))
+
+
+(defn rows->csv!
+  "Given an something convertible to an output stream, an optional set of headers
+  as string arrays, and a sequence of string arrows, write a CSV or a TSV file.
+
+  Options:
+
+  * `:separator` - Defaults to \tab.
+  * `:quote` - Default \\\"
+  * `:quote?` A predicate function which determines if a string should be quoted.
+        Defaults to quoting only when necessary.  May also be the the value 'true' in which
+        case every field is quoted.
+  *  :newline - `:lf` (default) or `:cr+lf`.
+  *  :close-writer? - defaults to true.  When true, close writer when finished."
+  ([output headers rows]
+   (rows->csv! output headers rows {}))
+  ([output headers rows
+    {:keys [separator]
+     :or {separator \tab}
+     :as options}]
+   (apply charred/write-csv (io/writer! output)
+          (if headers (lznc/concat [headers] rows) rows)
+          (apply concat (seq (merge {:close-writer? true
+                                     :separator separator}
+                                    options))))))
+
+
+(defn- data->string
+  ^String [data-item]
+  (when-not (nil? data-item)
+    (cond
+      (string? data-item) data-item
+      (keyword? data-item) (name data-item)
+      (symbol? data-item) (name data-item)
+      :else (.toString ^Object data-item))))
+
+
+(defn- write-csv!
+  "Write a dataset to a tsv or csv output stream.  Closes output if a stream
+  is passed in.  File output format will be inferred if output is a string -
+    - .csv, .tsv - switches between tsv, csv.  Tsv is the default.
+    - *.gz - write to a gzipped stream.
+
+  options:
+
+  * `:separator` - in case output isn't a string, you can use either \\, or \\tab to switch
+    between csv or tsv output respectively.
+  * `:headers?` - if csv headers are written, defaults to true.
+  * `:gzipped?` - When true, use a gizpped output stream.
+  * `:file-type` - `:csv` or `:tsv`."
+  ([ds output options]
+   (let [{:keys [gzipped? file-type]}
+         (merge
+          (when (string? output)
+            (ds-io/str->file-info output))
+          options)
+         headers (when (get options :headers? true)
+                   (map (comp data->string :name meta) (vals ds)))
+         rows (->> (ds-proto/rowvecs ds nil)
+                   (lznc/map #(lznc/map data->string %)))
+         tsv? (or (= file-type :tsv) (= \tab (:separator options)))
+         output (if gzipped?
+                  (io/gzip-output-stream! output)
+                  output)]
+     (rows->csv! output headers rows (assoc options :separator (if tsv? \tab \,)))))
+  ([ds output]
+   (write-csv! ds output {})))
+
+
+(defmethod ds-io/dataset->data! :csv
+  [dataset output options]
+  (write-csv! dataset output options))
+
+
+(defmethod ds-io/dataset->data! :tsv
+  [dataset output options]
+  (write-csv! dataset output (assoc options :separator \tab)))
+
+
+(defmethod ds-io/dataset->data! :txt
+  [dataset output options]
+  (write-csv! dataset output (assoc options :separator \tab)))
+
+
+(comment
+
+  (do
+    (import '[java.util.zip ZipFile ZipInputStream])
+    (import '[java.util.concurrent ArrayBlockingQueue])
+    (require '[charred.api :as charred])
+    (require '[charred.bulk :as bulk])
+
+    (defn- abq->iterable
+      [^ArrayBlockingQueue abq]
+      (reify
+        Iterable
+        (iterator [this]
+          (println "iterator requested")
+          (let [nv* (volatile! (.take abq))]
+            (reify
+              java.util.Iterator
+              (hasNext [this] (not= ::finished @nv*))
+              (next [this]
+                (let [nv @nv*]
+                  (vreset! nv* (.take abq))
+                  nv)))))
+        IReduceInit
+        (reduce [this rfn acc]
+          (println "reduce requested")
+          (loop [acc acc
+                 nv (.take abq)]
+            (if (or (identical? ::finished nv)
+                    (not (reduced? acc)))
+              (recur (rfn acc nv) (.take abq))
+              (if (reduced? acc)
+                @acc
+                acc))))))
+
+    (defn load-zip
+      [fname]
+      (let [zf (ZipInputStream. (io/input-stream fname))
+            fe (.getNextEntry zf)
+            _ (println (format "Found %s" (.getName fe)))
+            parse-fn (rows->dataset-fn nil)]
+        (reduce (fn [rc batch]
+                  (+ rc (ds-proto/row-count (parse-fn batch))))
+                0
+                (bulk/batch-csv-rows 10000 (charred/read-csv-supplier zf)))))
+
+
+    (defn load-zip-parallel
+      [fname]
+      (let [zf (ZipInputStream. (io/input-stream fname))
+            fe (.getNextEntry zf)
+            _ (println (format "Found %s" (.getName fe)))
+            s (charred/read-csv-supplier zf)
+            row-batches (bulk/batch-csv-rows 10000 s)
+            batch-queue (ArrayBlockingQueue. 16)
+            n-parse-threads 6
+            csv-thread
+            (Thread. ^java.lang.Runnable
+                     (fn []
+                       (let [rc
+                             (reduce (fn [rc row-batch]
+                                       (let [data (vec row-batch)
+                                             rc (+ rc (count data))]
+                                         (.put batch-queue data)
+                                         rc))
+                                     0
+                                     row-batches)]
+                         (.put batch-queue ::finished)
+                         (println "csv parse thread finished")))
+                     "CSV parse thread")
+            _ (.start csv-thread)
+            sum (->> (abq->iterable batch-queue)
+                     (hamf/pmap #(ds-proto/row-count (first (rows->dataset-seq nil %))))
+                     (reduce + 0))]
+        (.join csv-thread)
+        (println "csv thread joined")
+        sum))
+
+    )
+
+  (def result (load-zip "/home/chrisn/Downloads/bigcsv/full_data.zip"))
+
+
+  (def result (load-zip-parallel "/home/chrisn/Downloads/bigcsv/full_data.zip"))
+
+
+
+  )

tech.ml.dataset/src/tech/v3/dataset/io/datetime.clj

@@ -0,0 +1,179 @@
+(ns tech.v3.dataset.io.datetime
+  "Helpful and well tested string->datetime pathways."
+  (:require [clojure.string :as s]
+            [tech.v3.datatype.datetime :as dtype-dt])
+  (:import [java.time LocalDate LocalDateTime LocalTime
+            ZonedDateTime OffsetDateTime Instant Duration]
+           [java.time.format DateTimeFormatter DateTimeFormatterBuilder]))
+
+
+(set! *warn-on-reflection* true)
+
+
+;;Assumping is that the string will have /,-. replaced with /space
+(def ^{:doc "Local date parser patterns used to generate the local date
+formatter."} local-date-parser-patterns
+  ["yyyy MM dd"
+   "yyyyMMdd"
+   "MM dd yyyy"
+   "dd MMM yyyy"
+   "M d yyyy"
+   "M d yy"
+   "MMM dd yyyy"
+   "MMM dd yy"
+   "MMM d yyyy"])
+
+
+(defn- date-preparse
+  ^String [^String data]
+  (.replaceAll data "[/,-. ]+" " "))
+
+
+(def ^{:doc "DateTimeFormatter that runs through a set of options in order to
+parse a wide variety of local date formats."
+       :tag DateTimeFormatter}
+  local-date-formatter
+  (let [builder (DateTimeFormatterBuilder.)]
+    (.parseCaseInsensitive builder)
+    (doseq [pattern local-date-parser-patterns]
+      (.appendOptional builder (DateTimeFormatter/ofPattern pattern)))
+    (.appendOptional builder DateTimeFormatter/ISO_LOCAL_DATE)
+    (.toFormatter builder)))
+
+
+(defn parse-local-date
+  "Convert a string into a local date attempting a wide variety of format types."
+  ^LocalDate [^String str-data]
+  (LocalDate/parse (date-preparse str-data) local-date-formatter))
+
+
+(def ^{:doc "Parser patterns to parse a wide variety of time strings"}
+  time-parser-patterns
+  ["HH:mm:ss:SSS"
+   "hh:mm:ss a"
+   "HH:mm:ss"
+   "h:mm:ss a"
+   "H:mm:ss"
+   "hh:mm a"
+   "HH:mm"
+   "HHmm"
+   "h:mm a"
+   "H:mm"])
+
+
+(def ^{:doc "DateTimeFormatter built to help parse a wide variety of time strings"
+       :tag DateTimeFormatter}
+  local-time-formatter
+  (let [builder (DateTimeFormatterBuilder.)]
+    (.parseCaseInsensitive builder)
+    (doseq [pattern time-parser-patterns]
+      (.appendOptional builder (DateTimeFormatter/ofPattern pattern)))
+    (.appendOptional builder DateTimeFormatter/ISO_LOCAL_TIME)
+    (.toFormatter builder)))
+
+
+(defn- local-time-preparse
+  ^String [^String data]
+  (.replaceAll data "[._]" ":"))
+
+
+(defn parse-local-time
+  "Convert a string into a local time attempting a wide variety of
+  possible parser patterns."
+  ^LocalTime [^String str-data]
+  (LocalTime/parse (local-time-preparse str-data) local-time-formatter))
+
+
+(defn parse-local-date-time
+  "Parse a local-date-time by first splitting the string and then separately
+  parsing the local-date portion and the local-time portions."
+  ^LocalDateTime [^String str-data]
+  (let [split-data (s/split str-data #"[ T]+")]
+    (cond
+      (== 2 (count split-data))
+      (let [local-date (parse-local-date (first split-data))
+            local-time (parse-local-time (second split-data))]
+        (LocalDateTime/of local-date local-time))
+      (== 3 (count split-data))
+      (let [local-date (parse-local-date (first split-data))
+            local-time (parse-local-time (str (split-data 1) " " (split-data 2)))]
+        (LocalDateTime/of local-date local-time))
+      :else
+      (throw (Exception. (format "Failed to parse \"%s\" as a LocalDateTime"
+                                 str-data))))))
+
+
+(defn parse-duration
+  "Attempt a few ways to parse a duration."
+  ^Duration [^String str-data]
+  (try
+    (Duration/parse str-data)
+    (catch Throwable _e
+      (let [duration-str (.trim str-data)
+            [duration-str mult] (if (.startsWith duration-str "-")
+                                  [(.substring duration-str 1) -1]
+                                  [duration-str 1])
+            dur-data (s/split duration-str #":")
+            _ (when-not (> (count dur-data) 1)
+                (throw (Exception. "Not a valid duration: %s")))
+            nanos (reduce (fn [nanos [idx next-data]]
+                            (+ (long nanos)
+                               (long
+                                (case (long idx)
+                                  0 (* (Integer/parseInt next-data)
+                                       (dtype-dt/nanoseconds-in-hour))
+                                  1 (* (Integer/parseInt next-data)
+                                       (dtype-dt/nanoseconds-in-minute))
+                                  2 (* (Integer/parseInt next-data)
+                                       (dtype-dt/nanoseconds-in-second))
+                                  3 (* (Integer/parseInt next-data)
+                                       (dtype-dt/nanoseconds-in-millisecond))))))
+                          0
+                          (map-indexed vector dur-data))]
+        (Duration/ofNanos (* (long mult) (long nanos)))))))
+
+
+(def ^{:doc "Map of datetime datatype to generalized parse fn."}
+  datatype->general-parse-fn-map
+  {:local-date parse-local-date
+   :local-date-time parse-local-date-time
+   :duration parse-duration
+   :local-time parse-local-time
+   :instant #(Instant/parse ^String %)
+   :zoned-date-time #(ZonedDateTime/parse ^String %)})
+
+
+(defn datetime-formatter-parse-str-fn
+  "Given a datatype and a formatter return a function that
+  attempts to parse that specific datatype."
+  [datatype formatter]
+  (case datatype
+    :local-date
+    #(LocalDate/parse % formatter)
+    :local-date-time
+    #(LocalDateTime/parse % formatter)
+    :local-time
+    #(LocalTime/parse % formatter)
+    :zoned-date-time
+    #(ZonedDateTime/parse % formatter)
+    :offset-date-time
+    #(OffsetDateTime/parse % formatter)))
+
+
+(defn datetime-formatter-or-str->parser-fn
+  "Given a datatype and one of [fn? string? DateTimeFormatter],
+  return a function that takes strings and returns datetime objects
+  of type datatype."
+  [datatype format-string-or-formatter]
+  (cond
+    (instance? DateTimeFormatter format-string-or-formatter)
+    (datetime-formatter-parse-str-fn datatype format-string-or-formatter)
+    (string? format-string-or-formatter)
+    (datetime-formatter-parse-str-fn
+     datatype
+     (DateTimeFormatter/ofPattern format-string-or-formatter))
+    (fn? format-string-or-formatter)
+    format-string-or-formatter
+    :else
+    (throw (Exception. (format "Unrecognized datetime parser type: %s"
+                               format-string-or-formatter)))))

tech.ml.dataset/src/tech/v3/dataset/io/mapseq_colmap.clj

@@ -0,0 +1,212 @@
+(ns ^:no-doc tech.v3.dataset.io.mapseq-colmap
+  "Sequences of maps are maybe the most basic pure datastructure for data.
+  Converting them into a more structured form (and back) is a key component of
+  dealing with datasets"
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.dataset.io.context :as parse-context]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.parallel.for :as pfor]
+            [tech.v3.datatype.argtypes :as argtypes]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [ham-fisted.lazy-noncaching :as lznc]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.protocols :as hamf-proto])
+  (:import [java.util HashMap Map$Entry Map Map$Entry LinkedHashMap Iterator]
+           [java.util.function Function Consumer]
+           [tech.v3.dataset.protocols PDatasetParser PClearable]
+           [clojure.lang IDeref Counted Indexed]
+           [ham_fisted Reductions$IndexedAccum Reducible Consumers$IncConsumer
+            ITypedReduce]))
+
+
+(defrecord ParseRecord [^long col-idx column-name column-parser]
+  ds-proto/PClearable
+  (ds-clear [this] (ds-proto/ds-clear column-parser)))
+
+
+(deftype ^:private MapseqReducer [options parsers consumer ^Consumers$IncConsumer row-idx]
+  Consumer
+  (accept [this row]
+    (hamf-rf/consume! consumer row)
+    (.inc row-idx))
+  Counted
+  (count [this] (.value row-idx))
+  PDatasetParser
+  (add-row [this row] (.accept this row))
+  (add-rows [this rows] (hamf-rf/consume! this rows))
+  Indexed
+  (nth [this idx] (nth this idx nil))
+  (nth [this idx dv]
+    (let [ec (.value row-idx)
+          idx (if (< idx 0)
+                (+ idx ec)
+                idx)]
+      (if (or (< idx 0)
+              (>= idx ec))
+        dv
+        (into {} (map (fn [^ParseRecord pr]
+                        [(.-column-name pr) (nth (.-column-parser pr)
+                                                 (unchecked-int idx))]))
+              (.values ^Map parsers)))))
+  ITypedReduce
+  (reduce [this rfn init]
+    (let [parser-vals (.values ^Map parsers)]
+      (reduce (fn [acc ^long idx]
+                (rfn acc (into {} (map (fn [^ParseRecord pr]
+                                         [(.-column-name pr) (nth (.-column-parser pr)
+                                                                  (unchecked-int idx))]))
+                               parser-vals)))
+              init (hamf/range (.value row-idx)))))
+  IDeref
+  (deref [this]
+    (if (.isEmpty ^Map parsers)
+      {:tech.v3.dataset/row-count (.value row-idx)
+       :tech.v3.dataset/missing :all}
+      (parse-context/parsers->dataset (assoc options :key-fn nil) parsers (.value row-idx))))
+  PClearable
+  (ds-clear [this]
+    (reduce (fn [_ p] (ds-proto/ds-clear p)) nil (.values ^Map parsers))
+    (.setValue row-idx 0)
+    this))
+
+
+(defn mapseq-reducer
+  "Create a non-parallelized mapseq hamf reducer.  If you want a single IFn that follows the
+  convention of clojure transducers call hamf/reducer->rfn."
+  [options]
+  (reify
+    hamf-proto/Reducer
+    (->init-val-fn [r]
+      #(let [parse-context (parse-context/options->parser-fn options :object)
+             parsers (LinkedHashMap.)
+             key-fn (:key-fn options identity)
+             colparser-compute-fn (hamf-fn/function
+                                   colname
+                                   (ParseRecord. (.size parsers) (key-fn colname) (parse-context colname)))
+             colname->parser (fn [colname]
+                               (.-column-parser ^ParseRecord
+                                                (.computeIfAbsent parsers colname
+                                                                  colparser-compute-fn)))
+             row-idx (hamf/inc-consumer)
+             consumer (hamf-fn/consumer
+                       e
+                       (let [^Map$Entry e e
+                             parser (colname->parser (.getKey e))]
+                         (column-parsers/add-value! parser (.value row-idx) (.getValue e))))]
+         (MapseqReducer. options parsers consumer row-idx)))
+    (->rfn [r] hamf-rf/consumer-accumulator)
+    hamf-proto/Finalize
+    (finalize [r v] @v)))
+
+
+(defn mapseq->dataset
+  ([options mapseq]
+   (hamf-rf/reduce-reducer (mapseq-reducer options) mapseq))
+  ([mapseq]
+   (mapseq->dataset {} mapseq)))
+
+
+(defn column-map->dataset
+  ([options column-map]
+   (let [parse-context (parse-context/options->parser-fn options :object)
+         coltypes (->> column-map
+                       (group-by (fn [e] (argtypes/arg-type (val e)))))
+         parse-scalar (fn [e ^long n-rows]
+                        #:tech.v3.dataset{:name (key e)
+                                          :data (dtype/const-reader (val e) n-rows)})]
+     ;;new rule - anything iterable can only be iterated once.  Not all iterables can be re-iterated
+     ;;without kicking off a potentially expensive process again
+     ;;This means that if we haven't decided on n-rows yet the iteration of all
+     ;;the iterables must both create columns *and* take the min length to be the new n-rows.
+
+     ;;If we have readers those dictate the dataset length
+     (if-let [rdr-cols (:reader coltypes)]
+       (let [n-rows (long (apply max (map (comp dtype/ecount val) rdr-cols)))]
+         (->> column-map
+              (pfor/pmap
+               (fn [e]
+                 (let [coldata (val e)
+                       colname (key e)]
+                   (case (argtypes/arg-type coldata)
+                     :scalar (parse-scalar e n-rows)
+                     :reader (if (identical? :object (dtype/elemwise-datatype coldata))
+                               (let [parser (parse-context colname)]
+                                 (reduce (hamf-rf/indexed-accum
+                                          acc idx v
+                                          (column-parsers/add-value! parser idx v))
+                                         nil
+                                         coldata)
+                                 (assoc (column-parsers/finalize! parser n-rows)
+                                        :tech.v3.dataset/name colname))
+                               #:tech.v3.dataset{:name colname
+                                                 :data coldata})
+                     :iterable (let [parser (parse-context colname)]
+                                 (reduce (hamf-rf/indexed-accum
+                                          acc idx v
+                                          (if (< idx n-rows)
+                                            (column-parsers/add-value! parser idx v)
+                                            (reduced true)))
+                                         nil coldata)
+                                 (assoc (column-parsers/finalize! parser n-rows)
+                                        :tech.v3.dataset/name colname))))))
+              (ds-impl/new-dataset options)))
+       ;;If we only have iterables the shortest one dictates dataset length
+       (if-let [iter-cols (:iterable coltypes)]
+         (let [[n-rows iterable-cols]
+               (let [iterable-cols iter-cols
+                     parse-contexts (mapv (fn [e]
+                                            (let [cname (key e)]
+                                              [cname
+                                               (parse-context cname)
+                                               (.iterator ^Iterable (ham-fisted.protocols/->iterable (val e)))]))
+                                          iterable-cols)
+                     val-data (object-array (count parse-contexts))
+                     next-valid?
+                     (fn [^long row-idx]
+                       (let [all-valid?
+                             (reduce (hamf-rf/indexed-accum
+                                      acc idx pctx
+                                      (let [^Iterator iter (nth pctx 2)]
+                                        (if (.hasNext iter)
+                                          (do
+                                            (aset val-data idx (.next iter))
+                                            true)
+                                          (reduced false))))
+                                     true
+                                     parse-contexts)]
+                         (when all-valid?
+                           (reduce (hamf-rf/indexed-accum
+                                    acc idx pctx
+                                    (column-parsers/add-value! (nth pctx 1) row-idx (aget val-data idx)))
+                                   nil
+                                   parse-contexts)
+                           true)))
+                     n-rows
+                     (loop [row-idx 0]
+                       (if (next-valid? row-idx)
+                         (recur (unchecked-inc row-idx))
+                         row-idx))]
+                 [n-rows
+                  (into {} (map (fn [val]
+                                  [(nth val 0)
+                                   (assoc (column-parsers/finalize! (nth val 1) n-rows)
+                                          :tech.v3.dataset/name (nth val 0))]))
+                        parse-contexts)])]
+           (->> column-map
+                (map
+                 (fn [e]
+                   (let [coldata (val e)
+                         colname (key e)]
+                     (case (argtypes/arg-type coldata)
+                       :scalar (parse-scalar e n-rows)
+                       :iterable (get iterable-cols colname)))))
+                (ds-impl/new-dataset options)))
+         ;;Finally constants have a dataset length of 1
+         (->> column-map
+              (map #(parse-scalar % 1))
+              (ds-impl/new-dataset options))))))
+  ([column-map]
+   (column-map->dataset nil column-map)))

tech.ml.dataset/src/tech/v3/dataset/io/nippy.clj

@@ -0,0 +1,58 @@
+(ns tech.v3.dataset.io.nippy
+  (:require [tech.v3.dataset.io :as ds-io]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.datatype.errors :as errors]
+            ;;Support for tensor/array buffers in nippy
+            [tech.v3.datatype.nippy]
+            [tech.v3.io :as io]
+            [taoensso.nippy :as nippy])
+  (:import [tech.v3.dataset.impl.dataset Dataset]
+           [tech.v3.dataset.impl.column Column]))
+
+
+(nippy/extend-freeze
+ Dataset :tech.ml/dataset
+ [ds out]
+ (nippy/-freeze-without-meta! (ds-base/dataset->data ds) out))
+
+
+(nippy/extend-thaw
+ :tech.ml/dataset
+ [in]
+ (-> (nippy/thaw-from-in! in)
+     (ds-base/data->dataset)))
+
+
+(nippy/extend-freeze
+ Column :tech.ml.dataset/column
+ [col out]
+ (nippy/-freeze-without-meta! (ds-base/column->data col) out))
+
+
+(nippy/extend-thaw
+ :tech.ml.dataset/column
+ [in]
+ (-> (nippy/thaw-from-in! in)
+     (ds-base/data->column)))
+
+
+(defn load-nippy
+  [data options]
+  (ds-io/wrap-stream-fn
+   data (:gzipped? options)
+   (fn [instream]
+     (let [retval (io/get-nippy instream)]
+       (errors/when-not-errorf
+        (instance? Dataset retval)
+        "Unthawed data is not a dataset: %s"
+        (type retval))
+       retval))))
+
+
+(defn write-nippy!
+  [dataset output options]
+  (if (:gzipped? options)
+    (with-open [os (io/gzip-output-stream! output)]
+      (let [^bytes data (nippy/freeze dataset)]
+        (.write os data)))
+    (io/put-nippy! output dataset)))

tech.ml.dataset/src/tech/v3/dataset/io/spreadsheet.clj

@@ -0,0 +1,61 @@
+(ns ^:no-doc tech.v3.dataset.io.spreadsheet
+  "Spreadsheets in general are stored in a cell-based format.  This means that any cell
+  could have data of any type.  Commonalities around parsing spreadsheet-type systems
+  are captured here."
+  (:require [tech.v3.dataset.io.context :as parse-context]
+            [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.datatype :as dtype])
+  (:import [tech.v3.dataset Spreadsheet$Sheet Spreadsheet$Row Spreadsheet$Cell]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn sheet->dataset
+  [^Spreadsheet$Sheet sheet
+   {:keys [header-row? n-initial-skip-rows]
+    :or {header-row? true}
+    :as options}]
+  (let [ds-name (or (:dataset-name options)
+                    (.name sheet)
+                    :_unnamed)
+        options (assoc options :dataset-name ds-name)
+        rows (iterator-seq (.iterator sheet))
+        n-initial-skip-rows (long (or n-initial-skip-rows 0))
+        rows (if-not (== 0 n-initial-skip-rows)
+               (drop-while #(< (.getRowNum ^Spreadsheet$Row %)
+                               (long n-initial-skip-rows))
+                           rows)
+               rows)
+        [header-row rows]
+        (if header-row?
+          ;;Always have to keep in mind that columns are sparse.
+          [(->> (first rows)
+                (map (fn [^Spreadsheet$Cell cell]
+                       (let [column-number (.getColumnNum cell)]
+                         [column-number (.value cell)])))
+                (into {}))
+            (rest rows)]
+          [{} rows])
+        {:keys [parsers col-idx->parser]}
+        (parse-context/options->col-idx-parse-context options :object header-row)
+        row-dec (+ n-initial-skip-rows (if header-row? 1 0))]
+    (doseq [^Spreadsheet$Row row rows]
+      (let [row-num (- (.getRowNum row) row-dec)]
+        (doseq [^Spreadsheet$Cell cell row]
+          (let [parser (col-idx->parser (.getColumnNum cell))]
+            (when-not (.missing cell)
+              (case (dtype/elemwise-datatype cell)
+                :boolean (column-parsers/add-value! parser row-num (.boolValue cell))
+                :float64 (column-parsers/add-value! parser row-num (.doubleValue cell))
+                (column-parsers/add-value! parser row-num (.value cell))))))))
+    ;;Fill out columns that only have missing values
+    (when-not (== 0 (count parsers))
+      (let [max-col-idx (->> parsers
+                             (map-indexed (fn [idx parser]
+                                            (when parser idx)))
+                             (remove nil?)
+                             (last))]
+        (dotimes [idx max-col-idx]
+          (col-idx->parser idx))))
+    (parse-context/parsers->dataset options parsers)))

tech.ml.dataset/src/tech/v3/dataset/io/string_row_parser.clj

@@ -0,0 +1,79 @@
+(ns tech.v3.dataset.io.string-row-parser
+  "Parsing functions based on raw data that is represented by a sequence
+  of string arrays."
+  (:require [tech.v3.dataset.io.column-parsers :as column-parsers]
+            [tech.v3.dataset.io.context :as parse-context]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.parallel.for :as pfor]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn rows->dataset
+  "Given a sequence of string[] rows, parse into columnar data.
+  See csv->columns.
+  This method is useful if you have another way of generating sequences of
+  string[] row data."
+  [{:keys [header-row? skip-bad-rows?]
+    :or {header-row? true}
+    :as options}
+   row-seq]
+  (let [initial-row (first row-seq)
+        header-row (dtype/->reader (if header-row?
+                                     initial-row
+                                     []))
+        n-header-cols (count header-row)
+        {:keys [parsers col-idx->parser]}
+        (parse-context/options->col-idx-parse-context
+         options :string (fn [^long col-idx]
+                           (when (< col-idx n-header-cols)
+                             (header-row col-idx))))]
+    ;;side effecting loop
+    (->> (if header-row?
+           (rest row-seq)
+           row-seq)
+         (map-indexed vector)
+         (pfor/consume!
+          (fn [[^long row-idx ^"[Ljava.lang.String;" row]]
+            (when-not (and skip-bad-rows? (not= (alength row) n-header-cols))
+              (dotimes [col-idx (alength row)]
+                (let [parser (col-idx->parser col-idx)]
+                  (column-parsers/add-value! parser row-idx (aget row col-idx))))))))
+    (parse-context/parsers->dataset options parsers)))
+
+
+(defn partition-all-rows
+  "Given a sequence of rows, partition into an undefined number of partitions of at most
+  N rows but keep the header row as the first for all sequences."
+  ([{:keys [header-row?]
+     :or {header-row? true}} n row-seq]
+   (let [[header-row row-seq] (if header-row?
+                                [(first row-seq) (rest row-seq)]
+                                [nil row-seq])
+         row-partitions (partition-all n row-seq)]
+     (if header-row
+       (map #(concat [header-row] %) row-partitions)
+       row-partitions))))
+
+
+(defn sample-rows
+  "Sample at most N rows selected randomly from the row sequence.  If sequence is
+  shorter than length N will return less than N rows.
+  Uses naive reservoir sampling:
+  https://en.wikipedia.org/wiki/Reservoir_sampling"
+  [{:keys [header-row?]
+    :or {header-row? true}} n row-seq]
+  (let [[header-row row-seq] (if header-row?
+                               [(first row-seq) (rest row-seq)]
+                               [nil row-seq])
+        n (long n)
+        ^objects row-data (into-array Object (take n row-seq))
+        row-seq (seq (drop n row-seq))]
+    ;;if we have more data than N
+    (doseq [[idx row] (map-indexed vector row-seq)]
+      (let [idx (+ (long idx) n)
+            replace-idx (rand-int idx)]
+        (when (< replace-idx n)
+          (aset row-data replace-idx row))))
+    (concat [header-row] row-data)))

tech.ml.dataset/src/tech/v3/dataset/io/svm.clj

@@ -0,0 +1,65 @@
+(ns tech.v3.dataset.io.svm
+  (:require [clojure.string :as s]))
+
+
+(def test-line "1 1:2.617300e+01 2:5.886700e+01 3:-1.894697e-01 4:1.251225e+02")
+
+
+(defn- parse-line
+  [line]
+  (let [parse (s/split line #"\s+")
+        label (Double/parseDouble (first parse))
+        idx-val-pairs (->> (rest parse)
+                           (map (fn [item]
+                                  (let [[idx val] (s/split item #":")]
+                                    [(Long/parseLong idx)
+                                     (Double/parseDouble val)]))))]
+    {:label label
+     :features (->> idx-val-pairs
+                    (into {}))
+     :max-idx (apply max (map first idx-val-pairs))
+     :min-idx (apply min (map first idx-val-pairs))}))
+
+
+(defn parse-svm-file
+  "Parse an svm file and generate a dataset of {:features :label}.  Always
+  represents result as a dense matrix; no support for sparse datasets."
+  [fname & {:keys [label-map]}]
+  (let [f-data (slurp fname)
+        [labels features min-idx max-idx]
+        (->> (s/split f-data #"\n")
+             (pmap parse-line)
+             (reduce
+              (fn [[labels features min-idx max-idx] next-line]
+                (let [{label :label
+                       line-feature :features
+                       line-max-idx :max-idx
+                       line-min-idx :min-idx} next-line]
+                  [(conj labels (if label-map
+                                  (if-let [label-value (get label-map label)]
+                                    label-value
+                                    (throw (ex-info (format "Failed to find label for value: %s" label)
+                                                    {:label-map label-map})))
+                                  label))
+                   (conj features (->> line-feature
+                                       (map (fn [[k v]]
+                                              [(str k) v]))
+                                       (into {})))
+                   (if (and min-idx
+                            (< min-idx line-min-idx))
+                     min-idx
+                     line-min-idx)
+                   (if (and max-idx
+                            (> max-idx line-max-idx))
+                     max-idx
+                     line-max-idx)]))
+              [[] [] nil nil]))
+        min-idx (long min-idx)
+        max-idx (long max-idx)
+        _num-items (+ 1 (- max-idx min-idx))]
+    {:min-idx min-idx
+     :max-idx max-idx
+     :feature-ecount (+ 1 (- max-idx min-idx))
+     :dataset (map (fn [label features]
+                     (assoc features :label label))
+                   labels features)}))

tech.ml.dataset/src/tech/v3/dataset/io/univocity.clj

@@ -0,0 +1,390 @@
+(ns tech.v3.dataset.io.univocity
+  "Bindings to univocity.  Transforms csv's, tsv's into sequences
+  of string arrays that are then passed into `tech.v3.dataset.io.string-row-parser`
+  methods."
+  (:require [tech.v3.io :as io]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.dataset.io.string-row-parser :as row-parser]
+            [tech.v3.dataset.io :as ds-io]
+            [tech.v3.dataset.column :as ds-col]
+            [tech.v3.dataset.utils :as ds-utils])
+  (:import  [tech.v3.datatype ObjectReader]
+            [com.univocity.parsers.common AbstractParser AbstractWriter CommonSettings]
+            [com.univocity.parsers.csv CsvParserSettings CsvParser CsvWriterSettings CsvWriter]
+            [com.univocity.parsers.tsv
+             TsvWriterSettings TsvWriter]
+            [java.io Reader Closeable Writer]
+            [java.util List]
+            [java.lang AutoCloseable]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn- sequence-type
+  [item-seq]
+  (cond
+    (every? string? item-seq)
+    :string
+    (every? number? item-seq)
+    :number
+    :else
+    (throw (Exception. "Item seq must of either strings or numbers"))))
+
+
+(defn- ->character
+  [item]
+  (cond
+    (instance? Character item)
+    item
+    (string? item)
+    (if (== 1 (count item))
+      (first item)
+      (throw (Exception.
+              (format "Multicharacter separators (%s) are not supported." item))))
+    :else
+    (throw (Exception. (format "'%s' is not a valid separator" item)))))
+
+(defn- default-csv-options
+  [options]
+  (-> options
+      (update :max-chars-per-column #(or % (* 64 1024)))
+      (update :max-num-columns #(or % 8192))))
+
+
+
+(defn- apply-options-to-format!
+  ^CommonSettings [^CommonSettings settings {:keys [disable-comment-skipping?]}]
+  (when disable-comment-skipping?
+    (-> settings .getFormat (.setComment \u0000)))
+  settings)
+
+
+
+(defn- apply-options-to-settings!
+  ^CommonSettings [^CommonSettings settings options]
+  (let [{:keys [max-chars-per-column
+                max-num-columns]} (default-csv-options options)]
+    (doto settings
+      (.setMaxCharsPerColumn (long max-chars-per-column))
+      (.setMaxColumns (long max-num-columns))
+      (apply-options-to-format! options)))
+  settings)
+
+
+
+(defn create-csv-parser
+  "Create an implementation of univocity csv parser."
+  ^AbstractParser [{:keys [header-row?
+                           num-rows
+                           column-whitelist
+                           column-blacklist
+                           column-allowlist
+                           column-blocklist
+                           separator
+                           n-initial-skip-rows]
+                    :or {header-row? true
+                         ;;64K max chars per column.  This is a silly thing to have
+                         ;;to set...
+                         }
+                    :as options}]
+  (if-let [csv-parser (:csv-parser options)]
+    csv-parser
+    (let [settings (CsvParserSettings.)
+          num-rows (or num-rows (:n-records options))]
+      (when separator
+        (.detectFormatAutomatically settings
+                                    (into-array Character/TYPE
+                                                [(->character separator)])))
+      (when num-rows
+        (.setNumberOfRecordsToRead settings (if header-row?
+                                              (inc (int num-rows))
+                                              (int num-rows))))
+      (apply-options-to-settings! settings options)
+      (doto settings
+        (.setSkipEmptyLines true)
+        (.setIgnoreLeadingWhitespaces true)
+        (.setIgnoreTrailingWhitespaces true))
+      (when n-initial-skip-rows
+        (.setNumberOfRowsToSkip settings (int n-initial-skip-rows)))
+      (when (or (seq column-whitelist)
+                (seq column-blacklist))
+        (when (and (seq column-whitelist)
+                   (seq column-blacklist))
+          (throw (Exception.
+                  "Either whitelist or blacklist can be provided but not both")))
+        (when (and (seq column-allowlist)
+                   (seq column-blocklist))
+          (throw (Exception.
+                  "Either allowlist or blocklist can be provided but not both")))
+        (when (and (seq column-allowlist)
+                   (seq column-whitelist))
+          (throw (Exception.
+                  "Either allowlist or whitelist can be provided but not both")))
+        (when (and (seq column-blacklist)
+                   (seq column-blocklist))
+          (throw (Exception.
+                  "Either blacklist or blocklist can be provided but not both")))
+        (let [[string-fn! number-fn!]
+              (if (seq column-whitelist)
+                [#(.selectFields
+                   settings
+                   ^"[Ljava.lang.String;" (into-array String %))
+                 #(.selectIndexes
+                   settings
+                   ^"[Ljava.lang.Integer;" (into-array Integer (map int %)))]
+                [#(.excludeFields
+                   settings
+                   ^"[Ljava.lang.String;" (into-array String %))
+                 #(.excludeIndexes
+                   settings
+                   ^"[Ljava.lang.Integer;"(into-array Integer (map int %)))])
+              column-data (if (seq (or column-allowlist column-whitelist))
+                            (or column-allowlist column-whitelist)
+                            (or column-blocklist column-blacklist))
+              column-type (sequence-type column-data)]
+          (case column-type
+            :string (string-fn! column-data)
+            :number (number-fn! column-data))))
+      (CsvParser. settings))))
+
+
+(deftype RawRowIterator  [^:unsynchronized-mutable closer
+                          ^AbstractParser parser
+                          ^:unsynchronized-mutable next-val]
+  java.util.Iterator
+  (hasNext [_this] (boolean next-val))
+  (next [_this]
+    (let [retval next-val]
+      (set! next-val (.parseNext parser))
+      (when-not next-val
+        (when closer
+          (cond
+            (instance? Closeable closer)
+            (.close ^Closeable closer)
+            (instance? AutoCloseable closer)
+            (.close ^AutoCloseable closer))
+          (set! closer nil)))
+      retval)))
+
+
+(defn raw-row-iterable
+  "Returns an iterable that produces string[]'s"
+  (^Iterable [input ^AbstractParser parser]
+   (reify Iterable
+     (iterator [this]
+       (let [^Reader reader (io/reader input)]
+         (.beginParsing parser reader)
+         (RawRowIterator. reader parser (.parseNext parser))))))
+  (^Iterable [input]
+   (raw-row-iterable input (create-csv-parser {}))))
+
+
+(defn csv->rows
+  "Given a csv, produces a sequence of rows.  The csv options from ->dataset
+  apply here.
+
+  options:
+
+  - `:column-allowlist` - either sequence of string column names or sequence of column
+     indices of columns to whitelist. In preference to `:column-whitelist`.
+  - `:column-blocklist` - either sequence of string column names or sequence of column
+     indices of columns to blacklist. In preference to `:column-blacklist`.
+  - `:num-rows` - Number of rows to read
+  - `:separator` - Add a character separator to the list of separators to auto-detect.
+  - `:max-chars-per-column` - Defaults to 4096.  Columns with more characters that this
+     will result in an exception.
+  - `:max-num-columns` - Defaults to 8192.  CSV,TSV files with more columns than this
+     will fail to parse.  For more information on this option, please visit:
+     https://github.com/uniVocity/univocity-parsers/issues/301"
+  ([input options]
+   (raw-row-iterable
+    input
+    (create-csv-parser options)))
+  ([input]
+   (csv->rows input {})))
+
+
+(defn csv->dataset
+  "Non-lazily and serially parse the columns.  Returns a vector of maps of
+  {
+   :name column-name
+   :missing long-reader of in-order missing indexes
+   :data typed reader/writer of data
+   :metadata - optional map with unparsed-indexes and unparsed-values
+  }
+  Supports a subset of tech.v3.dataset/->dataset options:
+  :column-allowlist in preference to :column-whitelist
+  :column-blocklist in preference to :column-blacklist
+  :n-initial-skip-rows
+  :num-rows
+  :header-row?
+  :separator
+  :parser-fn
+  :parser-scan-len"
+  ([input options]
+   (->> (csv->rows input options)
+        (seq)
+        (row-parser/rows->dataset options)))
+  ([input]
+   (csv->dataset input {})))
+
+
+(defn- load-csv
+  [data options]
+  (ds-io/wrap-stream-fn
+   data (:gzipped? options)
+   #(csv->dataset %1 options))
+  )
+
+
+#_(defmethod ds-io/data->dataset :csv
+  [data options]
+  (load-csv data options))
+
+
+#_(defmethod ds-io/data->dataset :tsv
+  [data options]
+  (load-csv data (merge {:separator \tab} options)))
+
+
+#_(defmethod ds-io/data->dataset :txt
+  [data options]
+    (load-csv data options))
+
+
+(defprotocol PApplyWriteOptions
+  (apply-write-options! [settings options]))
+
+
+(extend-protocol PApplyWriteOptions
+  CsvWriterSettings
+  (apply-write-options! [settings options]
+    (when-let [quoted-fields (seq (:quoted-columns options))]
+      (let [^"[Ljava.lang.String;" str-ary
+            (into-array String (map ds-utils/column-safe-name quoted-fields))]
+        (.quoteFields settings str-ary)))
+    settings)
+  TsvWriterSettings
+  (apply-write-options! [settings options]
+    settings))
+
+
+(defn rows->csv!
+  "Given an something convertible to an output stream, an optional set of headers
+  as string arrays, and a sequence of string arrows, write a CSV or a TSV file.
+
+  Options:
+
+  * `:separator` - Defaults to \tab.
+  * `:quoted-columns` - For csv, specify which columns should always be quoted
+    regardless of their data."
+  ([output header-string-array row-string-array-seq]
+   (rows->csv! output header-string-array row-string-array-seq {}))
+  ([output header-string-array row-string-array-seq
+    {:keys [separator]
+     :or {separator \tab}
+     :as options}]
+   (let [^Writer writer (io/writer! output)
+
+         ^AbstractWriter csvWriter
+         (if (:csv-writer options)
+           (:csv-writer options)
+           (let [settings (-> (case separator
+                                \,
+                                (CsvWriterSettings.)
+                                \tab
+                                (TsvWriterSettings.))
+                              (apply-options-to-settings! options)
+                              (apply-write-options! options))]
+             (cond
+               (instance? CsvWriterSettings settings)
+               (CsvWriter. writer ^CsvWriterSettings settings)
+               (instance? TsvWriterSettings settings)
+               (TsvWriter. writer ^TsvWriterSettings settings)
+               :else
+               (errors/throwf "Unrecognized settings type %s" (type settings))
+               )))]
+     (when header-string-array
+       (.writeHeaders csvWriter ^"[Ljava.lang.String;" header-string-array))
+     (try
+       (doseq [^"[Ljava.lang.String;" row row-string-array-seq]
+         (.writeRow csvWriter row))
+       (finally
+         (.close csvWriter))))))
+
+
+(defn- data->string
+  ^String [data-item]
+  (when-not (nil? data-item)
+    (cond
+      (string? data-item) data-item
+      (keyword? data-item) (name data-item)
+      (symbol? data-item) (name data-item)
+      :else (.toString ^Object data-item))))
+
+
+(defn- write-csv!
+  "Write a dataset to a tsv or csv output stream.  Closes output if a stream
+  is passed in.  File output format will be inferred if output is a string -
+    - .csv, .tsv - switches between tsv, csv.  Tsv is the default.
+    - *.gz - write to a gzipped stream.
+  At this time writing to json is not supported.
+  options -
+  :separator - in case output isn't a string, you can use either \\, or \\tab to switch
+    between csv or tsv output respectively.
+  :headers? - if csv headers are written, defaults to true."
+  ([ds output options]
+   (let [{:keys [gzipped? file-type]}
+         (merge
+          (when (string? output)
+            (ds-io/str->file-info output))
+          options)
+         {:keys [max-chars-per-column
+                 max-num-columns]} (default-csv-options options)
+         columns (vals ds)
+         _ (errors/when-not-errorf
+            (<= (count columns) (long max-num-columns))
+            "Too many columns detected (%d) for max-num-columns (%d)"
+            (count columns) max-num-columns)
+
+         headers (when (get options :headers? true)
+                   (into-array String
+                               (map (comp data->string :name meta) columns)))
+         column-names (mapv (comp :name meta) columns)
+         ^List str-readers
+         (mapv (comp dtype/->reader #(ds-col/column-map data->string :string %)) columns)
+
+         tsv? (or (= file-type :tsv) (= \tab (:separator options)))
+         [n-cols n-rows] (dtype/shape ds)
+         n-cols (long n-cols)
+         n-rows (long n-rows)
+         max-chars-per-column (long max-chars-per-column)
+         ;;Create a reader that produces string arrays of each row.
+         str-rdr (reify ObjectReader
+                   (lsize [rdr] n-rows)
+                   (readObject [rdr row-idx]
+                     (let [^"[Ljava.lang.String;" str-array (make-array
+                                                             String n-cols)]
+                       (dotimes [col-idx n-cols]
+                         (let [str-data (.readObject ^ObjectReader
+                                                     (.get str-readers col-idx)
+                                                     row-idx)]
+                           (errors/when-not-errorf
+                            (< (count str-data) max-chars-per-column)
+                            "Column %s has value whose length (%d) is greater than max-chars-per-column (%d)."
+                            (column-names col-idx) (count str-data) max-chars-per-column)
+                           (aset str-array col-idx ^String str-data)))
+                       str-array)))
+         output (if gzipped?
+                  (io/gzip-output-stream! output)
+                  output)
+         output-options (if tsv?
+                          (merge options
+                                 {:separator \tab})
+                          (merge options
+                                 {:separator \,}))]
+     (rows->csv! output headers str-rdr output-options)))
+  ([ds output]
+   (write-csv! ds output {})))

tech.ml.dataset/src/tech/v3/dataset/join.clj

@@ -0,0 +1,799 @@
+(ns tech.v3.dataset.join
+  "implementation of join algorithms, both exact (hash-join) and near."
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.argops :as argops]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.parallel.for :as parallel-for]
+            [tech.v3.dataset.column :as ds-col]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.readers :as ds-readers]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.utils :as ds-utils]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.function :as hamf-fn]
+            [clj-commons.primitive-math :as pmath]
+            [clojure.set :as set])
+  (:import [tech.v3.datatype ObjectReader Buffer
+            BinaryPredicate BinaryOperator
+            BinaryOperators$DoubleBinaryOperator]
+           [ham_fisted IMutList]
+           [java.util List HashSet Map Set]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn- colname->str
+  ^String [item]
+  (ds-utils/column-safe-name item))
+
+
+(defn- similar-colname-type
+  [orign-name new-name]
+  (cond
+    (string? orign-name) new-name
+    (keyword? orign-name) (keyword new-name)
+    (symbol? orign-name) (symbol new-name)
+    :else
+    new-name))
+
+
+(defn- colname->lhs-rhs-colnames
+  [colname]
+  (if (instance? java.util.Collection colname)
+    colname
+    [colname colname]))
+
+
+(declare finalize-join-result)
+
+
+(defn- add-all!
+  [^List target ^List new-data]
+  (.addAll target new-data)
+  target)
+
+(defn- default-table-name
+  [ds-table default-val]
+  (if (= (ds-base/dataset-name ds-table) "_unnamed")
+    default-val
+    (ds-base/dataset-name ds-table)))
+
+(defn- nice-column-names
+  [& table-name-column-seq-pairs]
+  (->>
+   table-name-column-seq-pairs
+   (mapcat (fn [[table-name column-seq]]
+             (map vector
+                  column-seq
+                  (repeat table-name))))
+   (reduce
+    (fn [[final-columns name-set] [column prefix]]
+      (let [original-colname (ds-col/column-name column)
+            colname
+            (loop [found? (contains? name-set
+                                     original-colname)
+                   new-col-name original-colname
+                   idx 0]
+              (if found?
+                (let [new-col-name
+                      (if (== 0 idx)
+                        (str prefix "."
+                             (colname->str original-colname))
+                        (str prefix "." original-colname "-" idx))]
+                  (recur (contains? name-set new-col-name)
+                         new-col-name
+                         (unchecked-inc idx)))
+                (similar-colname-type original-colname
+                                      new-col-name)))]
+        [(conj final-columns (with-meta column
+                               (assoc (meta column)
+                                      :name colname
+                                      :src-table-name prefix
+                                      :previous-colname original-colname)))
+         (conj name-set colname)]))
+    [[] #{}])
+   (first)))
+
+
+(defn- update-join-metadata
+  [result-table lhs-table-name rhs-table-name]
+  (let [name-data (->> (map meta (vals result-table))
+                       (group-by :src-table-name))]
+    (with-meta result-table
+      (assoc (meta result-table)
+             :left-column-names
+             (->> (get name-data lhs-table-name)
+                  (map (juxt :previous-colname :name))
+                  (into {}))
+             :right-column-names
+             (->> (get name-data rhs-table-name)
+                  (map (juxt :previous-colname :name))
+                  (into {}))))))
+
+
+(defn- fix-inner-join-metadata
+  [result-table lhs-join-colname rhs-join-colname]
+  (with-meta result-table
+    (assoc-in (meta result-table)
+              [:right-column-names rhs-join-colname]
+              lhs-join-colname)))
+
+
+(defn- append-str
+  [name-or-kwd data]
+  (let [rv (str (if (instance? clojure.lang.Named name-or-kwd)
+                  (name name-or-kwd)
+                  name-or-kwd) "-" data)]
+    (if (keyword? name-or-kwd)
+      (keyword rv)
+      rv)))
+
+
+(defn- finalize-join-result
+  [lhs-colname rhs-colname lhs rhs lhs-indexes rhs-indexes lhs-missing rhs-missing]
+  (let [lhs-columns (ds-base/columns (ds-base/remove-column lhs lhs-colname))
+        rhs-columns (ds-base/columns (ds-base/remove-column rhs rhs-colname))
+        lhs-table-name (default-table-name lhs "left")
+        rhs-table-name (default-table-name rhs "right")
+        ;;The table names *must* be different
+        [lhs-table-name rhs-table-name] (if (= lhs-table-name rhs-table-name)
+                                          [(append-str lhs-table-name "left")
+                                           (append-str rhs-table-name "right")]
+                                          [lhs-table-name rhs-table-name])
+        lhs-join-column (lhs lhs-colname)
+        rhs-join-column (rhs rhs-colname)]
+    (merge
+     {:inner
+       (let [lhs-columns (map #(ds-col/select % lhs-indexes) lhs-columns)
+             rhs-columns (map #(ds-col/select % rhs-indexes) rhs-columns)]
+         (-> (ds-impl/new-dataset
+              "inner-join"
+              (nice-column-names
+               [lhs-table-name (concat [(ds-col/select lhs-join-column lhs-indexes)]
+                                       lhs-columns)]
+               [rhs-table-name rhs-columns]))
+             (update-join-metadata lhs-table-name rhs-table-name)
+             (fix-inner-join-metadata lhs-colname rhs-colname)))
+       :lhs-indexes lhs-indexes
+       :rhs-indexes rhs-indexes}
+      (when rhs-missing
+        {:rhs-missing rhs-missing
+         :right-outer
+         (let [n-empty (count rhs-missing)
+               rhs-indexes (add-all! (dtype/clone rhs-indexes) rhs-missing)
+               rhs-columns (map #(ds-col/select % rhs-indexes) rhs-columns)
+               lhs-columns
+               (->> (concat [lhs-join-column] lhs-columns)
+                    (map (fn [old-col]
+                           (ds-col/extend-column-with-empty
+                            (ds-col/select old-col lhs-indexes)
+                            n-empty))))]
+           (-> (ds-impl/new-dataset
+                "right-outer-join"
+                (nice-column-names
+                 [lhs-table-name lhs-columns]
+                 [rhs-table-name (concat [(ds-col/select rhs-join-column rhs-indexes)]
+                                         rhs-columns)]))
+               (update-join-metadata lhs-table-name rhs-table-name)))})
+      (when lhs-missing
+        {:lhs-missing lhs-missing
+         :left-outer
+         (let [n-empty (count lhs-missing)
+               lhs-indexes (add-all! (dtype/clone lhs-indexes) lhs-missing)
+               lhs-columns (map #(ds-col/select % lhs-indexes) lhs-columns)
+               rhs-columns
+               (->> (concat [rhs-join-column] rhs-columns)
+                    (map (fn [old-col]
+                           (ds-col/extend-column-with-empty
+                            (ds-col/select old-col rhs-indexes)
+                            n-empty))))]
+           (-> (ds-impl/new-dataset
+                "left-outer-join"
+                (nice-column-names
+                 [lhs-table-name (concat [(ds-col/select lhs-join-column lhs-indexes)]
+                                         lhs-columns)]
+                 [rhs-table-name rhs-columns]))
+               (update-join-metadata lhs-table-name rhs-table-name)))}))))
+
+
+(defn- hash-join-algo
+  [lhs-col rhs-col lhs-missing? rhs-missing? operation-space]
+  (let [lhs-dtype (packing/unpack-datatype (dtype/elemwise-datatype lhs-col))
+        rhs-dtype (packing/unpack-datatype (dtype/elemwise-datatype rhs-col))
+        op-dtype (casting/simple-operation-space
+                  (casting/widest-datatype lhs-dtype rhs-dtype))
+        ;;We have to group in operation in object space else missing values can
+        ;;cause issues with numeric columns.
+        ^Map idx-groups (argops/arggroup
+                         {:operation-space :object}
+                         (dtype/elemwise-cast lhs-col op-dtype))
+        rhs-col (dtype/elemwise-cast rhs-col op-dtype)
+        n-elems (dtype/ecount rhs-col)
+
+        {lhs-indexes :lhs-indexes
+         rhs-indexes :rhs-indexes
+         rhs-missing :rhs-missing
+         lhs-found :lhs-found}
+        ;;Directly from talks - parallelize building the maps then apply optimized
+        ;;union operations.
+        (->> (hamf/pgroups
+              n-elems
+              (fn [^long sidx ^long eidx]
+                (let [lhs-indexes (dtype/make-list operation-space)
+                      rhs-indexes (dtype/make-list operation-space)
+                      rhs-missing (dtype/make-list operation-space)
+                      lhs-found (hamf/mut-set)
+                      ne (- eidx sidx)
+                      ;;Sub-buffer here gives us a chance to avoid missing index checks.
+                      rhs-col (dtype/->buffer (dtype/sub-buffer rhs-col sidx ne))]
+                  (dotimes [inner-idx ne]
+                    (let [idx (+ sidx inner-idx)
+                          ;;Note the reading is done in object space.  This means missing values will be nil
+                          ;;in all cases.
+                          rhs-val (.readObject rhs-col inner-idx)]
+                      (if-let [^IMutList item (.get idx-groups rhs-val)]
+                        (do
+                          (when lhs-missing? (.add lhs-found rhs-val))
+                          (when-not (.isEmpty item) (.addAllReducible rhs-indexes (hamf/repeat (.size item) idx)))
+                          (.addAll lhs-indexes item))
+                        (when rhs-missing? (.add rhs-missing idx)))))
+                  (hamf/hash-map :lhs-indexes lhs-indexes
+                                 :rhs-indexes rhs-indexes
+                                 :rhs-missing rhs-missing
+                                 :lhs-found lhs-found))))
+             (hamf/union-reduce-maps (hamf-fn/bi-function
+                                      lhs rhs
+                                      (if (instance? Set lhs)
+                                        (hamf/union lhs rhs)
+                                        (do (.addAll ^List lhs rhs) lhs)))))
+
+        ;;idx-groups is a hamf linked hashmap with highly optimized reduce-kv implementation
+        lhs-missing (when lhs-missing?
+                      (reduce-kv (fn [lhs-missing k v]
+                                   (when-not (.contains ^Set lhs-found k)
+                                     (.addAll ^List lhs-missing v))
+                                   lhs-missing)
+                                 (dtype/make-list operation-space)
+                                 idx-groups))]
+    {:lhs-indexes lhs-indexes
+     :rhs-indexes rhs-indexes
+     :lhs-missing lhs-missing
+     :rhs-missing rhs-missing}))
+
+
+
+(defn hash-join
+  "Join by column.  For efficiency, lhs should be smaller than rhs.
+  colname - may be a single item or a tuple in which is destructures as:
+     (let [[lhs-colname rhs-colname]] colname] ...)
+  An options map can be passed in with optional arguments:
+  :lhs-missing? Calculate the missing lhs indexes and left outer join table.
+  :rhs-missing? Calculate the missing rhs indexes and right outer join table.
+  :operation-space - either :int32 or :int64.  Defaults to :int32.
+  Returns
+  {:join-table - joined-table
+   :lhs-indexes - matched lhs indexes
+   :rhs-indexes - matched rhs indexes
+   ;; -- when rhs-missing? is true --
+   :rhs-missing - missing indexes of rhs.
+   :rhs-outer-join - rhs outer join table.
+   ;; -- when lhs-missing? is true --
+   :lhs-missing - missing indexes of lhs.
+   :lhs-outer-join - lhs outer join table.
+  }"
+  ([colname lhs rhs]
+   (hash-join colname lhs rhs {}))
+  ([colname lhs rhs {:keys [operation-space]
+                     :or {operation-space :int32}
+                     :as options}]
+   (let [[lhs-colname rhs-colname] (colname->lhs-rhs-colnames colname)
+
+         lhs-col (lhs lhs-colname)
+         rhs-col (rhs rhs-colname)
+         lhs-missing? (:lhs-missing? options)
+         rhs-missing? (:rhs-missing? options)
+         {:keys [lhs-indexes rhs-indexes lhs-missing rhs-missing]}
+         (hash-join-algo lhs-col rhs-col lhs-missing? rhs-missing? operation-space)]
+     (finalize-join-result lhs-colname rhs-colname lhs rhs
+                           lhs-indexes rhs-indexes
+                           lhs-missing
+                           rhs-missing))))
+
+
+(defn inner-join
+  "Inner join by column.  For efficiency, lhs should be smaller than rhs.
+   colname - may be a single item or a tuple in which is destructures as:
+     (let [[lhs-colname rhs-colname]] colname] ...)
+  An options map can be passed in with optional arguments:
+  :operation-space - either :int32 or :int64.  Defaults to :int32.
+  Returns the joined table"
+  ([colname lhs rhs]
+   (inner-join colname lhs rhs {}))
+  ([colname lhs rhs options]
+   (-> (hash-join colname lhs rhs options)
+       :inner)))
+
+
+(defn right-join
+  "Right join by column.  For efficiency, lhs should be smaller than rhs.
+  colname - may be a single item or a tuple in which is destructures as:
+     (let [[lhs-colname rhs-colname]] colname] ...)
+  An options map can be passed in with optional arguments:
+  :operation-space - either :int32 or :int64.  Defaults to :int32.
+  Returns the joined table"
+  ([colname lhs rhs]
+   (right-join colname lhs rhs {}))
+  ([colname lhs rhs options]
+   (-> (hash-join colname lhs rhs (assoc options :rhs-missing? true))
+       :right-outer)))
+
+
+(defn left-join
+  "Left join by column.  For efficiency, lhs should be smaller than rhs.
+   colname - may be a single item or a tuple in which is destructures as:
+     (let [[lhs-colname rhs-colname]] colname] ...)
+  An options map can be passed in with optional arguments:
+  :operation-space - either :int32 or :int64.  Defaults to :int32.
+  Returns the joined table"
+  ([colname lhs rhs]
+   (left-join colname lhs rhs {}))
+  ([colname lhs rhs options]
+   (-> (hash-join colname lhs rhs (assoc options :lhs-missing? true))
+       :left-outer)))
+
+(defn- col-or-data->reader
+  ([tuple-data ds])
+  ([tuple-data ds outer?]
+   ;;Else not having the column is an error
+   (if (and (sequential? tuple-data)
+            (not= 1 (count tuple-data)))
+     (-> (ds-base/select-columns ds tuple-data)
+         (ds-readers/value-reader {:copying? true}))
+     (let [tuple-data (if (sequential? tuple-data)
+                        (first tuple-data)
+                        tuple-data)]
+       (if outer?
+         (get ds tuple-data [])
+         (ds-base/column ds tuple-data))))))
+
+(defn- ensure-sequential
+  [colname]
+  (if-not (sequential? colname) [colname] colname))
+
+(defn- filter-columns
+  [ds collist outer?]
+  (when collist
+    (if outer?
+      (vec (filter (set (ds-base/column-names ds)) collist))
+      collist)))
+
+
+(defn pd-merge
+  "Pandas-style [merge](https://pandas.pydata.org/docs/reference/api/pandas.DataFrame.merge.html).
+  This is similar to join except it can merge on multiple columns for the left and right
+  sides.
+
+  Options:
+
+  * `:on` - column name or list of columns names.  Names must be found in both datasets.
+  * `:left-on` - Column name or list of column names
+  * `:right-on` - Column name or list of column names
+  * `:how` - left, right inner, outer, cross.  If cross, then no on, left-on, right-on can
+     be provided.
+
+  Examples:
+
+```clojure
+user> (require '[tech.v3.dataset :as ds])
+nil
+user> (require '[tech.v3.dataset.join :as ds-join])
+nil
+user> (def ds-a (ds/->dataset {:a [:a :b :b :a :c]
+                            :b (range 5)
+                            :c (range 5)}))
+#'user/ds-a
+user> (def ds-b (ds/->dataset {:a [:a :b :a :b :d]
+                            :b (range 5)
+                            :c (range 6 11)}))
+#'user/ds-b
+user> ds-a
+_unnamed [5 3]:
+
+| :a | :b | :c |
+|----|---:|---:|
+| :a |  0 |  0 |
+| :b |  1 |  1 |
+| :b |  2 |  2 |
+| :a |  3 |  3 |
+| :c |  4 |  4 |
+user> ds-b
+_unnamed [5 3]:
+
+| :a | :b | :c |
+|----|---:|---:|
+| :a |  0 |  6 |
+| :b |  1 |  7 |
+| :a |  2 |  8 |
+| :b |  3 |  9 |
+| :d |  4 | 10 |
+user> (ds-join/pd-merge ds-a ds-b {:on [:a :b] :how :inner})
+inner-join [2 4]:
+
+| :a | :b | :c | :right.c |
+|----|---:|---:|---------:|
+| :a |  0 |  0 |        6 |
+| :b |  1 |  1 |        7 |
+user> (ds-join/pd-merge ds-a ds-b {:on [:a :b] :how :outer})
+outer-join [8 4]:
+
+| :a | :b | :c | :right.c |
+|----|---:|---:|---------:|
+| :a |  0 |  0 |        6 |
+| :b |  1 |  1 |        7 |
+| :b |  2 |  2 |          |
+| :a |  3 |  3 |          |
+| :c |  4 |  4 |          |
+| :a |  2 |    |        8 |
+| :b |  3 |    |        9 |
+| :d |  4 |    |       10 |
+```"
+  ([left-ds right-ds options]
+   (let [lhs-table-name (default-table-name left-ds "left")
+         rhs-table-name (default-table-name right-ds "right")
+         how (get options :how :inner)]
+     (if (identical? how :cross)
+       (do
+         (errors/when-not-errorf
+          (nil? (or (options :on)
+                    (options :left-on)
+                    (options :right-on)))
+          "Columns must not be specified during a cross merge")
+         (let [left-rc (ds-base/row-count left-ds)
+               right-rc (ds-base/row-count right-ds)
+               n-result (* left-rc right-rc)
+               [lhs-indexes rhs-indexes]
+               (if (< n-result Integer/MAX_VALUE)
+                 [(dtype/make-reader :int32 n-result (quot idx right-rc))
+                  (dtype/make-reader :int32 n-result (rem idx right-rc))]
+                 [(dtype/make-reader :int64 n-result (quot idx right-rc))
+                  (dtype/make-reader :int64 n-result (rem idx right-rc))])
+               lhs-columns (map #(ds-col/select % lhs-indexes) (ds-base/columns left-ds))
+               rhs-columns (map #(ds-col/select % rhs-indexes) (ds-base/columns right-ds))]
+           (-> (ds-impl/new-dataset
+                "cross-join"
+                (nice-column-names
+                 [lhs-table-name lhs-columns]
+                 [rhs-table-name rhs-columns]))
+               (update-join-metadata lhs-table-name rhs-table-name))))
+       (let [left-on (ensure-sequential (get options :left-on (get options :on)))
+             right-on (ensure-sequential (get options :right-on (get options :on)))
+             
+             outer? (identical? :outer (get options :how))
+             on-int (->> (concat left-on right-on)
+                         (filter (set/intersection (set left-on) (set right-on)))
+                         (distinct)
+                         (vec))
+             _ (errors/when-not-errorf
+                (== (count left-on) (count right-on))
+                "Number of left join columns (%d) doesn't equal number of right join columns %d"
+                (count left-on) (count right-on))
+             left-on (filter-columns left-ds left-on outer?)
+             right-on (filter-columns right-ds right-on outer?)
+             left-join-data (col-or-data->reader left-on left-ds outer?)
+             right-join-data (col-or-data->reader right-on right-ds outer?)
+
+
+             {:keys [lhs-indexes rhs-indexes lhs-missing rhs-missing]}
+             (hash-join-algo left-join-data right-join-data true true
+                             (get options :operation-space :int32))
+             ;;Ensure a reasonable column order
+
+             left-cols (->> (concat left-on (ds-base/column-names left-ds)) distinct vec)
+             right-cols (->> (concat right-on (ds-base/column-names right-ds)) distinct vec)
+             left-ds (ds-base/select-columns left-ds left-cols)
+             right-ds (ds-base/select-columns right-ds right-cols)]
+         (case how
+           :left
+           (let [n-empty (count lhs-missing)
+                 lhs-indexes (add-all! (dtype/clone lhs-indexes) lhs-missing)
+                 lhs-cols (-> (ds-base/select-rows left-ds lhs-indexes)
+                              (ds-base/columns))
+                 rhs-cols (->> (ds-base/columns (ds-base/remove-columns right-ds on-int))
+                               (map (fn [col]
+                                      (ds-col/extend-column-with-empty
+                                       (ds-col/select col rhs-indexes)
+                                       n-empty))))]
+             (-> (ds-impl/new-dataset
+                  "left-outer-join"
+                  (nice-column-names
+                   [lhs-table-name lhs-cols]
+                   [rhs-table-name rhs-cols]))
+                 (update-join-metadata lhs-table-name rhs-table-name)))
+           :right
+           (let [n-empty (count rhs-missing)
+                 rhs-indexes (add-all! (dtype/clone rhs-indexes) rhs-missing)
+                 rhs-cols (-> (ds-base/select-rows right-ds rhs-indexes)
+                              (ds-base/columns))
+                 lhs-cols (->> (ds-base/columns (ds-base/remove-columns left-ds on-int))
+                               (map (fn [col]
+                                      (ds-col/extend-column-with-empty
+                                       (ds-col/select col lhs-indexes)
+                                       n-empty))))]
+             (-> (ds-impl/new-dataset
+                  "right-outer-join"
+                  (nice-column-names
+                   [rhs-table-name rhs-cols]
+                   [lhs-table-name lhs-cols]))
+                 (update-join-metadata lhs-table-name rhs-table-name)))
+           :inner
+           (let [lhs-cols (-> (ds-base/select-rows left-ds lhs-indexes)
+                              (ds-base/columns))
+                 rhs-cols (->> (-> (ds-base/remove-columns right-ds on-int)
+                                   (ds-base/columns))
+                               (mapv #(ds-base/select-rows % rhs-indexes)))]
+             (-> (ds-impl/new-dataset
+                  "inner-join"
+                  (nice-column-names
+                   [lhs-table-name lhs-cols]
+                   [rhs-table-name rhs-cols]))
+                 (update-join-metadata lhs-table-name rhs-table-name)))
+           :outer
+           (cond
+             (== 0 (ds-base/row-count left-ds))
+             (vary-meta right-ds assoc :name "outer-join")
+             (== 0 (ds-base/row-count right-ds))
+             (vary-meta left-ds assoc :name "outer-join")
+             :else 
+             (let [n-left-empty (count rhs-missing)
+                   n-right-empty (count lhs-missing)
+                   ;;Order is intersection, left-missing, right-missing
+                   lhs-indexes (add-all! (dtype/clone lhs-indexes) lhs-missing)
+                   left-valid (ds-base/select-rows left-ds lhs-indexes)
+                   right-valid (ds-base/select-rows right-ds rhs-indexes)
+                   right-missing (ds-base/select-rows right-ds rhs-missing)
+                   ;;For the columns we perhaps joined on
+                   intersection-ds (-> (ds-base/select-columns left-valid on-int)
+                                       (ds-base/concat-copying (ds-base/select-columns
+                                                                right-missing on-int)))
+                   left-full (-> (ds-base/remove-columns left-valid on-int)
+                                 (ds-base/extend-with-empty n-left-empty))
+                   right-full (-> (ds-base/remove-columns right-valid on-int)
+                                  (ds-base/extend-with-empty n-right-empty)
+                                  (ds-base/concat-copying (ds-base/remove-columns
+                                                           right-missing on-int)))]
+               (-> (ds-impl/new-dataset
+                    "outer-join"
+                    (nice-column-names
+                     [lhs-table-name (concat (ds-base/columns intersection-ds)
+                                             (ds-base/columns left-full))]
+                     [rhs-table-name (ds-base/columns right-full)]))
+                   (update-join-metadata lhs-table-name rhs-table-name)))))))))
+  ([left-ds right-ds]
+   (pd-merge left-ds right-ds {:on (set/intersection
+                                    (set (ds-base/column-names left-ds))
+                                    (set (ds-base/column-names right-ds)))})))
+
+
+(defn- ensure-numeric-reader
+  "Column is either a float or integer reader."
+  ^Buffer [col]
+  (let [col-dtype (casting/un-alias-datatype (dtype/get-datatype col))]
+    (if (dtype-dt/datetime-datatype? col-dtype)
+      (-> (dtype-dt/datetime->milliseconds col)
+          (dtype/->reader))
+      (dtype/->reader col (casting/simple-operation-space col-dtype)))))
+
+
+(defn- asof-op->binary-pred
+  ^BinaryPredicate [asof-op
+                    ^Buffer lhs-rdr
+                    ^Buffer rhs-rdr]
+  (let [comp-op (argops/->binary-predicate asof-op)
+        op-space (casting/simple-operation-space
+                  (.elemwiseDatatype lhs-rdr)
+                  (.elemwiseDatatype rhs-rdr))]
+    (case op-space
+      :int64
+      (reify BinaryPredicate
+        (binaryLong [this lhs-idx rhs-idx]
+          (.binaryLong comp-op
+                       (.readLong lhs-rdr lhs-idx)
+                       (.readLong rhs-rdr rhs-idx))))
+      :float64
+      (reify BinaryPredicate
+        (binaryLong [this lhs-idx rhs-idx]
+          (.binaryDouble comp-op
+                         (.readDouble lhs-rdr lhs-idx)
+                         (.readDouble rhs-rdr rhs-idx)))))))
+
+
+(defn- asof-lt
+  [asof-op lhs rhs]
+  (let [op-space (casting/simple-operation-space
+                  (dtype/elemwise-datatype lhs)
+                  (dtype/elemwise-datatype rhs))
+        lhs-rdr (dtype/->reader lhs op-space)
+        rhs-rdr (dtype/->reader rhs op-space)
+        n-elems (.lsize lhs-rdr)
+        n-right (.lsize rhs-rdr)
+        retval (dtype/make-list :int32)
+        comp-fn (asof-op->binary-pred asof-op lhs-rdr rhs-rdr)]
+     (loop [lhs-idx 0
+            rhs-idx 0]
+        (when-not (or (== lhs-idx n-elems)
+                      (== rhs-idx n-right))
+          (let [found? (.binaryLong comp-fn lhs-idx rhs-idx)
+                new-lhs-idx (if found?
+                              (unchecked-inc lhs-idx)
+                              lhs-idx)
+                new-rhs-idx (if found?
+                              rhs-idx
+                              (unchecked-inc rhs-idx))]
+            (when found?
+              (.addLong retval (unchecked-int rhs-idx)))
+            (recur new-lhs-idx new-rhs-idx))))
+     [0 retval]))
+
+
+(defn- asof-gt
+  [asof-op lhs rhs]
+  (let [op-space (casting/simple-operation-space
+                  (dtype/elemwise-datatype lhs)
+                  (dtype/elemwise-datatype rhs))
+        lhs-rdr (dtype/->reader lhs op-space)
+        rhs-rdr (dtype/->reader rhs op-space)
+        n-elems (.lsize lhs-rdr)
+        n-right (.lsize rhs-rdr)
+        n-right-dec (dec n-right)
+        retval (dtype/make-list :int32)
+        comp-fn (asof-op->binary-pred asof-op lhs-rdr rhs-rdr)]
+     (loop [lhs-idx (unchecked-dec n-elems)
+            rhs-idx n-right-dec]
+       (when-not (or (== lhs-idx -1)
+                     (== rhs-idx -1))
+         (let [found? (.binaryLong comp-fn lhs-idx rhs-idx)
+               new-lhs-idx (if found?
+                              (unchecked-dec lhs-idx)
+                              lhs-idx)
+               new-rhs-idx (if found?
+                              rhs-idx
+                              (unchecked-dec rhs-idx))]
+           (when found?
+             (.addLong retval (unchecked-int rhs-idx)))
+           (recur new-lhs-idx new-rhs-idx))))
+     ;;Now we have to reverse retval
+     (let [rev-retval (dtype/make-list :int32)
+           n-retval (.size retval)
+           n-retval-dec (unchecked-dec n-retval)]
+       (dotimes [iter n-retval]
+         (.addLong rev-retval (.getLong retval (- n-retval-dec iter))))
+       [(- n-elems (.size rev-retval))
+        rev-retval])))
+
+(def ^{:private true
+       :tag BinaryOperator} abs-diff-op
+  (reify BinaryOperators$DoubleBinaryOperator
+    (binaryLong [this lhs rhs]
+      (Math/abs (- rhs lhs)))
+    (binaryDouble [this lhs rhs]
+      (Math/abs (- rhs lhs)))))
+
+
+(defn- abs-diff-bin-pred
+  ^BinaryPredicate
+  [^Buffer lhs-rdr
+   ^Buffer rhs-rdr]
+  (let [op-space (casting/simple-operation-space
+                  (.elemwiseDatatype lhs-rdr)
+                  (.elemwiseDatatype rhs-rdr))
+        ^BinaryOperator comp-op abs-diff-op]
+    (case op-space
+      :int64
+      (reify BinaryPredicate
+        (binaryLong [this lhs-idx rhs-idx]
+          (let [lhs-val (.readLong lhs-rdr lhs-idx)
+                rhs-val (.readLong rhs-rdr rhs-idx)
+                rhs-next-val (.readLong rhs-rdr (unchecked-inc rhs-idx))
+                asof-diff (pmath/- (.binaryLong comp-op lhs-val rhs-val)
+                                   (.binaryLong comp-op lhs-val rhs-next-val))]
+            (< asof-diff 0))))
+      :float64
+      (reify BinaryPredicate
+        (binaryLong [this lhs-idx rhs-idx]
+          (let [lhs-val (.readLong lhs-rdr lhs-idx)
+                rhs-val (.readLong rhs-rdr rhs-idx)
+                rhs-next-val (.readLong rhs-rdr (unchecked-inc rhs-idx))
+                asof-diff (pmath/- (.binaryDouble comp-op lhs-val rhs-val)
+                                   (.binaryDouble comp-op lhs-val rhs-next-val))]
+            (< asof-diff 0)))))))
+
+
+(defn- asof-nearest
+  [lhs rhs]
+  (let [op-space (casting/simple-operation-space
+                  (dtype/elemwise-datatype lhs)
+                  (dtype/elemwise-datatype rhs))
+        lhs-rdr (dtype/->reader lhs op-space)
+        rhs-rdr (dtype/->reader rhs op-space)
+        n-elems (.lsize lhs-rdr)
+        n-right (.lsize rhs-rdr)
+        n-right-dec (dec n-right)
+        retval (dtype/make-list :int32)
+        bin-pred (abs-diff-bin-pred lhs-rdr rhs-rdr)]
+     (loop [lhs-idx 0
+            rhs-idx 0]
+       (when-not (or (== lhs-idx n-elems)
+                     (== rhs-idx n-right-dec))
+         (let [found? (.binaryLong bin-pred lhs-idx rhs-idx)
+               new-lhs-idx (if found?
+                              (unchecked-inc lhs-idx)
+                              lhs-idx)
+               new-rhs-idx (if found?
+                              rhs-idx
+                              (unchecked-inc rhs-idx))]
+           (when found?
+             (.add retval (unchecked-int rhs-idx)))
+           (recur new-lhs-idx new-rhs-idx))))
+     (dotimes [_iter (- n-elems (.size retval))]
+       (.add retval n-right-dec))
+     [0 retval]))
+
+
+(defn left-join-asof
+  "Perform a left join asof.  Similar to left join except this will join on nearest
+  value.  lhs and rhs must be sorted by join-column.  join columns must be either
+  datetime columns in which the join happens in millisecond space or they must be
+  numeric - integer or floating point datatypes.
+
+  Options:
+
+  - `asof-op`- may be [:< :<= :nearest :>= :>] - type of join operation.  Defaults to
+     <=."
+  ([colname lhs rhs {:keys [asof-op]
+                     :or {asof-op :<=}}]
+   (when-not (#{:< :<= :nearest :>= :>} asof-op)
+     (throw (Exception. (format "Unrecognized asof op: %s" asof-op))))
+   (let [[lhs-colname rhs-colname] (colname->lhs-rhs-colnames colname)
+         lhs-col (ds-base/column lhs lhs-colname)
+         rhs-col (ds-base/column rhs rhs-colname)
+         lhs-table-name (default-table-name lhs "left")
+         rhs-table-name (default-table-name rhs "right")
+         lhs-reader (ensure-numeric-reader lhs-col)
+         rhs-reader (ensure-numeric-reader rhs-col)
+         [rhs-offset rhs-indexes]
+         (cond
+           (#{:< :<=} asof-op)
+           (asof-lt (keyword "tech.numerics" (name asof-op)) lhs-reader rhs-reader)
+           (#{:> :>=} asof-op)
+           (asof-gt (keyword "tech.numerics" (name asof-op)) lhs-reader rhs-reader)
+           (= asof-op :nearest)
+           (asof-nearest lhs-reader rhs-reader)
+           :else
+           (throw (Exception. "Unsupported")))
+         rhs-offset (long rhs-offset)
+         n-indexes (dtype/ecount rhs-indexes)
+         n-empty (- (ds-base/row-count lhs) (+ rhs-offset n-indexes))
+         lhs-columns (ds-base/columns lhs)
+         rhs-columns
+         (->> (ds-base/columns rhs)
+              (map (fn [old-col]
+                     (if (== 0 rhs-offset)
+                       (ds-col/extend-column-with-empty
+                        (ds-col/select old-col rhs-indexes)
+                        n-empty)
+                       (ds-col/prepend-column-with-empty
+                        (ds-col/select old-col rhs-indexes)
+                        rhs-offset)))))]
+     (-> (ds-impl/new-dataset
+          (format "asof-%s" (name asof-op))
+          (nice-column-names
+           [lhs-table-name lhs-columns]
+           [rhs-table-name rhs-columns]))
+         (update-join-metadata lhs-table-name rhs-table-name))))
+  ([colname lhs rhs]
+   (left-join-asof colname lhs rhs {})))

tech.ml.dataset/src/tech/v3/dataset/math.clj

@@ -0,0 +1,344 @@
+(ns tech.v3.dataset.math
+  "Various mathematic transformations of datasets such as (inefficiently)
+  building simple tables, pca, and normalizing columns to have mean of 0 and variance of 1.
+  More in-depth transformations are found at `tech.v3.dataset.neanderthal`."
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.functional :as dfn]
+            [tech.v3.datatype.statistics :as statistics]
+            [tech.v3.parallel.for :as pfor]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.dataset.column :as ds-col]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.tensor :as ds-tens]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.utils :as ds-utils]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.missing :as ds-missing]
+            [ham-fisted.set :as set]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.defprotocol :refer [extend-type]]
+            [clj-commons.primitive-math :as pmath]
+            [clojure.tools.logging :as log]
+            [clojure.set :as c-set])
+  (:import [org.apache.commons.math3.analysis.interpolation LoessInterpolator]
+           [tech.v3.datatype DoubleReader]
+           [org.roaringbitmap RoaringBitmap])
+  (:refer-clojure :exclude [extend-type]))
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* true)
+
+
+(defn correlation-table
+  "Return a map of colname->list of sorted tuple of [colname, coefficient].
+  Sort is:
+  (sort-by (comp #(Math/abs (double %)) second) >)
+
+  Thus the first entry is:
+  [colname, 1.0]
+
+  There are three possible correlation types:
+  :pearson
+  :spearman
+  :kendall
+
+  :pearson is the default."
+  [dataset & {:keys [correlation-type
+                     colname-seq]}]
+  (let [missing-columns (ds-base/columns-with-missing-seq dataset)
+        _ (when missing-columns
+            (println "WARNING - excluding columns with missing values:\n"
+                     (mapv :column-name  missing-columns)))
+        non-numeric (->> (ds-base/columns dataset)
+                         (map meta)
+                         (remove #(casting/numeric-type?
+                                   (:datatype %)))
+                         (map :name)
+                         seq)
+        _ (when non-numeric
+            (println "WARNING - excluding non-numeric columns:\n"
+                     (vec non-numeric)))
+        _ (when-let [selected-non-numeric
+                     (seq (c-set/intersection (set colname-seq)
+                                              (set non-numeric)))]
+            (throw (ex-info (format "Selected columns are non-numeric: %s"
+                                    selected-non-numeric)
+                            {:selected-columns colname-seq
+                             :non-numeric-columns non-numeric})))
+        dataset (ds-base/select-columns dataset
+                                        (->> (ds-base/columns dataset)
+                                             (map ds-col/column-name)
+                                             (remove (set (concat
+                                                           (map :column-name  missing-columns)
+                                                           non-numeric)))))
+        lhs-colseq (->> (if (seq colname-seq)
+                          (map (partial ds-base/column dataset) colname-seq)
+                          (ds-base/columns dataset))
+                        (map (fn [col] [(ds-col/column-name col)
+                                        (hamf/double-array (dtype/->reader col :float64))])))
+        rhs-colseq (->> (ds-base/columns dataset)
+                        (map (fn [col] [(ds-col/column-name col)
+                                        (hamf/double-array (dtype/->reader col :float64))])))
+        correlation-type (or correlation-type :pearson)
+        corr-fn (case correlation-type
+                  :pearson #(statistics/pearsons-correlation %1 %2 {:nan-strategy :keep})
+                  :spearman #(statistics/spearmans-correlation %1 %2 {:nan-strategy :keep})
+                  :kendall #(statistics/kendalls-correlation %1 %2 {:nan-strategy :keep}))]
+    (->> (for [[lname ldata] lhs-colseq]
+           [lname
+            (->> rhs-colseq
+                 (map (fn [[rname rdata]]
+                        (let [corr (corr-fn ldata rdata)]
+                          (if (Double/isFinite corr)
+                            [rname corr]
+                            (do
+                              (log/warnf "Correlation failed: %s-%s" lname rname)
+                              nil)))))
+                 (remove nil?)
+                 ;;Using a type-hinted key-fn allows the sort operator to use a double array
+                 ;;which has a very fast indirect sort operation.
+                 (hamf/sort-by (hamf-fn/obj->double
+                                v (-> (second v)
+                                      (double)
+                                      (Math/abs))) >))])
+         (into {}))))
+
+
+(defn interpolate-loess
+  "Interpolate using the LOESS regression engine.  Useful for smoothing out graphs."
+  ([ds x-colname y-colname
+    {:keys [bandwidth iterations accuracy result-name]
+     ;;Using R defaults, as close as we can get.
+     :or {bandwidth 0.75
+          iterations 4
+          accuracy LoessInterpolator/DEFAULT_ACCURACY}}]
+   (let [interp (LoessInterpolator. (double bandwidth)
+                                    (int iterations)
+                                    (double accuracy))
+         x-col (ds x-colname)
+         x-orig-datatype (dtype/elemwise-datatype x-col)
+         x-datetime? (dtype-dt/datetime-datatype? x-orig-datatype)
+         x-col (if x-datetime?
+                 (dtype-dt/datetime->milliseconds x-col)
+                 x-col)
+         y-col (ds y-colname)
+         spline (.interpolate interp
+                              (dtype/->double-array x-col)
+                              (dtype/->double-array y-col))
+         new-col-name (or result-name
+                          (keyword (str (ds-utils/column-safe-name y-colname) "-loess")))
+         n-elems (ds-base/row-count ds)
+         x-rdr (dtype/->buffer x-col)]
+     (-> (ds-base/add-or-update-column ds new-col-name
+                                    (reify DoubleReader
+                                      (lsize [rdr] n-elems)
+                                      (readDouble [rdr idx]
+                                        (.value spline (.readDouble x-rdr idx)))))
+         (ds-base/update-column new-col-name
+                             #(with-meta % (assoc (meta %)
+                                                  :interpolator spline))))))
+  ([ds x-colname y-colname]
+   (interpolate-loess ds x-colname y-colname {})))
+
+
+(defn- scatter-missing
+  [index-rdr ^RoaringBitmap missing]
+  (let [retval (RoaringBitmap.)
+        iter (.getIntIterator missing)]
+    (loop [continue? (.hasNext iter)]
+      (when continue?
+        (.add retval (int (index-rdr (.next iter))))
+        (recur (.hasNext iter))))
+    retval))
+
+
+(defn fill-range-replace
+  "Given an in-order column of a numeric or datetime type, fill in spans that are
+  larger than the given max-span.  The source column must not have missing values.
+  For more documentation on fill-range, see tech.v3.datatype.function.fill-range.
+
+  If the column is a datetime type the operation happens in millisecond space and
+  max-span may be a datetime type convertible to milliseconds.
+
+  The result column has the same datatype as the input column.
+
+  After the operation, if missing strategy is not nil the newly produced missing
+  values along with the existing missing values will be replaced using the given
+  missing strategy for all other columns.  See
+  `tech.v3.dataset.missing/replace-missing` for documentation on missing strategies.
+  The missing strategy defaults to :down unless explicity set.
+
+  Returns a new dataset."
+  ([ds colname max-span]
+   (fill-range-replace ds colname max-span :down nil))
+    ([ds colname max-span missing-strategy]
+   (fill-range-replace ds colname max-span missing-strategy nil))
+  ([ds colname max-span missing-strategy missing-value]
+   (let [target-col (ds colname)
+         _ (when-not (== 0 (dtype/ecount (ds-col/missing target-col)))
+             (throw (Exception. "Fill-range column must not have missing values")))
+         target-dtype (dtype/get-datatype target-col)
+         target-col (if (dtype-dt/datetime-datatype? target-dtype)
+                      (dtype-dt/datetime->milliseconds target-col)
+                      target-col)
+         max-span (if (dtype-dt/datetime-datatype? max-span)
+                    (dtype-dt/datetime->milliseconds max-span)
+                    max-span)
+         {:keys [result missing]} (dfn/fill-range target-col max-span)
+         ;;This is the set of values that have not changed.  Iterating through it and
+         ;;and a source vector in parallel allow us to scatter the original data into
+         ;;a new storage container.
+         original-indexes (-> (doto  (bitmap/->bitmap
+                                      (range (dtype/ecount result)))
+                                (.andNot ^RoaringBitmap missing))
+                              (bitmap/->random-access))
+         result (if (dtype-dt/datetime-datatype? target-dtype)
+                  (dtype-dt/milliseconds->datetime target-dtype result)
+                  result)]
+
+     (->> (ds-base/columns ds)
+          (pfor/pmap
+           (fn [col]
+             (if (= colname (ds-col/column-name col))
+               (ds-col/new-column colname result)
+               (let [new-colname (ds-col/column-name col)
+                     new-data (dtype/make-container
+                               :jvm-heap
+                               (dtype/get-datatype col)
+                               (dtype/ecount result))
+                     ^RoaringBitmap col-missing (ds-col/missing col)
+                     any-missing? (not (.isEmpty col-missing))
+                     updated-missing (if any-missing?
+                                       (scatter-missing original-indexes col-missing)
+                                       (bitmap/->bitmap))
+                     total-missing (set/union updated-missing missing)
+                     ;;Scatter original data into new locations
+                     _ (dtype/copy! col
+                                    (dtype/indexed-buffer original-indexes new-data))
+                     ;;Use col-impl as it skips the scanning of the data and we know
+                     ;;that it is dense
+                     new-col (ds-col/new-column new-colname new-data
+                                                (meta col)
+                                                total-missing)]
+                 (if-not (nil? missing-strategy)
+                   (ds-missing/replace-missing-with-strategy
+                    new-col total-missing missing-strategy missing-value)
+                   new-col)))))
+          (ds-impl/new-dataset (meta ds))))))
+
+
+(defrecord StdScaleTransform [])
+
+
+(defn fit-std-scale
+  "Calculate nan-aware means, stddev - per-column - of a dataset.
+
+  Options are passed through to
+  tech.v3.datatype.statistics/descriptive-statistics."
+  ([dataset {:keys [mean? stddev?]
+             :or {mean? true stddev? true}
+             :as options}]
+   (let [stats-data (cond-> []
+                      mean? (conj :mean)
+                      stddev? (conj :standard-deviation))]
+     (errors/when-not-error
+      (seq stats-data)
+      "Either mean? or stddev? must be true")
+     (map->StdScaleTransform
+      (->> (vals dataset)
+           (map (fn [col]
+                  [(:name (meta col))
+                   (statistics/descriptive-statistics col stats-data options)]))
+           (into {})))))
+  ([dataset]
+   (fit-std-scale dataset nil)))
+
+
+(defn transform-std-scale
+  "Given a dataset and a standard scale transform return a new dataset
+  with the columns "
+  [dataset std-scale-xform]
+  (reduce (fn [dataset [colname {:keys [mean standard-deviation]}]]
+            (let [mean (double (or mean 0.0))
+                  standard-deviation (double  (or standard-deviation 1.0))]
+              (ds-base/update-column
+               dataset colname
+               (fn [coldata]
+                 (ds-col/column-map
+                  (fn [val]
+                    (pmath// (pmath/- (double val) mean)
+                             standard-deviation))
+                  :float64
+                  coldata)))))
+          dataset
+          std-scale-xform))
+
+
+(extend-type StdScaleTransform
+  ds-proto/PDatasetTransform
+  (transform [t dataset]
+    (transform-std-scale dataset t)))
+
+
+(defrecord MinMaxTransform [min max column-data])
+
+
+(defn fit-minmax
+  "nan-aware min-max fit of the dataset.  Returns an object that can be used
+  in transform-minmax.  target Min-max default to -0.5,0.5"
+  ([dataset {:keys [min max]
+              :or {min -0.5
+                   max 0.5}
+             :as options}]
+   (let [min (double min)
+         max (double max)]
+     (map->MinMaxTransform
+      {:min min :max max
+       :column-data
+       (->> (vals dataset)
+            (map (fn [col]
+                   [(:name (meta col))
+                    (statistics/descriptive-statistics col [:min :max] options)]))
+            (into {}))})))
+  ([dataset]
+   (fit-minmax dataset nil)))
+
+
+(defn transform-minmax
+  "Scale columns listed in the min-max transform to the mins and maxes dictated
+  by that transform."
+  [dataset {:keys [min max column-data]}]
+  (let [min (double min)
+        max (double max)
+        target-range (- max min)]
+    (reduce (fn [dataset [colname coldata]]
+              (let [{column-min :min
+                     column-max :max} coldata
+                    column-min (double column-min)
+                    column-max (double column-max)
+                    column-range (- column-max column-min)]
+                (ds-base/update-column
+                 dataset colname
+                 (fn [coldata]
+                   (ds-col/column-map
+                    (fn [val]
+                      (-> (double val)
+                          (pmath/- column-min)
+                          (pmath// column-range)
+                          (pmath/* target-range)
+                          (pmath/+ min)))
+                    :float64
+                    coldata)))))
+            dataset
+            column-data)))
+
+
+(extend-type MinMaxTransform
+  ds-proto/PDatasetTransform
+  (transform [t dataset]
+    (transform-minmax dataset t)))

tech.ml.dataset/src/tech/v3/dataset/metamorph_api.clj

@@ -0,0 +1,67 @@
+(ns tech.v3.dataset.metamorph-api
+  "This is an auto-generated api system - it scans the namespaces and changes the first
+  to be metamorph-compliant which means transforming an argument that is just a dataset into
+  an argument that is a metamorph context - a map of `{:metamorph/data ds}`.  They also return
+  their result as a metamorph context."
+  (:require [tech.v3.dataset :as ds]
+            [tech.v3.dataset.modelling]
+            [tech.v3.dataset.protocols :as prot])
+  (:refer-clojure :exclude [filter group-by sort-by concat take-nth shuffle
+                            rand-nth update]))
+
+(defmacro build-pipelined-function
+  [f m]
+  (let [args (map (comp vec rest) (:arglists m))
+        doc-string (:doc m)]
+    `(defn ~(symbol (name f)) {:doc ~doc-string :orig (symbol (var ~f))}
+       ~@(for [arg args
+               :let [narg (mapv #(if (map? %) 'options %) arg)
+                     [a & r] (split-with (partial not= '&) narg)]]
+           (list narg `(fn [ds#]
+                         (let [ctx# (if (ds/dataset? ds#)
+                                      {:metamorph/data ds#} ds#)]
+                           (assoc ctx# :metamorph/data (apply ~f (ctx# :metamorph/data) ~@a ~(rest r))))))))))
+
+
+
+(def ^:private excludes-dataset
+  '#{bind-> all-descriptive-stats-names major-version ->dataset ->>dataset column-map-m
+     mapseq-parser mapseq-rf dataset-parser})
+
+
+
+(defmacro ^:private process-all-api-symbols-dataset
+  []
+  (let [ps (ns-publics 'tech.v3.dataset)]
+    `(do ~@(for [[f v] ps
+                 :when (not (excludes-dataset f))
+                 :let [m (meta v)
+                       f (symbol "tech.v3.dataset" (name f))]]
+             `(build-pipelined-function ~f ~m)))))
+
+
+(def ^:private excludes-dataset-modelling
+  '#{ds-mod/inference-column?})
+
+(defmacro ^:private process-all-api-symbols-dataset-modelling
+  []
+  (let [ps (ns-publics 'tech.v3.dataset.modelling)]
+    `(do ~@(for [[f v] ps
+                 :when (not (excludes-dataset-modelling f))
+                 :let [m (meta v)
+                       f (symbol "tech.v3.dataset.modelling" (name f))]]
+             `(build-pipelined-function ~f ~m)))))
+
+
+
+(process-all-api-symbols-dataset)
+(process-all-api-symbols-dataset-modelling)
+
+(comment
+  (require '[tech.v3.datatype.export-symbols :as export-symbols])
+  (export-symbols/write-api! 'tech.v3.dataset.metamorph-api
+                             'tech.v3.dataset.metamorph
+                             "src/tech/v3/dataset/metamorph.clj"
+                             '[filter group-by sort-by concat take-nth shuffle
+                               rand-nth update])
+  )

tech.ml.dataset/src/tech/v3/dataset/missing.clj

@@ -0,0 +1,293 @@
+(ns ^:no-doc tech.v3.dataset.missing
+  "Functions for dealing with missing data.  Taken (with permission) nearly verbatim
+  from https://github.com/scicloj/tablecloth"
+  (:require [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.column :as col]
+            [tech.v3.datatype.update-reader :as update-rdr]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [clojure.tools.logging :as log])
+  (:import [org.roaringbitmap RoaringBitmap]
+           [clojure.lang IFn]
+           [tech.v3.datatype ObjectReader]
+           [tech.v3.dataset.impl.column Column]))
+
+
+(defn- iterable-sequence?
+  "Check if object is sequential, is column or maybe a reader (iterable)?"
+  [xs]
+  (or (sequential? xs)
+      (and (not (map? xs))
+           (instance? Iterable xs))))
+
+
+(defn select-missing
+  "Select only rows with missing values"
+  [ds]
+  (ds-base/select-rows ds (ds-base/missing ds)))
+
+
+(defn- remove-from-rbitmap
+  ^RoaringBitmap [^RoaringBitmap rb ks]
+  (let [rb (.clone rb)]
+    (reduce (fn [^RoaringBitmap rb ^long k]
+              (.remove rb k)
+              rb) rb ks)))
+
+(defn- maybe-column-buffer
+  [col]
+  (if (ds-proto/is-column? col)
+    (ds-proto/column-buffer col)
+    col))
+
+(defn- replace-missing-with-value
+  [col missing value]
+  (let [unpack-data (packing/unpack (maybe-column-buffer col))]
+    (col/new-column (col/column-name col)
+                    (update-rdr/update-reader
+                     unpack-data
+                     (cond
+                       (map? value) value
+                       (iterable-sequence? value) (zipmap missing (cycle value))
+                       :else (bitmap/bitmap-value->map
+                              missing
+                              (let [col-dt (dtype/elemwise-datatype unpack-data)]
+                                (casting/cast value col-dt)))))
+                    (meta col)
+                    (if (map? value)
+                      (remove-from-rbitmap missing (keys value))
+                      (RoaringBitmap.)))))
+
+
+(defn- missing-direction-prev
+  ^long [^RoaringBitmap rb ^long idx]
+  (.previousAbsentValue rb idx))
+
+
+(defn- missing-direction-next
+  ^long [^RoaringBitmap rb ^long idx]
+  (.nextAbsentValue rb idx))
+
+
+(defn- replace-missing-with-direction
+  [[primary-f secondary-f] col missing value]
+  (let [cnt (dtype/ecount col)
+        missing-map-pre-fn (fn [f m v]
+                             (let [vv (f missing v)]
+                               (if (< -1 vv cnt)
+                                 (assoc m v (dtype/get-value col vv))
+                                 m)))
+        missing-map-fn #(reduce (partial missing-map-pre-fn %1) {} %2)
+        col (replace-missing-with-value col missing (missing-map-fn primary-f missing))
+        missing (col/missing col)]
+    (cond
+      (empty? missing)
+      col
+      (not (nil? value))
+      (replace-missing-with-value col missing value)
+      secondary-f
+      (replace-missing-with-value col missing (missing-map-fn secondary-f missing))
+      :else
+      col)))
+
+
+(defn- replace-missing-with-abb
+  [col ^RoaringBitmap missing]
+  (let [^RoaringBitmap non-missing (doto (RoaringBitmap.)
+                                     (.add 0 (dtype/ecount col))
+                                     (.andNot missing)) ;; prepare non-missing indices
+        non-missing-cnt (.getCardinality non-missing) ;; how many non-missing we have
+        ;; bootstrap `non-missing-count` values from a column
+        samples1 (col/select col (repeatedly non-missing-cnt #(.select non-missing (rand-int non-missing-cnt))))
+        ;; bootstrap `missing-count` values for imputation from first bootstrap round
+        samples2 (col/select samples1 (repeatedly (.getCardinality missing) #(rand-int (dtype/ecount samples1))))]
+    (replace-missing-with-value col missing samples2)))
+
+;; mid and range
+
+(defn- find-missing-ranges
+  [^RoaringBitmap missing]
+  (when-not (empty? missing)
+    (loop [current (.first missing)
+           buff []]
+      (if (neg? current)
+        buff
+        (let [p (.previousAbsentValue missing current)
+              n (.nextAbsentValue missing current)]
+          (recur (.nextValue missing n) (conj buff [p n])))))))
+
+
+(defn- find-lerp-values
+  [cnt col lerp-fn curr [start end]]
+  (let [no-left? (neg? start)
+        no-right? (>= end cnt)]
+    (when-not (and no-left? no-right?) ;; all values are missing?
+      (let [s (dtype/get-value col (if no-left? end start))
+            e (dtype/get-value col (if no-right? start end))
+            start (inc start)
+            end (min cnt end)
+            size (- end start)]
+        (merge curr (zipmap (range start end) (lerp-fn s e size)))))))
+
+
+(defn- midpoint-lerp-double
+  [^double start ^double end ^long n-steps]
+  (let [mid (+ start (/ (- (double end) (double start)) 2.0))]
+    (dtype/const-reader mid n-steps)))
+
+(defn- midpoint-lerp-object
+  [start end ^long n-steps]
+  (let [mid (+ start (/ (- end start) 2.0))]
+    (dtype/const-reader mid n-steps)))
+
+(defn- lerp-double
+  [^double start ^double end ^long n-steps]
+  (let [steps+ (inc n-steps)
+        data-range (/ (- end start) (double steps+))]
+    (dtype/make-reader :float64 n-steps
+                       (+ start (* data-range (inc idx))))))
+
+(defn- lerp-object
+  [start end ^long n-steps]
+  (let [steps+ (inc n-steps)
+        data-range (/ (- end start) steps+)]
+    (dtype/make-reader :object n-steps
+                       (+ start (* data-range (inc idx))))))
+
+
+(defn- replace-missing-with-lerp
+  ([lerp-type col missing]
+   (let [ranges (find-missing-ranges missing)
+         cnt (dtype/ecount col)
+         orig-col-dtype (dtype/elemwise-datatype col)
+         [col-dtype col-rdr]
+         (cond
+           (dtype-dt/datetime-datatype? orig-col-dtype)
+           [:float64 (-> (dtype-dt/datetime->milliseconds col)
+                         (dtype-proto/elemwise-cast :float64))]
+           (casting/numeric-type? orig-col-dtype)
+           [:float64 (dtype-proto/elemwise-cast col :float64)]
+           :else
+           [:object (dtype-proto/->reader col)])
+         lerp-fn (condp = [col-dtype lerp-type]
+                   [:float64 :midpoint] midpoint-lerp-double
+                   [:object :midpoint] midpoint-lerp-object
+                   [:float64 :lerp] lerp-double
+                   [:object :lerp] lerp-object)
+         missing-replace (reduce (partial find-lerp-values cnt col-rdr lerp-fn)
+                                 {} ranges)
+         temp-result-col (replace-missing-with-value col-rdr missing missing-replace)]
+     (if (dtype-dt/datetime-datatype? orig-col-dtype)
+       (col/new-column (:name (meta col))
+                       (dtype-dt/milliseconds->datetime orig-col-dtype
+                                                        temp-result-col))
+       (vary-meta temp-result-col assoc :name (:name (meta col)))))))
+
+
+(defn- replace-missing-with-nearest
+  [col missing]
+  (let [ranges (find-missing-ranges missing)
+        cnt (dtype/ecount col)
+        col-dt (dtype/elemwise-datatype col)
+        lerp-fn (fn [start end ^long n-steps]
+                  (let [hs (quot (inc n-steps) 2)]
+                    (reify ObjectReader
+                      (elemwiseDatatype [rdr] col-dt)
+                      (lsize [rdr] n-steps)
+                      (readObject [rdr idx]
+                        (if (< idx hs) start end)))))
+        missing-replace (reduce (partial find-lerp-values cnt col lerp-fn)
+                                {} ranges)]
+    (replace-missing-with-value col missing missing-replace)))
+
+
+(defn replace-missing-with-strategy
+  [col missing strategy value]
+  (let [value (if (fn? value)
+                (value col)
+                value)
+        col-dtype (dtype/elemwise-datatype col)
+        ;;non-numeric columns default to down from lerp or mid
+        strategy (cond
+                   (and (#{:lerp :midpoint} strategy)
+                        (not (or (casting/numeric-type? col-dtype)
+                                 (dtype-dt/datetime-datatype? col-dtype))))
+                   :down
+                   (= strategy :mid)
+                   :nearest
+                   :else
+                   strategy)]
+    (condp = strategy
+      :down (replace-missing-with-direction
+             [missing-direction-prev nil] col missing value)
+      :up (replace-missing-with-direction
+           [missing-direction-next nil] col missing value)
+      :downup (replace-missing-with-direction
+               [missing-direction-prev missing-direction-next] col missing value)
+      :updown (replace-missing-with-direction
+               [missing-direction-next missing-direction-prev] col missing value)
+      :abb (replace-missing-with-abb col missing)
+      :lerp (replace-missing-with-lerp :lerp col missing)
+      :nearest (replace-missing-with-nearest col missing)
+      :midpoint (replace-missing-with-lerp :midpoint col missing)
+      (replace-missing-with-value col missing value))))
+
+
+
+(defn replace-missing
+  "Replace missing values in some columns with a given strategy.
+  The columns selector may be:
+
+  - seq of any legal column names
+  - or a column filter function, such as `numeric` and `categorical`
+
+  Strategies may be:
+
+  - `:down` - take value from previous non-missing row if possible else use provided value.
+  - `:up` - take value from next non-missing row if possible else use provided value.
+  - `:downup` - take value from previous if possible else use next.
+  - `:updown` - take value from next if possible else use previous.
+  - `:nearest` - Use nearest of next or previous values.  `:mid` is an alias for `:nearest`.
+  - `:midpoint` - Use midpoint of averaged values between previous and next nonmissing
+     rows.
+  - `:abb` - Impute missing with approximate bayesian bootstrap.  See [r's ABB](https://search.r-project.org/CRAN/refmans/LaplacesDemon/html/ABB.html).
+  - `:lerp` - Linearly interpolate values between previous and next nonmissing rows.
+  - `:value` - Value will be provided - see below.
+
+      value may be provided which will then be used.  Value may be a function in which
+      case it will be called on the column with missing values elided and the return will
+      be used to as the filler."
+  ([ds] (replace-missing ds :mid))
+  ([ds strategy] (replace-missing ds :all strategy))
+  ([ds columns-selector strategy]
+   (replace-missing ds columns-selector strategy nil))
+  ([ds columns-selector strategy value]
+   (let [strategy (or strategy :mid)
+         row-cnt (ds-base/row-count ds)
+         selected (if (fn? columns-selector)
+                    (columns-selector ds)
+                    (ds-base/select-columns ds columns-selector))]
+     (->> selected
+          (ds-base/columns)
+          (reduce (fn [ds col]
+                    (let [^RoaringBitmap missing (col/missing col)]
+                      (cond
+                        (.isEmpty missing)
+                        ds
+                        (== row-cnt (.getCardinality missing))
+                        (if (and (= :value strategy)
+                                 (not (instance? IFn value)))
+                          (assoc ds (:name (meta col)) (dtype/const-reader value (ds-base/row-count ds)))
+                          (do
+                            (log/warnf "Column has no values and strategy (%s) is dependent upon existing values"
+                                       strategy)
+                            ds))
+                        :else
+                        (ds-base/add-or-update-column
+                         ds (replace-missing-with-strategy col missing strategy value)))))
+                  ds)))))

tech.ml.dataset/src/tech/v3/dataset/modelling.clj

@@ -0,0 +1,260 @@
+(ns tech.v3.dataset.modelling
+  "Methods related specifically to machine learning such as setting the inference
+  target.  This file integrates tightly with tech.v3.dataset.categorical which provides
+  categorical -> number and one-hot transformation pathways.
+
+  The functions in this namespace manipulate the metadata on the columns of the dataset, wich can be inspected  via `clojure.core/meta`"
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.argops :as argops]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.readers :as ds-readers]
+            [tech.v3.dataset.categorical :as categorical]
+            [tech.v3.dataset.column :as ds-col]
+            [clojure.set :as set])
+  (:import [java.util List]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn inference-column?
+  [col]
+  (:inference-target? (meta col)))
+
+
+(defn set-inference-target
+  "Set the inference target on the column.  This sets the :column-type member
+  of the column metadata to :inference-target?."
+  [dataset target-name-or-target-name-seq]
+  (let [colnames (if (sequential? target-name-or-target-name-seq)
+                   target-name-or-target-name-seq
+                   [target-name-or-target-name-seq])]
+    (ds-base/update-columns dataset colnames
+                            #(vary-meta % assoc :inference-target? true))))
+
+
+(defn inference-target-column-names
+  "Return the names of the columns that are inference targets."
+  [ds]
+  (->> (map meta (vals ds))
+       (filter :inference-target?)
+       (map :name)
+       (seq)))
+
+
+(defn inference-target-label-map
+  [dataset & [label-columns]]
+  (let [label-columns (or label-columns (inference-target-column-names dataset))]
+    (errors/when-not-errorf
+     (= 1 (count label-columns))
+     "Multiple or zero label columns found: %s" label-columns)
+    (-> (ds-base/column dataset (first label-columns))
+        (meta)
+        (get-in [:categorical-map :lookup-table]))))
+
+
+(defn inference-target-label-inverse-map
+  "Given options generated during ETL operations and annotated with :label-columns
+  sequence container 1 label column, generate a reverse map that maps from a dataset
+  value back to the label that generated that value."
+  [dataset & [label-columns]]
+  (set/map-invert (inference-target-label-map dataset label-columns)))
+
+
+
+(defn dataset->categorical-xforms
+  "Given a dataset, return a map of column-name->xform information."
+  [ds]
+  (->> (concat (categorical/dataset->categorical-maps ds)
+               (categorical/dataset->one-hot-maps ds))
+       (map (juxt :src-column identity))
+       (into {})))
+
+
+(defn num-inference-classes
+  "Given a dataset and correctly built options from pipeline operations,
+  return the number of classes used for the label.  Error if not classification
+  dataset."
+  ^long [dataset]
+  (count (inference-target-label-map dataset)))
+
+
+(defn feature-ecount
+  "Number of feature columns.  Feature columns are columns that are not
+  inference targets."
+  ^long [dataset]
+  (count (remove #(= :inference-target? (meta %))
+                 (vals dataset))))
+
+
+(defn model-type
+  "Check the label column after dataset processing.
+  Return either
+  :regression
+  :classification"
+  [dataset & [column-name-seq]]
+  (->> (or column-name-seq
+           (inference-target-column-names dataset))
+       (ds-base/select-columns dataset)
+       (vals)
+       (map (fn [column]
+              (let [colmeta (meta column)]
+                [(:name colmeta) (if (:categorical? colmeta)
+                                   :classification
+                                   :regression)])))
+       (into {})))
+
+
+(defn column-values->categorical
+  "Given a column encoded via either string->number or one-hot, reverse
+  map to the a sequence of the original string column values.
+  In the case of one-hot mappings, src-column must be the original
+  column name before the one-hot map"
+  [dataset src-column]
+  (if-let [cmap (->> (categorical/dataset->categorical-maps dataset)
+                     (filter #(= src-column (:src-column %)))
+                     (first))]
+    (-> (categorical/invert-categorical-map dataset cmap)
+        (ds-base/column src-column))
+    (if-let [one-hot-map (->> (categorical/dataset->one-hot-maps dataset)
+                              (filter #(= src-column (:src-column %)))
+                              (first))]
+      (-> (categorical/invert-one-hot-map dataset one-hot-map)
+          (ds-base/column src-column))
+      (errors/throwf
+       "Column %s does not appear to have either a categorical or one hot map"
+       src-column))))
+
+
+(defn- dataset-indexes
+  [^long n-rows {:keys [randomize-dataset?]
+                 :or {randomize-dataset? true}
+                 :as options}]
+  (if randomize-dataset?
+    (argops/argshuffle n-rows options)
+    (range n-rows)))
+
+
+(defn k-fold-datasets
+  "Given 1 dataset, prepary K datasets using the k-fold algorithm.
+  Randomize dataset defaults to true which will realize the entire dataset
+  so use with care if you have large datasets.
+
+  Returns a sequence of {:test-ds :train-ds}
+
+  Options:
+
+  * `:randomize-dataset?` - When true, shuffle the dataset.  In that case 'seed' may be
+     provided.  Defaults to true.
+  * `:seed` -  when `:randomize-dataset?` is true then this can either be an
+     implementation of java.util.Random or an integer seed which will be used to
+     construct java.util.Random."
+  ([dataset k options]
+   (let [n-rows (ds-base/row-count dataset)
+         indexes (dataset-indexes n-rows options)
+         indexes-per-fold (quot n-rows k)
+         leftover (rem n-rows k)
+         folds (mapv (fn [^long idx]
+                       (let [start-idx (-> (* idx indexes-per-fold)
+                                           (+ (if (< idx leftover)
+                                                idx
+                                                0)))
+                             glen (+ indexes-per-fold
+                                     (if (< idx leftover)
+                                       1
+                                       0))]
+                         (dtype/sub-buffer indexes start-idx glen)))
+                     (range k))]
+     (for [i (range k)]
+       {:test-ds (ds-base/select-rows dataset (nth folds i))
+        :train-ds (ds-base/select-rows dataset
+                                       (->> (keep-indexed #(when (not= %1 i) %2) folds)
+                                            (apply concat)))})))
+  ([dataset k]
+   (k-fold-datasets dataset k {})))
+
+
+(defn train-test-split
+  "Probabilistically split the dataset returning a map of `{:train-ds :test-ds}`.
+
+  Options:
+
+  * `:randomize-dataset?` - When true, shuffle the dataset.  In that case 'seed' may be
+     provided.  Defaults to true.
+  * `:seed` -  when `:randomize-dataset?` is true then this can either be an
+     implementation of java.util.Random or an integer seed which will be used to
+     construct java.util.Random.
+  * `:train-fraction` - Fraction of the dataset to use as training set.  Defaults to
+     0.7."
+  ([dataset {:keys [train-fraction]
+             :or {train-fraction 0.7}
+             :as options}]
+   (let [[_n-cols n-rows] (dtype/shape dataset)
+         indexes (dataset-indexes n-rows options)
+         n-elems (long n-rows)
+         n-training (long (Math/round (* n-elems (double train-fraction))))]
+     {:train-ds (ds-base/select-rows dataset (take n-training indexes))
+      :test-ds (ds-base/select-rows dataset (drop n-training indexes))}))
+  ([dataset]
+   (train-test-split dataset {})))
+
+
+(defn inference-target-ds
+  "Given a dataset return reverse-mapped inference target columns or nil
+  in the case where there are no inference targets."
+  [dataset]
+  (when-let [target-cols (inference-target-column-names dataset)]
+    (-> (ds-base/select-columns dataset target-cols)
+        (categorical/reverse-map-categorical-xforms))))
+
+
+(defn labels
+  "Return the labels.  The labels sequence is the reverse mapped inference
+  column.  This returns a single column of data or errors out."
+  [dataset]
+  (let [
+        rev-mapped (inference-target-ds dataset)]
+    (errors/when-not-errorf
+        (== 1 (ds-base/column-count rev-mapped))
+      "Incorrect number of columns (%d) in dataset for labels transformation"
+      (ds-base/column-count rev-mapped))
+    rev-mapped))
+
+
+(defn probability-distributions->label-column
+  "Given a dataset that has columns in which the column names describe labels and the
+  rows describe a probability distribution, create a label column by taking the max
+  value in each row and assign column that row value.
+  Creates a categorical label column which has a catgeorical map in its meta.
+  "
+  ([prob-ds dst-colname label-column-datatype]
+   (let [^List cnames (vec (ds-base/column-names prob-ds))
+         idx-col (->> (ds-readers/value-reader prob-ds)
+                      (dtype/emap
+                       (fn [valvec]
+                         (let [rdr (dtype/->reader valvec :float64)]
+                           ;;scan for missing and throw
+                           (dotimes [idx (.lsize rdr)]
+                             (errors/when-not-errorf
+                              (Double/isFinite (.readDouble rdr idx))
+                              "Nan/infinite values not allowed in probability distributions"))
+                           (argops/argmax rdr)))
+                       label-column-datatype)
+                      (dtype/clone))
+         cat-map (categorical/create-categorical-map
+                  (->> (map-indexed vector cnames)
+                       (into {})
+                       (set/map-invert))
+                  dst-colname
+                  label-column-datatype)
+         retval
+         (assoc prob-ds dst-colname
+                (ds-col/new-column
+                 dst-colname
+                 idx-col
+                 {:categorical? true
+                  :categorical-map cat-map}
+                 (ds-base/missing prob-ds)))]
+     retval))
+  ([prob-ds dst-colname] (probability-distributions->label-column prob-ds dst-colname :float64)))

tech.ml.dataset/src/tech/v3/dataset/neanderthal.clj

@@ -0,0 +1,332 @@
+(ns tech.v3.dataset.neanderthal
+  "Conversion of a dataset to/from a neanderthal dense matrix as well as various
+  dataset transformations such as pca, covariance and correlation matrixes.
+
+
+  Please include these additional dependencies in your project:
+
+```clojure
+  [uncomplicate/neanderthal \"0.45.0\"]
+```"
+  (:require [uncomplicate.neanderthal.core :as n-core]
+            [uncomplicate.neanderthal.native :as n-native]
+            [uncomplicate.neanderthal.linalg :as linalg]
+            [uncomplicate.commons.core :as n-com-core]
+            [tech.v3.libs.neanderthal :as dt-nean]
+            [tech.v3.libs.neanderthal]
+            [tech.v3.parallel.for :as pfor]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.argops :as argops]
+            [tech.v3.dataset.tensor :as ds-tens]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.functional :as dfn]
+            [tech.v3.tensor :as dtt]
+            [tech.v3.parallel.for :as pfor]
+            [ham-fisted.defprotocol :refer [extend-type]]
+            [clojure.tools.logging :as log])
+  (:refer-clojure :exclude [extend-type]))
+
+
+(defn dataset->dense
+  "Convert a dataset into a dense neanderthal CPU matrix.  If the matrix
+  is column-major, then potentially you can get accelerated copies from the dataset
+  into neanderthal.
+
+  * neanderthal-layout - either :column for a column-major matrix or :row for a row-major
+    matrix.
+  * datatype - either :float64 or :float32"
+  ([dataset neanderthal-layout datatype]
+   (let [[n-cols n-rows] (dtype/shape dataset)
+         retval (case datatype
+                  :float64
+                  (n-native/dge n-rows n-cols {:layout neanderthal-layout})
+                  :float32
+                  (n-native/fge n-rows n-cols {:layout neanderthal-layout}))
+         tens (dtt/ensure-tensor retval)
+         tens-cols (dtt/columns tens)]
+     ;;If possible, these will be accelerated copies
+     (->> (pfor/pmap (fn [tens-col ds-col]
+                       (dtype/copy! ds-col tens-col))
+                     tens-cols
+                     (vals dataset))
+          (dorun))
+     retval))
+  ([dataset neanderthal-layout]
+   (dataset->dense dataset neanderthal-layout :float64))
+  ([dataset]
+   (dataset->dense dataset :column :float64)))
+
+
+(defn dense->dataset
+  "Given a neanderthal matrix, convert its columns into the columns of a
+  tech.v3.dataset.  This does the conversion in-place.  If you would like to copy
+  the neanderthal matrix into JVM arrays, then after method use dtype/clone."
+  [matrix]
+  (->> (n-core/cols matrix)
+       (map dtt/ensure-tensor)
+       (ds-impl/new-dataset :neandtheral)))
+
+
+(defn fit-pca!
+  "Run Principle Component Analysis on a tensor.
+
+  Keep in mind that PCA may be highly influenced by outliers in the dataset
+  and a probabilistic or some level of auto-encoder dimensionality reduction
+  more effective for your problem.
+
+
+  Returns a map of:
+
+    * :means - vec of means
+    * :eigenvalues - vec of eigenvalues.  These are the variance of columns of the
+       post-projected tensor if :cov is used.  They are in the ballpark if :svd is used.
+    * :eigenvectors - matrix of eigenvectors
+
+  Options:
+
+  - method - svd, cov - Either use SVD or covariance based method.  SVD is faster
+    but covariance method means the post-projection variances are accurate.  Both
+    methods produce an identical or extremely similar projection matrix. Defaults
+    to `:cov`.
+  - covariance-bias? - When using :cov, divide by n-rows if true and (dec n-rows)
+    if false. defaults to false."
+  ([tensor {:keys [method
+                   covariance-bias?]
+            :or {method :cov
+                 covariance-bias? false}
+            :as _options}]
+   (let [{:keys [means tensor]} (ds-tens/mean-center-columns! tensor {:nan-strategy :keep})
+         [n-rows n-cols] (dtype/shape tensor)
+         n-rows (long n-rows)
+         n-cols (long n-cols)
+         matrix (dt-nean/tensor->matrix tensor)]
+     (case method
+       :svd
+       (let [{:keys [sigma u vt]} (linalg/svd matrix false true)
+             retval {:eigenvalues (dtype/clone (dtt/as-tensor (n-core/dia sigma)))
+                     :means means
+                     :method :svd
+                     :eigenvectors (dtype/clone (dtt/transpose (dtt/as-tensor vt) [1 0]))}]
+         (n-com-core/release matrix)
+         (n-com-core/release sigma)
+         (n-com-core/release u)
+         (n-com-core/release vt)
+         retval)
+       :cov
+       (let [;;Because we have subtracted out the means above, the covariance matrix
+             ;;is defined by (/ (Xt*X) (- n-rows 1))
+             tens-dt (dtype/elemwise-datatype tensor)
+             trans-mat (n-core/trans matrix)
+             cov-mat (n-core/mm trans-mat matrix)
+             bias (double (if covariance-bias?
+                            n-rows
+                            (dec n-rows)))
+             cov-buf (dtype/as-buffer cov-mat)
+             ;; Neanderthal's vecmath space failed us here
+             inv-bias (/ 1.0 bias)
+             _ (pfor/parallel-for idx (* n-cols n-cols)
+                                  (.writeDouble cov-buf idx
+                                                (* inv-bias (.readDouble cov-buf idx))))
+             fact (dt-nean/datatype->native-factory tens-dt)
+             w (n-core/ge fact n-cols 1)
+             vl (n-core/ge fact n-cols n-cols)
+             sym-cov (n-core/view-sy cov-mat)
+             _ (linalg/ev! sym-cov w vl nil)
+             wt (dtt/as-tensor w)
+             eigvals (dtt/select wt :all 0)
+             validx (argops/argsort :tech.numerics/> eigvals)
+             eigvals (dtype/clone (dtt/select eigvals validx))
+             eigvecs (dtype/clone (dtt/select vl :all validx))]
+         (n-com-core/release matrix)
+         (n-com-core/release cov-mat)
+         (n-com-core/release w)
+         (n-com-core/release vl)
+         {:eigenvalues eigvals
+          :means means
+          :eigenvectors eigvecs
+          :method :cov}))))
+  ([tensor]
+   (fit-pca! tensor nil)))
+
+
+(defn transform-pca!
+  "PCA transform the dataset returning a new tensor.  Mean-centers
+  the tensor in-place."
+  [tensor pca-info n-components]
+  (let [[_n-row n-cols] (dtype/shape tensor)
+        eigenvectors (:eigenvectors pca-info)
+        [_n-eig-rows n-eig-cols] (dtype/shape eigenvectors)
+        _ (errors/when-not-errorf
+           (= (long n-cols) (long n-eig-cols))
+           "Column count of dataset (%d) does not match column count of eigenvectors (%d)"
+           n-cols n-eig-cols)
+        _ (errors/when-not-errorf
+           (<= (long n-components) (long n-cols))
+           "Num components (%d) must be <= num cols (%d)"
+           n-components n-cols)
+        tensor (:tensor (ds-tens/mean-center-columns! tensor (select-keys pca-info [:means])))
+        project-matrix (dtt/select eigenvectors :all (range n-components))
+        ntens (dt-nean/tensor->matrix tensor)
+        nproj (dt-nean/tensor->matrix project-matrix nil (dtype/elemwise-datatype tensor))
+        resmat (n-core/mm ntens nproj)
+        result (dtype/clone (dtt/as-tensor resmat))]
+    (n-com-core/release ntens)
+    (n-com-core/release nproj)
+    (n-com-core/release resmat)
+    result))
+
+
+(defrecord PCATransform [means eigenvalues eigenvectors n-components result-datatype])
+
+(def ^:private neanderthal-fns*
+  (delay
+    (try
+      {:fit-pca (requiring-resolve 'tech.v3.dataset.neanderthal/fit-pca!)
+       :transform-pca (requiring-resolve 'tech.v3.dataset.neanderthal/transform-pca!)}
+      (catch Exception e
+        (log/debugf "Neanderthal loading failed: %s" (str e))
+        {}))))
+
+
+(defn neanderthal-enabled?
+  []
+  (empty? @neanderthal-fns*))
+
+
+(defn fit-pca
+  "Run PCA on the dataset.  Dataset must not have missing values
+  or non-numeric string columns.
+
+  Keep in mind that PCA may be highly influenced by outliers in the dataset
+  and a probabilistic or some level of auto-encoder dimensionality reduction
+  more effective for your problem.
+
+
+  Returns pca-info:
+  {:means - vec of means
+   :eigenvalues - vec of eigenvalues
+   :eigenvectors - matrix of eigenvectors
+  }
+
+
+  Use transform-pca with a dataset and the the returned value to perform
+  PCA on a dataset.
+
+  Options:
+
+    - method - svd, cov - Either use SVD or covariance based method.  SVD is faster
+      but covariance method means the post-projection variances are accurate.
+      Defaults to cov.  Both methods produce similar projection matrixes.
+    - variance-amount - fractional amount of variance to keep.  Defaults to 0.95.
+    - n-components - If provided overrides variance amount and sets the number of
+      components to keep. This controls the number of result columns directly as an
+      integer.
+    - covariance-bias? - When using :cov, divide by n-rows if true and (dec n-rows)
+      if false. defaults to false."
+  (^PCATransform [dataset {:keys [n-components variance-amount]
+                           :or {variance-amount 0.95} :as options}]
+   (errors/when-not-error
+    (== 0 (dtype/ecount (ds-base/missing dataset)))
+    "Cannot pca a dataset with missing entries.  See replace-missing.")
+   (let [result-datatype :float64
+         {:keys [eigenvalues] :as pca-result}
+         (fit-pca! (ds-tens/dataset->tensor dataset :float64) options)
+         ;;The eigenvalues are the variance.
+         variance-amount (double variance-amount)
+         ;;We know the eigenvalues are sorted from greatest to least
+         used-variance? (nil? n-components)
+         n-components (long
+                       (or n-components
+                           (let [variance-sum (double (dfn/reduce-+ eigenvalues))
+                                 target-variance-sum (* variance-amount variance-sum)
+                                 n-variance (dtype/ecount eigenvalues)]
+                             (loop [idx 0
+                                    tot-var 0.0]
+                               (if (and (< idx n-variance)
+                                        (< tot-var target-variance-sum))
+                                 (recur (unchecked-inc idx)
+                                        (+ tot-var (double (nth eigenvalues idx))))
+                                 idx)))))]
+     (map->PCATransform (merge (assoc pca-result
+                                      :n-components n-components
+                                      :result-datatype result-datatype)
+                               (when used-variance?
+                                 {:variance-amount variance-amount})))))
+  (^PCATransform [dataset]
+   (fit-pca dataset nil)))
+
+
+(defn transform-pca
+  "PCA transform the dataset returning a new dataset.  The method used to generate the pca information
+  is indicated in the metadata of the dataset."
+  [dataset {:keys [n-components result-datatype] :as pca-transform}]
+  (-> (ds-tens/dataset->tensor dataset result-datatype)
+      (transform-pca! pca-transform n-components)
+      (ds-tens/tensor->dataset dataset :pca-result)
+      (vary-meta assoc :pca-method (:method pca-transform))))
+
+
+(extend-type PCATransform
+  ds-proto/PDatasetTransform
+  (transform [t dataset]
+    (transform-pca dataset t)))
+
+
+
+#_(defn mean-std[rets]
+  (let [N (nc/mrows rets)
+        A (nn/fge rets)
+        fge1s (nc/entry! (nn/fge 1 N) 1)
+        means (nc/scal! (/ 1.0 N) (nc/mm fge1s A))
+        -ones (nc/scal -1 (nc/view-vctr fge1s))
+        -meancols (nc/rk -ones (nc/view-vctr means))
+        A-mcm (nc/axpy! 1.0 A (nc/copy -meancols))
+        A-means-sqr-summed (nc/mm fge1s (nm/sqr A-mcm))
+        A-stdevs (nm/sqrt (nc/scal (/ 1.0 (dec N)) A-means-sqr-summed))
+        A-sharpes (nc/ax (Math/sqrt 252) (nm/div means A-stdevs))]
+     {:means means :mcm A-mcm :stdevs A-stdevs :sharpes A-sharpes}))
+
+#_(defn cov-cor[rets]
+  (let [mstd (mean-std rets)
+        N (nc/mrows rets)
+        A-mcm (:mcm mstd)
+        A-stdevs (:stdevs mstd)
+        A-cov (nc/scal (/ 1.0 (dec N)) (nc/mm (nc/trans A-mcm) A-mcm))
+        sigx*sigy (nc/rk (nc/view-vctr A-stdevs) (nc/view-vctr A-stdevs))
+        A-cor (nm/div A-cov sigx*sigy)]
+    (merge mstd {:covmatrix A-cov :corrmatrix A-cor})))
+
+
+#_(defn matrix-desc-stats
+  "Return a set of information about neanderthal matrix A
+  - per-column means
+  - per-column variances
+  - per-column standard deviations
+  - covariance matrix
+  - correlation matrix"
+  ([A] (matrix-desc-stats nil A))
+  ([options A]
+   (with-release [n-cols (second (nc/dims a))
+                  fge1s (entry! (nm/fge 1 5) 1)
+                  means (scal! (/ 1.0 5) (nc/mm fge1s A))
+                  -meancols (rk  (nc/scal -1 (nc/view-vctr fge1s)) (nc/view-vctr means))
+                  A-means (axpy! 1.0 A (copy -meancols))
+                  A-means-sqr (vm/sqr A-means)
+                  A-means-sqr-summed (mm fge1s A-means-sqr)
+                  A-var (nc/scal (/ 1.0 5) A-means-sqr-summed)
+                  A-stdevs (vm/sqrt A-var)
+                  A-cov (nc/scal (/ 1.0 5) (mm (trans A-means) A-means))
+                  sigx*sigy (rk (view-vctr A-stdevs) (view-vctr A-stdevs))
+                  A-cor (vm/div A-cov sigx*sigy)]
+     (pr-str [A
+              means -meancols
+              A-means A-means-sqr
+              A-means-sqr-summed
+              A-var
+              A-stdevs
+              A-cov
+              sigx*sigy
+              A-cor]))))

tech.ml.dataset/src/tech/v3/dataset/print.clj

@@ -0,0 +1,376 @@
+(ns tech.v3.dataset.print
+  (:require [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.format-sequence :as format-sequence]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.pprint :as dtype-pp]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.graal-native :as graal-native]
+            [clojure.string :as str]
+            [ham-fisted.lazy-noncaching :as lznc]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.function :as hamf-fn])
+  (:import [tech.v3.datatype ObjectReader]
+           [java.util List ArrayList]
+           [org.roaringbitmap RoaringBitmap]))
+
+
+(graal-native/when-not-defined-graal-native
+ (require '[clojure.pprint :as pp]))
+
+
+(set! *warn-on-reflection* true)
+
+;;The default number of rows to print
+(def ^:dynamic ^:no-doc *default-table-row-print-length* 20)
+;;The default line policy - see dataset-data->str
+(def ^:dynamic ^:no-doc *default-print-line-policy* :repl)
+;;The default max width with 'nil' indicating no limit.
+(def ^:dynamic ^:no-doc *default-print-column-max-width* nil)
+;;The default to show/hide column types
+(def ^:dynamic ^:no-doc *default-print-column-types?* false)
+
+
+
+(defn- print-stringify
+  [item]
+  (-> (if (or (vector? item)
+              (map? item)
+              (set? item))
+        (with-out-str
+          (graal-native/if-defined-graal-native
+           (println item)
+           (do
+             (require '[clojure.pprint :as pp])
+             (pp/pprint item))))
+        (dtype-pp/format-object item))
+      (str/replace "|" "\\|")))
+
+
+(defn- reader->string-lines
+  [reader-data ^RoaringBitmap missing line-policy column-max-width new-number-format?
+   maximum-precision]
+  (let [reader-data (if (and new-number-format?
+                             (#{:float32 :float64} (dtype/elemwise-datatype reader-data)))
+                      (vec (format-sequence/format-sequence
+                            reader-data
+                            (long (or maximum-precision 8))))
+                      reader-data)]
+    (reify ObjectReader
+      (lsize [rdr] (dtype/ecount reader-data))
+      (readObject [rdr idx]
+        (if (.contains missing (int idx))
+           nil
+           (let [lines (str/split-lines (print-stringify (reader-data idx)))
+                 lines (if (number? column-max-width)
+                         (let [width (long column-max-width)]
+                           (->> lines (map (fn [^String line]
+                                             (if (> (count line) width)
+                                               (.substring line 0 width)
+                                               line)))))
+                         lines)]
+             (case line-policy
+               :single
+               [(first lines)]
+               :markdown
+               [(str/join "<br>" lines)]
+               :repl
+               lines)))))))
+
+
+(defn- append-line!
+  [^StringBuilder builder line]
+  (.append builder line)
+  (.append builder "\n"))
+
+
+(defn- rpad-str
+  [col-width line]
+  (let [n-data (count line)
+        n-pad (- (long col-width) n-data)
+        builder (StringBuilder.)]
+    (.append builder line)
+    (dotimes [_idx n-pad]
+      (.append builder " "))
+    (.toString builder)))
+
+
+(defn dataset-data->str
+  "Convert the dataset values to a string.
+
+Options may be provided in the dataset metadata or may be provided
+as an options map.  The options map overrides the dataset metadata.
+
+
+  * `:print-index-range` - The set of indexes to print.  If an integer then
+     is interpreted according to `:print-style`.  Defaults to the integer
+     `*default-table-row-print-length*`.
+  * `:print-style` - Defaults to :first-last.  Options are #{:first-last :first :last}.  In
+     the case `:print-index-range` is an integer and the dataset has more than that number of
+     rows prints the first N/2 and last N/2 rows or the first N or last N rows.
+  * `:print-line-policy` - defaults to `:repl` - one of:
+     - `:repl` - multiline table - default nice printing for repl
+     - `:markdown` - lines delimited by <br>
+     - `:single` - Only print first line
+  * `:print-column-max-width` - set the max width of a column when printing.
+  * `:print-column-types?` - show/hide column types.
+  * `:maximum-precision` - When provided, the maximum double precision as an integer.
+  * `:elide-header?` - When true, the header such as `test/data/alldtypes.arrow-feather-compressed [1000 15]:` is hidden.
+
+
+Examples of print styles:
+
+```clojure
+user> (require '[tech.v3.dataset :as ds])
+nil
+user> (require '[tech.v3.libs.arrow :as arrow])
+nil
+user> (def ds (ds/->dataset \"test/data/alldtypes.arrow-feather-compressed\" {:file-type :arrow}))
+08:26:03.156 [tech.resource.gc ref thread] INFO  tech.v3.resource.gc - Reference thread starting
+#'user/ds
+
+user> (vary-meta ds assoc :print-style :last :print-index-range 10)
+test/data/alldtypes.arrow-feather-compressed [1000 15]:
+
+| uints | longs | ubytes | strings | doubles | ushorts |  local_times | local_dates | ints |            instants | shorts | bytes | boolean | floats | text |
+|------:|------:|-------:|---------|--------:|--------:|--------------|-------------|-----:|--------------------:|-------:|------:|---------|-------:|------|
+|   990 |   990 |    222 |     990 |   990.0 |     990 | 13:39:59.923 |  2022-02-19 |  990 | 1645303199916000000 |    990 |   -34 |         |  990.0 |  990 |
+|   991 |   991 |    223 |     991 |   991.0 |     991 | 13:39:59.923 |  2022-02-19 |  991 | 1645303199916000000 |    991 |   -33 |         |  991.0 |  991 |
+|   992 |   992 |    224 |     992 |   992.0 |     992 | 13:39:59.923 |  2022-02-19 |  992 | 1645303199916000000 |    992 |   -32 |         |  992.0 |  992 |
+|   993 |   993 |    225 |     993 |   993.0 |     993 | 13:39:59.923 |  2022-02-19 |  993 | 1645303199916000000 |    993 |   -31 |         |  993.0 |  993 |
+|   994 |   994 |    226 |     994 |   994.0 |     994 | 13:39:59.923 |  2022-02-19 |  994 | 1645303199916000000 |    994 |   -30 |         |  994.0 |  994 |
+|   995 |   995 |    227 |     995 |   995.0 |     995 | 13:39:59.923 |  2022-02-19 |  995 | 1645303199916000000 |    995 |   -29 |         |  995.0 |  995 |
+|   996 |   996 |    228 |     996 |   996.0 |     996 | 13:39:59.923 |  2022-02-19 |  996 | 1645303199916000000 |    996 |   -28 |         |  996.0 |  996 |
+|   997 |   997 |    229 |     997 |   997.0 |     997 | 13:39:59.923 |  2022-02-19 |  997 | 1645303199916000000 |    997 |   -27 |         |  997.0 |  997 |
+|   998 |   998 |    230 |     998 |   998.0 |     998 | 13:39:59.923 |  2022-02-19 |  998 | 1645303199916000000 |    998 |   -26 |         |  998.0 |  998 |
+|   999 |   999 |    231 |     999 |   999.0 |     999 | 13:39:59.923 |  2022-02-19 |  999 | 1645303199916000000 |    999 |   -25 |         |  999.0 |  999 |
+user> (vary-meta ds assoc :print-style :first :print-index-range 10)
+test/data/alldtypes.arrow-feather-compressed [1000 15]:
+
+| uints | longs | ubytes | strings | doubles | ushorts |  local_times | local_dates | ints |            instants | shorts | bytes | boolean | floats | text |
+|------:|------:|-------:|---------|--------:|--------:|--------------|-------------|-----:|--------------------:|-------:|------:|---------|-------:|------|
+|     0 |     0 |      0 |       0 |     0.0 |       0 | 13:39:59.908 |  2022-02-19 |    0 | 1645303199909000000 |      0 |     0 |    true |    0.0 |    0 |
+|     1 |     1 |      1 |       1 |     1.0 |       1 | 13:39:59.910 |  2022-02-19 |    1 | 1645303199911000000 |      1 |     1 |   false |    1.0 |    1 |
+|     2 |     2 |      2 |       2 |     2.0 |       2 | 13:39:59.910 |  2022-02-19 |    2 | 1645303199911000000 |      2 |     2 |    true |    2.0 |    2 |
+|     3 |     3 |      3 |       3 |     3.0 |       3 | 13:39:59.910 |  2022-02-19 |    3 | 1645303199911000000 |      3 |     3 |    true |    3.0 |    3 |
+|     4 |     4 |      4 |       4 |     4.0 |       4 | 13:39:59.910 |  2022-02-19 |    4 | 1645303199911000000 |      4 |     4 |   false |    4.0 |    4 |
+|     5 |     5 |      5 |       5 |     5.0 |       5 | 13:39:59.910 |  2022-02-19 |    5 | 1645303199911000000 |      5 |     5 |   false |    5.0 |    5 |
+|     6 |     6 |      6 |       6 |     6.0 |       6 | 13:39:59.910 |  2022-02-19 |    6 | 1645303199911000000 |      6 |     6 |    true |    6.0 |    6 |
+|     7 |     7 |      7 |       7 |     7.0 |       7 | 13:39:59.910 |  2022-02-19 |    7 | 1645303199911000000 |      7 |     7 |   false |    7.0 |    7 |
+|     8 |     8 |      8 |       8 |     8.0 |       8 | 13:39:59.910 |  2022-02-19 |    8 | 1645303199911000000 |      8 |     8 |   false |    8.0 |    8 |
+|     9 |     9 |      9 |       9 |     9.0 |       9 | 13:39:59.910 |  2022-02-19 |    9 | 1645303199911000000 |      9 |     9 |    true |    9.0 |    9 |
+
+;; first-last is default with print-index-range of 20
+user> (vary-meta ds assoc :print-style :first-last :print-index-range 10)
+test/data/alldtypes.arrow-feather-compressed [1000 15]:
+
+| uints | longs | ubytes | strings | doubles | ushorts |  local_times | local_dates | ints |            instants | shorts | bytes | boolean | floats | text |
+|------:|------:|-------:|---------|--------:|--------:|--------------|-------------|-----:|--------------------:|-------:|------:|---------|-------:|------|
+|     0 |     0 |      0 |       0 |     0.0 |       0 | 13:39:59.908 |  2022-02-19 |    0 | 1645303199909000000 |      0 |     0 |    true |    0.0 |    0 |
+|     1 |     1 |      1 |       1 |     1.0 |       1 | 13:39:59.910 |  2022-02-19 |    1 | 1645303199911000000 |      1 |     1 |   false |    1.0 |    1 |
+|     2 |     2 |      2 |       2 |     2.0 |       2 | 13:39:59.910 |  2022-02-19 |    2 | 1645303199911000000 |      2 |     2 |    true |    2.0 |    2 |
+|     3 |     3 |      3 |       3 |     3.0 |       3 | 13:39:59.910 |  2022-02-19 |    3 | 1645303199911000000 |      3 |     3 |    true |    3.0 |    3 |
+|     4 |     4 |      4 |       4 |     4.0 |       4 | 13:39:59.910 |  2022-02-19 |    4 | 1645303199911000000 |      4 |     4 |   false |    4.0 |    4 |
+|   ... |   ... |    ... |     ... |     ... |     ... |          ... |         ... |  ... |                 ... |    ... |   ... |     ... |    ... |  ... |
+|   994 |   994 |    226 |     994 |   994.0 |     994 | 13:39:59.923 |  2022-02-19 |  994 | 1645303199916000000 |    994 |   -30 |         |  994.0 |  994 |
+|   995 |   995 |    227 |     995 |   995.0 |     995 | 13:39:59.923 |  2022-02-19 |  995 | 1645303199916000000 |    995 |   -29 |         |  995.0 |  995 |
+|   996 |   996 |    228 |     996 |   996.0 |     996 | 13:39:59.923 |  2022-02-19 |  996 | 1645303199916000000 |    996 |   -28 |         |  996.0 |  996 |
+|   997 |   997 |    229 |     997 |   997.0 |     997 | 13:39:59.923 |  2022-02-19 |  997 | 1645303199916000000 |    997 |   -27 |         |  997.0 |  997 |
+|   998 |   998 |    230 |     998 |   998.0 |     998 | 13:39:59.923 |  2022-02-19 |  998 | 1645303199916000000 |    998 |   -26 |         |  998.0 |  998 |
+|   999 |   999 |    231 |     999 |   999.0 |     999 | 13:39:59.923 |  2022-02-19 |  999 | 1645303199916000000 |    999 |   -25 |         |  999.0 |  999 |
+```
+
+Example of conservative printing:
+
+```clojure
+tech.ml.dataset.github-test> (def ds (with-meta ds
+                                       (assoc (meta ds)
+                                              :print-column-max-width 25
+                                              :print-line-policy :single)))
+```"
+  ([dataset]
+   (dataset-data->str dataset {}))
+  ([dataset options]
+   (let [options (merge (meta dataset) options)
+         {:keys [print-index-range print-line-policy
+                 print-column-max-width print-column-types?
+                 maximum-precision]} options
+         n-rows (long (second (dtype/shape dataset)))
+         index-range (or print-index-range
+                         (min n-rows *default-table-row-print-length*))
+         print-style (when (number? index-range) (get options :print-style :first-last))
+         [index-range ellipses?] (if (number? index-range)
+                                   (case print-style
+                                     :first-last
+                                     (if (> n-rows (long index-range))
+                                       (let [start-n (quot (long index-range) 2)
+                                             end-start (dec (- n-rows start-n))]
+                                         [(vec (concat (range start-n)
+                                                       (range end-start n-rows)))
+                                          true])
+                                       [(range n-rows) false])
+                                     :first
+                                     [(range (min index-range n-rows)) false]
+                                     :last
+                                     [(range (max 0 (- n-rows (long index-range))) n-rows) false])
+                                   [index-range false])
+         line-policy (or print-line-policy *default-print-line-policy*)
+         column-width (or print-column-max-width *default-print-column-max-width*)
+         column-types? (or print-column-types? *default-print-column-types?*)
+         print-ds (if (keyword? index-range)
+                    (if (identical? index-range :all)
+                      dataset
+                      (throw (RuntimeException. (str "Unrecognized index range keyword: "
+                                                     index-range))))
+                    (ds-proto/select-rows dataset
+                                          (lznc/filter
+                                           (hamf-fn/long-predicate
+                                            idx (and (< idx n-rows)
+                                                     (>= idx (- n-rows))))
+                                           index-range)))
+         column-names (map #(when (some? %) (.toString ^Object %)) (keys print-ds))
+         column-types (map #(str (when column-types? (:datatype (meta %))))
+                           (vals print-ds))
+         string-columns (map #(-> (dtype/->reader %)
+                                  (reader->string-lines (ds-proto/missing %)
+                                                        line-policy
+                                                        column-width
+                                                        true
+                                                        maximum-precision)
+                                  ;;Do the conversion to string once.
+                                  (dtype/clone)
+                                  (dtype/->reader))
+                             (vals print-ds))
+         string-columns (if ellipses?
+                          (let [insert-pos (quot (dtype/ecount index-range) 2)]
+                            (->> string-columns
+                                 (map (fn [str-col]
+                                        (vec (concat (take insert-pos str-col)
+                                                     [["..."]]
+                                                     (drop insert-pos str-col)))))))
+                          string-columns)
+         n-rows (long (second (dtype/shape print-ds)))
+         n-rows (long (if ellipses?
+                        (inc n-rows)
+                        n-rows))
+         row-heights (ArrayList.)
+         _ (.addAll row-heights (repeat n-rows 1))
+         column-widths
+         (->> string-columns
+              (map (fn [coltype colname coldata]
+                     (->> coldata
+                          (map-indexed
+                           (fn [row-idx lines]
+                             ;;Side effecting record row height.
+                             (.set row-heights (int row-idx)
+                                   (max (int (.get row-heights row-idx))
+                                        (count lines)))
+                             (apply max 0 (map count lines))))
+                          (apply max (count coltype) (count colname))))
+                   column-types
+                   column-names))
+         spacers (map #(apply str (repeat % "-")) column-widths)
+         fmts (map #(str "%" % "s") column-widths)
+         fmt-row (fn [leader divider trailer row]
+                   (str leader
+                        (apply str
+                               (interpose
+                                divider
+                                (map #(format %1 %2) fmts row)))
+                        trailer))
+         builder (StringBuilder.)]
+     (append-line! builder (fmt-row "| " " | " " |" column-names))
+     (when column-types? (append-line! builder (fmt-row "| " " | " " |" column-types)))
+     (append-line!
+      builder
+      (apply str
+             (concat (mapcat (fn [spacer dtype]
+                               (let [numeric? (and
+                                               (casting/numeric-type? dtype)
+                                               (not (dtype-dt/datetime-datatype?
+                                                     dtype)))]
+                                 (concat ["|-"]
+                                         spacer
+                                         (if numeric?
+                                           ":"
+                                           "-"))))
+                             spacers (map dtype/elemwise-datatype
+                                          (vals print-ds)))
+                     ["|"])))
+     (dotimes [idx n-rows]
+       (let [row-height (long (.get row-heights idx))]
+         (dotimes [inner-idx row-height]
+           (let [row-data
+                 (->> string-columns
+                      (map (fn [c-width column]
+                             (let [lines (column idx)]
+                               (if (< inner-idx (count lines))
+                                 (if (== 1 (count lines))
+                                   (.get ^List lines inner-idx)
+                                   (->> (.get ^List lines inner-idx)
+                                        (rpad-str c-width)))
+                                 "")))
+                           column-widths))]
+             (append-line! builder (fmt-row "| " " | " " |" row-data))))))
+     (.toString builder))))
+
+
+(defn dataset->str
+  "Convert a dataset to a string.  Prints a single line header and then calls
+  dataset-data->str.
+
+  For options documentation see dataset-data->str."
+  ([ds options]
+   (if (= [0 0] (dtype/shape ds))
+     (format "%s %s"
+             (ds-proto/dataset-name ds)
+             ;;make row major shape to avoid confusion
+             (vec (reverse (dtype/shape ds))))
+     (let [options (merge (meta ds) options)
+           elide-header? (get options :elide-header?)
+           header (if elide-header?
+                    ""
+                    (format "%s %s:\n\n"
+                            (ds-proto/dataset-name ds)
+                            (vec (reverse (dtype/shape ds)))))]
+
+       (str header (dataset-data->str ds options)))))
+  ([ds]
+   (dataset->str ds {})))
+
+
+(defn print-range
+  "Convenience function to set the number of rows to print.\n
+   Defaults to (range *default-table-row-print-length*) - one of:
+   - n - prints the first n rows
+   - range - prints the rows at positions corresponding to the range
+   - `:all` - prints all the rows in a dataset"
+  [dataset index-range]
+  (-> dataset
+      (vary-meta assoc :print-index-range index-range)))
+
+
+(defn print-policy
+  "Convenience function to vary printing behavior.\n
+   Defaults to `:repl` - one of:
+   - `:repl` - multiline table - default nice printing for repl
+   - `:markdown` - lines delimited by <br>
+   - `:single` - Only print first line"
+  [dataset line-policy]
+  (-> dataset
+      (vary-meta assoc :print-line-policy line-policy)))
+
+
+(defn print-width
+  "Convenience function to set the max width of a column when printing."
+  [dataset column-width]
+  (-> dataset
+      (vary-meta assoc :print-column-max-width column-width)))
+
+
+(defn print-types
+  "Convenience function to show/hide column types"
+  [dataset column-types]
+  (-> dataset
+      (vary-meta assoc :print-column-types? column-types)))

tech.ml.dataset/src/tech/v3/dataset/protocols.clj

@@ -0,0 +1,145 @@
+(ns tech.v3.dataset.protocols
+  (:require [tech.v3.datatype.protocols :as dtype-proto]
+            [ham-fisted.protocols :as hamf-proto]
+            [ham-fisted.defprotocol :refer [defprotocol extend-type extend-protocol]])
+  (:import [org.roaringbitmap RoaringBitmap]
+           [tech.v3.datatype Buffer]
+           [clojure.lang IDeref])
+  (:refer-clojure :exclude [merge defprotocol extend-type extend-protocol]))
+
+
+(defprotocol PRowCount
+  (^long row-count [this]))
+
+(defprotocol PColumnCount
+  (^long column-count [this]))
+
+(defprotocol PMissing
+  (missing [this])
+  (num-missing [this])
+  (any-missing? [this]))
+
+(defn missing-count
+  ^long [this] (num-missing this))
+
+(defprotocol PValidRows
+  (valid-rows [this]))
+
+(defprotocol PSelectRows
+  (select-rows [this rowidxs]))
+
+(defprotocol PRowFilter
+  (row-filter [this pred?]))
+
+(defprotocol PSelectColumns
+  (select-columns [this colnames]))
+
+(defprotocol PColumn
+  (is-column? [col])
+  (column-buffer [col]
+    "Return either the backing dataset for dense columns or tuple of [indexes,data] for sparse columns")
+  (empty-column? [col])
+  (column-data [col]
+    "Return the backing data store.  Note for sparse columns this may be much shorter than the column")
+  (with-column-data [col new-data]
+    "new data must be same length as old data"))
+
+(defprotocol PDataset
+  (is-dataset? [item])
+  ;;error on failure
+  (column [ds colname])
+  ;;indexable object.
+  (^Buffer rows [ds options])
+  (^Buffer rowvecs [ds options]))
+
+
+(defprotocol PDatasetParser
+  "Protocols for the dataset parser created via (dataset-parser)."
+  (add-row [p row]
+    "row needs to reduce to a sequence of objects implementing -key and -val")
+  (add-rows [p rows]
+    "rows need only be reducible"))
+
+(defprotocol PClearable
+  (ds-clear [p]
+    "Reset to initial state.  Avoid conflict with collection/clear"))
+
+
+(defprotocol PDatasetTransform
+  (transform [t dataset]))
+
+
+(extend-type Object
+  PDataset
+  (is-dataset? [item] false)
+  PColumn
+  (is-column? [item] false)
+  PRowCount
+  (row-count [this] (dtype-proto/ecount this))
+  PColumnCount
+  (column-count [this] 0)
+  PMissing
+  (missing [this] (RoaringBitmap.)))
+
+
+(extend-type nil
+  PDataset
+  (is-dataset? [item] false)
+  PColumn
+  (is-column? [item] false)
+  PRowCount
+  (row-count [this] 0)
+  PColumnCount
+  (column-count [this] 0)
+  PMissing
+  (missing [this] (RoaringBitmap.)))
+
+
+(defprotocol PColumnName
+  (column-name [col]))
+
+
+(extend-protocol PColumnName
+  nil
+  (column-name [col] nil)
+  Object
+  (column-name [col]
+    (if (map? col)
+      (get col :tech.v3.dataset/name
+           (get-in col [:tech.v3.dataset/metadata :name]))
+      (:name (meta col)))))
+
+
+(defn dataset-name
+  [ds]
+  (:name (meta ds)))
+
+
+(defn set-name
+  [item nm]
+  (vary-meta item assoc :name nm))
+
+
+(defprotocol PDatasetReducer
+  "An object that produces a per-dataset reducer and can merge contexts.
+  It is also expected that this implements hamf-proto/Finalize"
+  (ds->reducer [this ds])
+  (merge [this lctx rctx]))
+
+
+(extend-type Object
+  PDatasetReducer
+  (ds->reducer [this ds] this))
+
+;;For large reductions we may want to combine reducers on a single column when
+;;possible.
+(defprotocol PReducerCombiner
+  "Some reduces such as ones based on apache can be specified separately
+  in the output map but actually for efficiency need be represented by 1
+  concrete reducer."
+  (reducer-combiner-key [reducer]))
+
+
+(extend-protocol PReducerCombiner
+  Object
+  (reducer-combiner-key [reducer] nil))

tech.ml.dataset/src/tech/v3/dataset/readers.clj

@@ -0,0 +1,23 @@
+(ns ^:no-doc tech.v3.dataset.readers
+  (:require [tech.v3.dataset.protocols :as ds-proto]
+            [ham-fisted.api :as hamf])
+  (:import [tech.v3.datatype Buffer]))
+
+
+(defn value-reader
+  "Return a reader that produces a reader of column values per index.
+  Options:
+  :copying? - Default to false - When true row values are copied on read."
+  (^Buffer [dataset options]
+   (ds-proto/rowvecs dataset options))
+  (^Buffer [dataset]
+   (value-reader dataset nil)))
+
+
+(defn mapseq-reader
+  "Return a reader that produces a map of column-name->column-value
+  upon read."
+  (^Buffer [dataset options]
+   (ds-proto/rows dataset options))
+  (^Buffer [dataset]
+   (mapseq-reader dataset nil)))

tech.ml.dataset/src/tech/v3/dataset/reductions.clj

@@ -0,0 +1,678 @@
+(ns tech.v3.dataset.reductions
+  "Specific high performance reductions intended to be performend over a sequence
+  of datasets.  This allows aggregations to be done in situations where the dataset is
+  larger than what will fit in memory on a normal machine.  Due to this fact, summation
+  is implemented using Kahan algorithm and various statistical methods are done in using
+  statistical estimation techniques and thus are prefixed with `prob-` which is short
+  for `probabilistic`.
+
+  * `aggregate` - Perform a multi-dataset aggregation. Returns a dataset with row.
+  * `group-by-column-agg` - Perform a multi-dataset group-by followed by
+    an aggregation.  Returns a dataset with one row per key.
+
+  Examples:
+
+```clojure
+user> (require '[tech.v3.dataset :as ds])
+nil
+user> (require '[tech.v3.datatype.datetime :as dtype-dt])
+nil
+user> (def stocks (-> (ds/->dataset \"test/data/stocks.csv\" {:key-fn keyword})
+                      (ds/update-column :date #(dtype-dt/datetime->epoch :epoch-days %))))
+#'user/stocks
+user> (require '[tech.v3.dataset.reductions :as ds-reduce])
+nil
+user> (ds-reduce/group-by-column-agg
+       :symbol
+       {:symbol (ds-reduce/first-value :symbol)
+        :price-avg (ds-reduce/mean :price)
+        :price-sum (ds-reduce/sum :price)
+        :price-med (ds-reduce/prob-median :price)}
+       (repeat 3 stocks))
+:symbol-aggregation [5 4]:
+
+| :symbol |   :price-avg | :price-sum |   :price-med |
+|---------|--------------|------------|--------------|
+|     IBM |  91.26121951 |   33675.39 |  88.70468750 |
+|    AAPL |  64.73048780 |   23885.55 |  37.05281250 |
+|    MSFT |  24.73674797 |    9127.86 |  24.07277778 |
+|    AMZN |  47.98707317 |   17707.23 |  41.35142361 |
+|    GOOG | 415.87044118 |   84837.57 | 422.69722222 |
+```
+
+  * [zero-one benchmark winner](https://github.com/zero-one-group/geni-performance-benchmark/blob/da4d02e54de25a72214f72c4864ebd3d307520f8/dataset/src/dataset/optimised_by_chris.clj)"
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.sampling :as dt-sample]
+            [tech.v3.datatype.statistics :as dt-stats]
+            [tech.v3.datatype.argtypes :as argtypes]
+            [tech.v3.datatype.export-symbols :refer [export-symbols]]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.readers :as ds-readers]
+            [tech.v3.dataset.io :as ds-io]
+            [tech.v3.dataset.impl.column :as col-impl]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.column :as ds-col]
+            [tech.v3.dataset.io.mapseq-colmap :as io-mapseq]
+            [tech.v3.dataset.reductions.impl :as impl]
+            [tech.v3.dataset.reductions.apache-data-sketch :as sketch]
+            [tech.v3.parallel.for :as parallel-for]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.protocols :as hamf-proto]
+            [ham-fisted.lazy-noncaching :as lznc])
+  (:import [tech.v3.datatype Buffer]
+           [java.util List HashSet ArrayList LinkedHashMap Map]
+           [java.util.concurrent ConcurrentHashMap]
+           [java.util.concurrent.locks ReentrantLock]
+           [java.util.function LongConsumer Consumer LongPredicate]
+           [org.roaringbitmap RoaringBitmap]
+           [tech.v3.datatype LongReader BooleanReader ObjectReader DoubleReader
+            FastStruct]
+           [ham_fisted Sum Reducible Transformables Consumers$IncConsumer]
+           [clojure.lang IDeref IFn$OLO IFn$ODO])
+  (:refer-clojure :exclude [distinct]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+(defn reducer->column-reducer
+  "Given a hamf parallel reducer and a column name, return a dataset reducer of one column."
+  ([reducer cname]
+   (reducer->column-reducer reducer nil cname))
+  ([reducer op-space cname]
+   (impl/reducer->column-reducer reducer op-space cname)))
+
+
+(defn first-value
+  [colname]
+  (reify ds-proto/PDatasetReducer
+    (ds->reducer [this ds]
+      (let [col (ds-base/column ds colname)]
+        (reify
+          hamf-proto/Reducer
+          (->init-val-fn [r] (constantly nil))
+          (->rfn [r] (fn [acc ^long v] (if acc acc (clojure.lang.Box. (.nth ^clojure.lang.Indexed col v)))))
+          hamf-proto/ParallelReducer
+          (->merge-fn [r] (fn [l r] l)))))
+    (merge [this l r] l)
+    hamf-proto/Finalize
+    (finalize [this v] (if v (.-val ^clojure.lang.Box v) v))))
+
+
+(defn sum
+  "Create a double consumer which will sum the values."
+  [colname]
+  (reducer->column-reducer (hamf-rf/reducer-with-finalize
+                            (Sum.)
+                            #((deref %) :sum))
+                           colname))
+
+
+(defn mean
+  "Create a double consumer which will produce a mean of the column."
+  [colname]
+  (let [ds-fn (sum colname)]
+    (reducer->column-reducer (hamf-rf/reducer-with-finalize
+                              (Sum.)
+                              #(let [m (deref %)]
+                                 (/ (double (m :sum))
+                                    (double (m :n-elems)))))
+                             colname)))
+
+(defn row-count
+  "Create a simple reducer that returns the number of times reduceIndex was called."
+  []
+  (reify ds-proto/PDatasetReducer
+    (ds->reducer [this ds]
+      (hamf-rf/consumer-reducer #(Consumers$IncConsumer.)))
+    (merge [this l r] (hamf-rf/reducible-merge l r))
+    hamf-proto/Finalize
+    (finalize [this v] (deref v))))
+
+(defn maximum-rf
+  ([]
+   Double/NaN)
+  ([eax v]
+   (if (Double/isNaN eax)
+     v
+     (max (double v) (double eax))))
+  ([eax]
+   eax))
+
+(defn maximum
+  [colname]
+  (reducer->column-reducer maximum-rf colname))
+
+(deftype BitmapConsumer [^RoaringBitmap bitmap]
+  LongConsumer
+  (accept [_this lval]
+    (.add bitmap (unchecked-int lval)))
+  Reducible
+  (reduce [this other]
+    (let [^BitmapConsumer other other]
+      (.or bitmap (.bitmap other))
+      this))
+  IDeref
+  (deref [_this] bitmap))
+
+
+(defn distinct-int32
+  "Get the set of distinct items given you know the space is no larger than int32
+  space.  The optional finalizer allows you to post-process the data."
+  ([colname finalizer]
+   (let [r (hamf-rf/long-consumer-reducer #(BitmapConsumer. (bitmap/->bitmap)))
+         r (if finalizer
+             (hamf-rf/reducer-with-finalize r (fn [b] (finalizer @b)))
+             r)]
+     (reducer->column-reducer r colname)))
+  ([colname]
+   (distinct-int32 colname nil)))
+
+
+(deftype SetConsumer [^HashSet data]
+  Consumer
+  (accept [_this objdata]
+    (.add data objdata))
+  Reducible
+  (reduce [this other]
+    (let [^SetConsumer other other]
+      (.addAll ^HashSet data (.data other))
+      this))
+  IDeref
+  (deref [_this] data))
+
+
+(defn distinct
+  "Create a reducer that will return a set of values."
+  ([colname finalizer]
+   (let [r (hamf-rf/consumer-reducer #(SetConsumer. (HashSet.)))
+         r (if finalizer
+             (hamf-rf/reducer-with-finalize r (fn [b] (finalizer @b)))
+             r)]
+     (reducer->column-reducer r colname)))
+  ([colname]
+   (distinct colname nil)))
+
+
+(defn count-distinct
+  ([colname op-space]
+   (case op-space
+     :int32 (distinct-int32 colname dtype/ecount)
+     :object (distinct colname dtype/ecount)))
+  ([colname]
+   (count-distinct colname :object)))
+
+(defn prob-set-cardinality
+  "See docs for [[tech.v3.dataset.reductions.apache-data-sketch/prob-set-cardinality]].
+
+  Options:
+
+  * `:hll-lgk` - defaults to 12, this is log-base2 of k, so k = 4096. lgK can be
+           from 4 to 21.
+  * `:hll-type` - One of #{4,6,8}, defaults to 8.  The HLL_4, HLL_6 and HLL_8
+           represent different levels of compression of the final HLL array where the
+           4, 6 and 8 refer to the number of bits each bucket of the HLL array is
+           compressed down to. The HLL_4 is the most compressed but generally slightly
+           slower than the other two, especially during union operations.
+  * `:datatype` - One of :float64, :int64, :string"
+  ([colname options] (sketch/prob-set-cardinality colname options))
+  ([colname] (sketch/prob-set-cardinality colname)))
+
+(defn prob-cdf
+  "See docs for [[tech.v3.dataset.reductions.apache-data-sketch/prob-cdf]]
+
+  * k - defaults to 128. This produces a normalized rank error of about 1.7%"
+  ([colname cdf] (sketch/prob-cdf colname cdf))
+  ([colname cdf k] (sketch/prob-cdf colname cdf k)))
+
+(defn prob-quantile
+  "See docs for [[tech.v3.dataset.reductions.apache-data-sketch/prob-quantile]]
+
+  * k - defaults to 128. This produces a normalized rank error of about 1.7%"
+  ([colname quantile] (sketch/prob-quantile colname quantile))
+  ([colname quantile k] (sketch/prob-quantile colname quantile k)))
+
+(defn prob-median
+  "See docs for [[tech.v3.dataset.reductions.apache-data-sketch/prob-median]]
+
+  * k - defaults to 128. This produces a normalized rank error of about 1.7%"
+  ([colname] (sketch/prob-median colname))
+  ([colname k] (sketch/prob-median colname k)))
+
+(defn prob-interquartile-range
+  "See docs for [[tech.v3.dataset.reductions.apache-data-sketch/prob-interquartile-range
+
+  * k - defaults to 128. This produces a normalized rank error of about 1.7%"
+  ([colname k] (sketch/prob-interquartile-range colname k))
+  ([colname] (sketch/prob-interquartile-range colname)))
+
+(defn reservoir-desc-stat
+  "Calculate a descriptive statistic using reservoir sampling.  A list of statistic
+  names are found in `tech.v3.datatype.statistics/all-descriptive-stats-names`.
+  Options are options used in
+  [reservoir-sampler](https://cnuernber.github.io/dtype-next/tech.v3.datatype.sampling.html#var-double-reservoir).
+
+  Note that this method will *not* convert datetime objects to milliseconds for you as
+  in descriptive-stats."
+  ([colname reservoir-size stat-name options]
+   (let [col-reducer (reducer->column-reducer
+                      (dt-sample/reservoir-sampler reservoir-size
+                                     (assoc options :datatype :float64))
+                      colname)]
+     (reify
+       ds-proto/PDatasetReducer
+       (ds->reducer [this ds] (ds-proto/ds->reducer col-reducer ds))
+       (merge [this lhs rhs]
+         (reduce hamf-rf/double-consumer-accumulator
+                 lhs
+                 @rhs))
+       hamf-proto/Finalize
+       (finalize [this ctx]
+         ((dt-stats/descriptive-statistics @ctx [stat-name] options) stat-name))
+       ds-proto/PReducerCombiner
+       (reducer-combiner-key [reducer] [colname :reservoir-stats reservoir-size options]))))
+  ([colname reservoir-size stat-name]
+   (reservoir-desc-stat colname reservoir-size stat-name nil)))
+
+
+(defn reservoir-dataset
+  ([reservoir-size] (reservoir-dataset reservoir-size nil))
+  ([reservoir-size options]
+   (let [sampler-reducer (dt-sample/reservoir-sampler reservoir-size
+                                                      (assoc options :datatype :object))
+         sampler-rfn (hamf-proto/->rfn sampler-reducer)
+         merge-fn (hamf-proto/->merge-fn sampler-reducer)]
+     (reify
+       ds-proto/PDatasetReducer
+       (ds->reducer [this ds]
+         (let [^Buffer rows (ds-proto/rows ds {:copying? true})]
+           (reify
+             hamf-proto/Reducer
+             (->init-val-fn [r] (hamf-proto/->init-val-fn sampler-reducer))
+             (->rfn [r] (hamf-rf/long-accumulator
+                         acc idx (sampler-rfn acc (.readObject rows idx))))
+             hamf-proto/ParallelReducer
+             (->merge-fn [r] merge-fn))))
+       (merge [this lhs rhs] (merge-fn lhs rhs))
+       hamf-proto/Finalize
+       (finalize [this ctx] (ds-io/->dataset @ctx options))))))
+
+
+(defn reducer
+  "Make a group-by-agg reducer.
+
+  * `column-name` - Single column name or multiple columns.
+  * `init-val-fn` - Function to produce initial accumulators
+  * `rfn` - Function that takes the accumulator and each column's data as
+     as further arguments.  For a single-column pathway this looks like a normal clojure
+     reduction function but for two columns it gets extra arguments.
+  * `merge-fn` - Function that takes two accumulators and merges them.  Merge is not required
+    for [[group-by-column-agg]] but it *is* required for [[aggregate]].
+  * `finalize-fn` - finalize the result after aggregation.  Optional, will be replaced
+     with identity of not provided."
+  ([column-name init-val-fn rfn merge-fn finalize-fn]
+   (let [finalize-fn (or finalize-fn #(rfn %))
+         init-val-fn (or init-val-fn #(rfn))
+         column-names (if (= :scalar (argtypes/arg-type column-name))
+                        [column-name]
+                        (vec column-name))
+         merge-fn (or merge-fn #(rfn %1 %2))]
+     (reify ds-proto/PDatasetReducer
+       (ds->reducer [this ds]
+         (let [rvecs (-> (ds-proto/select-columns ds column-names)
+                         (ds-proto/rowvecs {:copying? true}))]
+           (reify
+             hamf-proto/Reducer
+             (->init-val-fn [r] init-val-fn)
+             (->rfn [r] (hamf-rf/long-accumulator
+                         acc row-idx
+                         (apply rfn acc (.readObject rvecs row-idx))))
+             hamf-proto/ParallelReducer
+             (->merge-fn [r] merge-fn))))
+       (merge [this lhs rhs] (merge-fn lhs rhs))
+       hamf-proto/Finalize
+       (finalize [this ctx] (finalize-fn ctx)))))
+  ([column-name rfn]
+   (reducer column-name rfn rfn
+            rfn rfn)))
+
+
+(defn- combine-reducers
+  [reducers]
+  (let [reducer->indexes (->> reducers
+                              (map-indexed vector)
+                              (hamf/group-by (comp ds-proto/reducer-combiner-key second))
+                              (mapcat (fn [[ckey reducer-seq]]
+                                        (if (nil? ckey)
+                                          (lznc/map (fn [[ridx reducer]]
+                                                      [reducer [ridx]])
+                                                    reducer-seq)
+                                          (let [reducer (second (first reducer-seq))]
+                                            [[reducer (hamf/mapv first reducer-seq)]])))))]
+    [(mapv first reducer->indexes)
+     (->> (lznc/map second reducer->indexes)
+          (lznc/map-indexed (fn [dst-idx src-indexes]
+                              (map #(vector % dst-idx) src-indexes)))
+          (apply lznc/concat)
+          (hamf/sort-by first)
+          (hamf/mapv second))]))
+
+
+(defn- finalize-combined-reducers
+  [reducers rev-indexes cnames ^objects reduced-values]
+  (->> reducers
+       (lznc/map-indexed
+        (fn [^long src-idx reducer]
+          (hamf-proto/finalize
+           reducer (aget reduced-values (long (.get ^List rev-indexes src-idx))))))
+       (hamf/vec)
+       (FastStruct. cnames)))
+
+
+(defn group-by-column-agg-rf
+  "Produce a transduce-compatible rf that will perform the group-by-column-agg pathway.
+  See documentation for [[group-by-column-agg]].
+
+```clojure
+tech.v3.dataset.reductions-test> (def stocks (ds/->dataset \"test/data/stocks.csv\" {:key-fn keyword}))
+#'tech.v3.dataset.reductions-test/stocks
+tech.v3.dataset.reductions-test> (transduce (map identity)
+                                            (ds-reduce/group-by-column-agg-rf
+                                             :symbol
+                                             {:n-elems (ds-reduce/row-count)
+                                              :price-avg (ds-reduce/mean :price)
+                                              :price-sum (ds-reduce/sum :price)
+                                              :symbol (ds-reduce/first-value :symbol)
+                                              :n-dates (ds-reduce/count-distinct :date :int32)}
+                                             {:index-filter (fn [dataset]
+                                                              (let [rdr (dtype/->reader (dataset :price))]
+                                                                (hamf/long-predicate
+                                                                 idx (> (.readDouble rdr idx) 100.0))))})
+                                            [stocks stocks stocks])
+_unnamed [4 5]:
+
+| :symbol | :n-elems |   :price-avg | :price-sum | :n-dates |
+|---------|---------:|-------------:|-----------:|---------:|
+|    AAPL |       93 | 160.19096774 |   14897.76 |       31 |
+|     IBM |      120 | 111.03775000 |   13324.53 |       40 |
+|    AMZN |       18 | 126.97833333 |    2285.61 |        6 |
+|    GOOG |      204 | 415.87044118 |   84837.57 |       68 |
+```"
+  ([colname agg-map]
+   (group-by-column-agg-rf colname agg-map nil))
+  ([colname agg-map options]
+   (let [;;By default, we include the key-columns in the result.
+         ;;Users can override this by passing in the column in agg-map
+         agg-map (merge
+                  (->> (if (sequential? colname)
+                         colname
+                         [colname])
+                       (reduce (fn [agg-map cname]
+                                 (assoc agg-map
+                                        cname
+                                        (first-value cname)))
+                               {}))
+                  agg-map)
+         cnames (->> (hamf/keys agg-map)
+                     (reduce (hamf-rf/indexed-accum
+                              acc idx v (.put ^Map acc v idx) acc)
+                             (LinkedHashMap.)))
+         ;;convert reducers to something with lightning fast reduction.
+         reducers (hamf/object-array-list (hamf/vals agg-map))
+         [combined-reducers rev-indexes] (combine-reducers reducers)
+         [colname ds-map-fn]
+         (if (sequential? colname)
+           (let [tmp-colname ::_temp_col]
+             [tmp-colname
+              #(assoc % tmp-colname
+                      (ds-col/new-column
+                       #:tech.v3.dataset{:name tmp-colname
+                                         :data
+                                         (-> (ds-base/select-columns % colname)
+                                             (ds-readers/value-reader {:copying? true}))
+                                         ;;no scanning for missing and no datatype
+                                         ;;detection
+                                         :missing (bitmap/->bitmap)
+                                         :force-datatype? true}))])
+           [colname identity])
+         finalize-fn #(finalize-combined-reducers reducers rev-indexes cnames %)]
+     (fn
+       ([] (ConcurrentHashMap. (int (get options :map-initial-capacity 10000))))
+       ([agg-map next-ds]
+        (let [next-ds (ds-map-fn next-ds)
+              group-col (dtype/->buffer (ds-base/column next-ds colname))
+              n-rows (ds-base/row-count next-ds)
+              ^LongPredicate idx-filter (when-let [filter-fn (get options :index-filter)]
+                                          (let [idx-filter (filter-fn next-ds)]
+                                            (if (instance? LongPredicate idx-filter)
+                                              idx-filter
+                                              (reify LongPredicate
+                                                (test [this v] (boolean (idx-filter v)))))))
+              agg-reducer (->> combined-reducers
+                               (hamf/mapv #(ds-proto/ds->reducer % next-ds))
+                               (hamf-rf/compose-reducers {:rfn-datatype :int64}))
+              group-col (-> (ds-base/column next-ds colname)
+                            (dtype/->reader))
+              agg-init (hamf-proto/->init-val-fn agg-reducer)
+              agg-rfn (hamf-proto/->rfn agg-reducer)]
+          (dorun (hamf/pgroups
+                  n-rows
+                  (fn [^long sidx ^long eidx]
+                    (if idx-filter
+                      (loop [sidx sidx]
+                        (when (< sidx eidx)
+                          (when (.test idx-filter sidx)
+                            (.compute ^Map agg-map (.readObject group-col sidx)
+                                      (hamf-fn/bi-function
+                                       k v
+                                       (agg-rfn (or v (agg-init)) sidx))))
+                          (recur (unchecked-inc sidx))))
+                      (loop [sidx sidx]
+                        (when (< sidx eidx)
+                          (.compute ^Map agg-map (.readObject group-col sidx)
+                                    (hamf-fn/bi-function
+                                     k v
+                                     (agg-rfn (or v (agg-init)) sidx)))
+                          (recur (unchecked-inc sidx))))))))
+          agg-map
+          #_(->> (if idx-filter
+                 (lznc/filter idx-filter (hamf/range n-rows))
+                 (hamf/range n-rows))
+               (hamf-rf/preduce (constantly nil)
+                                (fn [acc ^long idx]
+
+                                  )
+                                )
+               (hamf/group-by-reducer
+                (hamf-fn/long->obj idx (.readObject group-col idx))
+                agg-reducer
+                {:map-fn (constantly agg-map)
+                 :ordered? false
+                 :skip-finalize? true
+                 :min-n 1000}))))
+       ([agg-map]
+        (if (get options :skip-finalize?)
+          agg-map
+          (let [c ((hamf-proto/->init-val-fn (io-mapseq/mapseq-reducer options)))
+                ll (ReentrantLock.)]
+            ;;Also possible to parse N datasets in parallel and do a concat-copying
+            ;;operation but in my experience this steps takes up nearly no time.
+            (.forEach ^ConcurrentHashMap agg-map 32
+                      (hamf-fn/bi-consumer
+                       k v
+                       (let [vv (finalize-fn v)]
+                         (.lock ll)
+                         (try
+                           (.accept ^Consumer c vv)
+                           (finally
+                             (.unlock ll))))))
+            @c)))))))
+
+
+(defn group-by-column-agg
+  "Group a sequence of datasets by a column and aggregate down into a new dataset.
+
+  * colname - Either a single scalar column name or a vector of column names to group by.
+
+  * agg-map - map of result column name to reducer.  All values in the agg map must be
+    functions from dataset to hamf (non-parallel) reducers.  Note that transducer-compatible
+    rf's - such as kixi.mean, are valid hamf reducers.
+  * ds-seq - Either a single dataset or sequence of datasets.
+
+
+  See also [[group-by-column-agg-rf]].
+
+  Options:
+
+  * `:map-initial-capacity` - initial hashmap capacity.  Resizing hash-maps is expensive so we
+     would like to set this to something reasonable.  Defaults to 10000.
+  * `:index-filter` - A function that given a dataset produces a function from long index
+    to boolean, ideally either nil or a java.util.function.LongPredicate.  Only indexes for
+    which the index-filter returns true will be added to the aggregation.  For very large
+    datasets, this is a bit faster than using filter before the aggregation.
+
+  Example:
+
+```clojure
+
+user> (require '[tech.v3.dataset :as ds])
+nil
+user> (require '[tech.v3.dataset.reductions :as ds-reduce])
+nil
+user> (def ds (ds/->dataset \"https://github.com/techascent/tech.ml.dataset/raw/master/test/data/stocks.csv\"
+                            {:key-fn keyword}))
+
+#'user/ds
+user> (ds-reduce/group-by-column-agg
+       :symbol
+       {:price-avg (ds-reduce/mean :price)
+        :price-sum (ds-reduce/sum :price)}
+       ds)
+_unnamed [5 3]:
+
+| :symbol |   :price-avg | :price-sum |
+|---------|-------------:|-----------:|
+|    MSFT |  24.73674797 |    3042.62 |
+|    AAPL |  64.73048780 |    7961.85 |
+|     IBM |  91.26121951 |   11225.13 |
+|    AMZN |  47.98707317 |    5902.41 |
+|    GOOG | 415.87044118 |   28279.19 |
+
+user> (def testds (ds/->dataset {:a [\"a\" \"a\" \"a\" \"b\" \"b\" \"b\" \"c\" \"d\" \"e\"]
+                                 :b [22   21  22 44  42  44   77 88 99]}))
+#'user/testds
+user> (ds-reduce/group-by-column-agg
+       [:a :b] {:c (ds-reduce/row-count)}
+       testds)
+_unnamed [7 3]:
+
+| :a | :b | :c |
+|----|---:|---:|
+|  e | 99 |  1 |
+|  a | 21 |  1 |
+|  c | 77 |  1 |
+|  d | 88 |  1 |
+|  b | 44 |  2 |
+|  b | 42 |  1 |
+|  a | 22 |  2 |
+```"
+  ([colname agg-map options ds-seq]
+   (hamf-rf/reduce-reducer (group-by-column-agg-rf colname agg-map options)
+                        (if (ds-impl/dataset? ds-seq)
+                          [ds-seq]
+                          ds-seq)))
+  ([colname agg-map ds-seq]
+   (group-by-column-agg colname agg-map nil ds-seq)))
+
+
+(defn aggregate
+  "Create a set of aggregate statistics over a sequence of datasets.  Returns a
+  dataset with a single row and uses the same interface group-by-column-agg.
+
+  Example:
+
+```clojure
+  (ds-reduce/aggregate
+   {:n-elems (ds-reduce/row-count)
+    :price-avg (ds-reduce/mean :price)
+    :price-sum (ds-reduce/sum :price)
+    :price-med (ds-reduce/prob-median :price)
+    :price-iqr (ds-reduce/prob-interquartile-range :price)
+    :n-dates (ds-reduce/count-distinct :date :int32)}
+   [ds-seq])
+```"
+  ([agg-map options ds-seq]
+   (let [cnames (vec (keys agg-map))
+         reducers (vals agg-map)
+         [combined-reducers rev-indexes] (combine-reducers reducers)
+         context-map (ConcurrentHashMap.)
+         _ (reduce (fn [acc ds]
+                     (let [rs (->> (map #(ds-proto/ds->reducer % ds) combined-reducers)
+                                   (hamf-rf/compose-reducers {:rfn-datatype :int64}))
+                           rs-rfn (hamf-proto/->rfn rs)
+                           rs-init (hamf-proto/->init-val-fn rs)
+                           init-fn (hamf-fn/function _k (rs-init))]
+                       (dorun (hamf/pgroups
+                               (ds-base/row-count ds)
+                               (fn [^long sidx ^long eidx]
+                                 (let [tid (.getId (Thread/currentThread))]
+                                   (.put context-map tid
+                                         (reduce rs-rfn
+                                                 (.computeIfAbsent context-map tid init-fn)
+                                                 (hamf/range sidx eidx)))))
+                               {:min-n 100}))))
+                   nil
+                   (if (ds-impl/dataset? ds-seq) [ds-seq] ds-seq))
+         ^objects final-ctx
+         (reduce (fn [^objects lhs ^objects rhs]
+                   (dotimes [idx (count combined-reducers)]
+                     (aset lhs idx
+                           (ds-proto/merge (combined-reducers idx)
+                                           (aget lhs idx)
+                                           (aget rhs idx))))
+                   lhs)
+                 (.values context-map))]
+     (ds-io/->dataset [(zipmap cnames
+                               (->> reducers
+                                    (map-indexed
+                                     (fn [ridx reducer]
+                                       (hamf-proto/finalize
+                                        reducer
+                                        (aget final-ctx (long (rev-indexes ridx))))))))])))
+  ([agg-map ds-seq]
+   (aggregate agg-map nil ds-seq)))
+
+
+(comment
+  (require '[tech.v3.dataset :as ds])
+  (require '[tech.v3.datatype.datetime :as dtype-dt])
+  (def stocks (-> (ds/->dataset "test/data/stocks.csv" {:key-fn keyword})
+                  (ds/update-column :date #(dtype-dt/datetime->epoch :epoch-days %))))
+
+
+  (aggregate
+   {:n-elems (row-count)
+    :price-avg (mean :price)
+    :price-sum (sum :price)
+    :price-med (prob-median :price)
+    :price-iqr (prob-interquartile-range :price)
+    :n-dates (count-distinct :date :int32)
+    :stddev (reservoir-desc-stat :price 100 :standard-deviation)
+    :sub-stocks (reservoir-dataset 100)}
+   [stocks stocks stocks])
+
+  (group-by-column-agg
+   :symbol
+   {:symbol (first-value :symbol)
+    :n-elems (row-count)
+    :price-med (prob-median :price)
+    :stddev (reservoir-desc-stat :price 100 :standard-deviation)
+    :sub-stocks (reservoir-dataset 100)}
+   [stocks stocks stocks])
+
+  )

tech.ml.dataset/src/tech/v3/dataset/reductions/apache_data_sketch.clj

@@ -0,0 +1,326 @@
+(ns tech.v3.dataset.reductions.apache-data-sketch
+  "Reduction reducers based on the apache data sketch family of algorithms.
+
+  * [apache data sketches](https://datasketches.apache.org/)
+
+  Algorithms included here are:
+
+### Set Cardinality
+
+   * [hyper-log-log](https://datasketches.apache.org/docs/HLL/HLL.html)
+   * [theta](https://datasketches.apache.org/docs/Theta/ThetaSketchFramework.html)
+   * [cpc](https://datasketches.apache.org/docs/CPC/CPC.html)
+
+### Quantiles
+   * [doubles](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html)
+
+
+  Example:
+```clojure
+user> (require '[tech.v3.dataset :as ds])
+11:04:44.508 [nREPL-session-e40a19c2-8d41-40a8-8853-abe1293abe20] DEBUG tech.v3.tensor.dimensions.global-to-local - insn custom indexing enabled!
+nil
+user> (require '[tech.v3.dataset.reductions :as ds-reduce])
+nil
+user> (require '[tech.v3.dataset.reductions.apache-data-sketch :as ds-sketch])
+#'user/stocks
+user> (def stocks (ds/->dataset \"test/data/stocks.csv\" {:key-fn keyword}))
+  #'user/stocks
+user> (ds-reduce/group-by-column-agg
+       :symbol
+       {:symbol (ds-reduce/first-value :symbol)
+        :price-quantiles (ds-sketch/prob-quantiles :price [0.25 0.5 0.75])
+        :price-cdfs (ds-sketch/prob-cdfs :price [25 50 75])}
+       [stocks stocks stocks])
+:symbol-aggregation [5 3]:
+
+| :symbol |      :price-quantiles |              :price-cdfs |
+|---------|-----------------------|--------------------------|
+|    AAPL | [11.03, 36.81, 105.1] | [0.4065, 0.5528, 0.6423] |
+|     IBM | [77.26, 88.70, 102.4] |   [0.000, 0.000, 0.1382] |
+|    AMZN | [30.12, 41.50, 67.00] | [0.2249, 0.6396, 0.8103] |
+|    MSFT | [21.75, 24.11, 27.34] |   [0.5772, 1.000, 1.000] |
+|    GOOG | [338.5, 421.6, 510.0] |    [0.000, 0.000, 0.000] |
+```"
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.reductions.impl :as impl]
+            [ham-fisted.protocols :as hamf-proto]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf])
+
+  (:import [org.apache.datasketches.hll HllSketch TgtHllType]
+           [org.apache.datasketches.quantiles DoublesSketch UpdateDoublesSketch
+            DoublesUnion]
+           [java.util.function DoubleConsumer]
+           [ham_fisted Reducible]
+           [clojure.lang IDeref]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(defprotocol ^:private PSketchResult
+  (^{:private true
+     :tag 'double} sketch-estimate [cls]))
+
+(extend-protocol PSketchResult
+  HllSketch
+  (sketch-estimate [r] (.getEstimate r))
+  org.apache.datasketches.hll.Union
+  (sketch-estimate [r] (.getEstimate r)))
+
+
+(defn- hll-union?
+  [val]
+  (instance? org.apache.datasketches.hll.Union val))
+
+
+(defn- ->hll-union
+  ^org.apache.datasketches.hll.Union
+  [item]
+  (if (instance? org.apache.datasketches.hll.Union item)
+    item
+    (doto (org.apache.datasketches.hll.Union.)
+      (.update  ^HllSketch item))))
+
+
+(defn hll-reducer
+  "Return a hamf parallel reducer that produces a hyper-log-log-based set cardinality.
+
+  At any point you can get an estimate from the reduced value - call sketch-estimate.
+
+  Options:
+
+  * `:hll-lgk` - defaults to 12, this is log-base2 of k, so k = 4096. lgK can be
+           from 4 to 21.
+  * `:hll-type` - One of #{4,6,8}, defaults to 8.  The HLL_4, HLL_6 and HLL_8
+           represent different levels of compression of the final HLL array where the
+           4, 6 and 8 refer to the number of bits each bucket of the HLL array is
+           compressed down to. The HLL_4 is the most compressed but generally slightly
+           slower than the other two, especially during union operations.
+  * `:datatype` - One of :float64, :int64, :string"
+  [{:keys [hll-lgk hll-type datatype]
+    :or {hll-lgk 12 hll-type 8 datatype :float64}}]
+  (let [cons-fn #(HllSketch. (int hll-lgk)
+                             ^TgtHllType (case (long hll-type)
+                                           4 TgtHllType/HLL_4
+                                           6 TgtHllType/HLL_6
+                                           8 TgtHllType/HLL_8))
+        rfn (case datatype
+              :float64 (hamf-rf/double-accumulator
+                        acc val (.update ^HllSketch acc val) acc)
+              :int64 (hamf-rf/long-accumulator
+                      acc val (.update ^HllSketch acc val) acc)
+              :string (fn [acc val] (.update ^HllSketch acc (str val)) acc))
+        merge-fn (fn [lhs rhs]
+                   (let [lhs (->hll-union lhs)]
+                     (if (hll-union? rhs)
+                       (.update lhs (.getResult (->hll-union rhs)))
+                       (.update lhs ^HllSketch rhs))
+                     lhs))]
+    (reify
+      hamf-proto/Reducer
+      (->init-val-fn [r] cons-fn)
+      (->rfn [r] rfn)
+      hamf-proto/Finalize
+      (finalize [r v] (sketch-estimate v))
+      hamf-proto/ParallelReducer
+      (->merge-fn [r] merge-fn))))
+
+
+(defn prob-set-cardinality
+  "Get the probabilistic set cardinality using hyper-log-log.  See [[hll-reducer]]."
+  ([colname options]
+   (impl/reducer->column-reducer (hll-reducer options) colname))
+  ([colname]
+   (prob-set-cardinality colname nil)))
+
+
+(defn- ->doubles-union
+  ^DoublesUnion [v]
+  (if (instance? DoublesUnion v)
+    v
+    (doto (.. (DoublesUnion/builder) build)
+      (.union ^UpdateDoublesSketch v))))
+
+
+(defn- ->doubles-sketch
+  ^DoublesSketch [item]
+  (if (instance? DoublesSketch item)
+    item
+    (.getResult ^DoublesUnion item)))
+
+
+(defn doubles-sketch-reducer
+  "Return a doubles updater.  This is the reservoir and k is the reservoir size.  From
+  a reservoir we can then get various different statistical quantities.
+
+  A k of 128 results in about 1.7% error in returned quantities."
+  [k finalize-fn]
+  (let [cons-fn #(-> (DoublesSketch/builder)
+                     (.setK (long k))
+                     (.build))
+        rfn (hamf-rf/double-accumulator
+             acc v (.update ^UpdateDoublesSketch acc v) acc)
+        merge-fn (fn [lhs rhs]
+                   (let [lhs (->doubles-union lhs)]
+                     (.union lhs (->doubles-sketch rhs))
+                     lhs))]
+    (reify
+      hamf-proto/Reducer
+      (->init-val-fn [r] cons-fn)
+      (->rfn [r] rfn)
+      hamf-proto/ParallelReducer
+      (->merge-fn [r] merge-fn)
+      hamf-proto/Finalize
+      (finalize [r v] (finalize-fn v)))))
+
+
+(defn ^:private doubles-ds-reducer
+  [colname k finalize-fn]
+  (let [r (doubles-sketch-reducer k finalize-fn)
+        col-reducer (impl/reducer->column-reducer r colname)
+        merge-fn (hamf-proto/->merge-fn r)]
+    (reify
+      ds-proto/PDatasetReducer
+      (ds->reducer [this ds] (ds-proto/ds->reducer col-reducer ds))
+      (merge [this lhs rhs] (merge-fn lhs rhs))
+      hamf-proto/Finalize
+      (finalize [this v] (finalize-fn v))
+      ds-proto/PReducerCombiner
+      (reducer-combiner-key [this] [colname :doubles-sketch k]))))
+
+
+(def ^:private default-doubles-k 128)
+
+
+(defn prob-quantile
+  "Probabilistic quantile estimation - see [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html).
+
+  * k - defaults to 128. This produces a normalized rank error of about 1.7%"
+  ([colname quantile k]
+   (doubles-ds-reducer colname k #(.getQuantile (->doubles-sketch %) (double quantile))))
+  ([colname quantile]
+   (prob-quantile colname quantile default-doubles-k)))
+
+
+(defn prob-quantiles
+  "Probabilistic quantile estimation - see [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html).
+
+  * quantiles - sequence of quantiles.
+  * k - defaults to 128. This produces a normalized rank error of about 1.7%"
+  ([colname quantiles k]
+   (let [src-data (double-array quantiles)]
+     (doubles-ds-reducer colname k
+                         #(-> (.getQuantiles (->doubles-sketch %) src-data)
+                              ;;fix printing
+                              (dtype/as-array-buffer)
+                              (vary-meta assoc :simple-print? true)))))
+  ([colname quantiles]
+   (prob-quantiles colname quantiles default-doubles-k)))
+
+
+(defn prob-median
+  "Probabilistic median -  [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html)."
+  ([colname k]
+   (prob-quantile colname 0.5 k))
+  ([colname]
+   (prob-quantile colname 0.5)))
+
+
+(defn prob-interquartile-range
+    "Probabilistic interquartile range -  [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html)."
+  ([colname k]
+   (doubles-ds-reducer colname k
+                       #(let [quantiles (.getQuantiles (->doubles-sketch %)
+                                                       (double-array [0.25 0.75]))]
+                          (- (aget quantiles 1) (aget quantiles 0)))))
+  ([colname]
+   (prob-interquartile-range colname default-doubles-k)))
+
+
+(defn prob-cdfs
+  "Probabilistic cdfs, one for each value passed in.  See  [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html).
+  See prob-quantiles for k."
+  ([colname cdfs k]
+   (doubles-ds-reducer
+    colname k
+    #(-> (.getCDF (->doubles-sketch %) (double-array cdfs))
+         (dtype/as-array-buffer)
+         (dtype/sub-buffer 0 (count cdfs))
+         (vary-meta assoc :simple-print? true))))
+  ([colname cdfs]
+   (prob-cdfs colname cdfs default-doubles-k)))
+
+
+(defn prob-cdf
+  "Probabilistic cdfs, one for each value passed in.  See  [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html).
+  See prob-quantiles for k."
+  ([colname cdf k]
+   (doubles-ds-reducer
+    colname k
+    #(-> (.getCDF (->doubles-sketch %) (double-array [cdf]))
+         (first))))
+  ([colname cdf]
+   (prob-cdfs colname cdf default-doubles-k)))
+
+
+(defn prob-pmfs
+  "Returns an approximation to the Probability Mass Function (PMF) of the input stream
+  given a set of splitPoints (values). See [DoublesSketch](https://datasketches.apache.org/api/java/snapshot/apidocs/index.html).
+
+  See prog-quantiles for k"
+  ([colname pmfs k]
+   (doubles-ds-reducer
+    colname k
+    #(-> (.getPMF (->doubles-sketch  %) (double-array pmfs))
+         (dtype/as-array-buffer)
+         (dtype/sub-buffer 0 (count pmfs))
+         (vary-meta assoc :simple-print? true))))
+  ([colname pmfs]
+   (prob-pmfs colname pmfs default-doubles-k)))
+
+
+(comment
+
+  (extend-protocol PSketchResult
+  org.apache.datasketches.theta.Sketch
+  (sketch-estimate [sketch] (.getEstimate sketch)))
+
+  (let [union (.. (org.apache.datasketches.theta.SetOperation/builder)
+                  (buildUnion))]
+    (.update union ^org.apache.datasketches.theta.Sketch
+             (.value ^Consumers$StagedConsumer this))
+    (dotimes [idx (.size other-sketches)]
+      (.update union ^org.apache.datasketches.theta.Sketch
+               (.value ^Consumers$StagedConsumer
+                       (.get other-sketches idx))))
+    (ThetaConsumer. (.getResult union)))
+
+  (-> (org.apache.datasketches.theta.UpdateSketchBuilder.)
+      (.build)
+      (ThetaConsumer.))
+
+
+  (extend-protocol PSketchResult
+    org.apache.datasketches.cpc.CpcSketch
+    (sketch-estimate [sketch] (.getEstimate sketch)))
+
+  (combineList [this other-sketches]
+               (let [union (org.apache.datasketches.cpc.CpcUnion.)]
+                 (.update union ^org.apache.datasketches.cpc.CpcSketch
+                          (.value ^Consumers$StagedConsumer this))
+                 (dotimes [idx (.size other-sketches)]
+                   (.update union ^org.apache.datasketches.cpc.CpcSketch
+                            (.value ^Consumers$StagedConsumer
+                                    (.get other-sketches idx))))
+                 (CpcConsumer. (.getResult union))))
+
+  (defmethod sketch-build-fn :cpc
+    [{:keys [cpc-lgk]
+      :or {cpc-lgk 10}}]
+    #(-> (org.apache.datasketches.cpc.CpcSketch. cpc-lgk)
+         (CpcConsumer.))))

tech.ml.dataset/src/tech/v3/dataset/reductions/impl.clj

@@ -0,0 +1,63 @@
+(ns tech.v3.dataset.reductions.impl
+  "Helper namespace to help make reductions.clj more understandable."
+  (:require [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.dataset.base :as ds-base]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.protocols :as hamf-proto])
+  (:import [clojure.lang IFn$OLO IFn$ODO]
+           [ham_fisted Transformables]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(defn reducer->column-reducer
+  ([reducer cname]
+   (reducer->column-reducer reducer nil cname))
+  ([reducer op-space cname]
+   (let [merge-fn (hamf-proto/->merge-fn reducer)]
+     (reify
+       ds-proto/PDatasetReducer
+       (ds->reducer [this ds]
+         (let [rfn (hamf-proto/->rfn reducer)
+               op-space (or op-space
+                            (cond
+                              (instance? IFn$OLO rfn) :int64
+                              (instance? IFn$ODO rfn) :float64
+                              :else
+                              :object))
+               col (dtype/->reader (ds-base/column ds cname) op-space)
+               init-fn (hamf-proto/->init-val-fn reducer)]
+           (case (casting/simple-operation-space op-space)
+             :int64
+             (let [rfn (Transformables/toLongReductionFn rfn)]
+               (reify
+                 hamf-proto/Reducer
+                 (->init-val-fn [r] init-fn)
+                 (->rfn [r] (hamf-rf/long-accumulator
+                             acc v (.invokePrim rfn acc (.readLong col v))))
+                 hamf-proto/ParallelReducer
+                 (->merge-fn [r] merge-fn)))
+             :float64
+             (let [rfn (Transformables/toDoubleReductionFn rfn)]
+               (reify
+                 hamf-proto/Reducer
+                 (->init-val-fn [r] init-fn)
+                 (->rfn [r] (hamf-rf/long-accumulator
+                             acc v (.invokePrim rfn acc (.readDouble col v))))
+                 hamf-proto/ParallelReducer
+                 (->merge-fn [r] merge-fn)))
+             (reify
+               hamf-proto/Reducer
+               (->init-val-fn [r] init-fn)
+               (->rfn [r] (hamf-rf/long-accumulator
+                           acc v (rfn acc (.readObject col v))))
+               hamf-proto/ParallelReducer
+               (->merge-fn [r] merge-fn)))))
+       (merge [this lhs rhs] (merge-fn lhs rhs))
+       hamf-proto/Finalize
+       (finalize [this v] (hamf-proto/finalize reducer v))))))

tech.ml.dataset/src/tech/v3/dataset/rolling.clj

@@ -0,0 +1,323 @@
+(ns tech.v3.dataset.rolling
+  "Implement a generalized rolling window including support for time-based variable
+  width windows."
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.rolling :as dt-rolling]
+            [tech.v3.datatype.argtypes :as argtypes]
+            [tech.v3.datatype.datetime.operations :as dtype-dt-ops]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.statistics :as stats]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.binary-op :as binary-op]
+            [tech.v3.dataset.base :as ds-base])
+  (:import [tech.v3.datatype Buffer])
+  (:refer-clojure :exclude [min max nth first last]))
+
+
+(defn mean
+  [column-name]
+  {:column-name column-name
+   :reducer stats/mean
+   :datatype :float64})
+
+
+(defn sum
+  [column-name]
+  {:column-name column-name
+   :reducer stats/sum
+   :datatype :float64})
+
+
+(defn min
+  [column-name]
+  {:column-name column-name
+   :reducer stats/min})
+
+
+(defn max
+  [column-name]
+  {:column-name column-name
+   :reducer stats/max})
+
+
+(defn variance
+  [column-name]
+  {:column-name column-name
+   :reducer stats/variance
+   :datatype :float64})
+
+
+(defn standard-deviation
+  [column-name]
+  {:column-name column-name
+   :reducer stats/standard-deviation
+   :datatype :float64})
+
+
+(defn nth
+  "Get the nth window value"
+  [column-name nth-val]
+  {:column-name column-name
+   :reducer (fn [rdr] (rdr nth-val))})
+
+
+(defn first
+  [column-name]
+  {:column-name column-name
+   :reducer (fn [rdr] (rdr 0))})
+
+
+(defn last
+  [column-name]
+  {:column-name column-name
+   :reducer (fn [rdr] (rdr -1))})
+
+
+(defn ^:no-doc apply-window-ranges
+  [ds windows reducer-map edge-mode]
+  (->> reducer-map
+       (map-indexed
+        (fn [_idx [k red]]
+          (assoc red :dest-column-name k)))
+       (group-by :column-name)
+       (mapv (fn [[colname reducers]]
+               (let [colname (if (= :scalar (argtypes/arg-type colname))
+                               [colname]
+                               (vec colname))]
+                 {:columns (mapv (partial ds-base/column ds) colname)
+                  :reducers (vec reducers)})))
+       (mapv
+        (fn [{:keys [columns reducers]}]
+          ;;common case is 1 column
+          (if (== 1 (count columns))
+            (let [win-data (dt-rolling/window-ranges->window-reader
+                            (columns 0) windows edge-mode)]
+              (mapv (fn [reducer]
+                      {:tech.v3.dataset/name (:dest-column-name reducer)
+                       :tech.v3.dataset/data
+                       (-> (dtype/emap (:reducer reducer) (:datatype reducer :object)
+                                       win-data)
+                           (dtype/clone))})
+                    reducers))
+            (let [win-data (mapv #(dt-rolling/window-ranges->window-reader
+                                   % windows edge-mode)
+                                 columns)]
+              (mapv (fn [reducer]
+                      {:tech.v3.dataset/name (:dest-column-name reducer)
+                       :tech.v3.dataset/data
+                       (-> (apply dtype/emap (:reducer reducer) (:datatype reducer :object)
+                                  win-data)
+                           (dtype/clone))})
+                    reducers)))))
+       (apply concat)
+       (reduce #(ds-base/add-column %1 %2) ds)))
+
+
+(defn rolling
+  "Perform a rolling window operation appending columns to the original dataset.
+
+  * ds - src dataset.
+  * window - either an integer for fixed window sizes or a map describing the window
+    operation containing keys:
+    - `:window-type` - either `:fixed` or `:variable`.  For variable window operations
+      `:column-name` must be a monotonically increasing column.
+    - `:window-size` - for fixed window operation must be a positive integer.  For
+       variable window operations must be a double value which is produced via a
+       comparison function.
+    - `:relative-window-position` - describes where the window is
+       positioned.  Operations are `:left`, `:center`, `:right` and defaults to
+       `:center` for fixed and `:right` for relative window types.
+    - `:edge-mode` - for fixed windows describes what values to fill in at the edges
+       of the source column.  Options are `:zero` which is 0 for numeric types and `nil`
+       for object types and `:clamp` which fills in the first,last values of the column
+       respectively.  Defaults to `:clamp`.
+    - `:comp-fn` - if provided must return a double which is the result of comparing
+      the last value of the range to the first which means `clojure.core/-`
+      is a reasonable default.
+    - `:units` - for datetime types, describes the units of `:window-size` and will
+      dictate the numeric space if `:comp-fn` is not provided.
+  * reducer-map - A map of result column name to reducer map.  The reducer map is a
+    map which must contain at least `{:column-name :reducer}` where reducer is an ifn
+    that is passed each window.  The result column is scanned to ascertain datatype and
+    missing value status.  Multi-column reducers are supported if column-name is a vector
+    of column names.  In that case each column's window is passed to the reducer.  The
+    reducer can also specify the final datatype if `:datatype` is a key in the map.  Beware,
+    however, that this disables missing value detection for integer datatypes.
+
+
+**Fixed Window Examples:**
+
+
+```clojure
+user> (def test-ds (ds/->dataset {:a (map #(Math/sin (double %))
+                                          (range 0 200 0.1))}))
+#'user/test-ds
+user> (ds/head (ds-roll/rolling test-ds 10 {:mean (ds-roll/mean :a)
+                                            :min (ds-roll/min :a)
+                                            :max (ds-roll/max :a)}))
+_unnamed [5 4]:
+
+|         :a |      :mean | :min |       :max |
+|-----------:|-----------:|-----:|-----------:|
+| 0.00000000 | 0.09834413 |  0.0 | 0.38941834 |
+| 0.09983342 | 0.14628668 |  0.0 | 0.47942554 |
+| 0.19866933 | 0.20275093 |  0.0 | 0.56464247 |
+| 0.29552021 | 0.26717270 |  0.0 | 0.64421769 |
+| 0.38941834 | 0.33890831 |  0.0 | 0.71735609 |
+user> (ds/head (ds-roll/rolling test-ds
+                                {:window-type :fixed
+                                 :window-size 10
+                                 :relative-window-position :left}
+                                {:mean (ds-roll/mean :a)
+                                 :min (ds-roll/min :a)
+                                 :max (ds-roll/max :a)}))
+_unnamed [5 4]:
+
+|         :a |      :mean | :min |       :max |
+|-----------:|-----------:|-----:|-----------:|
+| 0.00000000 | 0.00000000 |  0.0 | 0.00000000 |
+| 0.09983342 | 0.00998334 |  0.0 | 0.09983342 |
+| 0.19866933 | 0.02985027 |  0.0 | 0.19866933 |
+| 0.29552021 | 0.05940230 |  0.0 | 0.29552021 |
+| 0.38941834 | 0.09834413 |  0.0 | 0.38941834 |
+user> (ds/head (ds-roll/rolling test-ds
+                                {:window-type :fixed
+                                 :window-size 10
+                                 :relative-window-position :right}
+                                {:mean (ds-roll/mean :a)
+                                 :min (ds-roll/min :a)
+                                 :max (ds-roll/max :a)}))
+_unnamed [5 4]:
+
+|         :a |      :mean |       :min |       :max |
+|-----------:|-----------:|-----------:|-----------:|
+| 0.00000000 | 0.41724100 | 0.00000000 | 0.78332691 |
+| 0.09983342 | 0.50138810 | 0.09983342 | 0.84147098 |
+| 0.19866933 | 0.58052549 | 0.19866933 | 0.89120736 |
+| 0.29552021 | 0.65386247 | 0.29552021 | 0.93203909 |
+ | 0.38941834 | 0.72066627 | 0.38941834 | 0.96355819 |
+
+user> ;;Multi column reducer
+user> (ds/head (ds-roll/rolling test-ds 10
+                                {:c {:column-name [:a :a]
+                                     :reducer (fn [a b]
+                                                (Math/round
+                                                 (+ (dfn/sum a) (dfn/sum b))))
+                                     :datatype :int16}}))
+_unnamed [5 2]:
+
+|         :a | :c |
+|-----------:|---:|
+| 0.00000000 |  2 |
+| 0.09983342 |  3 |
+| 0.19866933 |  4 |
+| 0.29552021 |  5 |
+| 0.38941834 |  7 |
+```
+
+**Variable Window Examples:**
+
+
+```clojure
+user> (def stocks (ds/->dataset \"test/data/stocks.csv\" {:key-fn keyword}))
+#'user/stocks
+user> ;;variable window column must be monotonically increasing
+user> (def stocks (ds/sort-by-column stocks :date))
+#'user/stocks
+user> (ds/head stocks)
+test/data/stocks.csv [5 3]:
+
+| :symbol |      :date | :price |
+|---------|------------|-------:|
+|    AAPL | 2000-01-01 |  25.94 |
+|     IBM | 2000-01-01 | 100.52 |
+|    MSFT | 2000-01-01 |  39.81 |
+|    AMZN | 2000-01-01 |  64.56 |
+|    AAPL | 2000-02-01 |  28.66 |
+
+user> (ds/head (ds-roll/rolling stocks
+                                {:window-type :variable
+                                 :column-name :date
+                                 :units :days
+                                 :window-size 3}
+                                {:price-mean-3d (ds-roll/mean :price)
+                                 :price-max-3d (ds-roll/max :price)
+                                 :price-min-3d (ds-roll/min :price)}))
+test/data/stocks.csv [5 6]:
+
+| :symbol |      :date | :price | :price-mean-3d | :price-max-3d | :price-min-3d |
+|---------|------------|-------:|---------------:|--------------:|--------------:|
+|    AAPL | 2000-01-01 |  25.94 |    57.70750000 |        100.52 |         25.94 |
+|     IBM | 2000-01-01 | 100.52 |    68.29666667 |        100.52 |         39.81 |
+|    MSFT | 2000-01-01 |  39.81 |    52.18500000 |         64.56 |         39.81 |
+|    AMZN | 2000-01-01 |  64.56 |    64.56000000 |         64.56 |         64.56 |
+|    AAPL | 2000-02-01 |  28.66 |    56.49750000 |         92.11 |         28.66 |
+user> (ds/head (ds-roll/rolling stocks
+                                {:window-type :variable
+                                 :column-name :date
+                                 :units :months
+                                 :window-size 3}
+                                {:price-mean-3d (ds-roll/mean :price)
+                                 :price-max-3d (ds-roll/max :price)
+                                 :price-min-3d (ds-roll/min :price)}))
+test/data/stocks.csv [5 6]:
+
+| :symbol |      :date | :price | :price-mean-3d | :price-max-3d | :price-min-3d |
+|---------|------------|-------:|---------------:|--------------:|--------------:|
+|    AAPL | 2000-01-01 |  25.94 |    58.92500000 |        106.11 |         25.94 |
+|     IBM | 2000-01-01 | 100.52 |    61.92363636 |        106.11 |         28.66 |
+|    MSFT | 2000-01-01 |  39.81 |    58.06400000 |        106.11 |         28.66 |
+|    AMZN | 2000-01-01 |  64.56 |    60.09222222 |        106.11 |         28.66 |
+|    AAPL | 2000-02-01 |  28.66 |    57.56583333 |        106.11 |         28.37 |
+```"
+  ([ds window reducer-map options]
+   (let [n-rows (ds-base/row-count ds)
+         window-data (merge (if (integer? window)
+                              {:window-size window
+                               :window-type :fixed}
+                              window)
+                            options)
+         windows
+         (case (:window-type window-data :fixed)
+           :fixed
+           (dt-rolling/fixed-rolling-window-ranges
+            n-rows (:window-size window-data)
+            (:relative-window-position window-data :center))
+           :variable
+           (let [_ (when-not (:column-name window-data)
+                     (throw (Exception. (format "Variable rolling windows must have :column-name in the window data"))))
+                 src-col (ds-base/column ds (:column-name window-data))
+                 col-dt (dtype/elemwise-datatype src-col)]
+             (vec (dt-rolling/variable-rolling-window-ranges
+                   src-col (:window-size window-data)
+                   {:comp-fn
+                    (if-let [comp-fn (:comp-fn window-data)]
+                      comp-fn
+                      (when (dtype-dt/datetime-datatype? (packing/unpack-datatype col-dt))
+                        (dtype-dt-ops/between-op
+                         (dtype/elemwise-datatype src-col)
+                         (:units window-data :milliseconds)
+                         true)))
+                    :relative-window-position (get window-data :relative-window-position)}))))]
+     (apply-window-ranges ds windows reducer-map (:edge-mode window-data :clamp))))
+  ([ds window reducer-map]
+   (rolling ds window reducer-map nil)))
+
+
+(defn expanding
+  "Run a set of reducers across a dataset with an expanding set of windows.  These
+  will produce a cumsum-type operation."
+  [ds reducer-map]
+  (apply-window-ranges ds (dt-rolling/expanding-window-ranges
+                           (ds-base/row-count ds))
+                       reducer-map
+                       :clamp))
+
+(comment
+  (require '[tech.v3.dataset :as ds])
+  (def test-ds (ds/->dataset {:a (map #(Math/sin (double %))
+                                      (range 0 200 0.1))}))
+  (rolling test-ds 10 {:mean (mean :a)
+                       :min (min :a)
+                       :max (max :a)})
+  )

tech.ml.dataset/src/tech/v3/dataset/set.clj

@@ -0,0 +1,194 @@
+(ns tech.v3.dataset.set
+  "Extensions to datasets to do per-row bag-semantics set/union and intersection."
+  (:require [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.base :as ds-base]
+            [tech.v3.dataset.io :as ds-io]
+            [tech.v3.dataset.protocols :as ds-proto]
+            [tech.v3.datatype :as dtype]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.function :as hamf-fn]
+            [ham-fisted.lazy-noncaching :as lznc])
+  (:import [java.util.concurrent ConcurrentHashMap]
+           [java.util.function BiConsumer]
+           [java.util Map HashSet]
+           [tech.v3.datatype Buffer]
+           [ham_fisted BiFunctions]))
+
+
+(defn- concurrent-hashmap-frequencies
+  [data]
+  (hamf-rf/preduce
+   (constantly (hamf/java-concurrent-hashmap))
+   (fn [acc v]
+     (.compute ^Map acc v BiFunctions/incBiFn)
+     acc)
+   (fn [l r] l)
+   {:min-n 1000}
+   data))
+
+
+(defn- concurrent-hashmap-intersection
+  [bifn ^ConcurrentHashMap l ^ConcurrentHashMap r]
+  (let [[^ConcurrentHashMap minmap ^ConcurrentHashMap maxmap]
+        (if (< (.size l) (.size r))
+          [l r] [r l])
+        retval (hamf/java-concurrent-hashmap)
+        bifn (hamf-fn/->bi-function bifn)]
+    (.forEach minmap 100 (reify java.util.function.BiConsumer
+                           (accept [this k v]
+                             (let [ov (.getOrDefault maxmap k ::not-found)]
+                               (when-not (identical? ov ::not-found)
+                                 (.put retval k (.apply bifn v ov)))))))
+    retval))
+
+
+(defn- concurrent-hashmap-union
+  [bifn ^ConcurrentHashMap l ^ConcurrentHashMap r]
+  (let [retval (hamf/java-concurrent-hashmap l)
+        bifn (hamf-fn/->bi-function bifn)]
+    (.forEach r 100 (reify BiConsumer
+                      (accept [this k v]
+                        (let [ov (.getOrDefault l k ::not-found)]
+                          (if-not (identical? ov ::not-found)
+                            (.put retval k (.apply bifn ov v))
+                            (.put retval k v))))))
+    retval))
+
+
+
+(defn- expand-setop-result
+  [options ds-map]
+  (if-let [count-attname (get options :count)]
+    (->> ds-map
+         (lznc/map #(assoc (key %) count-attname (val %)))
+         (ds-io/->>dataset))
+    (->> ds-map
+         (lznc/map #(hamf/repeat (val %) (key %)))
+         (apply lznc/concat)
+         (ds-io/->>dataset))))
+
+
+(defn reduce-intersection
+  "Given a sequence of datasets, union the rows such that tuples that exist in all datasets
+  appear in the final dataset at their mininum repetition amount.  Can return either a
+  dataset with duplicate tuples or a dataset with a :count column.
+
+  Options:
+
+  * `:count` - Name of count column, if nil then tuples are duplicated and count is implicit.
+
+```clojure
+user> (def ds-a (ds/->dataset [{:a 1 :b 2} {:a 1 :b 2} {:a 2 :b 3}]))
+#'user/ds-a
+user> (def ds-b (ds/->dataset [{:a 1 :b 2} {:a 1 :b 2} {:a 3 :b 3}]))
+#'user/ds-b
+user> (ds-set/reduce-intersection [ds-a ds-b])
+_unnamed [2 2]:
+
+| :a | :b |
+|---:|---:|
+|  1 |  2 |
+|  1 |  2 |
+user> (ds-set/reduce-intersection {:count :count} [ds-a ds-b])
+_unnamed [1 3]:
+
+| :a | :b | :count |
+|---:|---:|-------:|
+|  1 |  2 |      2 |
+```"
+  ([options datasets]
+   (->> datasets
+        (reduce (fn [acc ds]
+                  (let [rows (ds-proto/rows ds {:copying? true})]
+                    (if acc
+                      (->> rows
+                           (lznc/filter (hamf-fn/predicate
+                                         v (.containsKey ^java.util.Map acc v)))
+                           (concurrent-hashmap-frequencies)
+                           (concurrent-hashmap-intersection
+                            (hamf-fn/bi-function l r (min (long l) (long r)))
+                            acc))
+                      (concurrent-hashmap-frequencies rows))))
+                nil)
+        (expand-setop-result options)))
+  ([datasets] (reduce-intersection nil datasets)))
+
+
+(defn reduce-union
+  "Given a sequence of datasets, union the rows such that all tuples appear in the final
+  dataset at their maximum repetition amount.  Can return either a dataset with duplicate
+  tuples or a dataset with a :count column.
+
+  Options:
+
+  * `:count` - Name of count column, if nil then tuples are duplicated and count is implicit.
+
+```clojure
+user> (def ds-a (ds/->dataset [{:a 1 :b 2} {:a 1 :b 2} {:a 2 :b 3}]))
+#'user/ds-a
+user> (def ds-b (ds/->dataset [{:a 1 :b 2} {:a 1 :b 2} {:a 3 :b 3}]))
+#'user/ds-b
+user> (ds-set/reduce-union [ds-a ds-b])
+_unnamed [4 2]:
+
+| :a | :b |
+|---:|---:|
+|  2 |  3 |
+|  3 |  3 |
+|  1 |  2 |
+|  1 |  2 |
+user> (ds-set/reduce-union {:count :count} [ds-a ds-b])
+_unnamed [3 3]:
+
+| :a | :b | :count |
+|---:|---:|-------:|
+|  2 |  3 |      1 |
+|  3 |  3 |      1 |
+|  1 |  2 |      2 |
+```"
+  ([options datasets]
+   (->> datasets
+        (reduce (fn [acc ds]
+                  (let [rows (ds-proto/rows ds {:copying? true})]
+                    (if acc
+                      (->> rows
+                           (concurrent-hashmap-frequencies)
+                           (concurrent-hashmap-union
+                            (hamf-fn/bi-function l r (min (long l) (long r)))
+                            acc))
+                      (concurrent-hashmap-frequencies rows))))
+                nil)
+        (expand-setop-result options)))
+  ([datasets] (reduce-union nil datasets)))
+
+
+(defn union
+  "Union two datasets producing a new dataset with the union of tuples.  Repeated tuples will
+  be repeated in final dataset at their maximum per-dataset repetition count."
+  ([a] a)
+  ([a b] (reduce-union [a b]))
+  ([a b & args] (reduce-union (lznc/concat [a b] args))))
+
+
+(defn intersection
+  "Intersect two datasets producing a new dataset with the union of tuples.
+  Tuples repeated across all datasets repeated in final dataset at their minimum
+  per-dataset repetition count."
+  ([a] a)
+  ([a b] (reduce-intersection [a b]))
+  ([a b & args] (reduce-intersection (lznc/concat [a b] args))))
+
+
+(defn difference
+  "Remove tuples from a that also appear in b."
+  ([a] a)
+  ([a b]
+   (let [b-rows (ds-proto/rows b {:copying? true})
+         ^HashSet s (->> (hamf/upgroups
+                          (dtype/ecount b-rows)
+                          (fn [^long sidx ^long eidx]
+                            (doto (HashSet.)
+                              (.addAll (.subBuffer ^Buffer b-rows sidx eidx)))))
+                         (reduce #(do (.addAll ^HashSet %1 ^HashSet %2) %1)))]
+     (ds-base/filter a (hamf-fn/predicate r (not (.contains s r)))))))

tech.ml.dataset/src/tech/v3/dataset/string_table.clj

@@ -0,0 +1,239 @@
+(ns tech.v3.dataset.string-table
+  (:require [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.base :as dtype-base]
+            [tech.v3.dataset.dynamic-int-list :as int-list]
+            [tech.v3.parallel.for :as parallel-for]
+            [tech.v3.datatype.errors :as errors]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.reduce :as hamf-rf]
+            [ham-fisted.lazy-noncaching :as lznc]
+            [clojure.tools.logging :as log])
+  (:import [java.util List HashMap Map ArrayList]
+           [java.util.function Function]
+           [tech.v3.datatype ObjectBuffer Buffer]
+           [ham_fisted IMutList ChunkedList Casts ArrayHelpers ArrayLists]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* :warn-on-boxed)
+
+
+(defprotocol PStrTable
+  (get-str-table [item]))
+
+
+(declare make-string-table)
+
+
+(deftype StringTable
+    [^List int->str
+     ^Map str->int
+     ^IMutList data]
+  dtype-proto/PClone
+  (clone [this]
+    ;;We do not need to dedup any more; a java array is a more efficient
+    ;;storage mechanism
+    (let [sz (.size this)
+          ^objects rv (make-array String sz)
+          local-int->str int->str
+          local-data data]
+      (StringTable. (ArrayLists/toList (hamf/object-array int->str)) nil (dtype-proto/clone data))
+      #_(dorun (hamf/pgroups sz (fn string-table-clone [^long sidx ^long eidx]
+                                (loop [sidx sidx]
+                                  (when (< sidx eidx)
+                                    (ArrayHelpers/aset rv sidx (.get int->str (.getLong local-data sidx)))
+                                    (recur (inc sidx)))))))
+      #_(ArrayLists/toList rv)))
+  PStrTable
+  (get-str-table [_this] {:int->str int->str
+                         :str->int str->int})
+  ObjectBuffer
+  (elemwiseDatatype [_this] :string)
+  (lsize [_this] (.size data))
+  (clear [this]
+    (.clear int->str)
+    (.clear str->int)
+    (.clear data))
+  (size [_this] (.size data))
+  (subBuffer [this sidx eidx]
+    (ChunkedList/sublistCheck sidx eidx (.lsize this))
+    (if (and (== sidx 0)
+             (== eidx (.lsize this)))
+      this)
+    (let [^List int->str int->str
+          ^IMutList data (.subList data sidx eidx)]
+      (reify ObjectBuffer
+        (elemwiseDatatype [rdr] :string)
+        (lsize [rdr] (- eidx sidx))
+        (subBuffer [rdr ssidx seidx]
+          (ChunkedList/sublistCheck ssidx seidx (.lsize this))
+          (.subBuffer this (+ sidx ssidx) (+ sidx seidx)))
+        (readObject [rdr idx] (.get int->str (.getLong data idx)))
+        (reduce [this rfn acc]
+          (.reduce data (hamf-rf/long-accumulator
+                         acc v
+                         (rfn acc (.get int->str v)))
+                   acc)))))
+  (add [this value]
+    (errors/when-not-errorf
+     (or (nil? value) (instance? String value))
+     "Value added to string table is not a string: %s" (type value))
+    (let [value (or value "")
+          item-idx (int (.computeIfAbsent
+                         str->int
+                         value
+                         (reify Function
+                           (apply [this keyval]
+                             (let [retval (.size int->str)]
+                               (.add int->str keyval)
+                               retval)))))]
+      (.addLong data item-idx))
+    true)
+  (add [this idx ct value]
+    (let [value (or value "")
+          item-idx (int (.computeIfAbsent
+                         str->int
+                         value
+                         (reify Function
+                           (apply [this keyval]
+                             (let [retval (.size int->str)]
+                               (.add int->str keyval)
+                               retval)))))]
+      (.add data (.size data) ct item-idx)))
+  (readObject [_this idx]
+    (.get int->str (.getLong data idx)))
+  (writeObject [this idx value]
+    (locking this
+      (let [item-idx (int (.computeIfAbsent
+                         str->int
+                         value
+                         (reify Function
+                           (apply [this keyval]
+                             (let [retval (.size int->str)]
+                               (.add int->str keyval)
+                               retval)))))]
+        (.setLong data idx item-idx))))
+  (reduce [this rfn acc]
+    (.reduce data (hamf-rf/long-accumulator
+                   acc v
+                   (rfn acc (.get int->str v)))
+             acc)))
+
+
+(defn make-string-table
+  (^Buffer [n-elems missing-val ^List int->str ^HashMap str->int]
+   (let [^Buffer data (int-list/dynamic-int-list n-elems)
+         missing-val (str missing-val)]
+     (.add int->str missing-val)
+     (.put str->int missing-val (dec (.size int->str)))
+     (StringTable. int->str str->int data)))
+  (^Buffer [n-elems missing-val]
+   (make-string-table n-elems missing-val (hamf/object-array-list n-elems) (HashMap.)))
+  (^Buffer [n-elems]
+   (make-string-table n-elems "" (hamf/object-array-list n-elems) (HashMap.)))
+  (^Buffer []
+   (make-string-table 0 "" (hamf/object-array-list) (HashMap.))))
+
+(defn compress-indexes
+  ^IMutList [^IMutList indexes ^long max-idx]
+  (cond
+    (<= max-idx Byte/MAX_VALUE) (ArrayLists/toList (hamf/byte-array indexes))
+    (<= max-idx Short/MAX_VALUE) (ArrayLists/toList (hamf/short-array indexes))
+    (<= max-idx Integer/MAX_VALUE) (ArrayLists/toList (hamf/int-array indexes))
+    :else (.toLongArray indexes)))
+
+(definterface IDof
+  (idOf ^long [s]))
+
+(defn fast-str
+  ^String [s]
+  (cond
+    (nil? s) ""
+    (instance? String s) s
+    :else (.toString ^Object s)))
+
+(deftype FastStringContainer [^IMutList indexes ^List int->str ^HashMap str->int]
+  IDof
+  (idOf [this s]
+    (let [s (fast-str s)
+          sz (long (.size str->int))
+          lookup (.putIfAbsent str->int s sz)]
+      (if lookup
+        lookup
+        (do
+          (.add int->str s)
+          sz))))
+  java.util.function.Consumer
+  (accept [this v] (.add this v))
+  IMutList
+  (add [this v]
+    (.addLong indexes (.idOf this v))
+    true)
+  (add [this idx ct v]
+    (.add indexes (.size indexes) ct (.idOf this v)))
+  (get [this idx]
+    (let [rv (.get int->str (.getLong indexes idx))]
+      (when (nil? rv)
+        (throw (RuntimeException. (str "Index out of range: " idx))))
+      rv))
+  (size [this] (.size indexes))
+  (clear [this]
+    (.clear indexes)
+    (.clear int->str)
+    (.clear str->int))
+  tech.v3.datatype.protocols/PElemwiseDatatype
+  (elemwise-datatype [this] :string)
+  clojure.lang.IDeref
+  (deref [this]
+    (StringTable. (hamf/vec int->str) (.clone str->int)
+                  (compress-indexes indexes (long (.size str->int))))))
+
+(defn fast-string-container
+  ([str->int int->str]
+   (when-not (instance? java.util.HashMap str->int)
+     (throw (RuntimeException. "Invalid creation of fast string container")))
+   (FastStringContainer. (hamf/long-array-list)
+                         int->str str->int))
+  ([]
+   (let [str->int (hamf/java-hashmap)
+         int->str (ArrayList.)]
+     (.put str->int "" 0)
+     (.add int->str "")
+     (fast-string-container str->int int->str))))
+
+(defn string-table-from-strings
+  ([str-data] (string-table-from-strings (fast-string-container) str-data))
+  ([fast-string-container str-data]
+   (hamf-rf/reduce-reducer (hamf-rf/consumer-reducer (constantly fast-string-container)) str-data)))
+
+
+(defn ->string-table
+  ^StringTable [str-t]
+  (if (instance? StringTable str-t)
+    str-t
+    (string-table-from-strings str-t)))
+
+
+(defn indices
+  "Get the string table backing index data."
+  [^StringTable str-t]
+  (-> (.data (->string-table str-t))
+      (dtype-base/as-buffer)))
+
+
+(defn int->string
+  "Returns an unmodifiable list of strings from a string table.  This serves as the
+  index->string lookup table.  Returned value also implements 'nth' efficiently."
+  ^List [^StringTable str-t]
+  (-> (->string-table str-t)
+      (.int->str)))
+
+(defn merge-string-tables
+  "Return new string table with strings from lhs and rhs.  Neither input is changed."
+  [^StringTable lhs ^StringTable rhs]
+  (string-table-from-strings (lznc/concat (.-int->str lhs)
+                                          (.-int->str rhs))))
+
+
+

tech.ml.dataset/src/tech/v3/dataset/tensor.clj

@@ -0,0 +1,167 @@
+(ns tech.v3.dataset.tensor
+  "Conversion mechanisms from dataset to tensor and back."
+  (:require [tech.v3.tensor :as dtt]
+            [tech.v3.tensor.dimensions :as dims]
+            [tech.v3.datatype.statistics :as stats]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.parallel.for :as pfor]
+            [tech.v3.datatype.functional :as dfn]
+            [tech.v3.datatype.argops :as argops]
+            [tech.v3.dataset :as ds]
+            [tech.v3.dataset.column :as ds-col]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.pprint :as dtype-pp]
+            [tech.v3.parallel.for :as pfor]
+            [clj-commons.primitive-math :as pmath])
+
+  (:import  [tech.v3.datatype DoubleReader Buffer]
+            [java.util List]
+            [java.nio DoubleBuffer]))
+
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* true)
+
+
+(defn tensor->dataset
+  "Convert a tensor to a dataset.  Columns of the tensor will be converted to
+  columns of the dataset."
+  [dtt & [table-name]]
+  (when-not (= 2 (count (dtype/shape dtt)))
+    (throw (ex-info "Tensors must be 2 dimensional to transform to datasets" {})))
+  (let [[_n-rows n-cols] (dtype/shape dtt)
+        table-name (or table-name :_unnamed)]
+    (ds/new-dataset table-name (->> (range n-cols)
+                                    (map
+                                     #(ds-col/new-column
+                                       %
+                                       (dtt/select dtt :all %)))))))
+
+
+(defn dataset->tensor
+  "Convert a dataset to a tensor.  Columns of the dataset will be converted
+  to columns of the tensor.  Default datatype is :float64."
+  ([dataset datatype]
+   (let [retval (dtt/new-tensor (dtype/shape dataset)
+                                :datatype datatype
+                                :init-value nil)]
+     (dtype/coalesce! retval
+                      (->> (ds/columns dataset)
+                           (map #(dtype/elemwise-cast % datatype))))
+     (dtt/transpose retval [1 0])))
+  ([dataset]
+   (dataset->tensor dataset :float64)))
+
+
+
+(defn- externally-safe
+  "Can we expose this tensor to outside systems - means
+  no broadcasting and no offsetting (rotation)"
+  ([tens datatype]
+   (if (and (= datatype (dtype/elemwise-datatype tens))
+            (dtt/dims-suitable-for-desc? tens))
+     tens
+     (dtt/clone tens :datatype datatype)))
+  ([tens]
+   (externally-safe tens :float64)))
+
+
+(defn- jvm-matrix-multiply
+  "**SLOW** fallback for when openblas/mkl aren't available."
+  [lhs rhs]
+  (let [;;Slice is lazy, so we make it concrete and perform all the
+        ;;translations necessary up front for rapid reading
+        lhs-rows ^List (mapv dtype/->buffer (dtt/slice lhs 1))
+        rhs-trans (dtt/transpose rhs [1 0])
+        n-rows (long (.size lhs-rows))
+        rhs-columns ^List (mapv dtype/->buffer (dtt/slice rhs-trans 1))
+        n-cols (long (.size rhs-columns))
+        n-elems (* n-rows n-cols)
+        n-inner (long (count (first lhs-rows)))]
+    (-> (reify DoubleReader
+          (lsize [rdr] n-elems)
+          (readDouble [rdr idx]
+            (let [row-idx (quot idx n-cols)
+                  col-idx (rem idx n-cols)
+                  ^Buffer lhs (.get lhs-rows row-idx)
+                  ^Buffer rhs (.get rhs-columns col-idx)]
+              ;;Hardcode operation to avoid dispatch costs.  In this case we know
+              ;;we are dealing with readers and we know the result is a double summation.
+              (loop [idx 0
+                     sum 0.0]
+                (if (< idx n-inner)
+                  (recur (unchecked-inc idx)
+                         (pmath/+ sum (pmath/* (.readDouble lhs idx)
+                                               (.readDouble rhs idx))))
+                  sum)))))
+        ;;Make buffer concrete
+        (dtype/clone)
+        ;;Reshape into result shape
+        (dtt/reshape [n-rows n-cols]))))
+
+
+(defn mean-center-columns!
+  "in-place nan-aware mean-center the rows of the tensor.  If tensor is writeable then this
+  writes the result directly to the tensor else it clones the tensor.
+  Return value is `{:means :tensor}`.
+
+  Pre-calculated per-column means may be provided."
+  ([tens {:keys [nan-strategy means]
+          :or {nan-strategy :remove}}]
+   (errors/when-not-errorf
+    (== 2 (count (dtype/shape tens)))
+    "Tensor must have 2 dimensional shape: %s"
+    (dtype/shape tens))
+   ;;Transpose tensor so our calculation can be in row-major form
+   (let [tens (dtt/transpose tens [1 0])
+         ;;Note I reversed the shape result to be column-major due to the
+         ;;transpose above.
+         [_n-cols n-rows] (dtype/shape tens)
+         n-rows (long n-rows)
+         ;;Remember the tensor is transposed, so the rows are the columns.
+         ^List columns (mapv dtype/->buffer (dtt/slice tens 1))
+         means (or means
+                   (-> (reify DoubleReader
+                         (lsize [rdr] (long (.size columns)))
+                         (readDouble [rdr idx]
+                           (let [^Buffer data (.get columns idx)]
+                             (stats/mean data {:nan-strategy nan-strategy}))))
+                       (dtype/clone)))
+         mean-buf (dtype/->buffer means)
+         tens-buf (dtype/->buffer tens)
+         ^Buffer tens-buf (if-not (.allowsWrite tens-buf)
+                            (dtype/->buffer (dtype/clone tens))
+                            tens-buf)
+         n-elems (.lsize tens-buf)]
+     ;;Now with the transposed tensor, we can iterate and get full
+     ;;parallelism but still have each thread run through the tensor
+     ;;column by column.
+     (pfor/parallel-for
+      idx n-elems
+      (let [col-idx (quot idx n-rows)
+            mean (.readDouble mean-buf col-idx)]
+        (.writeDouble tens-buf idx
+                      (pmath/- (.readDouble tens-buf idx)
+                               mean))))
+     {:means means
+      :tensor (dtt/transpose tens [1 0])}))
+  ([tens]
+   (mean-center-columns! tens nil)))
+
+
+(comment
+  (def test-tens (-> (dtt/transpose
+                      (dtt/->tensor [[7 4 6 8 8 7 5 9 7 8]
+                                     [4 1 3 6 5 2 3 5 4 2]
+                                     [3 8 5 1 7 9 3 8 5 2]] :datatype :float64)
+                      [1 0])))
+
+  ;; answer
+  {:means  [8.882E-17, 0.000, -4.441E-17],
+   :method :svd,
+   :eigenvalues [8.629338515997084, 5.751970392932843, 2.597951765363097],
+   :eigenvectors [[-0.1376 0.6990 -0.7017]
+                  [-0.2505 0.6609  0.7075]
+                  [ 0.9583 0.2731 0.08416]]}
+  )

tech.ml.dataset/src/tech/v3/dataset/utils.clj

@@ -0,0 +1,85 @@
+(ns ^:no-doc tech.v3.dataset.utils
+  (:require [clojure.string :as str])
+  (:import [java.util Iterator]))
+
+
+(defn nanos->millis
+  ^long [^long nanos]
+  (-> (/ nanos 1000000.0)
+      (Math/round)))
+
+
+(defmacro time-section
+  "Time a section, return
+  {:retval retval
+  :milliseconds ms}"
+  [& body]
+  `(let [start-time# (System/nanoTime)
+         retval# (do ~@body)
+         stop-time# (System/nanoTime)]
+     {:retval retval#
+      :milliseconds (-> (- stop-time# start-time#)
+                        nanos->millis)}))
+
+
+(defn prefix-merge
+  [prefix src-map merge-map]
+  (merge src-map
+         (->> merge-map
+              (map (fn [[item-k item-v]]
+                     [(keyword (str prefix "-" (name item-k))) item-v]))
+              (into {}))))
+
+
+
+(defn sequence->iterator
+  "Java ml interfaces sometimes use iterators where they really should
+  use sequences (iterators have state).  In any case, we do what we can."
+  ^Iterator [item-seq]
+  (.iterator ^Iterable (seq item-seq)))
+
+
+(defn set-slf4j-log-level
+  "Set the slf4j log level.  Safe to call if slf4j is not in the
+  classpath.  Upon success, returns a keyword.  Upon failure, returns
+  a map with {:exception} pointing to the failure."
+  [level]
+  (locking #'sequence->iterator
+    (try
+      ((requiring-resolve
+        'tech.v3.dataset.utils.slf4j-log-level/set-log-level) level)
+      (catch Throwable e
+        {:exception e}))))
+
+
+(defn column-safe-name
+  "Given a generic item (keyword, symbol) create a string that safe to be used
+  to name columns."
+  ^String [item-name]
+  (cond
+    (or (keyword? item-name)
+        (symbol? item-name))
+    (if (namespace item-name)
+      (str (namespace item-name) "/" (name item-name))
+      (str (name item-name)))
+    (boolean? item-name)
+    (if item-name "true" "false")
+    :else
+    (str item-name)))
+
+
+(defn rand-str
+  "Generates a random string of length `n` composed of alphanumeric characters."
+  [n]
+  (apply str (repeatedly n #(rand-nth "abcdefghijklmnopqrstuvwxyz0123456789"))))
+
+(defn remove-zero-width-spaces
+  "Remove zero-width non-breaking spaces (ZWNBSP) from a string.
+  These non-breaking spaces often occur in the beginning of CSV-files."
+  [s]
+  (str/replace s #"\uFEFF" ""))
+
+(defn rand-str-column-name-postfix
+  "Generates a random string postfix for a column name."
+  [col-idx colname]
+  (str (column-safe-name colname) "_" (rand-str 5)))

tech.ml.dataset/src/tech/v3/dataset/utils/slf4j_log_level.clj

@@ -0,0 +1,22 @@
+(ns ^:no-doc tech.v3.dataset.utils.slf4j-log-level
+  (:import [ch.qos.logback.classic Logger]
+           [ch.qos.logback.classic Level]))
+
+
+(defn set-log-level
+  "This has to be a reflection call because no one knows what is returned
+  by the getLogger fn call.  If you are using logback classic, then a logback
+  classic logger is returned.  Else, you are on your own!"
+  [log-level]
+  (.setLevel
+   ^Logger (org.slf4j.LoggerFactory/getLogger
+    (Logger/ROOT_LOGGER_NAME))
+   (case log-level
+     :all Level/ALL
+     :debug Level/DEBUG
+     :trace Level/TRACE
+     :info Level/INFO
+     :warn Level/WARN
+     :error Level/ERROR
+     :off Level/OFF))
+  log-level)

tech.ml.dataset/src/tech/v3/dataset/zip.clj

@@ -0,0 +1,113 @@
+(ns tech.v3.dataset.zip
+  "Load zip data.  Zip files with a single file entry can be loaded with ->dataset.  When
+  a zip file has multiple entries you have to call zipfile->dataset-seq."
+  (:require [tech.v3.dataset.io :as ds-io]
+            [tech.v3.io :as io]
+            [clojure.tools.logging :as log])
+  (:import [java.util.zip ZipInputStream ZipOutputStream ZipEntry]
+           [java.util Set HashSet]
+           [tech.v3.dataset NoCloseInputStream NoCloseOutputStream]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn- load-next-entry
+  [^ZipEntry entry ^ZipInputStream is options]
+  (let [fdata (ds-io/str->file-info (.getName entry))
+        ftype (:file-type fdata)]
+    (when-not (= (:file-type fdata) :unknown)
+      (try (ds-io/data->dataset (NoCloseInputStream. is)
+                                (merge (assoc options
+                                              :dataset-name (.getName entry))
+                                       fdata))
+           (catch Exception e
+             (log/warnf "Filed to load zip entry: %s" (.getName entry))
+             nil)))))
+
+
+(defn- load-zip-entry
+  [^ZipInputStream is options]
+  (try
+    (loop [entry (.getNextEntry is)]
+      (if entry
+        (let [nds (load-next-entry entry is options)]
+          (if-not nds
+            (recur (.getNextEntry is))
+            (cons nds (lazy-seq (load-zip-entry is options)))))
+        (do
+          (.close is)
+          nil)))
+    (catch Exception e
+      (.close is)
+      (throw e))))
+
+
+(defn zipfile->dataset-seq
+  "Load a zipfile attempting to load each zip entry."
+  ([input options]
+   (let [is (-> (apply io/input-stream input (apply concat (seq options)))
+                (ZipInputStream.))]
+     (load-zip-entry is options)))
+  ([input]
+   (zipfile->dataset-seq input nil)))
+
+
+(defmethod ds-io/data->dataset :zip
+  [data options]
+  (let [ds-seq (zipfile->dataset-seq data options)
+        rv (first ds-seq)]
+    (when (rest ds-seq)
+      ;;forces the input stream to close.
+      (dorun ds-seq)
+      (log/warnf "Multiple entries found in zipfile"))
+    rv))
+
+
+(defmethod ds-io/dataset->data! :zip
+  [data output options]
+  (let [inner-name (.substring (str output) 0 (- (count output) 4))
+        ftype (-> (ds-io/str->file-info inner-name)
+                  (get :file-type))]
+    (with-open [os (-> (apply io/output-stream! output (apply concat (seq options)))
+                       (ZipOutputStream.))]
+      (.putNextEntry os (ZipEntry. inner-name))
+      (ds-io/dataset->data! data os (assoc options :file-type ftype)))))
+
+
+(defn- ds-name->string
+  ^String [ds]
+  (let [nm (:name (meta ds))]
+    (if (or (symbol? nm) (keyword? nm))
+      (name nm)
+      (str nm))))
+
+
+(defn- unique-name!
+  ^String [ds ^Set used]
+  (let [nm (ds-name->string ds)
+        nm (if (.contains used nm )
+             (loop [idx 0]
+               (let [idx-nm (str nm "-" idx)]
+                 (if (.contains used idx-nm)
+                   (recur (inc idx))
+                   idx-nm)))
+             nm)]
+    (.add used nm)
+    nm))
+
+
+(defn dataset-seq->zipfile!
+  "Write a sequence of datasets to zipfiles.  You can control the inner type with the
+  :file-type option which defaults to .tsv"
+  ([output options ds-seq]
+   (let [fnames (HashSet.)
+         ftype (get options :file-type :tsv)
+         options (assoc options :file-type ftype)]
+     (with-open [os (-> (apply io/output-stream! output (apply concat (set options)))
+                        (ZipOutputStream.))]
+       (doseq [ds ds-seq]
+         (.putNextEntry os (ZipEntry. (str (unique-name! ds fnames) "." (name ftype))))
+         (ds-io/dataset->data! ds (NoCloseOutputStream. os) options)))))
+  ([output ds-seq]
+   (dataset-seq->zipfile! output nil ds-seq)))

tech.ml.dataset/src/tech/v3/libs/arrow/liblz4.clj

@@ -0,0 +1,105 @@
+(ns tech.v3.libs.arrow.liblz4
+  (:require [tech.v3.datatype :as dt]
+            [tech.v3.datatype.ffi :as dt-ffi]
+            [tech.v3.datatype.ffi.size-t :as ffi-size-t]
+            [tech.v3.datatype.struct :as dt-struct]
+            [tech.v3.resource :as resource])
+  (:import [tech.v3.datatype.ffi Pointer]))
+
+
+(def ^{:tag 'long} LZ4F_default 0)
+(def ^{:tag 'long} LZ4F_max64KB 4)
+(def ^{:tag 'long} LZ4F_max256KB 5)
+(def ^{:tag 'long} LZ4F_max1MB 6)
+(def ^{:tag 'long} LZ4F_max4MB 7)
+(def ^{:tag 'long} LZ4F_VERSION 100)
+(def ^{:tag 'long} LZ4F_HEADER_SIZE_MAX 19)
+(def ^{:tag 'long} LZ4F_blockLinked 0)
+(def ^{:tag 'long} LZ4F_blockIndependent 1)
+(def ^{:tag 'long} LZ4F_noContentChecksum 0)
+(def ^{:tag 'long} LZ4F_contentChecksumEnabled 1)
+(def ^{:tag 'long} LZ4F_noBlockChecksum 0)
+(def ^{:tag 'long} LZ4F_blockChecksumEnabled 1)
+(def ^{:tag 'long} LZ4F_frame 0)
+(def ^{:tag 'long} LZ4F_skippableFrame 1)
+
+
+(dt-ffi/define-library!
+  lz4
+  '{:LZ4F_getVersion {:rettype :int32
+                      :doc "library version"}
+    :LZ4F_createDecompressionContext {:rettype :size-t
+                                      :argtypes [[dctxPtr :pointer] ;;ptrptr
+                                                 [version :int32]]}
+    :LZ4F_freeDecompressionContext {:rettype :size-t
+                                    :argtypes [[dctx :pointer]]}
+
+    :LZ4F_isError {:rettype :int32
+                   :argtypes [[err :size-t]]}
+    :LZ4F_getErrorName {:rettype :string
+                        :argtypes [[err :size-t]]}
+    :LZ4F_getFrameInfo {:rettype :size-t
+                        :argtypes [[dctx :pointer] ;;decompression context
+                                   [frameInfoPtr :pointer] ;;frameinfo*
+                                   [srcBuffer :pointer] ;;void*
+                                   [srcSizePtr :pointer]]} ;;size-t*
+    :LZ4F_decompress {:rettype :size-t
+                      :argtypes [[dctx :pointer]
+                                 [dstbuf :pointer]
+                                 [dstsize :pointer] ;;size-t*
+                                 [srcbuf :pointer]
+                                 [srcsize :pointer] ;;size-t*
+                                 [decomp-opt :pointer?]]} ;;dOptPtr
+
+    }
+  nil
+  nil)
+
+;;checked against actual record layout
+(def frame-info-def*
+  (delay (dt-struct/define-datatype! :lz4-frame-info
+           [{:name :block-size-id :datatype :int32}
+            {:name :block-mode :datatype :int32}
+            {:name :content-checksum :datatype :int32}
+            {:name :frame-type :datatype :int32}
+            {:name :content-size :datatype :int64}
+            {:name :dict-id :datatype :int32}
+            {:name :checksum :datatype :int32}])))
+
+
+(def decompress-options-def*
+  (delay (dt-struct/define-datatype! :lz4-decomp-options
+           [{:name :stable-dst :datatype :int32}
+            {:name :reserved0 :datatype :int32}
+            {:name :reserved1 :datatype :int32}
+            {:name :reserved2 :datatype :int32}])))
+
+
+;; Used for graal native pathways
+(defn set-library-instance!
+  [lib-instance]
+  (dt-ffi/library-singleton-set-instance! lz4 lib-instance))
+
+
+(defn initialize!
+  []
+  (dt-ffi/library-singleton-set! lz4 "lz4"))
+
+
+(defn create-decomp-ctx
+  []
+  (let [retval
+        (resource/stack-resource-context
+         (let [ptrptr (dt-ffi/make-ptr :pointer 0)
+               ctx-err (LZ4F_createDecompressionContext ptrptr LZ4F_VERSION)]
+           (when (== 1 (long (LZ4F_isError ctx-err)))
+             (throw (Exception. (str (LZ4F_getErrorName ctx-err)))))
+           (Pointer. (ptrptr 0))))
+        addr (.address retval)]
+    (resource/track retval {:track-type :auto
+                            :dispose-fn #(LZ4F_freeDecompressionContext (Pointer. addr))})))
+
+
+(defn free-decomp-ctx
+  [ctx]
+  (LZ4F_freeDecompressionContext ctx))

tech.ml.dataset/src/tech/v3/libs/clj_transit.clj

@@ -0,0 +1,383 @@
+(ns tech.v3.libs.clj-transit
+  "Transit bindings for the jvm version of tech.v3.dataset."
+  (:require [tech.v3.dataset :as ds]
+            [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.io :as ds-io]
+            [tech.v3.dataset.dynamic-int-list :as int-list]
+            [tech.v3.io :as io]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.array-buffer :as abuf]
+            [tech.v3.datatype.bitmap :as bitmap]
+            [clj-commons.primitive-math :as pmath]
+            [ham-fisted.api :as hamf]
+            [cognitect.transit :as t])
+  (:import [tech.v3.dataset.impl.dataset Dataset]
+           [tech.v3.dataset.impl.column Column]
+           [tech.v3.dataset Text]
+           [java.nio ByteBuffer ByteOrder]
+           [java.nio.charset StandardCharsets]
+           [java.util Base64 HashMap]
+           [java.time LocalDate Instant]))
+
+(set! *warn-on-reflection* true)
+
+
+(defn- le-bbuf
+  ^ByteBuffer [n-elems]
+  (-> (ByteBuffer/wrap (byte-array n-elems))
+      (.order ByteOrder/LITTLE_ENDIAN)))
+
+(defn- numeric-data->b64
+  [col]
+  (let [src-data (dtype/->reader col)
+        n-elems (count col)
+        ^ByteBuffer bbuf
+        (case (casting/host-flatten (dtype/elemwise-datatype col))
+          :int8
+          (let [retval (le-bbuf n-elems)
+                dst-data (dtype/->buffer retval)]
+            (dotimes [idx (count col)]
+              (.writeByte dst-data idx (unchecked-byte (.readLong src-data idx))))
+            retval)
+          :int16
+          (let [retval (le-bbuf (* Short/BYTES n-elems))
+                dst-data (.asShortBuffer retval)]
+            (dotimes [idx (count col)]
+              (.put dst-data idx (unchecked-short (.readLong src-data idx))))
+            retval)
+          :int32
+          (let [retval (le-bbuf (* Integer/BYTES n-elems))
+                dst-data (.asIntBuffer retval)]
+            (dotimes [idx (count col)]
+              (.put dst-data idx (unchecked-int (.readLong src-data idx))))
+            retval)
+          :int64
+          (let [retval (le-bbuf (* Long/BYTES n-elems))
+                dst-data (.asLongBuffer retval)]
+            (dotimes [idx (count col)]
+              (.put dst-data idx (.readLong src-data idx)))
+            retval)
+          :float32
+          (let [retval (le-bbuf (* Float/BYTES n-elems))
+                dst-data (.asFloatBuffer retval)]
+            (dotimes [idx (count col)]
+              (.put dst-data idx (.readDouble src-data idx)))
+            retval)
+          :float64
+          (let [retval (le-bbuf (* Double/BYTES n-elems))
+                dst-data (.asDoubleBuffer retval)]
+            (dotimes [idx (count col)]
+              (.put dst-data idx (.readDouble src-data idx)))
+            retval))]
+    (String. (.encode (Base64/getEncoder) (.array bbuf)))))
+
+
+(defn- string-col->data
+  [col]
+  (let [strdata (dtype/make-list :string)
+        indexes (dtype/make-list :int32)
+        seen (HashMap.)]
+    (dotimes [idx (count col)]
+      (let [strval (str (or (col idx) ""))
+            idx (.computeIfAbsent seen strval (reify java.util.function.Function
+                                                (apply [this arg]
+                                                  (let [retval (count strdata)]
+                                                    (.add strdata strval)
+                                                    retval))))]
+        (.add indexes idx)))
+    {:strtable (hamf/object-array strdata)
+     :indexes (numeric-data->b64 indexes)}))
+
+
+;;The assumption here is that transit has already optimized a vector or strings.
+(defn- text-col->data
+  [col]
+  (let [offsets (int-list/dynamic-int-list 0)
+        data (StringBuilder.)
+        n-elems (dtype/ecount col)]
+    (dotimes [idx n-elems]
+      (let [next-data (str (or (col idx) ""))]
+        (.append data next-data)
+        (.addLong offsets (.length data))))
+    (let [offbuf (dtype/as-concrete-buffer offsets)]
+      {:offset-dtype (dtype/elemwise-datatype offbuf)
+       :offsets (numeric-data->b64 offbuf)
+       :buffer (.toString data)})))
+
+
+(defn- obj-col->numeric-b64
+  [col dst-dtype convert-fn]
+  (let [data (dtype/make-list dst-dtype)]
+    (dotimes [idx (count col)]
+      (.add data (if-let [colval (col idx)]
+                   (convert-fn colval)
+                   0)))
+    (numeric-data->b64 data)))
+
+
+(defn- col->data
+  [col]
+  (let [col-dt (packing/unpack-datatype (dtype/elemwise-datatype col))]
+    {:metadata (assoc (meta col) :datatype col-dt)
+     :missing (vec (-> (ds/missing col)
+                       (bitmap/->random-access)
+                       (hamf/object-array)
+                       vec))
+     :data
+     (cond
+       (casting/numeric-type? col-dt)
+       (numeric-data->b64 col)
+       (= :boolean col-dt)
+       (numeric-data->b64 (dtype/make-reader  :uint8 (count col)
+                                             (if (col idx) 1 0)))
+       (= :string col-dt)
+       (string-col->data col)
+       (= :text col-dt)
+       (text-col->data col)
+       (#{:packed-local-date :local-date} col-dt)
+       (obj-col->numeric-b64 col :int32 dtype-dt/local-date->days-since-epoch)
+       (#{:packed-instant :instant :packed-milli-instant} col-dt)
+       (obj-col->numeric-b64 col :int64 dtype-dt/instant->milliseconds-since-epoch)
+       :else ;;Punt!!
+       (vec col))}))
+
+
+(defn ^:no-doc dataset->data
+  "Dataset to transit-safe data"
+  [ds]
+  {:metadata (meta ds)
+   :flavor :transit
+   :version 1
+   :columns (mapv col->data (ds/columns ds))})
+
+
+(defn ^:no-doc b64->numeric-data
+  [^String data dtype]
+  (let [byte-data (.decode (Base64/getDecoder) (.getBytes data))
+        bbuf (-> (ByteBuffer/wrap byte-data)
+                 (.order ByteOrder/LITTLE_ENDIAN))]
+    (case dtype
+      :int8 (dtype/->buffer byte-data)
+      :uint8 (dtype/make-reader :uint8 (alength byte-data)
+                                (pmath/byte->ubyte (aget byte-data idx)))
+      :int16 (let [sbuf (.asShortBuffer bbuf)]
+               (dtype/make-reader :int16 (.limit sbuf) (.get sbuf idx)))
+      :uint16 (let [sbuf (.asShortBuffer bbuf)]
+                (dtype/make-reader :uint16 (.limit sbuf) (pmath/short->ushort
+                                                          (.get sbuf idx))))
+      :int32 (let [ibuf (.asIntBuffer bbuf)]
+               (dtype/make-reader :int32 (.limit ibuf) (.get ibuf idx)))
+      :uint32 (let [ibuf (.asIntBuffer bbuf)]
+                (dtype/make-reader :uint32 (.limit ibuf) (pmath/int->uint (.get ibuf idx))))
+      :int64 (let [lbuf (.asLongBuffer bbuf)]
+               (dtype/make-reader :int64 (.limit lbuf) (.get lbuf idx)))
+      :uint64 (let [lbuf (.asLongBuffer bbuf)]
+                (dtype/make-reader :uint64 (.limit lbuf) (.get lbuf idx)))
+      :float32 (let [fbuf (.asFloatBuffer bbuf)]
+                 (dtype/make-reader :float32 (.limit fbuf) (.get fbuf idx)))
+      :float64 (let [fbuf (.asDoubleBuffer bbuf)]
+                 (dtype/make-reader :float64 (.limit fbuf) (.get fbuf idx))))))
+
+
+(defn ^:no-doc str-data->coldata
+  [{:keys [strtable indexes]}]
+  (let [indexes (dtype/->reader (b64->numeric-data indexes :int32))
+        strdata (dtype/->reader strtable)]
+    (dtype/make-reader :string (count indexes) (strdata (indexes idx)))))
+
+
+(defn ^:no-doc text-data->coldata
+  [{:keys [offsets buffer offset-dtype]}]
+  (let [offsets (dtype/->buffer (b64->numeric-data offsets offset-dtype))
+        n-elems (dtype/ecount offsets)
+        buffer (str buffer)]
+    (-> (dtype/make-reader
+         :text n-elems
+         (let [prev-idx (unchecked-dec idx)
+               prev-offset (long (if (> prev-idx -1)
+                                   (.readLong offsets prev-idx)
+                                   0))]
+           (Text. (.substring buffer prev-offset (.readLong offsets idx))))))))
+
+
+(defn ^:no-doc data->dataset
+  [{:keys [columns] :as ds-data}]
+  (let [ds-meta (:metadata ds-data)]
+    (errors/when-not-errorf
+      (and ds-meta columns)
+      "Passed in data does not appear to have metadata or columns")
+    (->> (:columns ds-data)
+         (map
+           (fn [{:keys [metadata missing data]}]
+             (let [dtype (:datatype metadata)]
+               #:tech.v3.dataset{:metadata metadata
+                                 :missing (bitmap/->bitmap missing)
+                                 ;;do not re-scan data.
+                                 :force-datatype? true
+                                 :data
+                                  (cond
+                                    (casting/numeric-type? dtype)
+                                    (b64->numeric-data data dtype)
+                                    (= :boolean dtype)
+                                    (let [ibuf (b64->numeric-data data :int8)]
+                                      (dtype/make-reader :boolean (count ibuf)
+                                                         (if (== 0 (unchecked-long (ibuf idx)))
+                                                           false true)))
+                                    (= :string dtype)
+                                    (str-data->coldata data)
+                                    (= :text dtype)
+                                    (text-data->coldata data)
+                                    (= :local-date dtype)
+                                    (-> (b64->numeric-data data :int32)
+                                        (dtype/->array-buffer)
+                                        (abuf/set-datatype :packed-local-date))
+                                    (= :instant dtype)
+                                    (-> (b64->numeric-data data :int64)
+                                        (dtype/->array-buffer)
+                                        (abuf/set-datatype :packed-milli-instant))
+                                    :else
+                                    (dtype/make-container dtype data))
+                                 :name            (:name metadata)})))
+         (ds-impl/new-dataset {:dataset-name (:name ds-meta)} ds-meta))))
+
+(comment
+  ;; verify that metadata is preserved
+  (let [ds_a (ds/->dataset {:a [5]} {:parser-fn {:a :uint8} :dataset-name "keep-this-name"})
+        ds_b (-> ds_a dataset->data data->dataset)]
+    (and (= ds_a ds_b)
+         (= (meta ds_a) (meta ds_b))))
+  )
+
+(def ^{:doc "Transit handler for writing datasets."}
+  write-handlers {Dataset (t/write-handler "tech.v3.dataset" dataset->data)})
+(def ^{:doc "Transit handler for reading datasets."}
+  read-handlers {"tech.v3.dataset" (t/read-handler data->dataset)})
+
+(def ^{:doc "Transit write handlers for java.time.LocalDate and java.time.Instant"}
+  java-time-write-handlers
+  {LocalDate (t/write-handler "java.time.LocalDate" dtype-dt/local-date->days-since-epoch)
+   Instant (t/write-handler "java.time.Instant" dtype-dt/instant->milliseconds-since-epoch)})
+
+(def ^{:doc "Transit read handlers for java.time.LocalDate and java.time.Instant"}
+  java-time-read-handlers
+  {"java.time.LocalDate" (t/read-handler dtype-dt/days-since-epoch->local-date)
+   "java.time.Instant" (t/read-handler dtype-dt/milliseconds-since-epoch->instant)})
+
+
+(defn dataset->transit
+  "Convert a dataset into a transit encoded writer. See source for details."
+  [ds out & [format handlers]]
+  (let [writer (t/writer out (or format :json) {:handlers (merge write-handlers handlers)})]
+    (t/write writer ds)))
+
+
+(defn dataset->transit-str
+  "Convert a dataset to a transit-encoded json string.  See [[dataset->transit]]."
+  [ds & [format handlers]]
+  (let [out (java.io.ByteArrayOutputStream.)]
+    (dataset->transit ds out format handlers)
+    (String. (.toByteArray out))))
+
+
+(defn transit->dataset
+  "Decode a transite reader installing the transit handlers for datasets.  See source
+  for details."
+  [in & [format handlers]]
+  (let [reader (t/reader in (or format :json) {:handlers (merge read-handlers handlers)})]
+    (t/read reader)))
+
+
+(defn transit-str->dataset
+  "Convert a transit string to a dataset.  This simply decodes the string, it isn't
+  dataset specific.  See [[transit->dataset]]"
+  [ds-str]
+  (transit->dataset (java.io.ByteArrayInputStream. (.getBytes ^String ds-str))))
+
+
+(defmethod ds-io/data->dataset :transit-json
+  [data options]
+  (with-open [in (io/input-stream data)]
+    (transit->dataset in (:transit-format options)
+                      (:transit-read-handlers options))))
+
+
+(defmethod ds-io/dataset->data! :transit-json
+  [ds output options]
+  (with-open [outs (io/output-stream! output)]
+    (dataset->transit ds outs
+                      (:transit-format options)
+                      (:transit-write-handlers options))))
+
+(comment
+  (defn master-ds
+    []
+    (ds/->dataset (array-map :a (mapv double (range 5))
+                             :b (repeat 5 :a)
+                             :c (repeat 5 "hey")
+                             :d (repeat 5 {:a 1 :b 2})
+                             :e (repeat 4 [1 2 3])
+                             :f (repeat 5 (dtype-dt/local-date))
+                             :g (repeat 5 (dtype-dt/instant))
+                             :h [true false true true false]
+                             :i (repeat 5 "text")
+                             :j [1 nil 2 nil 3])
+                  {:parser-fn {:i :text}}))
+  
+
+
+  (-> (master-ds)
+      (dataset->transit-str)
+      (transit-str->dataset))
+
+
+  (def test-data (vec (repeatedly 100000 #(hash-map :time (rand)
+                                                    :temp (rand)
+                                                    :valid? (if (> (rand) 0.5)
+                                                              true
+                                                              false)))))
+
+  (def test-ds (ds/->dataset test-data))
+
+  (do
+
+    (defn t->file
+      [ds fname]
+      (with-open [outs (io/output-stream! fname)]
+        (dataset->transit ds outs)))
+
+    (defn file->t
+      [fname]
+      (with-open [ins (io/input-stream fname)]
+        (transit->dataset ins)))
+    )
+
+  (time (t->file test-data "mapseq.transit-json"))
+  ;; 1027ms, 6.3MB raw, 1.9MB gzipped
+
+  (time (t->file test-ds "ds.transit-json"))
+  ;;   16ms, 2.2MB raw, 1.6MB gzipped
+
+  (do
+    (def stocks (ds/->dataset "https://github.com/techascent/tech.ml.dataset/raw/master/test/data/stocks.csv" {:key-fn keyword}))
+
+    (io/make-parents "test/data/stocks.transit-json")
+    (t->file stocks "test/data/stocks.transit-json")
+    )
+
+  (require '[tech.v3.datatype.functional :as dfn])
+
+  (->> (ds/group-by-column stocks :symbol)
+       (map (fn [[k v]]
+              [k (-> (dfn/mean (v :price))
+                     (* 100)
+                     (Math/round)
+                     (/ 100.0))]))
+       (into {}))
+  ;;{"MSFT" 24.74, "AMZN" 47.99, "IBM" 91.26, "GOOG" 415.87, "AAPL" 64.73}
+
+
+  )

tech.ml.dataset/src/tech/v3/libs/fastexcel.clj

@@ -0,0 +1,170 @@
+(ns tech.v3.libs.fastexcel
+  "Parse a dataset in xlsx format.  This namespace auto-registers a handler for
+  the 'xlsx' file type so that when using ->dataset, `xlsx` will automatically map to
+  `(first (workbook->datasets))`.
+
+  Note that this namespace does **not** auto-register a handler for the `xls` file type.
+  `xls` is handled by the poi namespace.
+
+
+  If you have an xlsx file that contains multiple sheets and you want a dataset
+  out of each sheet you have to use `workbook->datasets` as opposed to the higher level
+  `->dataset` operator.
+
+  This dependency has a known conflict with cognitec's aws library - see [issue 283](https://github.com/techascent/tech.ml.dataset/issues/283).
+
+  Required Dependencies:
+
+```clojure
+  [org.dhatim/fastexcel-reader \"0.12.8\" :exclusions [org.apache.poi/poi-ooxml]]
+```"
+  (:require [tech.v3.io :as io]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.dataset.io.spreadsheet :as parse-spreadsheet]
+            [tech.v3.dataset.io :as ds-io])
+  (:import [org.dhatim.fastexcel.reader ReadableWorkbook
+            Sheet Row Cell CellType]
+           [tech.v3.dataset Spreadsheet$Workbook Spreadsheet$Sheet
+            Spreadsheet$Row Spreadsheet$Cell]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn- cell-type->keyword
+  [^CellType cell-type]
+  (condp = cell-type
+    CellType/EMPTY :none
+    CellType/NUMBER :float64
+    CellType/BOOLEAN :boolean
+    CellType/STRING :string))
+
+
+(defn- formula-type?
+  [cell-type]
+  (or (= cell-type CellType/FORMULA)
+      (= cell-type CellType/ERROR)))
+
+
+(defn- try-parse-double
+  [^Cell cell]
+  (try
+    (Double/parseDouble (.getRawValue cell))
+    (catch Exception _e
+      (.getRawValue cell))))
+
+
+(defn- wrap-cell
+  [^Cell cell]
+  (reify
+    dtype-proto/PElemwiseDatatype
+    (elemwise-datatype [this]
+      (let [cell-type (.getType cell)]
+        (if (formula-type? cell-type)
+          (if (number? (try-parse-double cell))
+            :float64
+            :string)
+          (cell-type->keyword cell-type))))
+    Spreadsheet$Cell
+    (getColumnNum [this] (.getColumnIndex cell))
+    (missing [this] (= :none (dtype/get-datatype this)))
+    (value [this]
+      (if (formula-type? (.getType cell))
+        (try-parse-double cell)
+        (case (dtype-proto/elemwise-datatype this)
+          :none nil
+          :string (.getRawValue cell)
+          :boolean (.asBoolean cell)
+          (double (.asNumber cell)))))
+    (doubleValue [this]
+      (if (formula-type? (.getType cell))
+        (Double/parseDouble (.getRawValue cell))
+        (double (.asNumber cell))))
+    (boolValue [this] (.asBoolean cell))))
+
+
+(defn- wrap-row
+  [^Row row]
+  (reify
+    Spreadsheet$Row
+    (getRowNum [this] (dec (.getRowNum row)))
+    (iterator [this]
+      (let [iter (-> (.stream row)
+                     (.filter (reify
+                                java.util.function.Predicate
+                                (test [this val] (not= val nil))))
+                     (.iterator))]
+        (reify java.util.Iterator
+          ;;In some cases hasNext throws.
+          (hasNext [this] (try (.hasNext iter)
+                               (catch Exception _e false)))
+          (next [this] (wrap-cell (.next iter))))))))
+
+(defn- wrap-sheet
+  [^Sheet sheet]
+  (reify
+    Spreadsheet$Sheet
+    (name [this] (.getName sheet))
+    (id [this] (.getId sheet))
+    (stableId [this] (.getStableId sheet))
+    (iterator [this]
+      (let [iter (.iterator (.openStream sheet))]
+        (reify java.util.Iterator
+          (hasNext [this] (.hasNext iter))
+          (next [this] (wrap-row (.next iter))))))))
+
+
+(defn input->workbook
+  "Given an input data source, return an implementation of
+  `tech.v3.dataset/Spreadsheet$Workbook`.  This interface allows you
+  to iterate through sheets without necessarily parsing them.
+  Once you have a spreadsheet, use `tech.v3.dataset.io.spreadsheet/sheet->dataset`
+  to get a dataset."
+  (^Spreadsheet$Workbook [input]
+   (input->workbook input {}))
+  (^Spreadsheet$Workbook [input _options]
+   (let [workbook (ReadableWorkbook. (io/input-stream input))]
+     (reify
+       Spreadsheet$Workbook
+       (close [this] (.close workbook))
+       (iterator [this]
+         (let [sheet-iter (.iterator (.getSheets workbook))]
+           (reify java.util.Iterator
+             (hasNext [this] (.hasNext sheet-iter))
+             (next [this] (wrap-sheet (.next sheet-iter))))))))))
+
+
+(defn workbook->datasets
+  "Given a workbook, an string filename or an input stream return a sequence of
+  dataset named after the sheets.
+
+  Options are a subset of the arguments for tech.v3.dataset/->dataset:
+
+  * `:header-row?`
+  * `:num-rows`
+  * `:n-initial-skip-rows`
+  * `:parser-fn`"
+  ([input options]
+   (let [workbook (input->workbook input options)]
+     (try
+       (mapv #(parse-spreadsheet/sheet->dataset % options) workbook)
+       (finally
+         (when-not (identical? input workbook)
+           (.close workbook))))))
+  ([input]
+   (workbook->datasets input {})))
+
+
+(defmethod ds-io/data->dataset :xlsx
+  [data options]
+  (let [datasets (workbook->datasets data options)
+        n-datasets (count datasets)]
+    (errors/when-not-errorf
+     (== 1 n-datasets)
+     (if (== 0 n-datasets)
+       "No (%d) datasets found in file"
+       "Multiple (%d) datasets found in file")
+     n-datasets)
+    (first datasets)))

tech.ml.dataset/src/tech/v3/libs/guava/cache.clj

@@ -0,0 +1,63 @@
+(ns tech.v3.libs.guava.cache
+  "Use a google guava cache to memoize function results.  Function must not return
+  nil values.  Exceptions propagate to caller."
+  (:refer-clojure :exclude [memoize])
+  (:import [com.google.common.cache
+            Cache CacheBuilder CacheLoader
+            LoadingCache CacheStats]
+           [java.time Duration]))
+
+(set! *warn-on-reflection* true)
+
+
+(defn memoize
+  "Create a threadsafe, efficient memoized function using a guavacache backing store."
+  [f & {:keys [write-ttl-ms
+               access-ttl-ms
+               soft-values?
+               weak-values?
+               max-size
+               record-stats?]}]
+  (let [^CacheBuilder new-builder
+        (cond-> (CacheBuilder/newBuilder)
+          access-ttl-ms
+          (.expireAfterAccess (Duration/ofMillis access-ttl-ms))
+          write-ttl-ms
+          (.expireAfterWrite (Duration/ofMillis write-ttl-ms))
+          soft-values?
+          (.softValues)
+          weak-values?
+          (.weakValues)
+          max-size
+          (.maximumSize (long max-size))
+          record-stats?
+          (.recordStats))
+        ^LoadingCache cache
+        (.build new-builder
+                (proxy [CacheLoader] []
+                  (load [args]
+                    (if-let [retval (apply f args)]
+                      retval
+                      (throw (ex-info
+                              (format "Nil values not allowed in cache: %s" args)
+                              {}))))))]
+    (-> (fn [& args]
+          (.get cache args))
+        (with-meta {:cache cache}))))
+
+
+(defn memo-stats
+  "Get cache stats from a memoized object."
+  [filecache]
+  (let [^Cache memo-cache (-> (meta filecache)
+                              :cache)
+        ^CacheStats cache-map (.stats memo-cache)]
+    {:hit-count (.hitCount cache-map)
+     :hit-rate (.hitRate cache-map)
+     :miss-count (.missCount cache-map)
+     :miss-rate (.missRate cache-map)
+     :load-success-count (.loadSuccessCount cache-map)
+     :load-exception-count (.loadExceptionCount cache-map)
+     :average-load-penalty-nanos (.averageLoadPenalty cache-map)
+     :total-load-time-nanos (.totalLoadTime cache-map)
+     :eviction-count (.evictionCount cache-map)}))

tech.ml.dataset/src/tech/v3/libs/parquet_hardwood.clj

@@ -0,0 +1,156 @@
+(ns tech.v3.libs.parquet-hardwood
+  (:require [ham-fisted.lazy-caching :as lznc]
+            [ham-fisted.api :as hamf]
+            [ham-fisted.iterator :as hamf-iter]
+            [tech.v3.datatype :as dt]
+            [tech.v3.datatype.array-buffer :as array-buffer]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.dataset :as ds]
+            [tech.v3.dataset.io.column-parsers :as col-parsers]
+            [tech.v3.dataset.io.context :as parse-context]
+            [tech.v3.dataset.base :as ds-base]
+            [clojure.java.io :as io]
+            [clojure.tools.logging :as log])
+  (:import [dev.morling.hardwood.reader ParquetFileReader ColumnReader]
+           [dev.morling.hardwood.schema FileSchema ColumnSchema]
+           [dev.morling.hardwood.metadata RowGroup ColumnChunk LogicalType
+            LogicalType$DateType LogicalType$StringType LogicalType$UuidType
+            LogicalType$EnumType LogicalType$JsonType LogicalType$TimestampType
+            LogicalType$BsonType LogicalType$IntervalType LogicalType$IntType
+            LogicalType$DecimalType LogicalType$TimeType LogicalType$MapType
+            LogicalType$ListType]
+           [clojure.lang MapEntry]))
+
+(set! *warn-on-reflection* true)
+
+(def ^:private column-finalizers
+  {LogicalType$StringType (fn [_ str-data] (dt/emap (fn [ss] (String. ^bytes ss)) :string str-data))
+   LogicalType$DateType (fn [_ int-data] (-> (dt/as-array-buffer int-data)
+                                             (array-buffer/set-datatype :packed-local-date)))})
+
+(defn- read-column
+  [idx ^ColumnSchema col-schema ^ColumnChunk col-def ^ParquetFileReader rdr options]
+  (let [crdr (.getColumnReader rdr col-schema col-def)
+        parser (col-parsers/promotional-object-parser (.name col-schema) nil)
+        lt (.logicalType col-schema)
+        finalizer (get column-finalizers (type lt) (fn [_ v] v))
+        key-fn (:key-fn options identity)]
+    (loop [idx 0]
+      (if (.hasNext crdr)
+        (do
+          (when-let [nv (.readNext crdr)] (col-parsers/add-value! parser idx nv))
+          (recur (inc idx)))
+        {:column-name (key-fn (.name col-schema))
+         :column-parser (reify tech.v3.dataset.io.column_parsers.PParser
+                          (finalize [this n-rows]
+                            (-> (col-parsers/finalize! parser n-rows)
+                                (update :tech.v3.dataset/data #(finalizer lt %)))))
+         :n-rows idx}))))
+
+(defn- ->path
+  [data]
+  (if (instance? java.nio.file.Path data)
+    data
+    (java.nio.file.Paths/get (str data) (into-array String []))))
+
+(defn parquet->ds-seq
+  [path options]
+  (let [rdr (ParquetFileReader/open (->path path))
+        schema (.getFileSchema rdr)
+        schema-columns (->> (range (.getColumnCount schema))
+                            (into [] (map #(.getColumn schema (long %)))))
+        col-name->idx (into {} (map-indexed (fn [idx ^ColumnSchema col]
+                                              [(.name col) idx]))
+                            schema-columns)
+        col-idx->name (into {} (map-indexed (fn [idx ^ColumnSchema col]
+                                              [idx (.name col)]))
+                            schema-columns)
+        cref->idx (fn [centry] (if (number? centry) (long centry) (col-name->idx centry)))
+        allowset (into #{} (map cref->idx) (get options :column-allowlist))
+        blockset (into #{} (map cref->idx) (get options :column-blocklist))
+        is-allowed? (fn [^long idx]
+                      (if-not (empty? allowset)
+                        (boolean (allowset idx))
+                        (if-not (empty? blockset)
+                          (boolean (not (blockset idx)))
+                          true)))
+        src-indexes (vec (->> (hamf/range (count schema-columns))
+                              (lznc/filter is-allowed?)))
+        rv (->> (.getFileMetaData rdr)
+             (.rowGroups)
+             (lznc/map (fn [^RowGroup grp]
+                         (let [parsers (->> src-indexes
+                                            (hamf/pmap-io 12 (fn [^long idx]
+                                                               (read-column idx (nth schema-columns idx)
+                                                                            (nth (.columns grp) idx)
+                                                                            rdr
+                                                                            options)))
+                                            (vec))
+                               row-count (reduce max 0 (lznc/map :n-rows parsers))]
+                           (parse-context/parsers->dataset options parsers row-count)))))
+        closer* (delay (.close rdr))
+        seq* (delay (seq rv))]
+    (reify
+      java.lang.AutoCloseable
+      (close [this] @closer*)
+      clojure.lang.Seqable
+      (seq [this] @seq*)
+      Iterable
+      (iterator [this]
+        (if (realized? seq*)
+          (.iterator ^Iterable @seq*)
+          (let [src-iter (.iterator ^Iterable rv)]
+            (reify
+              java.util.Iterator
+              (hasNext [this] (let [rv (.hasNext src-iter)]
+                                (when-not rv @closer*)
+                                rv))
+              (next [this] (.next src-iter))))))
+      clojure.lang.IReduceInit
+      (reduce [this rfn acc]
+        (let [acc 
+              (if (realized? seq*)
+                (reduce rfn acc @seq*)
+                (reduce rfn acc rv))]
+          @closer*
+          acc)))))
+
+(defn parquet->ds
+  "Load a parquet file.  Input must be a file on disk.
+
+  Options are a subset of the options used for loading datasets -
+  specifically `:column-allowlist` and `:column-blocklist` can be
+  useful here.  The parquet metadata ends up as metadata on the
+  datasets."
+  ([input options]
+   (let [data-file (io/file input)
+         _ (errors/when-not-errorf
+            (.exists data-file)
+            "Only on-disk files work with parquet.  %s does not resolve to a file"
+            input)
+         dataset-seq (vec (parquet->ds-seq (.getCanonicalPath data-file) options))]
+     (when-not (or (:disable-parquet-warn-on-multiple-datasets options)
+                   (== 1 (count dataset-seq)))
+       (log/warnf "Concatenating multiple datasets (%d) into one.
+To disable this warning use `:disable-parquet-warn-on-multiple-datasets`"
+                  (count dataset-seq)))
+     (if (== 1 (count dataset-seq))
+       (first dataset-seq)
+       (apply ds-base/concat-copying dataset-seq))))
+  ([input]
+   (parquet->ds input nil)))
+
+;; No writing interface defined yet
+;; (defn ds-seq->parquet
+;;   ([path options ds-seq])
+;;   ([path ds-seq]))
+
+;; (defn ds->parquet
+;;   "Write a dataset to a parquet file.  Many parquet options are possible;
+;;   these can also be passed in via ds/->write!
+
+;;   Options are the same as ds-seq->parquet."
+;;   ([ds path options]
+;;    (ds-seq->parquet path options [ds]))
+;;   ([ds path]
+;;    (ds->parquet ds path nil)))

tech.ml.dataset/src/tech/v3/libs/poi.clj

@@ -0,0 +1,171 @@
+(ns tech.v3.libs.poi
+  "Parse a dataset in xls or xlsx format.  This namespace auto-registers a handler for
+  the `xls` file type so that when using ->dataset, `xls` will automatically map to
+  `(first (workbook->datasets))`.
+
+  Note that this namespace does **not** auto-register a handler for the `xlsx` file
+  type. `xlsx` is handled by the fastexcel namespace.
+
+  If you have an `xlsx` or `xls` file that contains multiple sheets and you want a
+  dataset out of each sheet you have to use `workbook->datasets` as opposed to the
+  higher level `->dataset` operator.
+
+  For serializing datasets to xlsx or xls formats please see
+  [kixi.large](https://github.com/MastodonC/kixi.large).
+
+  Note that poi has many versions and many version conflicts and for instance the
+  docjure library relies on a much older version of poi."
+  (:require [tech.v3.io :as io]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.protocols :as dtype-proto]
+            [tech.v3.datatype.errors :as errors]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.dataset.io.spreadsheet :as parse-spreadsheet]
+            [tech.v3.dataset.io :as ds-io])
+  (:import [org.apache.poi.ss.usermodel Workbook Sheet Cell
+            CellType Row]
+           [tech.v3.dataset Spreadsheet$Workbook Spreadsheet$Sheet
+            Spreadsheet$Row Spreadsheet$Cell]
+           [org.apache.poi.xssf.usermodel XSSFWorkbook]
+           [org.apache.poi.hssf.usermodel HSSFWorkbook]
+           [org.apache.poi.ss.usermodel DateUtil]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(defn- cell-type->keyword
+  [^CellType cell-type]
+  (condp = cell-type
+    CellType/BLANK :none
+    CellType/_NONE :none
+    CellType/NUMERIC :float64
+    CellType/BOOLEAN :boolean
+    CellType/STRING :string))
+
+
+(defn- wrap-cell
+  [^Cell cell]
+  (reify
+    dtype-proto/PElemwiseDatatype
+    (elemwise-datatype [this]
+      (let [cell-type (.getCellType cell)]
+        (if (or (= cell-type CellType/FORMULA)
+                (= cell-type CellType/ERROR))
+          (cell-type->keyword (.getCachedFormulaResultType cell))
+          (let [dtype-kwd (cell-type->keyword (.getCellType cell))]
+            (if (and (identical? :float64 dtype-kwd)
+                     (DateUtil/isCellDateFormatted cell))
+              :local-date
+              dtype-kwd)))))
+    Spreadsheet$Cell
+    (getColumnNum [this] (.. cell getAddress getColumn))
+    (missing [this] (identical? :none (dtype/get-datatype this)))
+    (value [this]
+      (case (dtype-proto/elemwise-datatype this)
+        :none nil
+        :string (.getStringCellValue cell)
+        :boolean (.getBooleanCellValue cell)
+        :local-date (-> (.getLocalDateTimeCellValue cell)
+                        (dtype-dt/local-date-time->local-date))
+        (.getNumericCellValue cell)))
+    (doubleValue [this] (.getNumericCellValue cell))
+    (boolValue [this] (.getBooleanCellValue cell))))
+
+
+(defn- wrap-row
+  ^Spreadsheet$Row [^Row row]
+  (reify
+    Spreadsheet$Row
+    (getRowNum [this] (.getRowNum row))
+    (iterator [this]
+      (let [iter (.iterator row)]
+        (reify java.util.Iterator
+          (hasNext [this] (.hasNext iter))
+          (next [this] (wrap-cell (.next iter))))))))
+
+
+(defn- wrap-sheet
+  ^Spreadsheet$Sheet [^Sheet sheet]
+  (reify
+    Spreadsheet$Sheet
+    (name [this] (.getSheetName sheet))
+    (iterator [this]
+      (let [iter (.iterator sheet)]
+        (reify java.util.Iterator
+          (hasNext [this] (.hasNext iter))
+          (next [this] (wrap-row (.next iter))))))))
+
+
+(defn- fname->file-type
+  [^String fname]
+  (if (.endsWith fname "xls")
+    :xls
+    :xlsx))
+
+
+
+(defn input->workbook
+  "Given an input data source, return an implementation of
+  `tech.v3.dataset/Spreadsheet$Workbook`.  This interface allows you
+  to iterate through sheets without necessarily parsing them.
+  Once you have a spreadsheet, use `tech.v3.dataset.io.spreadsheet/sheet->dataset`
+  to get a dataset."
+  (^Spreadsheet$Workbook [input options]
+   (if (instance? Spreadsheet$Workbook input)
+     input
+     (let [file-type (or (:file-type options)
+                         (when (string? input)
+                           (fname->file-type input))
+                         :xlsx)
+           ^Workbook workbook
+           (case file-type
+             :xlsx (XSSFWorkbook. (io/input-stream input))
+             :xls (HSSFWorkbook. (io/input-stream input)))]
+       (reify
+         Spreadsheet$Workbook
+         (iterator [this]
+           (let [iter (.iterator workbook)]
+             (reify java.util.Iterator
+               (hasNext [this] (.hasNext iter))
+               (next [this]
+                 (wrap-sheet (.next iter))))))
+         (close [this] (.close workbook))))))
+  (^Spreadsheet$Workbook [input]
+   (input->workbook input {})))
+
+
+(defn workbook->datasets
+  "Given a workbook, a string filename or an input stream return a sequence of
+  datasets named after the sheets.
+
+  Options are a subset of the arguments for tech.v3.dataset/->dataset:
+
+  * `:file-type` - either `:xls` or `:xlsx` - inferred from the filename when input is
+     a string.  If input is a stream defaults to `:xlsx`.
+  * `:header-row?`
+  * `:num-rows`
+  * `:n-initial-skip-rows`
+  * `:parser-fn`"
+  ([input options]
+   (let [workbook (input->workbook input options)]
+     (try
+       (mapv #(parse-spreadsheet/sheet->dataset % options) workbook)
+       (finally
+         (when-not (identical? input workbook)
+           (.close workbook))))))
+  ([input]
+   (workbook->datasets input {})))
+
+
+(defmethod ds-io/data->dataset :xls
+  [data options]
+  (let [datasets (workbook->datasets data options)
+        n-datasets (count datasets)]
+    (errors/when-not-errorf
+     (== 1 n-datasets)
+     (if (== 0 n-datasets)
+       "No (%d) datasets found in file"
+       "Multiple (%d) datasets found in file")
+     n-datasets)
+    (first datasets)))

tech.ml.dataset/src/tech/v3/libs/spark.clj

@@ -0,0 +1,220 @@
+(ns tech.v3.libs.spark
+  (:require [tech.v3.dataset.impl.dataset :as ds-impl]
+            [tech.v3.dataset.readers :as ds-readers]
+            [tech.v3.dataset.utils :as ds-utils]
+            [tech.v3.dataset.column :as ds-col]
+            [tech.v3.dataset.io :as ds-io]
+            [tech.v3.datatype.base :as dtype-base]
+            [tech.v3.datatype.emap :as emap]
+            [tech.v3.datatype.datetime :as dtype-dt]
+            [tech.v3.datatype.packing :as packing]
+            [tech.v3.datatype.casting :as casting]
+            [tech.v3.datatype.errors :as errors]
+            [clojure.set :as set])
+  (:import [org.apache.spark.sql Row RowFactory Dataset SparkSession]
+           [org.apache.spark.sql.types StructType StructField
+            DataTypes DataType]
+           [tech.v3.datatype ObjectReader]
+           [java.time LocalDate Instant]
+           [java.util List]))
+
+
+(set! *warn-on-reflection* true)
+
+
+(def ^:private datatype->sql-map
+  {:boolean DataTypes/BooleanType
+   :int8 DataTypes/ByteType
+   :int16 DataTypes/ShortType
+   :int32 DataTypes/IntegerType
+   :int64 DataTypes/LongType
+   :float32 DataTypes/FloatType
+   :float64 DataTypes/DoubleType
+   :sql-date DataTypes/DateType
+   :string DataTypes/StringType
+   :text DataTypes/StringType
+   :sql-timestamp DataTypes/TimestampType})
+
+
+(defn datatype->sql-type
+  ^DataType [datatype]
+  (let [datatype (packing/unpack-datatype datatype)
+        datatype (if-not (= datatype :epoch-days)
+                   (let [temp-dt (casting/un-alias-datatype datatype)]
+                     (if (casting/numeric-type? temp-dt)
+                       (casting/safe-flatten temp-dt)
+                       temp-dt))
+                   datatype)
+        sql-type (get datatype->sql-map datatype)
+        _ (errors/when-not-errorf
+           sql-type
+           "Failed to convert datatype %s"
+           datatype)]
+    sql-type))
+
+
+(def ^:private sql->datatype-map
+  (set/map-invert datatype->sql-map))
+
+
+(defn sql-type->datatype
+  [sql-type]
+  (if-let [retval (get sql->datatype-map sql-type)]
+    retval
+    (errors/throwf "Failed to find datatype for sql type %s"
+                   sql-type)))
+
+(defn sql-date->local-date
+  ^java.time.LocalDate [^java.sql.Date date]
+  (dtype-dt/milliseconds-since-epoch->local-date
+   (.getTime date)))
+
+
+(defn local-date->sql-date
+  ^java.sql.Date [^LocalDate ld]
+  (java.sql.Date/valueOf ld))
+
+
+(casting/add-object-datatype! :sql-date java.sql.Date)
+
+
+(defn sql-timestamp->instant
+  ^Instant [^java.sql.Timestamp date]
+  (dtype-dt/milliseconds-since-epoch->instant
+   (.getTime date)))
+
+
+(defn instant->sql-timestamp
+  ^java.sql.Timestamp [^Instant inst]
+  (java.sql.Timestamp.
+   (dtype-dt/instant->milliseconds-since-epoch inst)))
+
+
+(casting/add-object-datatype! :sql-timestamp java.sql.Timestamp)
+
+
+(defn- prepare-ds-for-spark
+  [ds]
+  (reduce
+   (fn [ds col]
+     (let [cname (ds-utils/column-safe-name (ds-col/column-name col))
+           col-dtype (packing/unpack-datatype
+                      (dtype-base/elemwise-datatype col))
+           missing (ds-col/missing col)
+           epoch-types #{:epoch-milliseconds :epoch-seconds
+                         :epoch-microseconds}
+           coldata (cond
+                     (epoch-types col-dtype)
+                     (->> (dtype-dt/epoch->datetime :instant col)
+                          (emap/emap instant->sql-timestamp :sql-timestamp))
+                     (= col-dtype :local-date)
+                     (emap/emap local-date->sql-date :sql-date
+                                (packing/unpack col))
+                     (= col-dtype :epoch-days)
+                     (->> (dtype-dt/epoch->datetime :local-date col)
+                          (emap/emap instant->sql-timestamp :sql-date))
+                     (= col-dtype :text)
+                     (emap/emap str :string col)
+                     (and (casting/numeric-type? col-dtype)
+                          (not= col-dtype (casting/safe-flatten col-dtype)))
+                     (dtype-base/elemwise-cast col (casting/safe-flatten col-dtype))
+                     :else
+                     col)]
+       (assoc ds cname (ds-col/new-column cname coldata (meta col) missing))))
+   ds
+   (vals ds)))
+
+
+(defn ds-schema->spark-schema
+  ^StructType [ds-schema]
+  (let [retval (StructType.)]
+    (reduce
+     (fn [retval col]
+       (let [{:keys [datatype name]} col
+             name (ds-utils/column-safe-name name)
+             nullable? (boolean (not (.isEmpty (ds-col/missing col))))]
+         (.add ^StructType retval name (datatype->sql-type datatype) nullable?)))
+     retval
+     (:columns ds-schema))))
+
+
+(defn ds-schema
+  [ds]
+  (assoc (meta ds)
+         :columns (mapv meta (vals ds))))
+
+
+(defn- dataset->row-list
+  ^List [ds]
+  (let [val-rdr (ds-readers/value-reader ds)
+        n-elems (.lsize val-rdr)]
+    (reify ObjectReader
+      (lsize [rdr] n-elems)
+      (readObject [rdr idx]
+        (RowFactory/create
+         (object-array (.readObject val-rdr idx)))))))
+
+
+(defn ds->spark-dataset
+  (^Dataset [ds ^SparkSession spark-session _options]
+   ;;Prepare the dataset datatypes
+   (let [ds (prepare-ds-for-spark ds)]
+     (.createDataFrame spark-session (dataset->row-list ds)
+                       (-> (ds-schema ds)
+                           (ds-schema->spark-schema)))))
+  (^Dataset [ds session]
+   (ds->spark-dataset ds session nil)))
+
+
+
+
+
+(defn collect-spark-dataset->ds
+  [^Dataset dataset]
+  ;;Make sure we are dealing with rows, not drama
+  ;;This system will not be able to deal with missing
+  ;;values without scanning each column.
+  (let [dataset (.toDF dataset)
+        schema (.schema dataset)
+        ;;data is an array of rows
+        ^objects data (.collect dataset)
+        n-rows (alength data)]
+    (->> (.fields schema)
+         (map-indexed
+          (fn [^long col-idx ^StructField field]
+            (let [colname (.name field)
+                  dtype (sql-type->datatype (.dataType field))]
+              (ds-col/new-column colname
+                                 (reify ObjectReader
+                                   (elemwiseDatatype [rdr] dtype)
+                                   (lsize [rdr] n-rows)
+                                   (readObject [rdr row-idx]
+                                     (let [^Row row (aget data row-idx)]
+                                       (.get row col-idx))))
+                                 nil
+                                 []))))
+         (ds-impl/new-dataset))))
+
+
+
+(comment
+  ;; databricks-connect specific classes
+  ;; should work similar for spark-connect
+
+;;Tested with hese deps
+;;org.scala-lang/scala-reflect {:mvn/version "2.12.18"}
+;;com.databricks/databricks-connect {:mvn/version "16.1.0"}
+    
+
+  (import
+   '[com.databricks.connect DatabricksSession]
+   '[com.databricks.sdk.core DatabricksConfig])
+  
+  (def config (.. (DatabricksConfig.) (setProfile "adb-xxxxx")))
+  (def spark (.. (DatabricksSession/builder) (sdkConfig config) getOrCreate))
+
+  (->
+    (.sql spark "show catalogs;")
+    collect-spark-dataset->ds)
+
+  )

tech.ml.dataset/src/tech/v3/libs/tribuo.clj

@@ -0,0 +1,326 @@
+(ns tech.v3.libs.tribuo
+  "Bindings to make working with tribuo more straight forward when using datasets.
+
+```clojure
+;; Classification
+
+tech.v3.dataset.tribuo-test> (def ds (classification-example-ds 10000))
+#'tech.v3.dataset.tribuo-test/ds
+tech.v3.dataset.tribuo-test> (def model (tribuo/train-classification (org.tribuo.classification.xgboost.XGBoostClassificationTrainer. 6) ds :label))
+#'tech.v3.dataset.tribuo-test/model
+tech.v3.dataset.tribuo-test> (ds/head (tribuo/predict-classification model (ds/remove-columns ds [:label])))
+_unnamed [5 3]:
+
+| :prediction |        red |      green |
+|-------------|-----------:|-----------:|
+|         red | 0.92524981 | 0.07475022 |
+|       green | 0.07464883 | 0.92535114 |
+|       green | 0.07464883 | 0.92535114 |
+|         red | 0.92525917 | 0.07474083 |
+|       green | 0.07464883 | 0.92535114 |
+
+
+  ;; Regression
+tech.v3.dataset.tribuo-test> (def ds (ds/->dataset \"test/data/winequality-red.csv\" {:separator \\;}))
+#'tech.v3.dataset.tribuo-test/ds
+tech.v3.dataset.tribuo-test> (def model (tribuo/train-regression (org.tribuo.regression.xgboost.XGBoostRegressionTrainer. 50) ds \"quality\"))
+#'tech.v3.dataset.tribuo-test/model
+tech.v3.dataset.tribuo-test> (ds/head (tribuo/predict-regression model (ds/remove-columns ds [\"quality\"])))
+_unnamed [5 1]:
+
+| :prediction |
+|------------:|
+|  5.01974726 |
+|  5.02164841 |
+|  5.22696543 |
+|  5.79519272 |
+|  5.01974726 |
+```"
+  (:require [tech.v3.dataset :as ds]
+            [tech.v3.dataset.modelling :as modelling]
+            [tech.v3.datatype :as dtype]
+            [tech.v3.datatype.casting :as casting]
+            [clojure.set :as set]
+            [charred.api :as charred])
+  (:import [tech.v3.datatype Buffer ArrayHelpers]
+           [java.util HashMap Map List]
+           [java.nio.file Files]
+           [java.nio.file.attribute FileAttribute]
+           [org.tribuo.classification Label LabelFactory]
+           [org.tribuo DataSource Output OutputFactory Trainer Model MutableDataset
+            Prediction]
+           [org.tribuo.impl ArrayExample]
+           [org.tribuo.provenance SimpleDataSourceProvenance]
+           [org.tribuo.regression RegressionFactory Regressor]
+           [org.tribuo.regression.evaluation RegressionEvaluator RegressionEvaluation]
+           [com.oracle.labs.mlrg.olcut.config ConfigurationManager]
+           [com.oracle.labs.mlrg.olcut.config.json JsonConfigFactory]))
+
+
+(set! *warn-on-reflection* true)
+
+(ConfigurationManager/addFileFormatFactory (JsonConfigFactory.)) ; allows json config
+
+(def ^:private str-ary-cls (Class/forName "[Ljava.lang.String;"))
+(def ^:private dbl-ary-cls (Class/forName "[D"))
+
+(defn- ->string
+  ^String [obj]
+  (if (nil? obj)
+    ""
+    (if (or (keyword? obj)
+            (symbol? obj))
+      (name obj)
+      (str obj))))
+
+(defn- ->string-array
+  ^"[Ljava.lang.String;" [data]
+  (if (instance? str-ary-cls data)
+    data
+    (into-array String (map ->string data))))
+
+(defn- ->double-array
+  "Slightly faster than (double-array) when the source data implements tech.v3.datatype.Buffer."
+  ^doubles [data]
+  (if (instance? dbl-ary-cls data)
+    data
+    (let [data (dtype/->buffer data)
+          ndata (.size data)
+          ddata (double-array ndata)]
+      ;;Clojure's aset function returns a value and thus boxes every item in the array.
+      (dotimes [idx ndata] (ArrayHelpers/aset ddata idx (.readDouble data idx)))
+      ddata)))
+
+(defn- ds->regression-outputs
+  [ds]
+  (let [fact (RegressionFactory.)]
+    (with-meta
+      (if (integer? ds)
+        (dtype/make-reader :object ds (.getUnknownOutput fact))
+        (let [rvecs (ds/rowvecs ds)
+              names (->string-array (ds/column-names ds))]
+          (dtype/make-reader :object (dtype/ecount rvecs)
+                             (Regressor. names (->double-array (rvecs idx))))))
+      {:output-factory fact})))
+
+
+(defn- ds->single-label-outputs
+  [ds]
+  (let [label-fact (LabelFactory.)]
+    (if (integer? ds)
+      (with-meta
+        (dtype/make-reader :object ds (.getUnknownOutput label-fact))
+        {:output-factory label-fact})
+      (do
+        (when-not (== 1 (ds/column-count ds))
+          (throw (Exception. "Single label output expected, got multi-label dataset")))
+        (let [col (first (vals ds))
+              colmeta (meta col)
+              data (dtype/->buffer col)
+              n-rows (.lsize data)
+              data (if-let [cat-map (get-in colmeta [:categorical-map :lookup-table])]
+                     (let [rev-map (set/map-invert cat-map)]
+                       (dtype/make-reader :object n-rows (get rev-map (long (data idx)))))
+                     data)]
+          (with-meta
+            (dtype/make-reader :object n-rows (Label. (->string (data idx))))
+            {:output-factory label-fact}))))))
+
+(defn- ensure-numeric-columns
+  [ds]
+  (when-not (every? casting/numeric-type? (map (comp :datatype meta) (vals ds)))
+    (throw (Exception.
+            (str "All columns must be numeric at this point.  Non numeric columns:\n"
+                 (->> (map meta (vals ds))
+                      (filter #(not (casting/numeric-type? (get % :datatype))))
+                      (mapv :name))))))
+  ds)
+
+(defn- ds->examples
+  ^Buffer [ds ds->outputs]
+  (let [inf-columns (modelling/inference-target-column-names ds)
+        inf-ds (when inf-columns (ds/select-columns ds inf-columns))
+        feat-ds (-> (ds/remove-columns ds inf-columns)
+                    (ensure-numeric-columns))
+        feat-data (ds/rowvecs feat-ds)
+        n-rows (ds/row-count ds)
+        ;;column names have to be strings.
+        cnames (->string-array (ds/column-names feat-ds))
+        n-rows (ds/row-count ds)
+        outputs (if inf-ds
+                  (ds->outputs inf-ds)
+                  (ds->outputs n-rows))]
+    (with-meta
+      (dtype/make-reader :object n-rows
+                         ;;idx is a compile-time variable below
+                         (ArrayExample. ^Output (outputs idx)
+                                        cnames (->double-array (feat-data idx))))
+      (meta outputs))))
+
+(defn- safe-str
+  [n]
+  (cond (string? n)
+    n
+    (or (keyword? n) (symbol? n))
+    (if-let [nn (namespace n)]
+      (str nn "/" (name n))
+      (str (name n)))))
+
+
+(defn- ds->datasource
+  ^DataSource [ds ds->outputs]
+  (let [examples (ds->examples ds ds->outputs)
+        {:keys [output-factory provenance]} (meta examples)
+        provenance (or provenance
+                       (SimpleDataSourceProvenance. (safe-str (:name (meta ds))) output-factory))]
+    (when-not output-factory
+      (throw (RuntimeException. "Output factory not present in example metadata")))
+    (reify DataSource
+      (getProvenance [this] provenance)
+      (iterator [this] (.iterator examples))
+      (getOutputFactory [this] output-factory))))
+
+
+(defn- label-score
+  ^double [^Label label]
+  (.getScore label))
+
+(defn- label-label
+  ^String [^Label label]
+  (.getLabel label))
+
+(defn- prediction-label
+  ^String [^Prediction pred]
+  (-> (.getOutput pred)
+      (label-label)))
+
+(defn- has-probabilities?
+  [^Prediction pred]
+  (.hasProbabilities pred))
+
+(defn- prediction-scores
+  ^Map [^Prediction pred]
+  (.getOutputScores pred))
+
+
+(defn- regressor-value
+  ^double [^Regressor reg]
+  (aget (.getValues reg) 0))
+
+
+(defn- prediction-regval
+  [^Prediction pred]
+  (regressor-value (.getOutput pred)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Begin public API
+
+
+;; Classification
+
+(defn make-classification-datasource
+  "Make a single label classification datasource."
+  (^DataSource [ds]
+   (make-classification-datasource ds nil))
+  (^DataSource [ds inf-col-name]
+   (if inf-col-name
+     (-> (modelling/set-inference-target ds inf-col-name)
+         (ds->datasource ds->single-label-outputs))
+     (ds->datasource ds ds->single-label-outputs))))
+
+
+(defn train-classification
+  "Train a single label classification model.  Returns the model."
+  ^Model [^Trainer trainer ds & [inf-col-name]]
+  (.train trainer (-> (make-classification-datasource ds inf-col-name)
+                      (MutableDataset.))))
+
+
+(defn classification-predictions->dataset
+  "Given the list of predictions from a classification model return a dataset
+  that will include probability distributions when possible.  The actual prediction
+  will be in the `:prediction` column."
+  [^List predictions]
+  (let [labels (dtype/emap prediction-label :string predictions)
+        pred (.get predictions 0)]
+    (-> (ds/->dataset
+         (merge {:prediction labels}
+                (when (has-probabilities? pred)
+                  (let [scores (prediction-scores pred)]
+                    (->> (.entrySet scores)
+                         (map (fn [entry]
+                                (let [ekey (key entry)]
+                                  [ekey (-> (dtype/emap #(-> (prediction-scores %)
+                                                             (.get ekey)
+                                                             (label-score))
+                                                        :float64
+                                                        predictions)
+                                            (dtype/clone))])))
+                         (into {}))))))
+        (modelling/set-inference-target :prediction))))
+
+
+(defn predict-classification
+  "Use this model to predict every row of this dataset returning a new dataset containing
+  at least a `:prediction` column.  If this classifier is capable of predicting probability
+  distributions those will be returned as per-label as separate columns."
+  [^Model model ds]
+  (when-not (== 0 (ds/row-count ds))
+    (->> (.predict model (make-classification-datasource ds))
+         (classification-predictions->dataset))))
+
+
+;; Regression
+(defn make-regression-datasource
+  "Make a regression datasource from a dataset."
+  (^DataSource [ds]
+   (make-regression-datasource ds nil))
+  (^DataSource [ds inf-col-name]
+   (if inf-col-name
+     (-> (modelling/set-inference-target ds inf-col-name)
+         (ds->datasource ds->regression-outputs))
+     (ds->datasource ds ds->regression-outputs))))
+
+
+(defn train-regression
+  "Train a regression model on a dataset returning the model."
+  ^Model [^Trainer trainer ds & [inf-col-name]]
+  (.train trainer (-> (make-regression-datasource ds inf-col-name)
+                      (MutableDataset.))))
+
+
+(defn predict-regression
+  "Use a regression model to predict each column of the dataset returning a dataset with
+  at least one column named `:prediction`."
+  [^Model model ds]
+  (when-not (== 0 (ds/row-count ds))
+    (ds/->dataset {:prediction (->> (.predict model (make-regression-datasource ds))
+                                    (dtype/emap prediction-regval :float64)
+                                    (dtype/clone))})))
+
+
+(defn evaluate-regression
+  "Evaluate a regression model against this model.  Returns map of
+  `{:rmse :mae :r2}`"
+  [^Model model ds inf-col-name]
+  (let [inf-col-name (->string inf-col-name)
+        ^RegressionEvaluation eval (.evaluate (RegressionEvaluator.) model
+                                              (MutableDataset. (make-regression-datasource ds inf-col-name)))
+        dim (Regressor. inf-col-name Double/NaN)]
+    {:rmse (.rmse eval dim)
+     :mae (.mae eval dim)
+     :r2 (.r2 eval dim)}))
+
+
+
+(defn trainer
+  "Creates a tribuo trainer from a list of config components
+  follwing OLCUT convention. One of the components should be a trainer,
+  which is the looked-up by `trainer-name` and returned."
+
+  [config-components trainer-name]
+  (let [config {:config {:components config-components}}
+        tmp (.toString (Files/createTempFile "config" ".json" (make-array FileAttribute 0)))
+        _ (charred/write-json tmp config)
+        config-manager (ConfigurationManager. tmp)]
+    (.lookup config-manager trainer-name)))