hanalyze-frame (empty) → 0.2.0.1
raw patch · 17 files changed
+4974/−0 lines, 17 filesdep +arraydep +basedep +bytestring
Dependencies added: array, base, bytestring, cassava, containers, dataframe-core, dataframe-csv, dataframe-json, dataframe-operations, dataframe-parquet, deepseq, hanalyze-core, regex-tdfa, temporary, text, unicode-transforms, unordered-containers, vector
Files
- README.ja.md +77/−0
- README.md +79/−0
- hanalyze-frame.cabal +72/−0
- src/Hanalyze/Data/ColumnSource.hs +116/−0
- src/Hanalyze/Data/Factor.hs +456/−0
- src/Hanalyze/Data/Strings.hs +724/−0
- src/Hanalyze/Data/Transform.hs +213/−0
- src/Hanalyze/Data/Wrangle.hs +307/−0
- src/Hanalyze/DataIO/CSV.hs +445/−0
- src/Hanalyze/DataIO/Clean.hs +291/−0
- src/Hanalyze/DataIO/Convert.hs +86/−0
- src/Hanalyze/DataIO/External.hs +38/−0
- src/Hanalyze/DataIO/Health.hs +461/−0
- src/Hanalyze/DataIO/Log.hs +181/−0
- src/Hanalyze/DataIO/Preprocess.hs +928/−0
- src/Hanalyze/DataIO/Reshape.hs +256/−0
- src/Hanalyze/DataIO/Sniff.hs +244/−0
+ README.ja.md view
@@ -0,0 +1,77 @@+# hanalyze-frame++[`hanalyze`](../README.ja.md) の**データ入出力層**。 Hackage の+`dataframe` を唯一のデータ表現として採用し、 **汚いデータの読み込み**から+**tidyverse 流の整形**までを担う。++依存は `hanalyze-core` + `dataframe-*` / `cassava` / `regex-tdfa` 等。+`-bayes` と並んで core の直上に位置し、 上位の `-models` / `-design` /+`-viz` はすべてこの層のデータ表現を前提にする。++## 主要 module (全 14 module)++### 読み込み (`Hanalyze.DataIO.*`)++| Module | 役割 |+|---|---|+| `DataIO.CSV` | CSV / TSV / SSV を `DataFrame` として直接返すローダ群。 `loadAuto` が拡張子から判別。 `loadAutoSafe` は `Either` + ログを返す防衛版 |+| `DataIO.Sniff` | delimiter・comment 記号・header 有無・NA 候補を先頭 8KB から自動推測 |+| `DataIO.Health` | 読み込み済み `DataFrame` の疑わしいパターンを警告コード W001〜W008 として検出 |+| `DataIO.Clean` | Health の警告を数値化ルールへ変換する列単位クリーニング DSL |+| `DataIO.Log` | ローダ / 前処理が共有する構造化警告 (`LogEntry` / `LogReport`) |+| `DataIO.External` | Parquet / JSON ローダ (`dataframe` 経由) |+| `DataIO.Convert` | `DataFrame` から数値 / Text 列を安全に `Vector` へ抽出する変換層 |++### 整形 (`Hanalyze.Data.*` / `DataIO.*`)++| Module | 役割 |+|---|---|+| `Data.Wrangle` | dplyr 風の `summarise` / `mutate` / `groupBy` を `DataFrame` in/out で提供。 hgg の pipe 記法と対称設計 |+| `Data.Transform` | dplyr 流の順位・オフセット・累積・区間化を純粋な `[a] -> [b]` として提供 |+| `Data.Factor` | forcats 流の因子型と水準操作 (`fct_*` 相当) |+| `Data.Strings` | stringr 流の Text 純粋操作 (`str_*` 相当) |+| `Data.ColumnSource` | 「列名 → 数値列」 を引ける最小抽象型クラス (plot 非依存) |+| `DataIO.Reshape` | `dataframe` に無い reshape 操作 (pivotWider / oneHot / lag・lead / rolling) |+| `DataIO.Preprocess` | 欠損の検出・除去・補完 / 列選択 / 派生列 / melt |++## 単体で使う++```cabal+build-depends: hanalyze-frame, dataframe-core+```++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Hanalyze.DataIO.CSV (loadAuto)+import Hanalyze.Data.Wrangle+import DataFrame.Operators ((|>))++main = do+ Right df <- loadAuto "flights.csv" -- IO (Either ParseError DataFrame)+ let out = df |> groupBy ["month"]+ |> summarise [ "mean" =: meanOf "dep_delay"+ , "q95" =: quantileOf 0.95 "dep_delay"+ , "n" =: nOf ]+ print out+ -- month | mean | q95 | n+ -- ------|--------------------|--------------------|----+ -- 1 | 4.5 | 11.549999999999999 | 3+ -- 2 | 11.166666666666666 | 23.25 | 3+```++集約子は既定で NA 除去 (dplyr の `na.rm = TRUE` 相当)、 群の並びはキー昇順。++通常は umbrella package `hanalyze` を依存に書けば+`import Hanalyze` からこれらも使える。 層を直接指定するのは+依存を最小化したいときのみで十分。++## 関連 docs++- 汚いデータ対策 (W001-W008 / auto-sniff / clean DSL):+ [docs/io/01-dirty-data.ja.md](../docs/io/01-dirty-data.ja.md)+- reshape (pivot_wider / one-hot / lag-lead / rolling):+ [docs/io/02-reshape.ja.md](../docs/io/02-reshape.ja.md)+- long-form 再グリッド: [docs/io/03-regrid.ja.md](../docs/io/03-regrid.ja.md)+- `df |-> model` 統一 fit API: [docs/io/04-fit-api.ja.md](../docs/io/04-fit-api.ja.md)++← [repository README](../README.ja.md)
+ README.md view
@@ -0,0 +1,79 @@+# hanalyze-frame++The **data I/O layer** of [`hanalyze`](../README.md). It adopts+Hackage's `dataframe` as the single data representation and covers everything+from **loading dirty data** to **tidyverse-style wrangling**.++It depends on `hanalyze-core` plus `dataframe-*` / `cassava` /+`regex-tdfa` and friends. Together with `-bayes` it sits directly on top of+core, and the upper layers (`-models` / `-design` / `-viz`) all assume the data+representation defined here.++## Main modules (14 in total)++### Loading (`Hanalyze.DataIO.*`)++| Module | Role |+|---|---|+| `DataIO.CSV` | CSV / TSV / SSV loaders returning a `DataFrame` directly. `loadAuto` dispatches on the extension; `loadAutoSafe` is the defensive variant returning `Either` plus a log |+| `DataIO.Sniff` | Guesses delimiter, comment marker, header presence and NA tokens from the first 8 KB |+| `DataIO.Health` | Flags suspicious patterns in a loaded `DataFrame` as warning codes W001–W008 |+| `DataIO.Clean` | A per-column cleaning DSL that turns Health warnings into numeric rules |+| `DataIO.Log` | Structured warnings shared by loaders and preprocessing (`LogEntry` / `LogReport`) |+| `DataIO.External` | Parquet / JSON loaders (via `dataframe`) |+| `DataIO.Convert` | Safe extraction of numeric / text columns from a `DataFrame` into `Vector` |++### Wrangling (`Hanalyze.Data.*` / `DataIO.*`)++| Module | Role |+|---|---|+| `Data.Wrangle` | dplyr-style `summarise` / `mutate` / `groupBy`, `DataFrame` in and out. Designed symmetrically with hgg's pipe notation |+| `Data.Transform` | dplyr-style ranking / offsets / cumulatives / binning as pure `[a] -> [b]` |+| `Data.Factor` | forcats-style factor type and level operations (`fct_*`) |+| `Data.Strings` | stringr-style pure Text operations (`str_*`) |+| `Data.ColumnSource` | Minimal "column name → numeric column" abstraction (plot-independent) |+| `DataIO.Reshape` | Reshape operations `dataframe` lacks (pivotWider / oneHot / lag & lead / rolling) |+| `DataIO.Preprocess` | Missing-value detection, removal and imputation / column selection / derived columns / melt |++## Using it standalone++```cabal+build-depends: hanalyze-frame, dataframe-core+```++```haskell+{-# LANGUAGE OverloadedStrings #-}+import Hanalyze.DataIO.CSV (loadAuto)+import Hanalyze.Data.Wrangle+import DataFrame.Operators ((|>))++main = do+ Right df <- loadAuto "flights.csv" -- IO (Either ParseError DataFrame)+ let out = df |> groupBy ["month"]+ |> summarise [ "mean" =: meanOf "dep_delay"+ , "q95" =: quantileOf 0.95 "dep_delay"+ , "n" =: nOf ]+ print out+ -- month | mean | q95 | n+ -- ------|--------------------|--------------------|----+ -- 1 | 4.5 | 11.549999999999999 | 3+ -- 2 | 11.166666666666666 | 23.25 | 3+```++Aggregators drop NAs by default (dplyr's `na.rm = TRUE`), and groups come out+in ascending key order.++Normally you would just depend on the umbrella package `hanalyze` and+reach these through `import Hanalyze`. Naming a layer directly is only+worth it when you want to minimise dependencies.++## Related docs++- Dirty-data defence (W001–W008 / auto-sniff / clean DSL):+ [docs/io/01-dirty-data.md](../docs/io/01-dirty-data.md)+- Reshape (pivot_wider / one-hot / lag-lead / rolling):+ [docs/io/02-reshape.md](../docs/io/02-reshape.md)+- Long-form regrid: [docs/io/03-regrid.md](../docs/io/03-regrid.md)+- The unified `df |-> model` fit API: [docs/io/04-fit-api.md](../docs/io/04-fit-api.md)++← [repository README](../README.md)
+ hanalyze-frame.cabal view
@@ -0,0 +1,72 @@+cabal-version: 3.0+name: hanalyze-frame+version: 0.2.0.1+synopsis: Data I/O layer of hanalyze: loaders, cleaning, tidy wrangling+description:+ The data I/O layer of the hanalyze toolkit, built on Hackage's+ dataframe as the single data representation. CSV / TSV / SSV / Parquet /+ JSON loaders with delimiter and header sniffing, a health checker that+ reports suspicious data as warning codes plus a cleaning DSL to act on+ them, and tidyverse-style wrangling: dplyr-style summarise / mutate /+ groupBy, forcats-style factors, stringr-style text helpers, and reshape+ operations (pivotWider / oneHot / lag / rolling).+ .+ Module names match the umbrella package hanalyze, which re-exports+ everything, so downstream imports stay identical. See README.md for the+ module map and a standalone usage example.+license: BSD-3-Clause+author: Toshiaki Honda+maintainer: frenzieddoll@gmail.com+copyright: 2026 Aelysce Project (Toshiaki Honda)+category: Math, Statistics, Numeric, Machine Learning+build-type: Simple+tested-with: GHC == 9.6.7+extra-source-files:+ README.md+ README.ja.md++common warnings+ ghc-options: -Wall -Wcompat -Widentities -Wredundant-constraints++-- -O2 は分割前と同一 (性能変更と構造変更を混ぜない、 層別 -O 調整は 106.5 後の別 Phase)+common opt+ ghc-options: -O2 -funbox-strict-fields++library+ import: warnings, opt+ hs-source-dirs: src+ default-language: GHC2021+ exposed-modules:+ Hanalyze.Data.ColumnSource+ Hanalyze.Data.Factor+ Hanalyze.Data.Strings+ Hanalyze.Data.Transform+ Hanalyze.Data.Wrangle+ Hanalyze.DataIO.CSV+ Hanalyze.DataIO.Clean+ Hanalyze.DataIO.Convert+ Hanalyze.DataIO.External+ Hanalyze.DataIO.Health+ Hanalyze.DataIO.Log+ Hanalyze.DataIO.Preprocess+ Hanalyze.DataIO.Reshape+ Hanalyze.DataIO.Sniff+ build-depends:+ base >= 4.14 && < 5+ , array >= 0.5 && < 0.6+ , bytestring >= 0.11 && < 0.13+ , cassava >= 0.5 && < 0.6+ , containers >= 0.6 && < 0.8+ , deepseq >= 1.4 && < 1.6+ , text >= 1.2 && < 2.2+ , temporary >= 1.3 && < 1.4+ , unordered-containers >= 0.2 && < 0.3+ , vector >= 0.12 && < 0.14+ , dataframe-core ^>= 1.1+ , dataframe-operations >= 1.1.1 && < 1.2+ , dataframe-csv ^>= 1.0.2+ , dataframe-json ^>= 1.0+ , dataframe-parquet ^>= 1.1+ , unicode-transforms >= 0.4 && < 0.5+ , regex-tdfa >= 1.3 && < 1.4+ , hanalyze-core == 0.2.0.1
+ src/Hanalyze/Data/ColumnSource.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.Data.ColumnSource+-- Description : 列名 → 数値列を引ける「データ源」の最小抽象型クラス (plot 非依存)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: 列名 → 数値列 を引ける「データ源」 の最小抽象。+--+-- モデル学習の入口 (@df |-> spec@) を、 データ表現+-- (@[(Text,[Double])]@ / @Map Text [Double]@ / Hackage @DataFrame@ /+-- plot @ColData@) から疎結合にするための型クラス。 数値列の取得と+-- 列名列挙の 2 メソッドのみを持ち、 factor/NA の解釈は上位+-- (formula 経路) に委ねる。+--+-- このモジュールは __plot 非依存 (portable)__。 plot 専用の+-- @[(Text, ColData)]@ instance は別パッケージ @hanalyze-plot@ の+-- @Hanalyze.Plot@ (@cabal build --project-file=cabal.project.plot@+-- で build) に隔離する。+--+-- [English]: A minimal abstraction for a "data source" from which a numeric+-- column can be looked up by column name.+--+-- This type class decouples the entry point of model fitting (@df |->+-- spec@) from the underlying data representation (@[(Text,[Double])]@ \/+-- @Map Text [Double]@ \/ the Hackage @DataFrame@ \/ plot's @ColData@). It+-- has only two methods — fetching a numeric column and enumerating column+-- names — and leaves the interpretation of factors\/NA to the upper layer+-- (the formula path).+--+-- This module is __plot-independent (portable)__. The plot-specific+-- @[(Text, ColData)]@ instance is isolated in the separate+-- @hanalyze-plot@ package's @Hanalyze.Plot@ (built via+-- @cabal build --project-file=cabal.project.plot@).+module Hanalyze.Data.ColumnSource+ ( ColumnSource (..)+ ) where++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Vector as V+import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX++import Hanalyze.DataIO.Convert (getDoubleVec)++-- ===========================================================================+-- 型クラス+-- ===========================================================================++-- | [日本語]: 列名で数値列を引けるデータ源。+--+-- * 'lookupCol' は __数値列__のみを返す (factor 列は formula 経路が+-- contrast 展開するため、 ここでは数値列の素取得に限る)。+-- * 'columnNames' は欠落検出 (要求列が無い) のための全列名列挙。+-- [English]: A data source from which a numeric column can be looked up+-- by column name.+--+-- * 'lookupCol' returns only __numeric columns__ (factor columns are+-- expanded via contrasts by the formula path, so this is limited to a+-- plain fetch of numeric columns).+-- * 'columnNames' enumerates all column names, used to detect missing+-- columns (a requested column that doesn't exist).+class ColumnSource d where+ -- | [日本語]: 列名 → 数値列 (無ければ 'Nothing')。+ -- [English]: Column name → numeric column (or 'Nothing' if absent).+ lookupCol :: Text -> d -> Maybe [Double]+ -- | [日本語]: 全列名。+ -- [English]: All column names.+ columnNames :: d -> [Text]+ -- | [日本語]: データ源全体を Hackage @DataFrame@ に変換 (formula 経路が+ -- @MissingPolicy@\/contrast\/応答列判定で ModelFrame に変換するため)。+ --+ -- 既定は __数値列のみから再構築__ (assoc\/Map など数値源で正しい)。+ -- @DX.DataFrame@ instance は 'id' で上書きし factor\/NA を温存する+ -- (formula 多変量の canonical 経路)。+ -- [English]: Converts the entire data source into a Hackage+ -- @DataFrame@ (so the formula path can convert it to a ModelFrame via+ -- @MissingPolicy@ \/ contrasts \/ response-column detection).+ --+ -- The default __reconstructs from numeric columns only__ (correct for+ -- numeric sources such as assoc lists \/ Map). The @DX.DataFrame@+ -- instance overrides this with 'id' to preserve factors\/NA (the+ -- canonical path for multivariate formulas).+ toFrame :: d -> DX.DataFrame+ toFrame d = DX.fromNamedColumns+ [ (n, DX.fromList vs)+ | n <- columnNames d, Just vs <- [lookupCol n d] ]++-- ===========================================================================+-- core instance (portable)+-- ===========================================================================++-- | [日本語]: HBM の既存入力 (列名 assoc) と同型。+-- [English]: Isomorphic to HBM's existing input (a column-name assoc list).+instance ColumnSource [(Text, [Double])] where+ lookupCol n = lookup n+ columnNames = map fst++-- | [日本語]: 'Map' 版。+-- [English]: The 'Map' variant.+instance ColumnSource (Map Text [Double]) where+ lookupCol = Map.lookup+ columnNames = Map.keys++-- | [日本語]: Hackage @dataframe@ (analyze formula 経路と同じ df)。+-- 数値変換は 'getDoubleVec' に委譲 (formula 経路と同じ判定)。+-- [English]: The Hackage @dataframe@ (the same df used by analyze's+-- formula path). Numeric conversion is delegated to 'getDoubleVec' (the+-- same judgment as the formula path).+instance ColumnSource DX.DataFrame where+ lookupCol n df = V.toList <$> getDoubleVec n df+ columnNames = DX.columnNames+ toFrame = id -- factor/NA を温存 (formula 経路の canonical)
+ src/Hanalyze/Data/Factor.hs view
@@ -0,0 +1,456 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Hanalyze.Data.Factor+-- Description : forcats 流の因子 (factor) 型と水準操作 (fct_* 相当)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: forcats 流の因子 (factor) 型操作 (Ch16 "Factors")。+--+-- R の `factor` を __水準 (levels) の順序付きリスト + 各観測の水準コード__として+-- 表す 'Factor' 型と、 forcats の `fct_*` 相当を純粋関数として公開する+-- ('Data.Strings' / 'Data.Transform' と同列の `Data/` 純粋抽象)。+--+-- === なぜ専用型か+-- ただの @[Text]@ と違い factor は (1) 水準の__意味的順序__ (アルファベット順とは別)、+-- (2) データに現れない水準の保持、 (3) 整数コード化、 を持つ。 forcats の `fct_*` は+-- この水準順序や中身を操作する関数群で、 順序概念のない @[Text]@ には無い。+--+-- === HBM の Column.Factor との違い+-- 'Hanalyze.Model.HBM' の内部 @Column = Numeric | Factor@ は NUTS に渡す+-- 観測列の内部表現。 本 'Factor' は __データ整形ドメイン__の公開型で責務が別 (独立実装)。+--+-- === コード規約+-- 'facCodes' は __0 始まり__ (@facLevels !! code@ で復元)。 欠損 (R の @\<NA\>@) は+-- コード @-1@ で表す ('naCode')。+--+-- [English]: forcats-style factor type operations (Ch16 "Factors").+--+-- Provides the 'Factor' type, which represents R's `factor` as+-- __an ordered list of levels plus each observation's level code__, along with pure+-- functions for the `fct_*` equivalents from forcats (a pure `Data/`+-- abstraction alongside 'Data.Strings' \/ 'Data.Transform').+--+-- === Why a dedicated type+-- Unlike a plain @[Text]@, a factor carries (1) a __semantic ordering__ of+-- levels (distinct from alphabetical order), (2) levels that persist even+-- when absent from the data, and (3) integer coding. forcats's `fct_*`+-- functions manipulate this level ordering and content, which has no+-- counterpart for an order-less @[Text]@.+--+-- === Difference from HBM's Column.Factor+-- The internal @Column = Numeric | Factor@ in 'Hanalyze.Model.HBM' is+-- the internal representation of an observation column passed to NUTS. This+-- 'Factor' is a public type for the __data-wrangling domain__ with a+-- separate responsibility (an independent implementation).+--+-- === Coding convention+-- 'facCodes' is __0-indexed__ (recovered via @facLevels !! code@). Missing+-- values (R's @\<NA\>@) are represented by code @-1@ ('naCode').+module Hanalyze.Data.Factor+ ( -- * 型+ Factor (..)+ , naCode+ -- * 生成 (factor / fct / ordered)+ , factor+ , factorWith+ , fct+ , ordered+ -- * 参照 (levels / as.character / count)+ , levels+ , isOrdered+ , asTexts+ , asTextsMaybe+ , fctCount+ -- * 順序操作 (16.4 forcats fct_reorder 系)+ , fctReorder+ , fctRelevel+ , fctReorder2+ , fctInfreq+ , fctRev+ -- * 水準操作 (16.5 forcats fct_recode / fct_collapse / fct_lump 系)+ , fctRecode+ , fctCollapse+ , fctLumpN+ , fctLumpMin+ , fctLumpProp+ , fctLumpLowfreq+ ) where++import Data.List (foldl', sort, sortBy, elemIndex)+import Data.Maybe (mapMaybe)+import Data.Ord (comparing, Down (..))+import qualified Data.Map.Strict as M+import Data.Text (Text)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU++-- === 型 =====================================================================++-- | [日本語]: 因子。 水準ラベル + 各観測の水準コード (0 始まり・NA は 'naCode')。+-- [English]: A factor. Level labels + each observation's level code+-- (0-indexed; NA is 'naCode').+data Factor = Factor+ { facLevels :: [Text] -- ^ [日本語]: 水準ラベル (定義順) [English]: The level labels, in definition order.+ , facCodes :: VU.Vector Int -- ^ [日本語]: 各観測の水準コード (0 始まり・NA = 'naCode') [English]: Each observation's level code (0-indexed; NA = 'naCode').+ , facOrdered :: Bool -- ^ [日本語]: 順序付き因子か (R `ordered()`) [English]: Whether this is an ordered factor (R's `ordered()`).+ } deriving (Eq, Show)++-- | [日本語]: 欠損コード (R の @NA_integer_@ 相当)。+-- [English]: The missing-value code (equivalent to R's @NA_integer_@).+naCode :: Int+naCode = -1++-- === 生成 ===================================================================++-- | [日本語]: @factor xs@ : R の `factor()` 既定。 水準 = 値の __ソート済 unique__。+-- [English]: @factor xs@: R's default `factor()`. The levels are the+-- __sorted unique__ values.+factor :: [Text] -> Factor+factor xs = factorWith (sortUnique xs) xs++-- | [日本語]: @factorWith lvls xs@ : 水準を明示。 @lvls@ に無い値は NA ('naCode')。+-- [English]: @factorWith lvls xs@: Levels are given explicitly. Values not+-- present in @lvls@ become NA ('naCode').+factorWith :: [Text] -> [Text] -> Factor+factorWith lvls xs = Factor lvls (VU.fromList (map enc xs)) False+ where+ idx = M.fromList (zip lvls [0 ..])+ enc x = M.findWithDefault naCode x idx++-- | [日本語]: @fct xs@ : forcats の `fct()`。 水準 = 値の __出現順 unique__ (factor() と違い sort しない)。+-- [English]: @fct xs@: forcats's `fct()`. The levels are the values'+-- __unique values in order of first appearance__ (unlike factor(), it+-- does not sort).+fct :: [Text] -> Factor+fct xs = factorWith (nubKeepOrder xs) xs++-- | [日本語]: @ordered lvls xs@ : 順序付き因子 (R `ordered()`)。 水準間に @<@ 順序を持つ。+-- [English]: @ordered lvls xs@: An ordered factor (R's `ordered()`), with+-- a @<@ ordering between levels.+ordered :: [Text] -> [Text] -> Factor+ordered lvls xs = (factorWith lvls xs) { facOrdered = True }++-- === 参照 ===================================================================++-- | [日本語]: 水準ラベル (定義順)。+-- [English]: The level labels, in definition order.+levels :: Factor -> [Text]+levels = facLevels++-- | [日本語]: 順序付き因子か。+-- [English]: Whether this is an ordered factor.+isOrdered :: Factor -> Bool+isOrdered = facOrdered++-- | [日本語]: @as.character()@ 相当。 各観測をラベルへ。 NA は @""@。+-- [English]: Equivalent to @as.character()@. Converts each observation to+-- its label; NA becomes @""@.+asTexts :: Factor -> [Text]+asTexts f = map (maybe "" id) (asTextsMaybe f)++-- | [日本語]: NA を 'Nothing' で残す版。+-- [English]: The variant that keeps NA as 'Nothing'.+asTextsMaybe :: Factor -> [Maybe Text]+asTextsMaybe f = map lab (VU.toList (facCodes f))+ where+ v = V.fromList (facLevels f)+ lab c | c < 0 || c >= V.length v = Nothing+ | otherwise = Just (v V.! c)++-- | [日本語]: dplyr `count()` 相当。 __水準順__に (ラベル, 出現数)。 0 件水準も含む。 NA は除外。+-- [English]: Equivalent to dplyr's `count()`. Returns (label, count) pairs+-- __in level order__, including levels with zero occurrences. NA is+-- excluded.+fctCount :: Factor -> [(Text, Int)]+fctCount f = [ (lv, M.findWithDefault 0 i cmap) | (lv, i) <- zip (facLevels f) [0 ..] ]+ where+ cmap = foldl' (\m c -> if c < 0 then m else M.insertWith (+) c 1 m)+ M.empty (VU.toList (facCodes f))++-- === 順序操作 (16.4) ========================================================+--+-- いずれも **facLevels の順序を入れ替え、 facCodes を旧 code → 新 code に+-- 再マッピング**して実装する ('applyLevelOrder')。 観測の中身 (どの水準か) は+-- 不変で、 水準の**並び順**だけが変わる (forcats `fct_reorder` 系と同義)。++-- | [日本語]: forcats `fct_reorder(f, x, .fun)`。 各水準に属する @x@ 値へ集約関数 @fun@+-- (R4DS の既定は @median@) を適用し、 その値の__昇順__に水準を並べ替える。+-- @x@ 中の @NaN@ は NA とみなし集約前に除去。 値が無い水準は末尾。+-- [English]: forcats's `fct_reorder(f, x, .fun)`. Applies the aggregation+-- function @fun@ (R4DS's default is @median@) to the @x@ values belonging+-- to each level, then reorders the levels by that value's __ascending__+-- order. @NaN@ in @x@ is treated as NA and removed before aggregation.+-- Levels with no values go last.+fctReorder :: ([Double] -> Double) -> Factor -> [Double] -> Factor+fctReorder fun f xs = applyLevelOrder order f+ where+ n = length (facLevels f)+ grp = groupByCode n (facCodes f) xs+ key i = case filter (not . isNaN) (grp V.! i) of+ [] -> 1 / 0 -- 値なし → +Inf で末尾へ+ vs -> fun vs+ order = sortBy (comparing key) [0 .. n - 1]++-- | [日本語]: forcats `fct_relevel(f, ...)`。 指定した水準を (指定順で) __先頭__へ移し、+-- 残りは元の相対順序を保つ。 存在しない水準名は無視する。+-- [English]: forcats's `fct_relevel(f, ...)`. Moves the given levels+-- (in the given order) to the __front__, keeping the rest in their+-- original relative order. Nonexistent level names are ignored.+fctRelevel :: [Text] -> Factor -> Factor+fctRelevel front f = applyLevelOrder order f+ where+ lvs = facLevels f+ frontIx = mapMaybe (`elemIndex` lvs) front+ rest = [ i | i <- [0 .. length lvs - 1], i `notElem` frontIx ]+ order = frontIx ++ rest++-- | [日本語]: forcats `fct_reorder2(f, x, y)` (既定 @last2@)。 各水準で+-- __最大の @x@ に対応する @y@__ を取り、 その値の__降順__に水準を並べ替える (凡例順を線の+-- 右端の高さに合わせる用途)。 @x@ 同値は後着 (入力順で後ろ) を採用。+-- [English]: forcats's `fct_reorder2(f, x, y)` (default @last2@). Takes,+-- for each level, __the @y@ corresponding to the largest @x@__, and+-- reorders levels by that value's __descending__ order (used to align+-- legend order with the height at the line's right edge). Ties in @x@+-- favor the later-occurring input.+fctReorder2 :: Factor -> [Double] -> [Double] -> Factor+fctReorder2 f xs ys = applyLevelOrder order f+ where+ n = length (facLevels f)+ grp = groupPairs n (facCodes f) xs ys+ key i = case grp V.! i of+ [] -> -1 / 0 -- 値なし → -Inf で降順末尾へ+ ps -> snd (foldl1 (\a b -> if fst b >= fst a then b else a) ps)+ order = sortBy (comparing (Down . key)) [0 .. n - 1]++-- | [日本語]: forcats `fct_infreq(f)`。 出現__頻度の降順__に水準を並べ替える。+-- 同頻度は元の水準順を保つ (安定)。 NA は計数対象外。+-- [English]: forcats's `fct_infreq(f)`. Reorders levels by+-- __descending frequency of occurrence__. Ties keep the original level order (stable);+-- NA is excluded from counting.+fctInfreq :: Factor -> Factor+fctInfreq f = applyLevelOrder order f+ where+ n = length (facLevels f)+ counts = [ M.findWithDefault 0 i cmap | i <- [0 .. n - 1] ] :: [Int]+ cmap = foldl' (\m c -> if c < 0 then m else M.insertWith (+) c 1 m)+ M.empty (VU.toList (facCodes f))+ order = sortBy (comparing (Down . (countArr V.!))) [0 .. n - 1]+ countArr = V.fromList counts++-- | [日本語]: forcats `fct_rev(f)`。 水準を__逆順__にする。+-- [English]: forcats's `fct_rev(f)`. Reverses the order of the levels.+fctRev :: Factor -> Factor+fctRev f = applyLevelOrder (reverse [0 .. length (facLevels f) - 1]) f++-- === 水準操作 (16.5) ========================================================+--+-- 水準**ラベルそのもの**を付け替える/併合する操作。 ラベルを付け替えた結果+-- 同名になった水準は 1 つに畳む ('relabelMerge')。 lump 系は余りを @"Other"@ に+-- まとめ、 forcats と同じく @"Other"@ を**末尾水準**に置く。++-- | [日本語]: 余り水準のまとめ先ラベル (forcats @other_level@ 既定)。+-- [English]: The label that leftover levels are merged into (forcats's+-- default @other_level@).+otherLevel :: Text+otherLevel = "Other"++-- | [日本語]: forcats `fct_recode(f, new = "old", ...)`。 水準ラベルを改名する。+-- 引数は @(新, 旧)@ の対。 複数の旧を同じ新に向ければ__併合__される。+-- 言及されない水準はそのまま。 水準の相対順序は保つ。+-- [English]: forcats's `fct_recode(f, new = "old", ...)`. Renames level+-- labels. Arguments are @(new, old)@ pairs; pointing multiple olds at the+-- same new __merges__ them. Unmentioned levels are left unchanged, and+-- the levels' relative order is preserved.+fctRecode :: [(Text, Text)] -> Factor -> Factor+fctRecode pairs f = relabelMerge newLabels f+ where+ m = M.fromList [ (old, new) | (new, old) <- pairs ]+ newLabels = [ M.findWithDefault lv lv m | lv <- facLevels f ]++-- | [日本語]: forcats `fct_collapse(f, new = c("o1","o2"), ...)`。 複数水準を 1 つへ併合。+-- 引数は @(新, [旧...])@。 言及されない水準はそのまま (@other_level@ は非対応)。+-- [English]: forcats's `fct_collapse(f, new = c("o1","o2"), ...)`. Merges+-- multiple levels into one. Arguments are @(new, [old...])@. Unmentioned+-- levels are left unchanged (@other_level@ is not supported).+fctCollapse :: [(Text, [Text])] -> Factor -> Factor+fctCollapse groups f = relabelMerge newLabels f+ where+ m = M.fromList [ (old, new) | (new, olds) <- groups, old <- olds ]+ newLabels = [ M.findWithDefault lv lv m | lv <- facLevels f ]++-- | [日本語]: forcats `fct_lump_n(f, n)`。 頻度上位 @n@ 水準を残し、 他を @"Other"@ へ。+-- @n@ 負なら頻度__下位__ @|n|@ を残す。 同頻度のタイは両方残す (上位 n 側)。+-- [English]: forcats's `fct_lump_n(f, n)`. Keeps the top-@n@ levels by+-- frequency, lumping the rest into @"Other"@. If @n@ is negative, keeps+-- the bottom @|n|@ by frequency. Ties at the frequency threshold are both+-- kept (on the top-n side).+fctLumpN :: Int -> Factor -> Factor+fctLumpN n f+ | m == 0 = f+ | n == 0 = lumpBy (const True) f+ | n > 0 = lumpBy (\i -> cnts !! i < thrTop) f+ | otherwise = lumpBy (\i -> cnts !! i > thrBot) f+ where+ cnts = levelCounts f+ m = length cnts+ thrTop | n >= m = minimum cnts -- 全水準保持+ | otherwise = sortBy (comparing Down) cnts !! (n - 1)+ k = negate n+ thrBot | k >= m = maximum cnts -- 全水準保持+ | otherwise = sort cnts !! (k - 1)++-- | [日本語]: forcats `fct_lump_min(f, min)`。 出現回数 @< min@ の水準を @"Other"@ へ (strict)。+-- [English]: forcats's `fct_lump_min(f, min)`. Lumps levels with a count+-- @< min@ into @"Other"@ (strict).+fctLumpMin :: Int -> Factor -> Factor+fctLumpMin k f = lumpBy (\i -> cnts !! i < k) f+ where cnts = levelCounts f++-- | [日本語]: forcats `fct_lump_prop(f, prop)`。 出現割合 @< prop@ の水準を @"Other"@ へ。+-- [English]: forcats's `fct_lump_prop(f, prop)`. Lumps levels whose+-- proportion of occurrences is @< prop@ into @"Other"@.+fctLumpProp :: Double -> Factor -> Factor+fctLumpProp p f = lumpBy (\i -> fromIntegral (cnts !! i) < p * fromIntegral total) f+ where+ cnts = levelCounts f+ total = sum cnts++-- | [日本語]: forcats `fct_lump_lowfreq(f)`。 低頻度水準を、 @"Other"@ が__最小水準のまま__で+-- いられる範囲で併合する。 頻度降順に並べ、 ある水準が「それより低頻度な水準の+-- 合計」 を上回った時点で、 以降を @"Other"@ へまとめる (forcats @lump_cutoff@ 同型)。+-- [English]: forcats's `fct_lump_lowfreq(f)`. Merges low-frequency levels+-- to the extent that @"Other"@ can remain __the smallest level__. Levels+-- are ordered by descending frequency, and once a level's count exceeds+-- "the sum of all less-frequent levels", everything from there on is+-- lumped into @"Other"@ (isomorphic to forcats's @lump_cutoff@).+fctLumpLowfreq :: Factor -> Factor+fctLumpLowfreq f+ | m == 0 = f+ | otherwise = lumpBy (\i -> (cnts !! i, i) `elem` lumpedKeys) f+ where+ cnts = levelCounts f+ m = length cnts+ -- (頻度, 水準index) を頻度降順 (タイは index 昇順) に+ descKeys = sortBy (comparing (\(c, i) -> (Down c, i))) (zip cnts [0 ..])+ cut = cutoff (map fst descKeys) -- 保持する個数 (cut..末尾を lump)+ lumpedKeys = drop cut descKeys++-- | [日本語]: forcats @lump_cutoff@: 降順 count 列で、 「自分 > 残り (より低頻度) の合計」 と+-- なる最初の位置 @i@ を見つけ、 @i+1@ (= 0 始まりで @i@ 番目まで保持) を返す。+-- 該当無しなら全保持 (= 長さ)。+-- [English]: forcats's @lump_cutoff@. In a descending-count list, finds+-- the first position @i@ where "this count > the sum of the remaining+-- (less-frequent) counts", and returns @i+1@ (i.e. keep through 0-indexed+-- position @i@). If no such position exists, keeps everything (= the+-- length).+cutoff :: [Int] -> Int+cutoff xs = go 0 (sum xs) xs+ where+ go i _ [] = i+ go i left (c : cs)+ | c > left - c = i + 1+ | otherwise = go (i + 1) (left - c) cs++-- === 内部 helper ============================================================++-- | [日本語]: 水準ラベルを @newLabels@ (旧水準 index 順・長さ = 旧水準数) に付け替え、+-- 同名になった水準を 1 つに畳む。 新水準順は新ラベルの__初出順__。 NA は不変。+-- [English]: Relabels the levels using @newLabels@ (in old-level index+-- order; length = number of old levels), folding levels that become+-- identically named into one. The new level order follows the new+-- labels' __order of first appearance__. NA is unchanged.+relabelMerge :: [Text] -> Factor -> Factor+relabelMerge newLabels f =+ Factor newLevels (VU.map remap (facCodes f)) (facOrdered f)+ where+ newLevels = nubKeepOrder newLabels+ pos = M.fromList (zip newLevels [0 ..])+ o2nVec = V.fromList [ pos M.! lab | lab <- newLabels ]+ remap c | c < 0 || c >= V.length o2nVec = c+ | otherwise = o2nVec V.! c++-- | [日本語]: 指定水準を__末尾__へ移す (存在しなければ不変)。 'applyLevelOrder' を再利用。+-- [English]: Moves the given level to the __end__ (a no-op if it doesn't+-- exist). Reuses 'applyLevelOrder'.+moveLevelToEnd :: Text -> Factor -> Factor+moveLevelToEnd lv f = case elemIndex lv (facLevels f) of+ Nothing -> f+ Just i -> applyLevelOrder ([ j | j <- [0 .. n - 1], j /= i ] ++ [i]) f+ where n = length (facLevels f)++-- | [日本語]: 水準 index で lump 判定し、 余りを 'otherLevel' へ併合 (末尾に置く)。+-- lump 対象が無ければ不変。+-- [English]: Decides lumping by level index, merging the leftovers into+-- 'otherLevel' (placed at the end). A no-op if nothing qualifies for+-- lumping.+lumpBy :: (Int -> Bool) -> Factor -> Factor+lumpBy isLump f+ | not (or lumpFlags) = f+ | otherwise = moveLevelToEnd otherLevel (relabelMerge newLabels f)+ where+ lumpFlags = map isLump [0 .. length (facLevels f) - 1]+ newLabels = [ if isLump i then otherLevel else lv+ | (i, lv) <- zip [0 ..] (facLevels f) ]++-- | [日本語]: 各水準 (定義順) の出現回数。 NA は除外。+-- [English]: The occurrence count of each level, in definition order.+-- NA is excluded.+levelCounts :: Factor -> [Int]+levelCounts f = [ M.findWithDefault 0 i cmap | i <- [0 .. length (facLevels f) - 1] ]+ where+ cmap = foldl' (\m c -> if c < 0 then m else M.insertWith (+) c 1 m)+ M.empty (VU.toList (facCodes f))++-- | [日本語]: @applyLevelOrder order f@ : @order@ は新しい並びを表す__旧 index のリスト__+-- (@order !! p@ = 新位置 @p@ に来る旧水準 index)。 facLevels を並べ替え、+-- facCodes を旧 code → 新 code に再マップする。 NA ('naCode') はそのまま。+-- [English]: @applyLevelOrder order f@: @order@ is+-- __a list of old indices__ representing the new arrangement (@order !! p@ = the old+-- level index that lands at new position @p@). Reorders facLevels and+-- remaps facCodes from old code to new code. NA ('naCode') is left+-- unchanged.+applyLevelOrder :: [Int] -> Factor -> Factor+applyLevelOrder order f = f+ { facLevels = map (lvs V.!) order+ , facCodes = VU.map remap (facCodes f)+ }+ where+ lvs = V.fromList (facLevels f)+ n = length (facLevels f)+ -- 旧 index → 新 index+ o2n = VU.replicate n (-1) VU.// [ (old, new) | (new, old) <- zip [0 ..] order ]+ remap c | c < 0 || c >= n = c+ | otherwise = o2n VU.! c++-- | [日本語]: 水準コードで @x@ 値をグループ化 (長さ n・入力順保持・NA/範囲外は除外)。+-- [English]: Groups @x@ values by level code (length n, preserving input+-- order; NA \/ out-of-range are excluded).+groupByCode :: Int -> VU.Vector Int -> [Double] -> V.Vector [Double]+groupByCode n codes xs =+ V.map reverse $ V.accum (flip (:)) (V.replicate n [])+ [ (c, x) | (c, x) <- zip (VU.toList codes) xs, c >= 0, c < n ]++-- | [日本語]: 水準コードで @(x, y)@ 対をグループ化 (長さ n・入力順保持・NA/範囲外は除外)。+-- [English]: Groups @(x, y)@ pairs by level code (length n, preserving+-- input order; NA \/ out-of-range are excluded).+groupPairs :: Int -> VU.Vector Int -> [Double] -> [Double] -> V.Vector [(Double, Double)]+groupPairs n codes xs ys =+ V.map reverse $ V.accum (flip (:)) (V.replicate n [])+ [ (c, (x, y)) | (c, x, y) <- zip3 (VU.toList codes) xs ys, c >= 0, c < n ]++-- | [日本語]: ソート済 unique (Map のキー集合 = 昇順 unique)。+-- [English]: Sorted unique values (a Map's key set = ascending unique).+sortUnique :: [Text] -> [Text]+sortUnique = M.keys . M.fromList . map (\x -> (x, ()))++-- | [日本語]: 出現順を保った unique。+-- [English]: Unique values that preserve order of appearance.+nubKeepOrder :: [Text] -> [Text]+nubKeepOrder = go M.empty+ where+ go _ [] = []+ go seen (x : xs)+ | x `M.member` seen = go seen xs+ | otherwise = x : go (M.insert x () seen) xs
+ src/Hanalyze/Data/Strings.hs view
@@ -0,0 +1,724 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Hanalyze.Data.Strings+-- Description : stringr 流の Text 純粋操作 (str_* 相当・行/列展開含む)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: stringr 流の文字列操作 (Ch14 "Strings")。+--+-- R4DS Ch14 で扱う `str_*` 関数を __純粋な `Text` 操作__として公開する+-- ('Data.Transform' と同列の `Data/` 純粋抽象)。 DataFrame 行/列展開を伴う+-- `separate_*` は別途 (本モジュール下部・要 DataFrame)。+--+-- === recycling / NA+-- @str_c@ 相当は tidyverse の __recycling 規則__ (長さ 1 か n) に従う。 NA 伝播は+-- 'Maybe' 版 ('strCMaybe') で表す (R の @NA@ は `Nothing`)。+--+-- === locale+-- 'strToUpper' / 'strSort' は __既定 locale__ (Unicode コードポイント順・en 相当)。+-- R4DS §14.6.3 の locale 依存 (Czech の "ch"・Turkish の dotless i 等) は ICU が要るため+-- 本モジュールでは扱わず、 tutorial 側で「概念のみ」 honest に注記する。+--+-- [English]: stringr-style string operations (Ch14 "Strings").+--+-- Exposes the `str_*` functions from R4DS Ch14 as __pure `Text` operations__+-- (a pure `Data/` abstraction alongside 'Data.Transform'). The `separate_*`+-- functions, which expand DataFrame rows/columns, live separately (further+-- down in this module; they require a DataFrame).+--+-- === Recycling \/ NA+-- @str_c@ and friends follow tidyverse's __recycling rule__ (length 1 or n).+-- NA propagation is expressed via the 'Maybe' variant ('strCMaybe') (R's @NA@+-- corresponds to `Nothing`).+--+-- === Locale+-- 'strToUpper' \/ 'strSort' use the __default locale__ (Unicode code point+-- order, roughly equivalent to en). The locale-dependent behavior from R4DS+-- §14.6.3 (e.g. Czech's "ch", Turkish's dotless i) would require ICU, so this+-- module does not handle it; the tutorial honestly notes it as "concept+-- only".+module Hanalyze.Data.Strings+ ( -- * 長さ / 部分取り出し (str_length / str_sub)+ strLength+ , strSub+ -- * 連結 (str_c / str_flatten / str_glue)+ , strC+ , strCMaybe+ , strFlatten+ , strGlue+ -- * 大文字化 / ソート (str_to_upper / str_sort)+ , strToUpper+ , strSort+ -- * 文字比較 / encoding (str_equal / charToRaw・§14.6)+ , strEqual+ , charToRaw+ -- * 行展開 (separate_longer・DataFrame)+ , separateLongerDelim+ , separateLongerPosition+ -- * 列分割 (separate_wider・DataFrame)+ , TooFew (..)+ , TooMany (..)+ , separateWiderDelim+ , separateWiderDelimWith+ , separateWiderPosition+ , separateWiderPositionWith+ -- * 正規表現 (§15 Regular expressions・regex-tdfa)+ , strDetect+ , strDetectWith+ , strCount+ , strSubset+ , strWhich+ , strExtract+ , strExtractAll+ , strMatch+ , strReplace+ , strReplaceAll+ , strRemove+ , strRemoveAll+ , strSplit+ , strLocate+ , strEscape+ , separateWiderRegex+ ) where++import Data.Array (elems)+import Data.List (sort, transpose)+import Data.Maybe (isJust)+import Data.Word (Word8)+import qualified Data.ByteString as BS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Text.Normalize (NormalizationMode (NFC), normalize)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import qualified DataFrame.Internal.Column as DF+import qualified DataFrame.Internal.DataFrame as DF+import qualified DataFrame.Operations.Subset as DF+import qualified DataFrame.Internal.Column as DFC+import qualified DataFrame.Operations.Subset as DFS (rowsAtIndices)+import Text.Regex.TDFA (Regex, CompOption (..), ExecOption (..))+import qualified Text.Regex.TDFA as RE++import Hanalyze.DataIO.Convert (getMaybeTextVec)++-- ===========================================================================+-- 長さ / 部分取り出し+-- ===========================================================================++-- | [日本語]: 文字数 (= stringr @str_length@・@T.length@)。 コードポイント単位。+-- [English]: Character count (= stringr @str_length@ \/ @T.length@); counted+-- in code points.+strLength :: Text -> Int+strLength = T.length++-- | [日本語]: 部分文字列 (= @str_sub(string, start, end)@)。 __1 始まり・両端含む__。+-- 負の index は末尾から (@-1@ = 最終文字)。 範囲外は内側にクリップ。+-- 例: @strSub 1 3 "Apple" == "App"@・@strSub (-3) (-1) "Apple" == "ple"@。+-- [English]: A substring (= @str_sub(string, start, end)@),+-- __1-indexed and inclusive of both ends__. Negative indices count from the end (@-1@ = the+-- last character). Out-of-range indices are clipped inward.+-- Example: @strSub 1 3 "Apple" == "App"@ \/ @strSub (-3) (-1) "Apple" == "ple"@.+strSub :: Int -> Int -> Text -> Text+strSub start end t =+ let n = T.length t+ norm i | i < 0 = n + i + 1 -- -1 → n (1 始まり)+ | otherwise = i+ s = max 1 (norm start)+ e = min n (norm end)+ in if s > e then "" else T.take (e - s + 1) (T.drop (s - 1) t)++-- ===========================================================================+-- 連結+-- ===========================================================================++-- | [日本語]: ベクトル連結 (= @str_c(...)@)。 各列を __recycling 規則__ (長さ 1 か n) で+-- 揃え、 行ごとに連結する。 リテラルは長さ 1 の列 (@["x"]@) として渡す。+-- 例: @strC [["Hello "], names, ["!"]]@。 NA 伝播版は 'strCMaybe'。+-- [English]: Vectorized concatenation (= @str_c(...)@). Aligns each column+-- using the __recycling rule__ (length 1 or n), then concatenates row by+-- row. Pass a literal as a length-1 column (@["x"]@).+-- Example: @strC [["Hello "], names, ["!"]]@. See 'strCMaybe' for the+-- NA-propagating variant.+strC :: [[Text]] -> [Text]+strC [] = []+strC cols = map T.concat (recycleCols cols)++-- | [日本語]: 'strC' の NA 伝播版 (= @str_c@ の R 既定)。 行内に 'Nothing' があれば結果も+-- 'Nothing' (R の @NA@ 伝播)。 リテラルは @[Just "x"]@。+-- [English]: The NA-propagating variant of 'strC' (= R's default @str_c@+-- behavior). If any element of a row is 'Nothing', the result for that row+-- is also 'Nothing' (mirroring R's @NA@ propagation). Pass a literal as+-- @[Just "x"]@.+strCMaybe :: [[Maybe Text]] -> [Maybe Text]+strCMaybe [] = []+strCMaybe cols =+ [ if any (== Nothing) row then Nothing else Just (T.concat [x | Just x <- row])+ | row <- recycleCols cols ]++-- | [日本語]: 文字ベクトル→単一文字列 (= @str_flatten(x, collapse)@)。 @T.intercalate@。+-- 例: @strFlatten ", " ["a","b","c"] == "a, b, c"@。+-- [English]: Collapses a character vector into a single string+-- (= @str_flatten(x, collapse)@); implemented via @T.intercalate@.+-- Example: @strFlatten ", " ["a","b","c"] == "a, b, c"@.+strFlatten :: Text -> [Text] -> Text+strFlatten = T.intercalate++-- | [日本語]: テンプレート補間 (= @str_glue@)。 @"{key}"@ を @env@ の列で置換 (recycling)。+-- 例: @strGlue "Hello {name}!" [("name", names)]@。 未知 key は error。+-- [English]: Template interpolation (= @str_glue@). Substitutes @"{key}"@+-- with the corresponding column from @env@ (with recycling).+-- Example: @strGlue "Hello {name}!" [("name", names)]@. An unknown key+-- raises an error.+strGlue :: Text -> [(Text, [Text])] -> [Text]+strGlue tmpl env =+ let n = maximum (1 : map (length . snd) env)+ segs = parseGlue tmpl+ val key i = case lookup key env of+ Just col+ | length col == 1 -> head col+ | i < length col -> col !! i+ | otherwise -> error "strGlue: 列長が不揃い (recycling 不能)"+ Nothing -> error ("strGlue: 未知の {" ++ T.unpack key ++ "}")+ in [ T.concat [ either id (\k -> val k i) s | s <- segs ] | i <- [0 .. n - 1] ]++-- ===========================================================================+-- 大文字化 / ソート+-- ===========================================================================++-- | [日本語]: 大文字化 (= @str_to_upper@・既定 locale)。 @T.toUpper@。+-- [English]: Converts to upper case (= @str_to_upper@, default locale);+-- implemented via @T.toUpper@.+strToUpper :: Text -> Text+strToUpper = T.toUpper++-- | [日本語]: 昇順ソート (= @str_sort@・既定 locale = Unicode コードポイント順)。+-- [English]: Sorts in ascending order (= @str_sort@, default locale =+-- Unicode code point order).+strSort :: [Text] -> [Text]+strSort = sort++-- ===========================================================================+-- 文字比較 / encoding (§14.6 Non-English Text)+-- ===========================================================================++-- | [日本語]: 見た目が同じ文字の等価判定 (= @str_equal@・§14.6.2)。 アクセント付き文字は+-- 合成済 (@"\xfc"@ = ü) と 基底+結合 (@"u\x308"@) で__符号列が違っても見た目は同じ__。+-- 両者を __NFC 正規化__してから比較するため等価になる+-- (例: @strEqual "\xfc" "u\x308" == True@・素の @==@ では False)。+-- [English]: Equality of visually-identical characters (= @str_equal@,+-- §14.6.2). An accented character can be represented either precomposed+-- (@"\xfc"@ = ü) or as base + combining mark (@"u\x308"@) —+-- __the code sequences differ but they look the same__. Both are compared after+-- __NFC normalization__, so they compare equal+-- (e.g. @strEqual "\xfc" "u\x308" == True@, whereas plain @==@ gives False).+strEqual :: Text -> Text -> Bool+strEqual a b = normalize NFC a == normalize NFC b++-- | [日本語]: 文字列の __UTF-8 バイト列__ (= R @charToRaw@・§14.6.1)。 各バイトを 'Word8' で+-- 返す (R は 16 進表示)。 例: @charToRaw "Hadley" == [0x48,0x61,0x64,0x6c,0x65,0x79]@。+-- [English]: The string's __UTF-8 byte sequence__ (= R's @charToRaw@,+-- §14.6.1). Returns each byte as a 'Word8' (R displays them in hex).+-- Example: @charToRaw "Hadley" == [0x48,0x61,0x64,0x6c,0x65,0x79]@.+charToRaw :: Text -> [Word8]+charToRaw = BS.unpack . TE.encodeUtf8++-- ===========================================================================+-- 行展開 (separate_longer・DataFrame)+-- ===========================================================================+--+-- @separate_longer_*@ は 1 行を **複数行**に展開する (tidyr §14.4.1)。 対象列の+-- 各セルを分割し、 piece 数だけその行を複製 (他列はそのまま複製) して、 対象列を+-- flatten した piece で差し替える。 NA (Nothing) は分割せず 1 行のまま保持。++-- | [日本語]: 区切り文字で行展開 (= @separate_longer_delim(df, col, delim)@)。+-- 例: 列 @x@ の @"a,b,c"@ → 3 行 (@"a"@/@"b"@/@"c"@)、 他列は複製。+-- [English]: Expands rows by a delimiter (= @separate_longer_delim(df, col,+-- delim)@). Example: column @x@'s @"a,b,c"@ becomes 3 rows+-- (@"a"@\/@"b"@\/@"c"@), with the other columns duplicated.+separateLongerDelim :: Text -> Text -> DF.DataFrame -> DF.DataFrame+separateLongerDelim col delim =+ separateLongerWith col $ \mv -> case mv of+ Nothing -> [Nothing]+ Just t -> map Just (T.splitOn delim t)++-- | [日本語]: 固定幅で行展開 (= @separate_longer_position(df, col, width)@)。+-- 各セルを先頭から @width@ 文字ずつの塊に分割して行展開する。+-- 例: @width=1@ で @"131"@ → 3 行 (@"1"@/@"3"@/@"1"@)。+-- [English]: Expands rows by a fixed width (= @separate_longer_position(df,+-- col, width)@). Splits each cell into chunks of @width@ characters from+-- the start. Example: with @width=1@, @"131"@ becomes 3 rows+-- (@"1"@\/@"3"@\/@"1"@).+separateLongerPosition :: Text -> Int -> DF.DataFrame -> DF.DataFrame+separateLongerPosition col width+ | width <= 0 = error "separateLongerPosition: width は正でなければならない"+ | otherwise =+ separateLongerWith col $ \mv -> case mv of+ Nothing -> [Nothing]+ Just t | T.null t -> [Just ""] -- 空セルは 1 空行を保持+ | otherwise -> map Just (T.chunksOf width t)++-- | [日本語]: 行展開の核: 対象列を Text 読みし、 各行を @split@ で pieces 化。 piece 数で+-- 全列を @rowsAtIndices@ 複製し、 対象列を flatten した piece に差し替える。+-- [English]: The core of row expansion: reads the target column as Text+-- and splits each row into pieces via @split@. Duplicates all columns via+-- @rowsAtIndices@ according to the piece count, then replaces the target+-- column with the flattened pieces.+separateLongerWith+ :: Text -> (Maybe Text -> [Maybe Text]) -> DF.DataFrame -> DF.DataFrame+separateLongerWith col split df =+ case getMaybeTextVec col df of+ Nothing -> error ("separateLonger: 列 " ++ T.unpack col+ ++ " が見つからない、 または Text 列でない")+ Just vec ->+ let piecesPerRow = map split (V.toList vec) -- [[Maybe Text]]+ idxs = concat [ replicate (length ps) i+ | (i, ps) <- zip [0 ..] piecesPerRow ]+ flat = concat piecesPerRow+ expanded = DFS.rowsAtIndices (VU.fromList idxs) df+ in DF.insertColumn col (buildTextCol flat) expanded++-- | [日本語]: @[Maybe Text]@ → Column。 全要素 Just なら素の Text 列、 NA 混在なら Maybe 列。+-- [English]: @[Maybe Text]@ → Column. A plain Text column if all elements+-- are Just; a Maybe column if any NA is present.+buildTextCol :: [Maybe Text] -> DFC.Column+buildTextCol xs+ | all isJust xs = DF.fromList [ t | Just t <- xs ]+ | otherwise = DF.fromList xs++-- ===========================================================================+-- 列分割 (separate_wider・DataFrame)+-- ===========================================================================+--+-- @separate_wider_*@ は 1 セルを **複数列**に分割する (tidyr §14.4.2・行数不変)。+-- piece 数と新列名の数が合わないときの方針を 'TooFew' / 'TooMany' で指定する+-- (§14.4.3 の @too_few@ / @too_many@)。++-- | [日本語]: piece が __足りない__ときの方針 (= @too_few@)。+-- [English]: Policy for when there are __too few__ pieces (= @too_few@).+data TooFew+ = AlignStart -- ^ [日本語]: 不足分を右側に NA で埋める (= @"align_start"@)。 [English]: Pads the shortfall with NA on the right (= @"align_start"@).+ | AlignEnd -- ^ [日本語]: 不足分を左側に NA で埋める (= @"align_end"@)。 [English]: Pads the shortfall with NA on the left (= @"align_end"@).+ | TooFewError -- ^ [日本語]: 不足があれば error (= @"error"@・既定)。 [English]: Errors if there is a shortfall (= @"error"@, the default).+ | TooFewDebug -- ^ [日本語]: align_start で埋めつつ診断列を付与 (= @"debug"@)。 [English]: Pads like align_start while adding diagnostic columns (= @"debug"@).+ deriving (Eq, Show)++-- | [日本語]: piece が __多すぎる__ときの方針 (= @too_many@)。+-- [English]: Policy for when there are __too many__ pieces (= @too_many@).+data TooMany+ = DropExtra -- ^ [日本語]: 余剰 piece を捨てる (= @"drop"@)。 [English]: Drops the extra pieces (= @"drop"@).+ | MergeExtra -- ^ [日本語]: 余剰を最終列に区切り文字で再結合 (= @"merge"@)。 [English]: Rejoins the extras into the final column using the delimiter (= @"merge"@).+ | TooManyError -- ^ [日本語]: 余剰があれば error (= @"error"@・既定)。 [English]: Errors if there is a surplus (= @"error"@, the default).+ | TooManyDebug -- ^ [日本語]: drop で埋めつつ診断列 (余剰を remainder) を付与 (= @"debug"@)。 [English]: Behaves like drop while adding a diagnostic column holding the surplus as a remainder (= @"debug"@).+ deriving (Eq, Show)++-- | [日本語]: 区切り文字で列分割 (= @separate_wider_delim(df, col, delim, names)@・厳密)。+-- piece 数と @names@ 数が不一致なら error。 @names@ の 'Nothing' はその piece を+-- 捨てる (= R の @NA@・§14.4.2)。+-- [English]: Splits a column by a delimiter (= @separate_wider_delim(df,+-- col, delim, names)@; strict). Errors if the piece count doesn't match+-- the number of @names@. A 'Nothing' in @names@ drops that piece+-- (= R's @NA@, §14.4.2).+separateWiderDelim+ :: Text -> Text -> [Maybe Text] -> DF.DataFrame -> DF.DataFrame+separateWiderDelim col delim names =+ separateWiderDelimWith col delim names TooFewError TooManyError++-- | [日本語]: 'separateWiderDelim' の方針指定版 (§14.4.3 の @too_few@ / @too_many@)。+-- [English]: The policy-configurable variant of 'separateWiderDelim'+-- (the @too_few@ \/ @too_many@ of §14.4.3).+separateWiderDelimWith+ :: Text -> Text -> [Maybe Text] -> TooFew -> TooMany -> DF.DataFrame -> DF.DataFrame+separateWiderDelimWith col delim names tf tm =+ separateWiderImpl col names tf tm (T.splitOn delim) (T.intercalate delim)++-- | [日本語]: 固定幅で列分割 (= @separate_wider_position(df, col, widths)@・厳密)。+-- @widths@ = @[(列名, 文字数)]@。 文字列長が総幅と一致しなければ error。+-- [English]: Splits a column by fixed widths (= @separate_wider_position(df,+-- col, widths)@; strict). @widths@ is @[(column name, character count)]@.+-- Errors if the string length doesn't match the total width.+separateWiderPosition+ :: Text -> [(Text, Int)] -> DF.DataFrame -> DF.DataFrame+separateWiderPosition col widths =+ separateWiderPositionWith col widths TooFewError TooManyError++-- | [日本語]: 'separateWiderPosition' の方針指定版。 文字列が総幅より短ければ @too_few@、+-- 長ければ余り (remainder) を @too_many@ で処理する。+-- [English]: The policy-configurable variant of 'separateWiderPosition'.+-- If the string is shorter than the total width, @too_few@ applies; if+-- longer, the remainder is handled via @too_many@.+separateWiderPositionWith+ :: Text -> [(Text, Int)] -> TooFew -> TooMany -> DF.DataFrame -> DF.DataFrame+separateWiderPositionWith col widths tf tm df =+ let names = map (Just . fst) widths+ -- 幅順に切り出す。 文字列が尽きたら打ち切り (→ piece 不足 = too_few)。+ -- 総幅を超える余りは最後に「余剰 piece」として 1 個付ける (→ too_many)。+ chop t =+ let go [] rest = ([], rest)+ go (w : ws) rest+ | T.null rest = ([], rest)+ | otherwise = let (h, r) = T.splitAt w rest+ (hs, r') = go ws r+ in (h : hs, r')+ (pieces, remainder) = go (map snd widths) t+ in if T.null remainder then pieces else pieces ++ [remainder]+ in separateWiderImpl col names tf tm chop T.concat df++-- | [日本語]: 列分割の核実装。 @split@ で各セルを piece 化し、 'TooFew' / 'TooMany' で+-- ちょうど @length names@ スロットに整える。 'TooFewDebug' / 'TooManyDebug' の+-- とき診断列 @{col}_ok@ / @{col}_pieces@ / @{col}_remainder@ を付ける。+-- [English]: The core implementation of column splitting. Splits each cell+-- into pieces via @split@, then reconciles them to exactly @length names@+-- slots using 'TooFew' \/ 'TooMany'. When 'TooFewDebug' \/ 'TooManyDebug'+-- is set, adds diagnostic columns @{col}_ok@ \/ @{col}_pieces@ \/+-- @{col}_remainder@.+separateWiderImpl+ :: Text -> [Maybe Text] -> TooFew -> TooMany+ -> (Text -> [Text]) -> ([Text] -> Text)+ -> DF.DataFrame -> DF.DataFrame+separateWiderImpl col names tf tm split rejoin df =+ case getMaybeTextVec col df of+ Nothing -> error ("separateWider: 列 " ++ T.unpack col+ ++ " が見つからない、 または Text 列でない")+ Just vec ->+ let cells = V.toList vec+ rows = map (resolveRow . fmap split) cells+ -- スロット行列を列向きに転置 (各新列 = 全行のその位置)。+ slotCols = transpose [ s | (s, _, _) <- rows ] -- [[Maybe Text]] (列×行)+ oks = [ ok | (_, ok, _) <- rows ]+ rems = [ r | (_, _, r) <- rows ]+ pieceCnt = map (maybe 0 (length . split)) cells+ debug = tf == TooFewDebug || tm == TooManyDebug+ -- names と slotCols を突き合わせ、 Just name の列だけ採用。+ namedCols = [ (nm, buildTextCol scol)+ | (Just nm, scol) <- zip names slotCols ]+ diagCols = [ (col <> "_ok", DF.fromList oks)+ , (col <> "_pieces", DF.fromList pieceCnt)+ , (col <> "_remainder", DF.fromList rems) ]+ base = DF.exclude [col] df+ insertAll = foldl (\d (nm, c) -> DF.insertColumn nm c d)+ withNamed = insertAll base namedCols+ in if debug then insertAll withNamed diagCols else withNamed+ where+ n0 = length names+ -- 1 行を (スロット [Maybe Text]・ok・remainder) に解決。+ -- remainder は診断列用で、 余剰なし行は "" (R の @{col}_remainder@ 準拠)。+ resolveRow :: Maybe [Text] -> ([Maybe Text], Bool, Text)+ resolveRow Nothing = (replicate n0 Nothing, True, "") -- NA 入力は全 NA+ resolveRow (Just pieces) =+ let k = length pieces+ in if k == n0+ then (map Just pieces, True, "")+ else if k < n0+ then case tf of+ TooFewError -> error ("separateWider: piece が不足 (" ++ show k+ ++ " < " ++ show n0 ++ ") col=" ++ T.unpack col)+ AlignEnd -> (replicate (n0 - k) Nothing ++ map Just pieces, False, "")+ _ -> (map Just pieces ++ replicate (n0 - k) Nothing, False, "")+ -- AlignStart / TooFewDebug+ else case tm of -- k > n0+ TooManyError -> error ("separateWider: piece が過多 (" ++ show k+ ++ " > " ++ show n0 ++ ") col=" ++ T.unpack col)+ MergeExtra ->+ let (keep, extra) = splitAt (n0 - 1) pieces+ in (map Just keep ++ [Just (rejoin extra)], False, "")+ _ -> -- DropExtra / TooManyDebug+ let (keep, extra) = splitAt n0 pieces+ in (map Just keep, False, rejoin extra)++-- ===========================================================================+-- 内部+-- ===========================================================================++-- | [日本語]: 列群を recycling 規則 (長さ 1 か n) で n 行に揃え、 行ごとの列リストに転置。+-- [English]: Aligns a set of columns to n rows via the recycling rule+-- (length 1 or n), then transposes into a per-row list of columns.+recycleCols :: [[a]] -> [[a]]+recycleCols cols =+ let n = maximum (map length cols)+ recy c+ | length c == n = c+ | length c == 1 = replicate n (head c)+ | otherwise = error "str_c/glue: 列長は 1 か n でなければならない (recycling)"+ in if n == 0 then [] else transpose (map recy cols)++-- | [日本語]: @"a {x} b {y}"@ → @[Left "a ", Right "x", Left " b ", Right "y"]@。+-- @{{@ / @}}@ はリテラルの @{@ / @}@ にエスケープ (glue 同様)。+-- [English]: @"a {x} b {y}"@ → @[Left "a ", Right "x", Left " b ", Right "y"]@.+-- @{{@ \/ @}}@ escape to literal @{@ \/ @}@ (same as glue).+parseGlue :: Text -> [Either Text Text]+parseGlue = go+ where+ go t+ | T.null t = []+ | otherwise =+ let (lit, rest) = T.break (== '{') t+ in case T.uncons rest of+ Nothing -> prependLit lit []+ Just ('{', r1)+ | Just ('{', r2) <- T.uncons r1 -> -- "{{" → リテラル '{'+ prependLit (lit <> "{") (go r2)+ | otherwise ->+ let (key, r2) = T.break (== '}') r1+ in case T.uncons r2 of+ Just ('}', r3) ->+ prependLit lit (Right (T.strip key) : go r3)+ _ -> error "strGlue: 閉じない { がある"+ _ -> [Left lit]++ -- リテラル segment では @}}@ を @}@ に畳む (glue の閉じ波括弧エスケープ。+ -- @{{@ → @{@ は break 側で処理済み)。+ prependLit l0 xs = let l = T.replace "}}" "}" l0 in [Left l | not (T.null l)] ++ xs++-- ===========================================================================+-- 正規表現 (§15 Regular expressions・regex-tdfa POSIX ERE)+-- ===========================================================================+--+-- regex-tdfa は **POSIX ERE** ゆえ PCRE ショートハンド @\\d@ @\\s@ @\\w@ を解さない+-- (実測 2026-06-19)。 本モジュールは R(stringr) 流のパターンをそのまま使えるよう、+-- @\\d \\D \\s \\S \\w \\W@ を 'translateShorthand' で **POSIX クラスに変換**してから+-- tdfa に渡す。 単語境界 @\\b@ は tdfa が直接対応。 ★後方参照 @\\1@ は POSIX に無く+-- **非対応** (tutorial 側で「概念のみ」 honest 注記)。+--+-- 引数順は **pattern 先・string 後** (stringr は string 先だが、 Haskell では+-- @map (strDetect pat) xs@ / @filter (strDetect pat) xs@ と部分適用しやすいため)。++-- | [日本語]: PCRE ショートハンド (@\\d \\D \\s \\S \\w \\W@) を POSIX クラスに変換する。+-- 文字クラス @[...]@ の内外で展開形が違う (外: @[[:digit:]]@・内: @[:digit:]@)。+-- @\\\\@ (literal backslash) や他のエスケープ (@\\.@ @\\b@ @\\1@ 等) はそのまま通す。+-- [English]: Translates PCRE shorthands (@\\d \\D \\s \\S \\w \\W@) into+-- POSIX classes. The expansion differs inside vs. outside a character+-- class @[...]@ (outside: @[[:digit:]]@; inside: @[:digit:]@). A literal+-- backslash (@\\\\@) and other escapes (@\\.@ @\\b@ @\\1@ etc.) pass+-- through unchanged.+translateShorthand :: Text -> Text+translateShorthand = T.pack . go False . T.unpack+ where+ go _ [] = []+ go inCls ('\\':c:rest)+ | Just body <- lookup c shorthands = wrap inCls body ++ go inCls rest+ | otherwise = '\\' : c : go inCls rest -- \. \\ \b \1 等はそのまま+ go _ ('[':rest) = '[' : go True rest+ go _ (']':rest) = ']' : go False rest+ go inCls (c:rest) = c : go inCls rest++ shorthands =+ [ ('d', "[:digit:]"), ('D', "^[:digit:]")+ , ('s', "[:space:]"), ('S', "^[:space:]")+ , ('w', "[:alnum:]_"), ('W', "^[:alnum:]_") ]+ -- クラス外は @[ ... ]@ で囲む (否定 ^... はクラス否定 [^...] に)。 クラス内は+ -- 中身だけ ([:digit:] 等)。 クラス内の否定 (\D 等) は POSIX で表現不能ゆえ近似 (caret 落とし)。+ wrap True body = stripCaret body+ wrap False ('^':body) = "[^" ++ body ++ "]"+ wrap False body = "[" ++ body ++ "]"+ stripCaret ('^':b) = b+ stripCaret b = b++-- | [日本語]: パターン (ショートハンド変換済) を tdfa 'Regex' に compile。+-- @ci@ = ignore_case (§15.5 の @regex(ignore_case = TRUE)@)。+-- @^@ @$@ は __文字列全体__の先頭/末尾 (R 既定・single line = multiline False)。+-- [English]: Compiles a pattern (after shorthand translation) into a tdfa+-- 'Regex'. @ci@ is ignore_case (§15.5's @regex(ignore_case = TRUE)@).+-- @^@ \/ @$@ anchor to the start\/end of the __whole string__ (R's+-- default, single line = multiline False).+mkRegex :: Bool -> Text -> Regex+mkRegex ci pat =+ RE.makeRegexOpts comp RE.defaultExecOpt (T.unpack (translateShorthand pat))+ where+ comp = RE.defaultCompOpt { caseSensitive = not ci, multiline = False }++-- | [日本語]: マッチ配列 (whole + groups) を @[(text, offset, len)]@ に。 offset<0 = 不参加グループ。+-- [English]: Converts a match array (whole + groups) into+-- @[(text, offset, len)]@. offset < 0 means the group didn't participate.+matchElems :: RE.MatchText String -> [(String, Int, Int)]+matchElems arr = [ (g, o, l) | (g, (o, l)) <- elems arr ]++-- | [日本語]: パターンにマッチするか (= @str_detect(string, pattern)@・§15.3.1)。+-- [English]: Whether the pattern matches (= @str_detect(string, pattern)@,+-- §15.3.1).+strDetect :: Text -> Text -> Bool+strDetect = strDetectWith False++-- | [日本語]: 'strDetect' の ignore_case 指定版 (§15.5)。 @strDetectWith True pat s@ で大小無視。+-- [English]: The ignore_case variant of 'strDetect' (§15.5).+-- @strDetectWith True pat s@ ignores case.+strDetectWith :: Bool -> Text -> Text -> Bool+strDetectWith ci pat s = RE.matchTest (mkRegex ci pat) (T.unpack s)++-- | [日本語]: マッチ回数 (= @str_count(string, pattern)@・§15.3.2)。+-- [English]: The number of matches (= @str_count(string, pattern)@,+-- §15.3.2).+strCount :: Text -> Text -> Int+strCount pat s = RE.matchCount (mkRegex False pat) (T.unpack s)++-- | [日本語]: マッチした要素だけ残す (= @str_subset(x, pattern)@)。+-- [English]: Keeps only the elements that match (= @str_subset(x,+-- pattern)@).+strSubset :: Text -> [Text] -> [Text]+strSubset pat = filter (strDetect pat)++-- | [日本語]: マッチした要素の位置 (= @str_which@・__1 始まり__)。+-- [English]: The positions of matching elements (= @str_which@,+-- __1-indexed__).+strWhich :: Text -> [Text] -> [Int]+strWhich pat xs = [ i | (i, x) <- zip [1 ..] xs, strDetect pat x ]++-- | [日本語]: 最初のマッチを取り出す (= @str_extract(string, pattern)@)。 無マッチは 'Nothing'。+-- [English]: Extracts the first match (= @str_extract(string, pattern)@).+-- Returns 'Nothing' if there is no match.+strExtract :: Text -> Text -> Maybe Text+strExtract pat s =+ case RE.matchOnceText (mkRegex False pat) (T.unpack s) of+ Just (_, arr, _) | ((m, _, _) : _) <- matchElems arr -> Just (T.pack m)+ _ -> Nothing++-- | [日本語]: すべてのマッチを取り出す (= @str_extract_all@)。+-- [English]: Extracts all matches (= @str_extract_all@).+strExtractAll :: Text -> Text -> [Text]+strExtractAll pat s =+ [ T.pack m+ | arr <- RE.matchAllText (mkRegex False pat) (T.unpack s)+ , ((m, _, _) : _) <- [matchElems arr] ]++-- | [日本語]: 最初のマッチの __whole + capture groups__ (= @str_match@)。 不参加グループ = 'Nothing'。+-- 先頭が whole match、 以降が @()@ グループ。 無マッチは @[]@。+-- [English]: The __whole match + capture groups__ of the first match+-- (= @str_match@); a non-participating group is 'Nothing'. The first+-- element is the whole match, followed by the @()@ groups. No match+-- yields @[]@.+strMatch :: Text -> Text -> [Maybe Text]+strMatch pat s =+ case RE.matchOnceText (mkRegex False pat) (T.unpack s) of+ Just (_, arr, _) -> [ if o < 0 then Nothing else Just (T.pack g)+ | (g, o, _) <- matchElems arr ]+ Nothing -> []++-- | [日本語]: 最初のマッチを置換 (= @str_replace(string, pattern, replacement)@・§15.3.3)。+-- replacement 内の @\\1@..@\\9@ は capture group 参照、 @\\\\@ はリテラル @\\@。+-- [English]: Replaces the first match (= @str_replace(string, pattern,+-- replacement)@, §15.3.3). Within the replacement, @\\1@..@\\9@ refer to+-- capture groups and @\\\\@ is a literal @\\@.+strReplace :: Text -> Text -> Text -> Text+strReplace = replaceImpl False++-- | [日本語]: すべてのマッチを置換 (= @str_replace_all@)。+-- [English]: Replaces all matches (= @str_replace_all@).+strReplaceAll :: Text -> Text -> Text -> Text+strReplaceAll = replaceImpl True++replaceImpl :: Bool -> Text -> Text -> Text -> Text+replaceImpl global pat rep s =+ let rx = mkRegex False pat+ str = T.unpack s+ ms = (if global then id else take 1) (RE.matchAllText rx str)+ repl = T.unpack rep+ go cur [] = drop cur str+ go cur (arr : rest) =+ case matchElems arr of+ gs@((_, o, l) : _) ->+ take (o - cur) (drop cur str) ++ expandRep repl gs ++ go (o + l) rest+ [] -> go cur rest+ in T.pack (go 0 ms)++-- | [日本語]: replacement の @\\n@ を group n に展開 (@\\0@=whole・@\\\\@=リテラル @\\@)。+-- [English]: Expands @\\n@ in the replacement to group n (@\\0@ = whole+-- match, @\\\\@ = a literal @\\@).+expandRep :: String -> [(String, Int, Int)] -> String+expandRep r groups = ex r+ where+ ex [] = []+ ex ('\\' : d : rest)+ | d >= '0' && d <= '9' = grp (fromEnum d - fromEnum '0') ++ ex rest+ | d == '\\' = '\\' : ex rest+ | otherwise = d : ex rest+ ex (c : rest) = c : ex rest+ grp i = case drop i groups of+ ((g, o, _) : _) | o >= 0 -> g+ _ -> ""++-- | [日本語]: 最初のマッチを削除 (= @str_remove@ = @str_replace(., pattern, "")@)。+-- [English]: Removes the first match (= @str_remove@ =+-- @str_replace(., pattern, "")@).+strRemove :: Text -> Text -> Text+strRemove pat = strReplace pat ""++-- | [日本語]: すべてのマッチを削除 (= @str_remove_all@)。+-- [English]: Removes all matches (= @str_remove_all@).+strRemoveAll :: Text -> Text -> Text+strRemoveAll pat = strReplaceAll pat ""++-- | [日本語]: パターンで分割 (= @str_split(string, pattern)@)。 マッチ部分を区切りとして除く。+-- [English]: Splits by a pattern (= @str_split(string, pattern)@); the+-- matched portions are removed as delimiters.+strSplit :: Text -> Text -> [Text]+strSplit pat s =+ let rx = mkRegex False pat+ str = T.unpack s+ ms = RE.matchAllText rx str+ go cur [] = [drop cur str]+ go cur (arr : rest) =+ case matchElems arr of+ ((_, o, l) : _) -> take (o - cur) (drop cur str) : go (o + l) rest+ [] -> go cur rest+ in map T.pack (go 0 ms)++-- | [日本語]: 最初のマッチの位置 @(start, end)@ (= @str_locate@・__1 始まり・両端含む__)。 無マッチ = 'Nothing'。+-- [English]: The position @(start, end)@ of the first match (=+-- @str_locate@, __1-indexed and inclusive of both ends__). No match+-- yields 'Nothing'.+strLocate :: Text -> Text -> Maybe (Int, Int)+strLocate pat s =+ case RE.matchOnceText (mkRegex False pat) (T.unpack s) of+ Just (_, arr, _) | ((_, o, l) : _) <- matchElems arr, o >= 0 -> Just (o + 1, o + l)+ _ -> Nothing++-- | [日本語]: 正規表現メタ文字をエスケープ (= @str_escape@・§15.6・リテラル文字列からパターンを作る用)。+-- [English]: Escapes regex metacharacters (= @str_escape@, §15.6; for+-- building a pattern from a literal string).+strEscape :: Text -> Text+strEscape = T.concatMap esc+ where+ esc c | c `elem` metas = T.pack ['\\', c]+ | otherwise = T.singleton c+ metas = ".^$|()[]{}*+?\\" :: String++-- | [日本語]: 名前付きグループで列に分割 (= @separate_wider_regex(df, col, patterns)@・§15.3.4)。+-- @specs@ = @[(Just 列名 | Nothing, 部分パターン)]@。 各部分パターンを順に capture group 化し、+-- セルを文字列全体マッチ (@^...$@) して各 group を対応列へ。 'Nothing' の group は捨てる+-- (= R の名無し)。 各部分パターンは __内部に capturing group を持たない前提__+-- (持つと group index がずれる・R4DS の例は単純パターンのみ)。+-- [English]: Splits into columns using named groups (=+-- @separate_wider_regex(df, col, patterns)@, §15.3.4). @specs@ is+-- @[(Just column name | Nothing, sub-pattern)]@. Each sub-pattern is+-- turned into a capture group in order, the cell is matched against the+-- whole string (@^...$@), and each group is assigned to its column. A+-- 'Nothing' group is dropped (= R's unnamed). Each sub-pattern is assumed+-- __not to contain a capturing group of its own__ (doing so would shift+-- the group indices; the R4DS examples use only simple patterns).+separateWiderRegex :: Text -> [(Maybe Text, Text)] -> DF.DataFrame -> DF.DataFrame+separateWiderRegex col specs df =+ case getMaybeTextVec col df of+ Nothing -> error ("separateWiderRegex: 列 " ++ T.unpack col+ ++ " が見つからない、 または Text 列でない")+ Just vec ->+ let pat = "^" <> T.concat [ "(" <> p <> ")" | (_, p) <- specs ] <> "$"+ rx = mkRegex False pat+ names = map fst specs+ nslot = length specs+ rowGroups mv = case mv of+ Nothing -> replicate nslot Nothing+ Just t -> case RE.matchOnceText rx (T.unpack t) of+ Just (_, arr, _) ->+ let grps = drop 1 (matchElems arr) -- whole match を除く+ in take nslot+ ([ if o < 0 then Nothing else Just (T.pack g) | (g, o, _) <- grps ]+ ++ repeat Nothing)+ Nothing -> error ("separateWiderRegex: パターン不一致 col=" ++ T.unpack col+ ++ " value=" ++ show t)+ rows = map rowGroups (V.toList vec)+ slotCols = transpose rows+ named = [ (nm, buildTextCol scol) | (Just nm, scol) <- zip names slotCols ]+ base = DF.exclude [col] df+ in foldl (\d (nm, c) -> DF.insertColumn nm c d) base named
+ src/Hanalyze/Data/Transform.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Hanalyze.Data.Transform+-- Description : dplyr 流の順位・オフセット・累積・区間化を純粋な [a] -> [b] として提供+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: dplyr 流の順序付き/窓関数的なベクトル変換。+--+-- R4DS Ch13 "Numbers" で扱う順位・オフセット・累積・区間化・連続識別子を、+-- __純粋な `[a] -> [b]`__ として公開する。 統計 ('Stat.Descriptive') でも IO/DataFrame+-- (@DataIO@) でもなく、 純粋データ抽象の `Data/` 名前空間に置く (@Data.ColumnSource@+-- の隣)。 DataFrame 直結解析 API の @mutate@ もこれを呼ぶ。+--+-- === NA+-- 順位関数は NA を含むベクトル用に @*NA@ 変種 (@[Maybe a] -> [Maybe b]@・dplyr の+-- @na.last="keep"@ と同じく Nothing は Nothing を保ち、 残りを順位付け) を併設する。+--+-- === desc+-- 降順順位は別関数を設けず 'Data.Ord.Down' を被せる (@minRank (map Down xs)@・+-- NA 付きは @minRankNA (map (fmap Down) xs)@)。+--+-- [English]: dplyr-style ordered\/window-function-like vector+-- transformations.+--+-- Exposes the ranking, offset, cumulative, binning, and consecutive-id+-- operations from R4DS Ch13 "Numbers" as __pure `[a] -> [b]` functions__.+-- Rather than statistics ('Stat.Descriptive') or IO\/DataFrame (@DataIO@),+-- this lives in the pure data abstraction `Data/` namespace (alongside+-- @Data.ColumnSource@). The DataFrame-integrated analysis API's @mutate@+-- also calls into this module.+--+-- === NA+-- The ranking functions have @*NA@ variants for vectors containing NA+-- (@[Maybe a] -> [Maybe b]@; like dplyr's @na.last="keep"@, Nothing stays+-- Nothing while the rest are ranked).+--+-- === desc+-- Descending rank has no separate function; instead, wrap with+-- 'Data.Ord.Down' (@minRank (map Down xs)@; with NA,+-- @minRankNA (map (fmap Down) xs)@).+module Hanalyze.Data.Transform+ ( -- * 順位 (dplyr ranking)+ minRank, denseRank, rowNumber+ , percentRank, cumeDist+ -- * 順位 (NA 保持変種)+ , minRankNA, denseRankNA, rowNumberNA+ , percentRankNA, cumeDistNA+ -- * オフセット+ , lag, lead+ -- * 累積+ , cumsum, cumprod, cummin, cummax, cummean+ -- * 区間化+ , cut, cutLabels+ -- * 連続識別子+ , consecutiveId+ ) where++import Data.List (sortOn)+import qualified Data.Map.Strict as M+import qualified Data.Set as S++-- ===========================================================================+-- 順位+-- ===========================================================================++-- | [日本語]: 最小順位法 (dplyr @min_rank@・tie は最小を共有し次を飛ばす: 1,2,2,4)。+-- 各値の順位 = 1 + (厳密に小さい要素数)。+-- [English]: Minimum-rank method (dplyr's @min_rank@; ties share the+-- smallest rank and the next rank is skipped: 1,2,2,4). Each value's rank+-- = 1 + (the number of strictly smaller elements).+minRank :: Ord a => [a] -> [Int]+minRank xs = map ((rm M.!) ) xs+ where+ sorted = sortOn id xs+ -- 値 → 最初の出現 index (= 厳密に小さい要素数)。1 始まりにして格納。+ rm = M.fromListWith min [ (v, i + 1) | (i, v) <- zip [0 ..] sorted ]++-- | [日本語]: 密順位法 (dplyr @dense_rank@・tie で番号を飛ばさない: 1,2,2,3)。+-- 各値の順位 = その値以下の __相異なる値の個数__。+-- [English]: Dense-rank method (dplyr's @dense_rank@; ties don't skip a+-- number: 1,2,2,3). Each value's rank = __the count of distinct values__+-- less than or equal to it.+denseRank :: Ord a => [a] -> [Int]+denseRank xs = map (dm M.!) xs+ where+ distinct = S.toAscList (S.fromList xs)+ dm = M.fromList (zip distinct [1 :: Int ..])++-- | [日本語]: 行番号 (dplyr @row_number@・tie も出現順で一意: 1,2,3,4)。+-- [English]: Row number (dplyr's @row_number@; even ties get a unique+-- value based on order of appearance: 1,2,3,4).+rowNumber :: Ord a => [a] -> [Int]+rowNumber xs = map (rm M.!) [0 .. n - 1]+ where+ n = length xs+ order = map fst (sortOn snd (zip [0 :: Int ..] xs)) -- (origIdx, value) を value, origIdx 昇順+ rm = M.fromList (zip order [1 :: Int ..])++-- | [日本語]: パーセント順位 (dplyr @percent_rank@ = (minRank - 1)/(n - 1))。+-- [English]: Percent rank (dplyr's @percent_rank@ = (minRank - 1)/(n - 1)).+percentRank :: Ord a => [a] -> [Double]+percentRank xs+ | n <= 1 = map (const 0) xs+ | otherwise = [ fromIntegral (r - 1) / fromIntegral (n - 1) | r <- minRank xs ]+ where n = length xs++-- | [日本語]: 累積分布 (dplyr @cume_dist@ = (≤x の個数)/n)。+-- [English]: Cumulative distribution (dplyr's @cume_dist@ = (count ≤ x)/n).+cumeDist :: Ord a => [a] -> [Double]+cumeDist xs = map (\x -> fromIntegral (cm M.! x) / fromIntegral n) xs+ where+ n = length xs+ sorted = sortOn id xs+ -- 値 → その値の最後の出現 index + 1 (= ≤ その値の個数)。+ cm = M.fromListWith max [ (v, i + 1) | (i, v) <- zip [0 ..] sorted ]++-- --- NA 保持変種 -----------------------------------------------------------++-- | [日本語]: 非 NA だけを @f@ で順位付けし、 NA (Nothing) は Nothing のまま位置を保つ。+-- [English]: Ranks only the non-NA values via @f@, keeping NA (Nothing)+-- as Nothing in place.+onJusts :: forall a b. ([a] -> [b]) -> [Maybe a] -> [Maybe b]+onJusts f xs =+ let idxVals = [ (i, a) | (i, Just a) <- zip [0 ..] xs ]+ ranked = f (map snd idxVals)+ m = M.fromList (zip (map fst idxVals) ranked)+ in [ M.lookup i m | i <- [0 .. length xs - 1] ]++minRankNA :: Ord a => [Maybe a] -> [Maybe Int]+minRankNA = onJusts minRank+denseRankNA :: Ord a => [Maybe a] -> [Maybe Int]+denseRankNA = onJusts denseRank+rowNumberNA :: Ord a => [Maybe a] -> [Maybe Int]+rowNumberNA = onJusts rowNumber+percentRankNA :: Ord a => [Maybe a] -> [Maybe Double]+percentRankNA = onJusts percentRank+cumeDistNA :: Ord a => [Maybe a] -> [Maybe Double]+cumeDistNA = onJusts cumeDist++-- ===========================================================================+-- オフセット+-- ===========================================================================++-- | [日本語]: @lag n d xs@: 各値を n 個後ろへずらし、 先頭 n 個を default @d@ で埋める+-- (dplyr @lag(x, n, default)@・既定 R は NA)。 入力と同長。+-- [English]: @lag n d xs@: Shifts each value back by n positions, filling+-- the first n with the default @d@ (dplyr's @lag(x, n, default)@; R's+-- default is NA). Same length as the input.+lag :: Int -> a -> [a] -> [a]+lag n d xs = take (length xs) (replicate n d ++ xs)++-- | [日本語]: @lead n d xs@: 各値を n 個前へずらし、 末尾 n 個を default @d@ で埋める。+-- [English]: @lead n d xs@: Shifts each value forward by n positions,+-- filling the last n with the default @d@.+lead :: Int -> a -> [a] -> [a]+lead n d xs = take (length xs) (drop n xs ++ repeat d)++-- ===========================================================================+-- 累積+-- ===========================================================================++cumsum :: Num a => [a] -> [a]+cumsum = scanl1 (+)+cumprod :: Num a => [a] -> [a]+cumprod = scanl1 (*)+cummin :: Ord a => [a] -> [a]+cummin = scanl1 min+cummax :: Ord a => [a] -> [a]+cummax = scanl1 max++-- | [日本語]: 累積平均 (dplyr @cummean@・i 番目 = 先頭 i 個の平均)。+-- [English]: Cumulative mean (dplyr's @cummean@; the i-th element = the+-- mean of the first i elements).+cummean :: [Double] -> [Double]+cummean xs = zipWith (\s i -> s / fromIntegral i) (scanl1 (+) xs) [1 :: Int ..]++-- ===========================================================================+-- 区間化 (base R cut・既定 right = TRUE → (a, b])+-- ===========================================================================++-- | [日本語]: @cut breaks xs@: 各値が属する bin の index (1 始まり) を返す。 境界は昇順前提・+-- 区間は @(lo, hi]@ (right=TRUE)・範囲外は Nothing (= R の NA)。+-- [English]: @cut breaks xs@: Returns the (1-indexed) bin index each value+-- belongs to. Breaks are assumed ascending; intervals are @(lo, hi]@+-- (right=TRUE); out-of-range values yield Nothing (= R's NA).+cut :: [Double] -> [Double] -> [Maybe Int]+cut breaks = map binOf+ where+ intervals = zip [1 :: Int ..] (zip breaks (drop 1 breaks))+ binOf x = case [ i | (i, (lo, hi)) <- intervals, x > lo, x <= hi ] of+ (i : _) -> Just i+ [] -> Nothing++-- | [日本語]: ラベル付き 'cut' (@labels@ は @breaks - 1@ 個)。+-- [English]: A labeled variant of 'cut' (@labels@ has @breaks - 1@+-- elements).+cutLabels :: [b] -> [Double] -> [Double] -> [Maybe b]+cutLabels labels breaks = map (fmap (labels !!) . fmap (subtract 1)) . cut breaks++-- ===========================================================================+-- 連続識別子 (dplyr consecutive_id・値が変わるたび +1)+-- ===========================================================================++consecutiveId :: Eq a => [a] -> [Int]+consecutiveId = go Nothing 0+ where+ go _ _ [] = []+ go prev cur (y : ys) =+ let cur' = case prev of+ Just p | p == y -> cur+ _ -> cur + 1+ in cur' : go (Just y) cur' ys
+ src/Hanalyze/Data/Wrangle.hs view
@@ -0,0 +1,307 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.Data.Wrangle+-- Description : DataFrame 直結の dplyr 風 summarise/mutate/groupBy 動詞+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: DataFrame 直結の解析動詞。+--+-- hgg の @df |>> layer (scatter "x" "y")@ と対称に、 DataFrame を直接+-- データ源として dplyr の @summarise@ / @mutate@ / @group_by@ 相当を+-- 「列名参照 + パイプライン + DataFrame in/out」 で書ける薄層。+--+-- 数値ロジックは 'Hanalyze.Stat.Descriptive' と+-- 'Hanalyze.Data.Transform' に委譲し、 本モジュールは+-- __列名解決 + 群化 + DataFrame 組み立て + NA 処理__のみを担う。+--+-- @+-- import DataFrame.Operators ((|>))+-- df |> summarise [ "mean" =: meanOf "dep_delay", "q95" =: quantileOf 0.95 "dep_delay", "n" =: nOf ]+-- df |> mutate [ "z" =: zscoreOf "x", "rank" =: minRankOf "dep_delay" ]+-- df |> groupBy ["year","month","day"] |> summarise [ "mean" =: meanOf "dep_delay" ]+-- @+--+-- 集約子は既定で __NA 除去 (na.rm=TRUE 相当)__。 数値列のみ対象 (factor は群キー+-- としてのみ扱う)。 群の並びは dplyr 同様キー昇順。+--+-- v1 の制限 (判断申し送り): 入力は Hackage @DataFrame@ 限定 (@ColumnSource@ 全多相化は+-- 後続)。 grouped @mutate@ は未対応 (ungrouped のみ)。+--+-- [English]: Analysis verbs directly on top of DataFrame.+--+-- Symmetric to hgg's @df |>> layer (scatter "x" "y")@, this is+-- a thin layer that lets you write dplyr's @summarise@ / @mutate@ /+-- @group_by@ equivalents directly against a DataFrame as the data+-- source, using "column-name references + pipeline + DataFrame in/out".+--+-- Numeric logic is delegated to 'Hanalyze.Stat.Descriptive' and+-- 'Hanalyze.Data.Transform'; this module is responsible only for+-- __column-name resolution + grouping + DataFrame assembly + NA handling__.+--+-- @+-- import DataFrame.Operators ((|>))+-- df |> summarise [ "mean" =: meanOf "dep_delay", "q95" =: quantileOf 0.95 "dep_delay", "n" =: nOf ]+-- df |> mutate [ "z" =: zscoreOf "x", "rank" =: minRankOf "dep_delay" ]+-- df |> groupBy ["year","month","day"] |> summarise [ "mean" =: meanOf "dep_delay" ]+-- @+--+-- Aggregators default to __NA removal (equivalent to na.rm=TRUE)__.+-- Only numeric columns are targeted (factors are used only as group+-- keys). Group ordering is ascending by key, same as dplyr.+--+-- v1 limitations (handed-off decisions): input is limited to Hackage's+-- @DataFrame@ (full polymorphism over @ColumnSource@ is a follow-up).+-- Grouped @mutate@ is unsupported (ungrouped only).+module Hanalyze.Data.Wrangle+ ( -- * 動詞+ summarise, Summarisable+ , mutate+ , groupBy, Grouped+ -- * 命名+ , (=:)+ -- * 集約子 (列名 → スカラ)+ , Agg+ , meanOf, medianOf, sdOf, varOf, iqrOf, quantileOf, sumOf, minOf, maxOf+ , nOf, nDistinctOf+ -- * 列式 (mutate・列名 → 列)+ , ColExpr+ , zscoreOf, minRankOf, denseRankOf, lagOf, leadOf, cumsumOf+ ) where++import Data.Maybe (catMaybes, isJust)+import Data.List (nub, transpose)+import qualified Data.Map.Strict as M+import qualified Data.Vector as V+import Data.Text (Text)+import qualified DataFrame.Internal.Column as DF+import qualified DataFrame.Internal.DataFrame as DF+import qualified DataFrame.Operations.Core as DF+import qualified DataFrame.Internal.Column as DFC++import Hanalyze.DataIO.Convert (getMaybeTextVec)+import Hanalyze.DataIO.Preprocess (readMaybeDoubleColumn)+import qualified Hanalyze.Stat.Descriptive as D+import qualified Hanalyze.Data.Transform as T++-- ===========================================================================+-- 内部表現+-- ===========================================================================++-- | [日本語]: 1 群分のデータ (行数 + 数値列の name→値・NA 保持・行整列)。+-- [English]: Data for a single group (row count + numeric columns'+-- name→value map; NA-preserving, row-aligned).+data Group = Group+ { gSize :: !Int+ , gNum :: !(M.Map Text [Maybe Double])+ }++-- | [日本語]: 集約結果のセル (数値列 or 整数列)。+-- [English]: An aggregation-result cell (numeric or integer column).+data Cell = CD !Double | CI !Int++-- | [日本語]: 群キーの 1 要素 (数値 or 文字列)。Ord は KNum<KTxt・KNum は数値順。+-- [English]: One element of a group key (numeric or string). Ord+-- orders KNum < KTxt, with KNum compared numerically.+data KeyVal = KNum !Double | KTxt !Text deriving (Eq, Ord)++-- | [日本語]: 集約子: 群 → セル。+-- [English]: An aggregator: group → cell.+newtype Agg = Agg (Group -> Cell)++-- | [日本語]: 列式: 群 → 新しい列 (NA 保持)。+-- [English]: A column expression: group → new column (NA-preserving).+newtype ColExpr = ColExpr (Group -> [Maybe Double])++-- | [日本語]: 結果列名 + 操作 を結ぶ。+-- [English]: Pairs a result column name with an operation.+(=:) :: Text -> a -> (Text, a)+(=:) = (,)+infixr 0 =:++-- ===========================================================================+-- 集約子 (na.rm = TRUE 既定)+-- ===========================================================================++col1 :: Text -> ([Double] -> Double) -> Agg+col1 c f = Agg (\g -> CD (f (catMaybes (M.findWithDefault [] c (gNum g)))))++meanOf, medianOf, sdOf, varOf, iqrOf, sumOf, minOf, maxOf :: Text -> Agg+meanOf c = col1 c D.meanL+medianOf c = col1 c D.medianL+sdOf c = col1 c D.sdL+varOf c = col1 c D.varianceL+iqrOf c = col1 c D.iqrL+sumOf c = col1 c sum+minOf c = col1 c minimum+maxOf c = col1 c maximum++quantileOf :: Double -> Text -> Agg+quantileOf p c = col1 c (D.quantileL p)++-- | [日本語]: 行数 (= R @n()@)。+-- [English]: Row count (= R's @n()@).+nOf :: Agg+nOf = Agg (CI . gSize)++-- | [日本語]: 相異なる非 NA 値の個数 (= R @n_distinct()@)。+-- [English]: The count of distinct non-NA values (= R's @n_distinct()@).+nDistinctOf :: Text -> Agg+nDistinctOf c = Agg (\g -> CI (length (nub (catMaybes (M.findWithDefault [] c (gNum g))))))++-- ===========================================================================+-- 列式 (mutate)+-- ===========================================================================++colE :: Text -> ([Maybe Double] -> [Maybe Double]) -> ColExpr+colE c f = ColExpr (\g -> f (M.findWithDefault [] c (gNum g)))++-- | [日本語]: Z スコア (x - mean) / sd。 NA は NA のまま。+-- [English]: Z-score (x - mean) / sd. NA stays NA.+zscoreOf :: Text -> ColExpr+zscoreOf c = colE c $ \xs ->+ let ys = catMaybes xs; m = D.meanL ys; s = D.sdL ys+ in map (fmap (\x -> (x - m) / s)) xs++-- | [日本語]: 最小順位 (dplyr min_rank・NA 保持)。+-- [English]: Minimum rank (dplyr's min_rank; NA-preserving).+minRankOf :: Text -> ColExpr+minRankOf c = colE c (map (fmap fromIntegral) . T.minRankNA)++-- | [日本語]: 密順位 (dplyr dense_rank・NA 保持)。+-- [English]: Dense rank (dplyr's dense_rank; NA-preserving).+denseRankOf :: Text -> ColExpr+denseRankOf c = colE c (map (fmap fromIntegral) . T.denseRankNA)++-- | [日本語]: n 個ラグ (先頭を NA 埋め)。+-- [English]: Lag by n (fills the front with NA).+lagOf :: Int -> Text -> ColExpr+lagOf n c = colE c (T.lag n Nothing)++-- | [日本語]: n 個リード (末尾を NA 埋め)。+-- [English]: Lead by n (fills the tail with NA).+leadOf :: Int -> Text -> ColExpr+leadOf n c = colE c (T.lead n Nothing)++-- | [日本語]: 累積和 (NA は以降へ伝播 = R cumsum)。+-- [English]: Cumulative sum (NA propagates onward, matching R's cumsum).+cumsumOf :: Text -> ColExpr+cumsumOf c = colE c scan+ where scan [] = []+ scan (x : xs) = scanl (\acc y -> (+) <$> acc <*> y) x xs++-- ===========================================================================+-- 列抽出・群化+-- ===========================================================================++nrows :: DF.DataFrame -> Int+nrows = fst . DF.dimensions++-- | [日本語]: 数値列をすべて NA 保持・行整列で取り出す。+-- [English]: Extracts every numeric column, NA-preserving and row-aligned.+numColumns :: DF.DataFrame -> [(Text, V.Vector (Maybe Double))]+numColumns df =+ [ (n, V.fromList ms) | n <- DF.columnNames df, Just ms <- [readMaybeDoubleColumn n df] ]++-- | [日本語]: 群キー列を 'KeyVal' 列として取り出す (数値優先・無理なら Text)。+-- [English]: Extracts a group-key column as a 'KeyVal' column+-- (numeric preferred; falls back to Text if that fails).+keyColumn :: Text -> DF.DataFrame -> [KeyVal]+keyColumn name df =+ -- 数値読みが「全 NA」 なら実体は Text 列ゆえ Text 抽出に倒す+ -- (readMaybeDoubleColumn は Text 列を Just [Nothing..] で返す罠の回避)。+ case readMaybeDoubleColumn name df of+ Just ms | any isJust ms -> map (maybe (KNum (0/0)) KNum) ms+ _ -> case getMaybeTextVec name df of+ Just v -> map (maybe (KTxt "NA") KTxt) (V.toList v)+ Nothing -> replicate (nrows df) (KTxt "NA")++-- | [日本語]: 各行の群キー tuple。+-- [English]: The group-key tuple for each row.+rowKeys :: [Text] -> DF.DataFrame -> [[KeyVal]]+rowKeys keys df = transpose (map (`keyColumn` df) keys)++-- | [日本語]: キー昇順の群 (キー tuple, 行 index 群)。+-- [English]: Groups in key-ascending order (key tuple, row indices).+groupRows :: [Text] -> DF.DataFrame -> [([KeyVal], [Int])]+groupRows keys df =+ M.toAscList (M.fromListWith (flip (++)) (zip (rowKeys keys df) (map (: []) [0 ..])))++mkGroup :: [(Text, V.Vector (Maybe Double))] -> [Int] -> Group+mkGroup ncols idxs = Group+ { gSize = length idxs+ , gNum = M.fromList [ (n, [ v V.! i | i <- idxs ]) | (n, v) <- ncols ]+ }++-- ===========================================================================+-- セル / キー列 → DataFrame Column+-- ===========================================================================++buildCol :: [Cell] -> DFC.Column+buildCol cells+ | all isCI cells = DF.fromList [ i | CI i <- cells ]+ | otherwise = DF.fromList (map toD cells)+ where+ isCI (CI _) = True+ isCI _ = False+ toD (CD x) = x+ toD (CI i) = fromIntegral i++buildKeyCol :: [KeyVal] -> DFC.Column+buildKeyCol ks+ | all isTxt ks = DF.fromList [ t | KTxt t <- ks ]+ | all isWholeNum ks = DF.fromList [ round d :: Int | KNum d <- ks ]+ | otherwise = DF.fromList [ d | KNum d <- ks ]+ where+ isTxt (KTxt _) = True+ isTxt _ = False+ isWholeNum (KNum d) = not (isNaN d) && d == fromIntegral (round d :: Int)+ isWholeNum _ = False++-- ===========================================================================+-- 動詞+-- ===========================================================================++-- | [日本語]: 群化された DataFrame (キー列名を保持)。+-- [English]: A grouped DataFrame (retains the key column names).+data Grouped = Grouped ![Text] !DF.DataFrame++-- | dplyr @group_by@。+groupBy :: [Text] -> DF.DataFrame -> Grouped+groupBy = Grouped++-- | [日本語]: @summarise@ は DataFrame (= 1 群) でも 'Grouped' でも使える。+-- [English]: @summarise@ works on a DataFrame (= a single group) as+-- well as a 'Grouped'.+class Summarisable g where+ summarise :: [(Text, Agg)] -> g -> DF.DataFrame++instance Summarisable DF.DataFrame where+ summarise aggs df =+ let g = Group { gSize = nrows df+ , gNum = M.fromList (map (fmap V.toList) (numColumns df)) }+ in DF.fromNamedColumns [ (rn, buildCol [runA a g]) | (rn, a) <- aggs ]++instance Summarisable Grouped where+ summarise aggs (Grouped keys df) =+ let ncols = numColumns df+ grps = [ (kt, mkGroup ncols idxs) | (kt, idxs) <- groupRows keys df ]+ keyCols = [ (kn, buildKeyCol [ kt !! j | (kt, _) <- grps ])+ | (j, kn) <- zip [0 ..] keys ]+ resCols = [ (rn, buildCol [ runA a g | (_, g) <- grps ])+ | (rn, a) <- aggs ]+ in DF.fromNamedColumns (keyCols ++ resCols)++runA :: Agg -> Group -> Cell+runA (Agg f) = f++-- | [日本語]: dplyr @mutate@ (ungrouped・元列を温存して新列を右端に足す)。+-- [English]: dplyr's @mutate@ (ungrouped; keeps the original columns+-- and appends new columns on the right).+mutate :: [(Text, ColExpr)] -> DF.DataFrame -> DF.DataFrame+mutate exprs df =+ let g = Group { gSize = nrows df+ , gNum = M.fromList (map (fmap V.toList) (numColumns df)) }+ in foldl (\d (nm, ColExpr f) -> DF.insertVector nm (V.fromList (f g)) d) df exprs
+ src/Hanalyze/DataIO/CSV.hs view
@@ -0,0 +1,445 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.DataIO.CSV+-- Description : CSV / TSV / SSV を Hackage dataframe の DataFrame として読み込むローダ群+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- CSV / TSV / SSV loaders that return Hackage @dataframe@'s+-- @DataFrame.Internal.DataFrame.DataFrame@ directly.+--+-- * CSV / TSV — delegated to Hackage's 'DX.readCsv' / 'DX.readTsv'+-- (improved type inference, missing-bitmap support).+-- * SSV — Hackage has no dedicated loader, so we read with+-- @cassava@ and assemble columns via 'DX.fromList' /+-- 'DX.insertColumn'.+module Hanalyze.DataIO.CSV+ ( loadCSV+ , loadTSV+ , loadSSV+ , loadAuto+ -- * Safe loaders (return Either + LogReport)+ , loadCsvSafe+ , loadTsvSafe+ , loadSsvSafe+ , loadAutoSafe+ -- * Loader options (Phase A4)+ , LoadOpts (..)+ , defaultLoadOpts+ , loadAutoSafeWith+ , ParseError+ ) where++import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX+import qualified DataFrame.IO.CSV as DX+import qualified DataFrame.IO.CSV as DXIO+import qualified DataFrame.Internal.DataFrame as DXD++import Control.Exception (SomeException, try, evaluate)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Char (ord)+import Data.List (isSuffixOf)+import Data.Csv (NamedRecord, Header, defaultDecodeOptions, DecodeOptions(..), decodeByNameWith)+import qualified Data.HashMap.Strict as HM+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V+import System.IO.Error (tryIOError)+import Text.Read (readMaybe)++import Hanalyze.DataIO.Log (Loaded, LogReport, mkInfo, hasWarnings, logReport, entries)+import Hanalyze.DataIO.Health (inspectWithPreview)+import qualified Hanalyze.DataIO.Sniff as Sniff+import qualified System.IO.Temp as Tmp+import System.IO (hClose)++-- | Parse-error message (a plain 'String').+type ParseError = String++-- ---------------------------------------------------------------------------+-- CSV / TSV: Hackage に直接委譲+-- ---------------------------------------------------------------------------++-- | Load a CSV file via Hackage's @readCsv@.+loadCSV :: FilePath -> IO (Either ParseError DXD.DataFrame)+loadCSV = loadHackage DX.readCsv++-- | Load a TSV file via Hackage's @readTsv@.+loadTSV :: FilePath -> IO (Either ParseError DXD.DataFrame)+loadTSV = loadHackage DX.readTsv++loadHackage :: (FilePath -> IO DXD.DataFrame)+ -> FilePath -> IO (Either ParseError DXD.DataFrame)+loadHackage reader path = do+ r <- try (reader path) :: IO (Either SomeException DXD.DataFrame)+ return $ case r of+ Left e -> Left ("CSV/TSV loader failed: " ++ show e)+ Right df -> Right df++-- ---------------------------------------------------------------------------+-- SSV: cassava で読み、Hackage @DataFrame@ に詰め替える+-- ---------------------------------------------------------------------------++-- | Load a space-separated value file via @cassava@; the result is+-- repackaged into a Hackage @DXD.DataFrame@.+loadSSV :: FilePath -> IO (Either ParseError DXD.DataFrame)+loadSSV path = do+ content <- BL.readFile path+ let opts = defaultDecodeOptions { decDelimiter = fromIntegral (ord ' ') }+ case decodeByNameWith opts content of+ Left err -> return (Left err)+ Right (hdr, rows) -> return (Right (toHackageDF hdr rows))++toHackageDF :: Header -> V.Vector NamedRecord -> DXD.DataFrame+toHackageDF hdr rows =+ foldl insert DX.empty+ [ (TE.decodeUtf8 key, classifyCells key rows) | key <- V.toList hdr ]+ where+ insert df (name, col) = DX.insertColumn name col df++-- | [日本語]: 列の値を全て読み 'Double' として parse できれば数値列、そうでなければ Text 列。+-- [English]: If every value in the column can be parsed as 'Double',+-- it's a numeric column; otherwise it's a Text column.+classifyCells :: BS.ByteString -> V.Vector NamedRecord -> DX.Column+classifyCells key rows =+ let cells = V.map (TE.decodeUtf8 . HM.lookupDefault "" key) rows+ texts = V.toList cells+ in case mapM (readMaybe . T.unpack) texts of+ Just nums -> DX.fromList (nums :: [Double])+ Nothing -> DX.fromList (texts :: [Text])++-- ---------------------------------------------------------------------------+-- 拡張子による自動振り分け+-- ---------------------------------------------------------------------------++-- | Auto-dispatch by file extension: @.tsv@ → @loadTSV@, @.ssv@ →+-- 'loadSSV', otherwise 'loadCSV'.+loadAuto :: FilePath -> IO (Either ParseError DXD.DataFrame)+loadAuto path+ | ".tsv" `isSuffixOf` path = loadTSV path+ | ".ssv" `isSuffixOf` path = loadSSV path+ | otherwise = loadCSV path++-- ---------------------------------------------------------------------------+-- Safe loaders (Phase A2)+--+-- 空ファイル / ヘッダのみ / Hackage の internal 'error' を全て 'Either' に+-- 押し込め、call stack を端末に出さないようにする。'Loaded' で副次的な+-- ログを返せる (現状はパス情報のみ、A3 で W コードが付き始める)。+-- ---------------------------------------------------------------------------++-- | [日本語]: ファイルを行ベクトルで先読みして、空 / ヘッダのみを検出する。+-- Right に返るのは「行リスト (改行で split, 空行は除く)」。+-- [English]: Pre-reads the file as a vector of lines to detect+-- empty-file / header-only cases. What's returned on 'Right' is "the+-- line list (split on newline, empty lines removed)".+preflight :: FilePath -> IO (Either ParseError [BS.ByteString])+preflight path = do+ e <- tryIOError (BS.readFile path)+ case e of+ Left ioe -> return (Left ("Cannot read file: " ++ show ioe))+ Right bs0 ->+ let bs = stripBOM bs0+ rows = filter (not . BS.null) (BS.split (fromIntegral (ord '\n')) bs)+ rs = map stripCR rows+ in case rs of+ [] -> return (Left "Empty file (no rows).")+ [_only] -> return (Left "File has only a header row (no data).")+ _ -> return (Right rs)++stripCR :: BS.ByteString -> BS.ByteString+stripCR bs+ | BS.null bs = bs+ | BS.last bs == fromIntegral (ord '\r') = BS.init bs+ | otherwise = bs++-- | [日本語]: UTF-8 BOM (EF BB BF) を取り除く。+-- [English]: Strips a UTF-8 BOM (EF BB BF).+stripBOM :: BS.ByteString -> BS.ByteString+stripBOM bs+ | BS.length bs >= 3+ , BS.index bs 0 == 0xEF+ , BS.index bs 1 == 0xBB+ , BS.index bs 2 == 0xBF = BS.drop 3 bs+ | otherwise = bs++-- | [日本語]: Hackage @readCsv@ / @readTsv@ を例外捕捉付きで呼ぶ。+-- [English]: Calls Hackage's @readCsv@ / @readTsv@ with exceptions caught.+runHackageSafe+ :: (FilePath -> IO DXD.DataFrame)+ -> FilePath+ -> IO (Either ParseError DXD.DataFrame)+runHackageSafe reader path = do+ r <- try (reader path >>= evaluate) :: IO (Either SomeException DXD.DataFrame)+ return $ case r of+ Right df -> Right df+ Left e -> Left (cleanError (show e))++-- | [日本語]: call-stack 行を取り除き、ユーザに見せる 1 行メッセージに整形する。+-- [English]: Strips call-stack lines and formats the message into a+-- single line to show the user.+cleanError :: String -> String+cleanError = takeWhile (/= '\n')++-- | Safe CSV loader. Returns 'Left' on empty input, header-only files,+-- or Hackage internal errors instead of bubbling them up as exceptions.+loadCsvSafe :: FilePath -> IO (Either ParseError (Loaded DXD.DataFrame))+loadCsvSafe = loadHackageSafe DX.readCsv++-- | Safe TSV loader (TSV analogue of 'loadCsvSafe').+loadTsvSafe :: FilePath -> IO (Either ParseError (Loaded DXD.DataFrame))+loadTsvSafe = loadHackageSafe DX.readTsv++loadHackageSafe+ :: (FilePath -> IO DXD.DataFrame) -> FilePath+ -> IO (Either ParseError (Loaded DXD.DataFrame))+loadHackageSafe reader path = do+ pre <- preflight path+ case pre of+ Left e -> return (Left e)+ Right rs -> do+ r <- runHackageSafe reader path+ return $ case r of+ Left e -> Left e+ Right df -> Right (df, inspectWithPreview (previewBytes rs) df)++-- | Safe SSV loader (SSV analogue of 'loadCsvSafe').+loadSsvSafe :: FilePath -> IO (Either ParseError (Loaded DXD.DataFrame))+loadSsvSafe path = do+ pre <- preflight path+ case pre of+ Left e -> return (Left e)+ Right rs -> do+ r <- loadSSV path+ return $ case r of+ Left e -> Left e+ Right df -> Right (df, inspectWithPreview (previewBytes rs) df)++-- | [日本語]: 先頭 8 KB 程度を健全性検査のプレビュー用に切り出す。+-- [English]: Slices out roughly the first 8 KB for use as a health-check preview.+previewBytes :: [BS.ByteString] -> BS.ByteString+previewBytes rs =+ let joined = BS.intercalate "\n" rs+ in BS.take 8192 joined++-- | Auto-dispatch safe loader: picks 'loadCsvSafe' / 'loadTsvSafe' /+-- 'loadSsvSafe' from the file extension.+loadAutoSafe :: FilePath -> IO (Either ParseError (Loaded DXD.DataFrame))+loadAutoSafe path+ | ".tsv" `isSuffixOf` path = loadTsvSafe path+ | ".ssv" `isSuffixOf` path = loadSsvSafe path+ | otherwise = loadCsvSafe path++-- ---------------------------------------------------------------------------+-- Phase A4: ロードオプション+-- ---------------------------------------------------------------------------++-- | Loading options that can be supplied from the CLI.+data LoadOpts = LoadOpts+ { loSkip :: !Int -- ^ Skip the first @N@ rows.+ , loComment :: !(Maybe Char) -- ^ Skip rows starting with this character (e.g. @\'#\'@).+ , loNoHeader :: !Bool -- ^ Treat the file as header-less and generate @col0, col1, …@.+ , loStrict :: !Bool -- ^ Short-circuit to 'Left' if the+ -- @LogReport@ contains a @Warn@ entry.+ , loSniff :: !Bool -- ^ Enable auto-inference (default 'True').+ , loDelim :: !(Maybe Char) -- ^ Override the delimiter ('Nothing'+ -- uses the file extension and sniff result).+ } deriving (Eq, Show)++-- | Default loading options: no skip, no comment char, header expected,+-- non-strict, sniff enabled, no delimiter override.+defaultLoadOpts :: LoadOpts+defaultLoadOpts = LoadOpts 0 Nothing False False True Nothing++-- | [日本語]: 指定された @LoadOpts@ で 'loadAutoSafe' を実行する。@skip@ /+-- @comment@ / @noHeader@ が全て未指定ならファイルを直接読む。それ以外は+-- 一時ファイルに前処理結果を書き出してから読む。+--+-- 'loSniff' が True (デフォルト) のときは、ユーザ未指定の項目に限り+-- 'Hanalyze.DataIO.Sniff.sniffBytes' の結果で自動補完する:+--+-- * 'loSkip == 0' なら sniff の skip 値で上書き+-- * 'loComment == Nothing' なら sniff のコメント文字で上書き+-- * 'loNoHeader == False' で sniff が「ヘッダ無し」を強く示唆したら上書き+--+-- 自動推論で値が変わったときは I013 (Info コード) として LogReport に残す。+-- [English]: Runs 'loadAutoSafe' with the given @LoadOpts@. When+-- @skip@, @comment@ and @noHeader@ are all unset the file is read+-- directly; otherwise the request is realized by writing the+-- preprocessed result to a temporary file and reading that.+--+-- When 'loSniff' is True (the default), only the items the user left+-- unspecified are auto-filled from 'Hanalyze.DataIO.Sniff.sniffBytes''s+-- result:+--+-- * If 'loSkip == 0', overwritten by sniff's skip value.+-- * If 'loComment == Nothing', overwritten by sniff's comment character.+-- * If 'loNoHeader == False' and sniff strongly suggests "no header",+-- overwritten.+--+-- When auto-inference changes a value, it's recorded in the+-- LogReport as an I013 (Info code).+loadAutoSafeWith+ :: LoadOpts -> FilePath+ -> IO (Either ParseError (Loaded DXD.DataFrame))+loadAutoSafeWith opts0 path = do+ -- Sniff: 必要なら冒頭バイト列を読んでオプションを補完する+ (opts, sniffLog) <- if loSniff opts0+ then do+ eRaw <- try (BS.readFile path) :: IO (Either SomeException BS.ByteString)+ case eRaw of+ Left _ -> return (opts0, mempty)+ Right raw -> return (applySniff opts0 (Sniff.sniffBytes (BS.take 8192 raw)))+ else return (opts0, mempty)+ if needRewrite opts+ then withRewritten opts path (\p extra -> go opts p (sniffLog <> extra))+ else go opts path sniffLog+ where+ go effOpts p extraLog = do+ -- delimiter 指定があれば Hackage の readCsvWithOpts を使う+ r <- case loDelim effOpts of+ Nothing -> loadAutoSafe p+ Just c -> loadCsvWithDelim c p+ case r of+ Left e -> return (Left e)+ Right (df, lg) ->+ let lg' = extraLog <> lg+ in if loStrict opts0 && hasWarnings lg'+ then return $ Left+ ("strict: 警告が発生しました ("+ <> show (length (entries lg'))+ <> " 件)。--strict を外すか、--skip / --comment / --no-header / --no-sniff で対処してください。")+ else return (Right (df, lg'))++-- | [日本語]: 指定 delimiter で CSV を読み、loadAutoSafe 同等の Loaded を返す。+-- [English]: Reads a CSV with the given delimiter, returning a+-- 'Loaded' equivalent to loadAutoSafe's.+loadCsvWithDelim+ :: Char -> FilePath -> IO (Either ParseError (Loaded DXD.DataFrame))+loadCsvWithDelim c path = do+ pre <- preflight path+ case pre of+ Left e -> return (Left e)+ Right rs -> do+ let opts = DXIO.defaultReadOptions { DXIO.columnSeparator = c }+ r <- try (DXIO.readCsvWithOpts opts path >>= evaluate)+ :: IO (Either SomeException DXD.DataFrame)+ return $ case r of+ Left e -> Left (cleanError (show e))+ Right df -> Right (df, inspectWithPreview (previewBytes rs) df)++-- | [日本語]: sniff 結果を @LoadOpts@ に反映する。ユーザ指定がある項目 (>0 / Just /+-- True) は尊重し、未指定のところだけ書き換える。書き換えた項目は+-- I013 ログに残す。+-- [English]: Reflects the sniff result into @LoadOpts@. Items the+-- user explicitly specified (@>0@ / @Just@ / @True@) are respected;+-- only unspecified ones are rewritten. Rewritten items are recorded+-- in the I013 log.+applySniff :: LoadOpts -> Sniff.Sniff -> (LoadOpts, LogReport)+applySniff o s =+ let (skip', noteSkip) =+ if loSkip o == 0 && Sniff.sfSkip s > 0+ then (Sniff.sfSkip s,+ Just $ "先頭 " <> tShow (Sniff.sfSkip s) <> " 行を skip (sniff)")+ else (loSkip o, Nothing)+ (comm', noteComm) =+ case (loComment o, Sniff.sfCommentChar s) of+ (Nothing, Just c) -> (Just c,+ Just $ "コメント文字 '" <> T.singleton c <> "' を採用 (sniff)")+ _ -> (loComment o, Nothing)+ (nohd', noteHdr) =+ if not (loNoHeader o) && not (Sniff.sfHasHeader s)+ then (True,+ Just "ヘッダ無しと推論 (sniff): col0... を生成")+ else (loNoHeader o, Nothing)+ (delim', noteDelim) =+ case (loDelim o, Sniff.sfDelim s) of+ (Nothing, c) | c /= ',' ->+ (Just c, Just $ "delimiter '" <> T.singleton c <> "' を採用 (sniff)")+ _ -> (loDelim o, Nothing)+ lg = mconcat+ [ logReport (mkInfo "I013" m Nothing)+ | Just m <- [noteSkip, noteComm, noteHdr, noteDelim]+ ]+ in (o { loSkip = skip', loComment = comm', loNoHeader = nohd'+ , loDelim = delim' }, lg)++needRewrite :: LoadOpts -> Bool+needRewrite o = loSkip o > 0+ || loComment o /= Nothing+ || loNoHeader o++-- | [日本語]: 前処理 (skip / comment / no-header) を施した一時ファイルを作って+-- アクションに渡す。withSystemTempFile で自動クリーンアップ。+-- [English]: Creates a temporary file with preprocessing (skip /+-- comment / no-header) applied and passes it to the action.+-- Automatically cleaned up via withSystemTempFile.+withRewritten+ :: LoadOpts -> FilePath+ -> (FilePath -> LogReport -> IO (Either ParseError (Loaded DXD.DataFrame)))+ -> IO (Either ParseError (Loaded DXD.DataFrame))+withRewritten opts path act = do+ raw <- BS.readFile path+ let (rewritten, plog) = rewriteContent opts raw+ Tmp.withSystemTempFile "ha-rewrite-.csv" $ \tmp h -> do+ BS.hPut h rewritten+ hClose h+ act tmp plog++-- | [日本語]: LoadOpts に従ってバイト列を変換し、変換ログを返す。+-- [English]: Transforms the byte string according to LoadOpts and+-- returns the transformation log.+rewriteContent :: LoadOpts -> BS.ByteString -> (BS.ByteString, LogReport)+rewriteContent opts bs0 =+ let nl = fromIntegral (ord '\n')+ bs = stripBOM bs0+ rawLines = BS.split nl bs+ lines0 = map stripCR rawLines+ (afterSkip, skippedNote) =+ if loSkip opts > 0+ then ( drop (loSkip opts) lines0+ , logReport (mkInfo "I010"+ ("先頭 " <> tShow (loSkip opts) <> " 行を skip しました。")+ Nothing))+ else (lines0, mempty)+ (afterComment, commentNote) = case loComment opts of+ Just ch ->+ let chBy = fromIntegral (ord ch)+ isC l = case BS.uncons (BS.dropWhile (== fromIntegral (ord ' ')) l) of+ Just (c, _) -> c == chBy+ Nothing -> False+ kept = filter (not . isC) afterSkip+ dropped = length afterSkip - length kept+ in if dropped > 0+ then ( kept+ , logReport (mkInfo "I011"+ ("コメント文字 '" <> T.singleton ch+ <> "' で始まる行を " <> tShow dropped <> " 件 skip しました。")+ Nothing))+ else (kept, mempty)+ Nothing -> (afterSkip, mempty)+ (afterHeader, headerNote) =+ if loNoHeader opts+ then case dropWhile BS.null afterComment of+ [] -> (afterComment, mempty)+ (firstRow:_) ->+ let nCols = length (BS.split (fromIntegral (ord ',')) firstRow)+ hdr = BS.intercalate ","+ [ TE.encodeUtf8 (T.pack ("col" ++ show i))+ | i <- [0 .. nCols - 1] ]+ lg = logReport (mkInfo "I012"+ ("--no-header: ヘッダ "+ <> tShow nCols+ <> " 列 (col0...) を生成しました。")+ Nothing)+ in (hdr : afterComment, lg)+ else (afterComment, mempty)+ out = BS.intercalate (BS.singleton nl) afterHeader+ logTotal = skippedNote <> commentNote <> headerNote+ in (out, logTotal)++tShow :: Show a => a -> Text+tShow = T.pack . show
+ src/Hanalyze/DataIO/Clean.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module : Hanalyze.DataIO.Clean+-- Description : Health check の警告を数値化ルールへ変換する列単位クリーニング DSL+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- Column-level cleaning DSL.+--+-- Health checks ('Hanalyze.DataIO.Health') only emit warnings for columns+-- containing currency symbols, thousands separators, units, or alternate+-- decimal points. This module turns each warning into an explicit rule+-- ('ColumnRule') that converts the column into a numeric column.+--+-- Design notes:+--+-- * Each rule has the shape "extract a Text column → transform →+-- write back into the DataFrame", and always returns a transformation+-- log (@LogReport@).+-- * Cells that fail to convert are stored as 'Nothing' (the null+-- bitmap). The number of failures is recorded as I100-series Info+-- codes in the log.+-- * 'cleanPipeline' applies multiple rules in sequence.+-- * Phase B の自動推論との二段構え: sniff で読み込みは通るがセル値が+-- text のままになる #08 / #16 を、Clean で数値化して回帰可能にする。+--+-- 主要ルール+--+-- * 'StripUnits' 末尾の英字を取り除いて Double 化 (\"12.3kg\" → 12.3)+-- * 'ParseCurrency' 通貨記号 / 桁区切り (@$@/@¥@/@€@/@,@) を除去して数値化+-- * 'ParseDecimalEU' decimal separator が ',' (EU style) のセルを Double 化+-- * 'TrimText' 前後の空白を除く+-- * 'CoerceNumeric' 上記 3 種を順に試して最初に成功した変換を採用+-- * @DedupeColumns@ 重複列名に @_2@ などのサフィックスを付ける+-- * @FillBlankNames@ 空列名を @col0@ 等で埋める+module Hanalyze.DataIO.Clean+ ( -- * 型+ ColumnRule (..)+ -- * Single-rule operators+ , applyRule+ , stripUnitsCol+ , parseCurrencyCol+ , parseDecimalEUCol+ , trimTextCol+ , coerceNumericCol+ -- * Pipeline+ , cleanPipeline+ -- * DataFrame-level operations+ , dedupeColumns+ , fillBlankNames+ ) where++import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX+import qualified DataFrame.Operations.Core as DX+import qualified DataFrame.Internal.DataFrame as DXD+import qualified DataFrame.Internal.Column as DXC++import Data.Char (isAlpha, isDigit)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Text.Read (readMaybe)++import Hanalyze.DataIO.Convert (getMaybeTextVec)+import Hanalyze.DataIO.Log (LogReport, mkInfo, mkWarn, logReport, noLog)++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++-- | A single column-cleaning rule.+data ColumnRule+ = StripUnits -- ^ Strip trailing alphabetic suffix and parse+ -- (@\"12.3kg\" → 12.3@).+ | ParseCurrency -- ^ Parse currency-like strings such as @\"$1,234.56\"@+ -- or @\"¥10,000\"@ into 'Double'.+ | ParseDecimalEU -- ^ Decimal point as @\",\"@ (@\"3,14\" → 3.14@).+ | TrimText -- ^ Strip surrounding whitespace; column stays as 'Text'.+ | CoerceNumeric -- ^ Try @StripUnits@, then @ParseCurrency@, then+ -- @ParseDecimalEU@ in that order.+ deriving (Eq, Show)++-- ---------------------------------------------------------------------------+-- 個別ルール (列名指定)+-- ---------------------------------------------------------------------------++-- | Apply a single 'ColumnRule' to a single named column.+applyRule :: ColumnRule -> Text -> DXD.DataFrame -> (DXD.DataFrame, LogReport)+applyRule r name df = case r of+ StripUnits -> stripUnitsCol name df+ ParseCurrency -> parseCurrencyCol name df+ ParseDecimalEU -> parseDecimalEUCol name df+ TrimText -> trimTextCol name df+ CoerceNumeric -> coerceNumericCol name df++-- | Drop a trailing alphabetic unit suffix and parse the prefix as+-- 'Double' (e.g. @\"12.3kg\"@, @\"11.5cm\"@).+stripUnitsCol :: Text -> DXD.DataFrame -> (DXD.DataFrame, LogReport)+stripUnitsCol = liftCellRule "I100" "stripUnits" $ \t ->+ let s = T.strip t+ (digits, rest) = T.span (\c -> isDigit c || c == '.' || c == '-') s+ suffix = T.takeWhile isAlpha rest+ in if T.null digits+ then Nothing+ else if T.null suffix+ then readMaybe (T.unpack digits)+ else readMaybe (T.unpack digits)++-- | Parse a currency-formatted string (with currency symbol and+-- thousands separators) into 'Double': @\"$1,234.56\" → 1234.56@.+parseCurrencyCol :: Text -> DXD.DataFrame -> (DXD.DataFrame, LogReport)+parseCurrencyCol = liftCellRule "I101" "parseCurrency" $ \t ->+ let s1 = T.strip t+ s2 = T.dropWhile (`elem` ("$¥€£" :: String)) s1+ s3 = T.replace "," "" s2+ in readMaybe (T.unpack s3)++-- | EU-style decimal separator @\",\"@: @\"3,14\" → 3.14@.+parseDecimalEUCol :: Text -> DXD.DataFrame -> (DXD.DataFrame, LogReport)+parseDecimalEUCol = liftCellRule "I102" "parseDecimalEU" $ \t ->+ let s = T.replace "," "." (T.strip t)+ in readMaybe (T.unpack s)++-- | Strip surrounding whitespace and write back as a 'Text' column.+trimTextCol :: Text -> DXD.DataFrame -> (DXD.DataFrame, LogReport)+trimTextCol name df = case getMaybeTextVec name df of+ Nothing -> (df, logReport (mkWarn "I103W"+ ("trimText: 列 '" <> name <> "' を text として取り出せません。")+ Nothing))+ Just v ->+ let trimmed = V.map (fmap T.strip) v+ out = V.toList trimmed+ in ( DX.insertColumn name (DX.fromList (out :: [Maybe Text])) df+ , logReport (mkInfo "I103" ("trimText 適用: 列 '" <> name <> "'") Nothing))++-- | Catch-all numeric coercion: try @StripUnits@, then+-- @ParseCurrency@, then @ParseDecimalEU@ in order. The first successful+-- conversion wins; a cell that fails every rule is stored as a null+-- (via the null bitmap).+coerceNumericCol :: Text -> DXD.DataFrame -> (DXD.DataFrame, LogReport)+coerceNumericCol = liftCellRule "I104" "coerceNumeric" $ \t ->+ let candidates =+ [ \s -> let s' = T.strip s+ in readMaybe (T.unpack s') :: Maybe Double+ , \s -> -- StripUnits 風+ let s' = T.strip s+ (digits, _) = T.span (\c -> isDigit c || c == '.' || c == '-') s'+ in if T.null digits then Nothing+ else readMaybe (T.unpack digits)+ , \s -> -- ParseCurrency 風+ let s1 = T.strip s+ s2 = T.dropWhile (`elem` ("$¥€£" :: String)) s1+ s3 = T.replace "," "" s2+ in readMaybe (T.unpack s3)+ , \s -> -- ParseDecimalEU 風+ let s' = T.replace "," "." (T.strip s)+ in readMaybe (T.unpack s')+ ]+ tryAll [] = Nothing+ tryAll (f : fs) = case f t of+ Just x -> Just x+ Nothing -> tryAll fs+ in tryAll candidates++-- ---------------------------------------------------------------------------+-- 共通ヘルパ: text → Maybe Double 変換を 1 列に適用+-- ---------------------------------------------------------------------------++-- | Helper: apply an arbitrary @text → 'Maybe Double'@ converter to a+-- single column. If the column cannot be read as Text, the DataFrame+-- is returned unchanged with a warning log entry.+liftCellRule+ :: Text -- ^ Info code.+ -> Text -- ^ Rule name (for the log).+ -> (Text -> Maybe Double) -- ^ Cell converter.+ -> Text -- ^ [日本語]: 列名。 [English]: Column name.+ -> DXD.DataFrame+ -> (DXD.DataFrame, LogReport)+liftCellRule code rule fn name df = case getMaybeTextVec name df of+ Nothing ->+ ( df+ , logReport (mkWarn (code <> "W")+ (rule <> ": 列 '" <> name <> "' を text として取り出せません。")+ (Just "数値列に対しては不要かもしれません。"))+ )+ Just v ->+ let raw = V.toList v+ -- raw :: [Maybe Text]+ processed = [ mt >>= (\t -> if isMissing t then Nothing else fn t)+ | mt <- raw ]+ nIn = length raw+ nOk = length [ () | Just _ <- processed ]+ nMis = length [ () | Just t <- raw, isMissing t ]+ df' = DX.insertColumn name+ (DX.fromList (processed :: [Maybe Double])) df+ msg = rule <> " 適用: 列 '" <> name <> "' "+ <> tShow nOk <> "/" <> tShow nIn <> " 成功"+ <> (if nMis > 0 then " (NA " <> tShow nMis <> ")" else "")+ lg = logReport (mkInfo code msg Nothing)+ warnLog = if nOk * 2 < nIn -- 半数未満しか成功していない場合+ then logReport (mkWarn (code <> "L")+ (rule <> ": 列 '" <> name <> "' は変換成功率が低いです (" <> tShow nOk <> "/" <> tShow nIn <> ")")+ (Just "別ルールを試すか、データを確認してください。"))+ else noLog+ in (df', lg <> warnLog)++isMissing :: Text -> Bool+isMissing t = T.null (T.strip t)++tShow :: Show a => a -> Text+tShow = T.pack . show++-- ---------------------------------------------------------------------------+-- パイプライン+-- ---------------------------------------------------------------------------++-- | Apply several rules in order, concatenating the per-rule logs.+cleanPipeline+ :: [(Text, ColumnRule)]+ -> DXD.DataFrame+ -> (DXD.DataFrame, LogReport)+cleanPipeline [] df = (df, noLog)+cleanPipeline ((n, r):rs) df0 =+ let (df1, lg1) = applyRule r n df0+ (df2, lg2) = cleanPipeline rs df1+ in (df2, lg1 <> lg2)++-- ---------------------------------------------------------------------------+-- DataFrame レベル操作+-- ---------------------------------------------------------------------------++-- | [日本語]: 重複列名に @_2@, @_3@, ... のサフィックスを付けて曖昧さを解消する+-- (Hackage の DataFrame は重複列を後勝ちでマージするため、ロード前に+-- 行いたい場合は CSV テキスト側で。本関数はロード後の DataFrame に対して+-- 行う suffix 付与で、新しい DataFrame を返す。)+-- [English]: Disambiguate duplicate column names by appending @_2@, @_3@, ...+-- (Hackage's DataFrame merges duplicate columns last-write-wins, so do+-- this on the CSV text side if you want it done before loading. This+-- function applies the suffixing after loading and returns a new+-- DataFrame.)+dedupeColumns :: DXD.DataFrame -> (DXD.DataFrame, LogReport)+dedupeColumns df =+ let names = DX.columnNames df+ go acc [] = reverse acc+ go acc (x:xs) =+ let used = Map.fromListWith (+) [(y, 1 :: Int) | y <- acc]+ n0 = Map.findWithDefault 0 x used+ in if n0 == 0 then go (x:acc) xs+ else go ((x <> "_" <> tShow (n0 + 1)):acc) xs+ newNames = go [] names+ changed = [ (a, b) | (a, b) <- zip names newNames, a /= b ]+ in if null changed+ then (df, noLog)+ else+ let df' = foldl rename df (zip names newNames)+ rename d (old, new)+ | old == new = d+ | otherwise = DX.rename old new d+ in ( df'+ , logReport (mkInfo "I105"+ ("重複列名に suffix を付与: "+ <> T.intercalate ", "+ [ a <> " → " <> b | (a, b) <- changed ])+ Nothing))++-- | [日本語]: 空列名を col0 / col1 / ... で埋める。+-- [English]: Fills blank column names with col0 / col1 / ...+fillBlankNames :: DXD.DataFrame -> (DXD.DataFrame, LogReport)+fillBlankNames df =+ let names = DX.columnNames df+ replaceBlank i n+ | T.null (T.strip n) = "col" <> tShow i+ | otherwise = n+ newNames = zipWith replaceBlank [0 :: Int ..] names+ changed = [ (a, b) | (a, b) <- zip names newNames, a /= b ]+ in if null changed+ then (df, noLog)+ else+ let df' = foldl rn df (zip names newNames)+ rn d (old, new) | old == new = d | otherwise = DX.rename old new d+ in ( df'+ , logReport (mkInfo "I106"+ ("空列名を埋めました: " <> tShow (length changed) <> " 列")+ Nothing))++-- 未使用 warning 抑止+_unused :: DXC.Column -> ()+_unused _ = ()
+ src/Hanalyze/DataIO/Convert.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Hanalyze.DataIO.Convert+-- Description : Hackage dataframe から数値/Text 列を安全に Vector へ抽出する変換層+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- Safe extraction of numeric / Text vectors from a Hackage @dataframe@+-- (@DXD.DataFrame@). Used widely across @Model.*@ and @Viz.*@.+--+-- * 'getDoubleVec' — normalize Double / Int / Integer / Maybe Double /+-- Maybe Int / Maybe Integer / Text columns to @V.Vector Double@. Text values are parsed; if any+-- missing slot is present (null bitmap or NA string), returns+-- 'Nothing' so model fits cannot crash on missing data.+-- * 'getTextVec' — extract a Text column. Returns 'Nothing' on type+-- mismatch.+module Hanalyze.DataIO.Convert+ ( getDoubleVec+ , getTextVec+ , getMaybeTextVec+ ) where++import qualified DataFrame.Operators as DX+import qualified DataFrame.Operations.Core as DX+import qualified DataFrame.Internal.Column as DXC+import qualified DataFrame.Internal.DataFrame as DXD++import Control.DeepSeq (NFData, force)+import Control.Exception (SomeException, try, evaluate)+import Data.Text (Text)+import qualified Data.Vector as V+import System.IO.Unsafe (unsafePerformIO)++import Hanalyze.DataIO.Preprocess (readMaybeDoubleColumn)++-- | Extract a numeric column as 'V.Vector Double'. Returns 'Nothing'+-- when any cell is missing or fails to parse.+getDoubleVec :: Text -> DXD.DataFrame -> Maybe (V.Vector Double)+getDoubleVec name df = do+ xs <- readMaybeDoubleColumn name df+ vs <- sequence xs+ return (V.fromList vs)++-- | Extract a Text column as 'V.Vector Text'. Returns 'Nothing' if any+-- slot has its null bit set, guaranteeing the result holds only proper+-- strings.+getTextVec :: Text -> DXD.DataFrame -> Maybe (V.Vector Text)+getTextVec name df = case tryColumnAsList @Text name df of+ Just xs -> Just (V.fromList xs)+ Nothing -> Nothing++-- | Extract a Text column as 'V.Vector (Maybe Text)'. Null cells become+-- 'Nothing' instead of failing. Useful for inspecting columns where+-- 'getTextVec' would return 'Nothing' (e.g. for @info@ display).+getMaybeTextVec :: Text -> DXD.DataFrame -> Maybe (V.Vector (Maybe Text))+getMaybeTextVec name df =+ case tryColumnAsList @(Maybe Text) name df of+ Just xs -> Just (V.fromList xs)+ Nothing -> case tryColumnAsList @Text name df of+ Just xs -> Just (V.fromList (map Just xs))+ Nothing -> Nothing++-- | [日本語]: 'DX.columnAsList' を例外セーフに呼び出す。型不一致 / null 要素アクセス+-- (Hackage が内部で 'error "fromMaybeVec: Nothing slot"' を投げるケース等)+-- でも 'Nothing' を返す。+--+-- 重要: 'evaluate' は WHNF までしか評価しないので、リスト要素に潜む 'error'+-- が逃げてくる。'force' を挟んで NF まで詰めてから捕捉する。+-- [English]: Calls 'DX.columnAsList' exception-safely. Returns 'Nothing'+-- even on a type mismatch or a null-element access (e.g. the case where+-- Hackage internally throws @error "fromMaybeVec: Nothing slot"@).+--+-- Important: 'evaluate' only forces to WHNF, so an 'error' lurking inside+-- a list element can still escape. 'force' is inserted to reduce to NF+-- before catching it.+tryColumnAsList+ :: forall a. (DXC.Columnable a, NFData a)+ => Text -> DXD.DataFrame -> Maybe [a]+tryColumnAsList name df = unsafePerformIO $ do+ r <- try (evaluate (force (DX.columnAsList (DX.col @a name) df)))+ :: IO (Either SomeException [a])+ return $ case r of+ Right xs -> Just xs+ Left _ -> Nothing
+ src/Hanalyze/DataIO/External.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.DataIO.External+-- Description : Hackage dataframe 経由の Parquet / JSON 外部フォーマットローダ+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- External data-format loaders (Parquet / JSON) via the Hackage+-- @dataframe@ library.+--+-- Returns Hackage's @DataFrame.Internal.DataFrame.DataFrame@ directly.+-- For CSV and TSV use 'Hanalyze.DataIO.CSV.loadCSV' / @loadTSV@ instead.+module Hanalyze.DataIO.External+ ( loadParquet+ , loadJSON+ ) where++import qualified DataFrame.IO.Parquet as DX+import qualified DataFrame.Internal.DataFrame as DXD+import qualified DataFrame.IO.JSON as DXJ++import Control.Exception (SomeException, try)++-- | Load an Apache Parquet file (columnar, supports compression).+loadParquet :: FilePath -> IO (Either String DXD.DataFrame)+loadParquet = loadRaw DX.readParquet++-- | Load a JSON file in records-of-objects format.+loadJSON :: FilePath -> IO (Either String DXD.DataFrame)+loadJSON = loadRaw DXJ.readJSON++loadRaw :: (FilePath -> IO DXD.DataFrame)+ -> FilePath -> IO (Either String DXD.DataFrame)+loadRaw reader path = do+ result <- try (reader path) :: IO (Either SomeException DXD.DataFrame)+ return $ case result of+ Left e -> Left ("External loader failed: " ++ show e)+ Right df -> Right df
+ src/Hanalyze/DataIO/Health.hs view
@@ -0,0 +1,461 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.DataIO.Health+-- Description : 読み込み済み DataFrame の疑わしいパターンを警告コード (W001〜W008) として検出+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: DataFrame の健全性チェック。 読み込みに成功した DataFrame の中に+-- 潜みうる「怪しい」パターンを、警告コードとして洗い出す。+--+-- 検出されるコード:+--+-- * @W001@ — ヘッダが疑わしい (全列名が数値として parse できる)。+-- * @W003@ — ragged: 列ごとの長さが異なる (Hackage 側で通常はパディングされるが、+-- 念のため二重チェックする)。+-- * @W004@ — 列名の重複 / 空 / 前後空白。+-- * @W005@ — delimiter ミスマッチ: 1 列だけの DataFrame で、値に別の+-- delimiter 候補が含まれている。+-- * @W006@ — NA 文字列の多型混在。+-- * @W007@ — 単位サフィックスを推測 (Text 列の大半のセルが+-- @^\\d+\\.?\\d*[a-zA-Z]+$@ に一致)。+-- * @W008@ — 通貨記号または桁区切りの疑い。+--+-- 生バイト列のプレビューが必要な補助チェックは 'inspectWithPreview' にある。+-- それ以外は 'inspectDataFrame' で DataFrame だけから判定可能。+--+-- 利用シナリオ:+--+-- @+-- (df, lg0) <- loadAutoSafe path+-- let lg = lg0 <> inspectDataFrame df+-- printLogReport lg+-- @+--+-- [English]: DataFrame health check. Surfaces the "looks suspicious" patterns that+-- can hide in a successfully-loaded DataFrame, as warning codes.+--+-- Codes detected:+--+-- * @W001@ — header is suspect (all column names parse as numbers).+-- * @W003@ — ragged: per-column lengths differ (Hackage normally pads,+-- but we double-check).+-- * @W004@ — duplicate / empty / surrounding-whitespace column names.+-- * @W005@ — delimiter mismatch: single-column DataFrame whose values+-- contain another delimiter candidate.+-- * @W006@ — heterogeneous mix of NA strings.+-- * @W007@ — unit suffix inferred (most cells in a Text column match+-- @^\\d+\\.?\\d*[a-zA-Z]+$@).+-- * @W008@ — currency or thousand-separator suspect.+--+-- Auxiliary checks that need a raw-byte preview are in+-- 'inspectWithPreview'. Everything else can be judged from the+-- DataFrame alone via 'inspectDataFrame'.+--+-- Usage scenario:+--+-- @+-- (df, lg0) <- loadAutoSafe path+-- let lg = lg0 <> inspectDataFrame df+-- printLogReport lg+-- @+module Hanalyze.DataIO.Health+ ( inspectDataFrame+ , inspectWithPreview+ , detectHeaderless+ , detectDuplicateBlankNames+ , detectMixedNAStrings+ , detectUnitSuffix+ , detectThousandsCurrency+ , detectDelimiterMismatch+ , detectCommentLines+ , detectRagged+ ) where++import qualified DataFrame.Internal.DataFrame as DX+import qualified DataFrame.Operations.Core as DX+import qualified DataFrame.Internal.Column as DXC+import qualified DataFrame.Internal.DataFrame as DXD++import qualified Data.ByteString as BS+import qualified Data.Map.Strict as Map+import Data.Char (isDigit, isAlpha, ord)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Text.Read (readMaybe)++import Hanalyze.DataIO.Log (LogEntry, LogReport, mkWarn, logReport, noLog)+import Hanalyze.DataIO.Convert (getMaybeTextVec)+import Hanalyze.DataIO.Preprocess (isNAString)++-- ---------------------------------------------------------------------------+-- 公開エントリポイント+-- ---------------------------------------------------------------------------++-- | Aggregate every W-code that can be checked from the DataFrame+-- alone (without the source bytes).+inspectDataFrame :: DXD.DataFrame -> LogReport+inspectDataFrame df = mconcat+ [ detectHeaderless df+ , detectDuplicateBlankNames df+ , detectRagged df+ , detectMixedNAStrings df+ , detectUnitSuffix df+ , detectThousandsCurrency df+ ]++-- | [日本語]: DataFrame と先頭の生バイト列プレビューの両方を必要とする W コード+-- (例: W005 delimiter ミスマッチ / W004 ヘッダ行レベルの重複) も合わせて返す。+-- [English]: Also returns the W-codes that need both the DataFrame+-- and a leading raw-byte preview (e.g. W005 delimiter mismatch / W004+-- header-row-level duplicates).+inspectWithPreview :: BS.ByteString -> DXD.DataFrame -> LogReport+inspectWithPreview preview df = mconcat+ [ inspectDataFrame df+ , detectDelimiterMismatch preview df+ , detectRawHeaderIssues preview df+ , detectCommentLines preview+ ]++-- ---------------------------------------------------------------------------+-- W002 コメント行 (#/!/// 等で始まる先頭行)+-- ---------------------------------------------------------------------------++detectCommentLines :: BS.ByteString -> LogReport+detectCommentLines preview =+ let ls = take 8 (BS.split (fromIntegral (ord '\n')) preview)+ isComment l =+ case BS.uncons (BS.dropWhile (\c -> c == fromIntegral (ord ' ')+ || c == fromIntegral (ord '\t')) l) of+ Just (c, _) -> c `elem` map (fromIntegral . ord) (['#', '!'] :: String)+ Nothing -> False+ n = length (filter isComment ls)+ in if n > 0+ then logReport+ (mkWarn "W002"+ ("先頭付近に "+ <> T.pack (show n)+ <> " 件のコメント風行 (# / ! 始まり) を検出。")+ (Just "--skip N でコメント行数を読み飛ばすか、--comment '#' を指定してください。"))+ else noLog++-- | [日本語]: 原本ヘッダ行 (先頭行) を見て、列数 / 重複 / 空セルが DataFrame と+-- 食い違っていないかをチェックする。Hackage は読込時に重複列を後勝ちで+-- 黙ってマージするため、ここで原本側を走査して気付く必要がある。+-- [English]: Looks at the original header row (first line) and checks+-- whether the column count / duplicates / blank cells disagree with+-- the DataFrame. Hackage silently merges duplicate columns+-- last-write-wins on load, so we need to scan the original side here+-- to notice it.+detectRawHeaderIssues :: BS.ByteString -> DXD.DataFrame -> LogReport+detectRawHeaderIssues preview df =+ case takeFirstLine preview of+ Nothing -> noLog+ Just hdrLine ->+ let -- まずは comma 区切りで素朴に分割 (TSV/SSV では別 delimiter だが、+ -- W005 で別途検出されるので OK)+ rawCells = T.splitOn "," (decodeAscii hdrLine)+ rawTrim = map T.strip rawCells+ dups = findDups rawTrim+ blanks = filter T.null rawTrim+ dfCols = DX.columnNames df+ missing = length rawTrim - length dfCols+ in mconcat+ [ if null dups then noLog+ else logReport+ (mkWarn "W004"+ ("原本ヘッダに重複列名: "+ <> T.intercalate ", " dups+ <> " — 後勝ちでマージされ、データの一部が消失している恐れがあります。")+ (Just "重複を解消した CSV を渡すか、コピー前の原本を確認してください。"))+ , if null blanks then noLog+ else logReport+ (mkWarn "W004"+ ("原本ヘッダに空セルが "+ <> T.pack (show (length blanks))+ <> " 件。匿名列として扱われます。")+ (Just "ヘッダ行のフォーマットを見直してください。"))+ , if missing > 0 && not (null dfCols)+ then logReport+ (mkWarn "W004"+ ("原本ヘッダ列数 (" <> T.pack (show (length rawTrim))+ <> ") と DataFrame 列数 (" <> T.pack (show (length dfCols))+ <> ") が不一致 — 列がマージ/欠落している可能性。")+ (Just "列名のフォーマットを確認してください。"))+ else noLog+ ]++takeFirstLine :: BS.ByteString -> Maybe BS.ByteString+takeFirstLine bs =+ case BS.split (fromIntegral (ord '\n')) bs of+ (l:_) | not (BS.null l) -> Just l+ _ -> Nothing++decodeAscii :: BS.ByteString -> Text+decodeAscii = T.pack . map (toEnum . fromIntegral) . BS.unpack++findDups :: Ord a => [a] -> [a]+findDups xs =+ let cnt = Map.fromListWith (+) [(x, 1 :: Int) | x <- xs]+ in [ x | (x, k) <- Map.toList cnt, k > 1 ]++-- ---------------------------------------------------------------------------+-- W001 ヘッダ無し疑い+-- ---------------------------------------------------------------------------++-- | [日本語]: 全列名が Double として parse できるなら、先頭行が data 行だった可能性が高い。+-- [English]: If every column name can be parsed as 'Double', the+-- first row was likely a data row, not a header.+detectHeaderless :: DXD.DataFrame -> LogReport+detectHeaderless df =+ let names = DX.columnNames df+ allNumeric = not (null names)+ && all (\n -> case readMaybe (T.unpack n) :: Maybe Double of+ Just _ -> True+ Nothing -> False) names+ in if allNumeric+ then logReport+ (mkWarn "W001"+ ("列名が全て数値です: "+ <> T.intercalate ", " names+ <> " — ヘッダ行が無いファイルの可能性。")+ (Just "ヘッダ無しなら --no-header を指定してください。"))+ else noLog++-- ---------------------------------------------------------------------------+-- W003 ragged (列ごとに非 null セル数が大きく異なる)+-- ---------------------------------------------------------------------------++-- | [日本語]: DataFrame の各列について、null 以外のセル数を求め、最大と最小の差が+-- 全行数の 1/3 を超えていたら警告。Hackage は ragged 行を null bitmap で+-- 補うため、この差で間接的に検出できる。+-- [English]: For each column of the DataFrame, computes the+-- non-null cell count; warns if the gap between the max and min+-- exceeds 1/3 of the total row count. Hackage pads ragged rows via+-- the null bitmap, so this gap lets us detect it indirectly.+detectRagged :: DXD.DataFrame -> LogReport+detectRagged df =+ let names = DX.columnNames df+ (nrows, _) = DX.dimensions df+ -- 列内の null bitmap を直接走査して非 null セル数を求める。+ -- これにより数値 / Text を問わず使える。+ nonNullN n = case DXD.getColumn n df of+ Nothing -> nrows+ Just c ->+ let len = DXC.columnLength c+ in length [ () | i <- [0 .. len - 1]+ , not (DXC.columnElemIsNull c i) ]+ counts = [ (n, nonNullN n) | n <- names ]+ in case counts of+ [] -> noLog+ _ ->+ let mx = maximum (map snd counts)+ mn = minimum (map snd counts)+ gap = mx - mn+ worst = [ n | (n, k) <- counts, k == mn ]+ in if nrows >= 6 && gap > 0 && gap * 3 >= nrows+ then logReport+ (mkWarn "W003"+ ("列ごとの非 null セル数に乖離: "+ <> T.pack (show mn) <> "..." <> T.pack (show mx)+ <> " (差 " <> T.pack (show gap) <> "); "+ <> "短い列: " <> T.intercalate ", " worst)+ (Just "ragged な行 (列数が揃っていない) の可能性。CSV を整形してください。"))+ else noLog++-- ---------------------------------------------------------------------------+-- W004 重複 / 空 / 前後空白の列名+-- ---------------------------------------------------------------------------++detectDuplicateBlankNames :: DXD.DataFrame -> LogReport+detectDuplicateBlankNames df =+ let names = DX.columnNames df+ blanks = [ n | n <- names, T.null (T.strip n) ]+ trimmedDiffer = [ n | n <- names, n /= T.strip n ]+ grouped = Map.fromListWith (+) [(n, 1 :: Int) | n <- names]+ dups = [ n | (n, k) <- Map.toList grouped, k > 1 ]+ mk code msg hint = logReport (mkWarn code msg hint)+ in mconcat+ [ if null blanks then noLog+ else mk "W004"+ ("空または空白のみの列名が "+ <> T.pack (show (length blanks))+ <> " 件あります。")+ (Just "ヘッダ行に空セルがある可能性。--skip N で読み飛ばすか、--no-header をお試しください。")+ , if null trimmedDiffer then noLog+ else mk "W004"+ ("前後に空白を持つ列名: "+ <> T.intercalate ", " (map (T.pack . show) trimmedDiffer))+ (Just "Hanalyze.DataIO.Preprocess.renameColumn でリネームできます。")+ , if null dups then noLog+ else mk "W004"+ ("重複した列名: "+ <> T.intercalate ", " dups+ <> " — 後勝ちで一方が消失している恐れがあります。")+ (Just "事前に列名を変更するか、CSV を見直してください。")+ ]++-- ---------------------------------------------------------------------------+-- W006 NA 文字列の多型混在+-- ---------------------------------------------------------------------------++-- | [日本語]: NA とみなしうる広めの文字列セット。'isNAString' (defaultNAStrings) に+-- 加えて単独の @-@ / @--@ / @.@ も対象にする (検出限定の判定であり、+-- 既存の補完 API の挙動は変えない)。+-- [English]: A broader set of strings treated as NA-like. In+-- addition to 'isNAString' (defaultNAStrings), also targets lone+-- @-@ / @--@ / @.@ (this is a detection-only judgment; it doesn't+-- change the behavior of the existing imputation API).+isNALike :: Text -> Bool+isNALike t =+ isNAString t+ || (let s = T.strip t in s `elem` ["-", "--", ".", "—"])++-- | [日本語]: 1 列の中に異なる NA 表現が 2 種以上混じっていたら警告。+-- DataFrame の null bitmap (= 既に欠損として処理されたセル) と、文字列上に+-- 残っている NA-like トークンを別カウントとして扱う。+-- [English]: Warns if a single column mixes 2 or more distinct NA+-- representations. The DataFrame's null bitmap (= cells already+-- treated as missing) and NA-like tokens still remaining as strings+-- are counted separately.+detectMixedNAStrings :: DXD.DataFrame -> LogReport+detectMixedNAStrings df = mconcat+ [ checkColumn n+ | n <- DX.columnNames df+ ]+ where+ checkColumn n = case getMaybeTextVec n df of+ Nothing -> noLog+ Just v ->+ let cells = V.toList v+ -- "<null>" を 1 つの形として扱う+ tokens = [ case mx of+ Nothing -> "<null>"+ Just x -> T.toLower (T.strip x)+ | mx <- cells+ , case mx of+ Nothing -> True+ Just x -> isNALike x+ ]+ naSet = Map.fromListWith (+) [ (k, 1 :: Int) | k <- tokens ]+ in if Map.size naSet >= 2+ then logReport+ (mkWarn "W006"+ ("列 " <> T.pack (show n)+ <> " に NA 表現が複数種類混在: "+ <> T.intercalate ", "+ [ k <> "(" <> T.pack (show v') <> ")"+ | (k, v') <- Map.toList naSet ])+ (Just "Hanalyze.DataIO.Preprocess.imputeMean / dropMissingRows で正規化できます。"))+ else noLog++-- ---------------------------------------------------------------------------+-- W007 単位混入+-- ---------------------------------------------------------------------------++-- | [日本語]: text 列で「数字 + 英字サフィックス」のセルが過半なら、単位付きの数値とみなす。+-- [English]: If more than half the cells in a Text column are+-- "number + alphabetic suffix", treats it as a unit-suffixed number.+detectUnitSuffix :: DXD.DataFrame -> LogReport+detectUnitSuffix df = mconcat+ [ checkColumn n | n <- DX.columnNames df ]+ where+ checkColumn n = case getMaybeTextVec n df of+ Nothing -> noLog+ Just v ->+ let xs = [ x | Just x <- V.toList v, not (isNAString x) ]+ n0 = length xs+ hits = length (filter looksLikeUnitNumber xs)+ in if n0 >= 2 && hits * 2 >= n0+ then logReport+ (mkWarn "W007"+ ("列 " <> T.pack (show n)+ <> " は単位付きの数値が混入している可能性 ("+ <> T.pack (show hits) <> "/"+ <> T.pack (show n0) <> " セル)。")+ (Just "Phase C で stripUnits を実装予定。当面は手動で数値化してください。"))+ else noLog++-- | [日本語]: "12.3kg" / "11cm" 等のパターン判定。+-- [English]: Judges patterns like "12.3kg" / "11cm".+looksLikeUnitNumber :: Text -> Bool+looksLikeUnitNumber t =+ let s = T.strip t+ (digits, rest) = T.span (\c -> isDigit c || c == '.' || c == '-') s+ suffix = T.takeWhile isAlpha rest+ in not (T.null digits)+ && not (T.null suffix)+ && T.length suffix <= 4+ && case readMaybe (T.unpack digits) :: Maybe Double of+ Just _ -> True+ Nothing -> False++-- ---------------------------------------------------------------------------+-- W008 通貨 / 桁区切り+-- ---------------------------------------------------------------------------++-- | [日本語]: "$1,234.56" / "1,234" / "¥10,000" 等のパターンを検出。+-- [English]: Detects patterns like "$1,234.56" / "1,234" / "¥10,000".+detectThousandsCurrency :: DXD.DataFrame -> LogReport+detectThousandsCurrency df = mconcat+ [ checkColumn n | n <- DX.columnNames df ]+ where+ checkColumn n = case getMaybeTextVec n df of+ Nothing -> noLog+ Just v ->+ let xs = [ x | Just x <- V.toList v, not (isNAString x) ]+ n0 = length xs+ hits = length (filter looksLikeThousands xs)+ in if n0 >= 2 && hits * 2 >= n0+ then logReport+ (mkWarn "W008"+ ("列 " <> T.pack (show n)+ <> " に通貨記号 / 桁区切りつき数値の可能性 ("+ <> T.pack (show hits) <> "/"+ <> T.pack (show n0) <> " セル)。")+ (Just "Phase C で parseCurrency を実装予定。"))+ else noLog++looksLikeThousands :: Text -> Bool+looksLikeThousands t0 =+ let t1 = T.strip t0+ t2 = T.dropWhile (`elem` ("$¥€£" :: String)) t1+ hasComma = T.any (== ',') t2+ onlyMoney = T.all (\c -> isDigit c || c == ',' || c == '.' || c == '-') t2+ in hasComma && onlyMoney++-- ---------------------------------------------------------------------------+-- W005 delimiter ミスマッチ+-- ---------------------------------------------------------------------------++-- | [日本語]: DataFrame が 1 列だけで、その値に @;@ / @\t@ / @|@ が頻出するなら delimiter+-- 判定がずれた可能性が高い。preview として渡された生バイト列も確認材料にする。+-- [English]: If the DataFrame has only a single column and its+-- values frequently contain @;@ / @\t@ / @|@, the delimiter+-- detection was likely wrong. The raw byte string passed as the+-- preview is also used as supporting evidence.+detectDelimiterMismatch :: BS.ByteString -> DXD.DataFrame -> LogReport+detectDelimiterMismatch preview df =+ let nCols = length (DX.columnNames df)+ candidates = [(';', "セミコロン"), ('\t', "タブ"), ('|', "縦棒")]+ counts =+ [ (c, n, ja)+ | (c, ja) <- candidates+ , let n = BS.count (fromIntegral (ord c)) preview+ , n > 0+ ]+ heavy = [ (c, n, ja) | (c, n, ja) <- counts, n >= 2 ]+ in if nCols == 1 && not (null heavy)+ then logReport+ (mkWarn "W005"+ ("DataFrame が 1 列のみで、生データに "+ <> T.intercalate "/" [ ja <> "(" <> T.pack (show n) <> ")"+ | (_,n,ja) <- heavy ]+ <> " が含まれます。delimiter が違う可能性。")+ (Just "--delim ';'/'\\t'/'|' を試してください。"))+ else noLog++-- 未使用ワーニングを抑える (将来 LogEntry を直接構築する箇所で使う)+_unused :: LogEntry+_unused = mkWarn "" "" Nothing
+ src/Hanalyze/DataIO/Log.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.DataIO.Log+-- Description : データローダ / 前処理が共有する構造化警告・情報メッセージ (LogEntry/LogReport)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: データローダ / 前処理が共有する構造化警告・情報メッセージ。+--+-- * 'LogEntry' — 1 件のメッセージ (重大度 / コード / 本文 / ヒント)。+-- * @LogReport@ — @[LogEntry]@ を包む 'Monoid' ラッパー。+-- * 'Loaded' — 各ローダが返す @(value, log)@ のペア。+-- * 'printLogReport' — stdout への整形出力。+-- * @logEntriesAsHtml@ — 'Hanalyze.Viz.ReportBuilder' 用アダプタ。+--+-- 利用シナリオ:+--+-- @+-- (df, lg) <- loadCsvSafe path -- :: IO (Either ParseError (Loaded DataFrame))+-- printLogReport lg -- 警告を端末に出す+-- when (isStrict opts && hasErrors lg) $ exitFailure+-- @+--+-- [English]: Structured warning / informational messaging shared by data+-- loaders and preprocessing.+--+-- * 'LogEntry' — a single message (severity / code / body / hint).+-- * @LogReport@ — a 'Monoid' wrapper around @[LogEntry]@.+-- * 'Loaded' — the @(value, log)@ pair returned by every loader.+-- * 'printLogReport' — stdout pretty printer.+-- * @logEntriesAsHtml@ — adapter for 'Hanalyze.Viz.ReportBuilder'.+--+-- Usage scenario:+--+-- @+-- (df, lg) <- loadCsvSafe path -- :: IO (Either ParseError (Loaded DataFrame))+-- printLogReport lg -- print warnings to the terminal+-- when (isStrict opts && hasErrors lg) $ exitFailure+-- @+module Hanalyze.DataIO.Log+ ( -- * 型+ Severity (..)+ , LogEntry (..)+ , LogReport+ , Loaded+ -- * Construction+ , mkInfo+ , mkWarn+ , mkErr+ , addEntry+ , logReport+ , noLog+ -- * Aggregation+ , entries+ , hasErrors+ , hasWarnings+ , severityCount+ -- * Output+ , printLogReport+ , prettyEntry+ ) where++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++-- | Message severity.+data Severity = Info | Warn | Err+ deriving (Eq, Ord, Show)++-- | A single log entry.+--+-- 'lgCode' is a stable identifier of the form @W001@ / @E002@ used for+-- grepping output and writing tests against the log.+data LogEntry = LogEntry+ { lgSev :: !Severity+ , lgCode :: !Text+ , lgMsg :: !Text+ , lgHint :: !(Maybe Text)+ } deriving (Eq, Show)++-- | A 'Monoid' list-wrapper of 'LogEntry'.+newtype LogReport = LogReport { entries :: [LogEntry] }+ deriving (Eq, Show)++instance Semigroup LogReport where+ LogReport a <> LogReport b = LogReport (a ++ b)++instance Monoid LogReport where+ mempty = LogReport []++-- | A value paired with its log. Loaders and cleaners return this shape.+type Loaded a = (a, LogReport)++-- ---------------------------------------------------------------------------+-- 構築+-- ---------------------------------------------------------------------------++-- | Build an 'Info' entry from @(code, message, optional hint)@.+mkInfo :: Text -> Text -> Maybe Text -> LogEntry+mkInfo c m h = LogEntry Info c m h++-- | Build a @Warn@ entry.+mkWarn :: Text -> Text -> Maybe Text -> LogEntry+mkWarn c m h = LogEntry Warn c m h++-- | Build an 'Err' entry.+mkErr :: Text -> Text -> Maybe Text -> LogEntry+mkErr c m h = LogEntry Err c m h++-- | Append an entry to the end of a report.+addEntry :: LogEntry -> LogReport -> LogReport+addEntry e (LogReport xs) = LogReport (xs ++ [e])++-- | Make a @LogReport@ that contains a single entry.+logReport :: LogEntry -> LogReport+logReport e = LogReport [e]++-- | The empty log (alias for 'mempty').+noLog :: LogReport+noLog = mempty++-- ---------------------------------------------------------------------------+-- 集約+-- ---------------------------------------------------------------------------++-- | True if the report contains any 'Err' entries.+--+-- >>> hasErrors noLog+-- False+-- >>> hasErrors (logReport (mkErr "E001" "boom" Nothing))+-- True+hasErrors :: LogReport -> Bool+hasErrors (LogReport xs) = any ((== Err) . lgSev) xs++-- | True if the report contains any @Warn@ entries.+hasWarnings :: LogReport -> Bool+hasWarnings (LogReport xs) = any ((== Warn) . lgSev) xs++-- | Number of entries with the given severity.+severityCount :: Severity -> LogReport -> Int+severityCount s (LogReport xs) = length (filter ((== s) . lgSev) xs)++-- ---------------------------------------------------------------------------+-- 出力+-- ---------------------------------------------------------------------------++-- | Pretty-print a single 'LogEntry' (severity tag + code + message,+-- and optionally the hint on a second line).+prettyEntry :: LogEntry -> Text+prettyEntry e =+ let prefix = case lgSev e of+ Info -> "[INFO] "+ Warn -> "[WARN] "+ Err -> "[ERROR] "+ hint = case lgHint e of+ Nothing -> ""+ Just h -> "\n ヒント: " <> h+ in prefix <> lgCode e <> ": " <> lgMsg e <> hint++-- | Print the log to stdout. Empty logs print nothing.+printLogReport :: LogReport -> IO ()+printLogReport (LogReport []) = return ()+printLogReport (LogReport xs) = do+ let nW = length (filter ((== Warn) . lgSev) xs)+ nE = length (filter ((== Err) . lgSev) xs)+ nI = length (filter ((== Info) . lgSev) xs)+ summary = T.concat+ [ "(" , T.pack (show (length xs)), " entries"+ , if nE > 0 then ", " <> T.pack (show nE) <> " error" else ""+ , if nW > 0 then ", " <> T.pack (show nW) <> " warning" else ""+ , if nI > 0 then ", " <> T.pack (show nI) <> " info" else ""+ , ")"+ ]+ TIO.putStrLn ("--- DataIO log " <> summary <> " ---")+ mapM_ (TIO.putStrLn . prettyEntry) xs+ TIO.putStrLn "----------------------"
+ src/Hanalyze/DataIO/Preprocess.hs view
@@ -0,0 +1,928 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+-- |+-- Module : Hanalyze.DataIO.Preprocess+-- Description : Hackage dataframe 上の前処理ヘルパ (欠損検出/除去/補完・列選択・派生列)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- [日本語]: Hackage の @dataframe@ 上に構築した前処理ヘルパ。+--+-- すべての操作は @DXD.DataFrame@ を受け取り、@DXD.DataFrame@ を返す。+--+-- * 欠損値の検出・除去・補完 (平均 / 中央値 / 定数)。+-- * 列の選択 / 削除 / リネーム+-- * 行のフィルタリング+-- * 派生列の計算 (mapNumeric / deriveNumeric / deriveText)+-- * Text 列を数値化 (NA 除去 + parse)+--+-- すべて純粋に新しい @DXD.DataFrame@ を返す。+--+-- [English]: Data-preprocessing helpers built on Hackage's @dataframe@.+--+-- All operations consume and produce @DXD.DataFrame@.+--+-- * Missing-value detection, removal, and imputation+-- (mean / median / constant).+-- * Column select / drop / rename.+-- * Row filtering.+-- * Derived-column computation (mapNumeric / deriveNumeric / deriveText).+-- * Numericizing Text columns (NA removal + parse).+--+-- Everything purely returns a new @DXD.DataFrame@.+module Hanalyze.DataIO.Preprocess+ ( -- * 値・行の表現+ Value (..)+ , DataRow+ , isVMissing+ -- * NA detection+ , isNAString+ , defaultNAStrings+ -- * Column select / drop / rename+ , selectColumns+ , dropColumns+ , renameColumn+ -- * Missing-value handling+ , countMissing+ , dropMissingRows+ , imputeConstant+ , imputeMean+ , imputeMedian+ , parseNumericColumn+ , readMaybeDoubleColumn+ -- * Row filters+ , rowsOf+ , filterRows+ , filterRowsByNumeric+ -- * Derived columns+ , mapNumeric+ , deriveNumeric+ , deriveText+ , replaceColumn+ , addColumn+ -- * groupBy and aggregate+ , groupByAggregate+ , groupByMean+ , groupBySum+ , groupByMin+ , groupByMax+ , groupByMedian+ , groupByCount+ -- * Wide ↔ long transformation (melt)+ , meltLonger+ -- * Long-form regrid (resample jagged data onto a common grid)+ , ZBoundsMode (..)+ , RegridOpts (..)+ , defaultRegridOpts+ , RegridResult (..)+ , PerIdStat (..)+ , regridLong+ ) where++import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX+import qualified DataFrame.Operators as DX+import qualified DataFrame.Operations.Core as DX+import qualified DataFrame.Operations.Subset as DX+import qualified DataFrame.Internal.Column as DXC+import qualified DataFrame.Internal.DataFrame as DXD+import qualified DataFrame.Internal.Types as DXT++import Control.DeepSeq (NFData, force)+import Control.Exception (SomeException, try, evaluate)+import Data.List (foldl', sort)+import qualified Data.List+import qualified Data.Ord+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import System.IO.Unsafe (unsafePerformIO)+import Text.Read (readMaybe)+import qualified Hanalyze.Stat.Interpolate+import qualified Hanalyze.Stat.AdaptiveGrid++-- ---------------------------------------------------------------------------+-- 値 / 行の表現 (deriveNumeric/deriveText 用の述語インタフェース)+-- ---------------------------------------------------------------------------++-- | A typed cell value used by 'deriveNumeric' / 'deriveText'-style+-- predicates. Missing values become 'VMissing'.+data Value = VNum Double | VText Text | VMissing+ deriving (Show, Eq)++-- | True for 'VMissing'; useful inside row predicates.+isVMissing :: Value -> Bool+isVMissing VMissing = True+isVMissing _ = False++-- | A single row keyed by column name.+type DataRow = Map.Map Text Value++-- ---------------------------------------------------------------------------+-- NA 検出 (Text レベル)+-- ---------------------------------------------------------------------------++-- | Strings recognised as missing values (case-sensitive on the trimmed+-- text): @\"\"@, @\"NA\"@, @\"N/A\"@, @\"n/a\"@, @\"null\"@, @\"NULL\"@,+-- @\"NaN\"@, @\"nan\"@, @\"?\"@.+defaultNAStrings :: [Text]+defaultNAStrings = ["", "NA", "N/A", "n/a", "null", "NULL", "NaN", "nan", "?"]++-- | True when the trimmed input text is in 'defaultNAStrings'.+isNAString :: Text -> Bool+isNAString t = T.strip t `elem` defaultNAStrings++-- ---------------------------------------------------------------------------+-- 列の選択 / 削除 / リネーム+-- ---------------------------------------------------------------------------++-- | Keep only the named columns (silently ignoring names that are not+-- present).+selectColumns :: [Text] -> DXD.DataFrame -> DXD.DataFrame+selectColumns names df =+ let present = filter (`elem` DX.columnNames df) names+ in DX.select present df++-- | Drop the named columns (silently ignoring names that are not present).+dropColumns :: [Text] -> DXD.DataFrame -> DXD.DataFrame+dropColumns names df =+ let present = filter (`elem` DX.columnNames df) names+ in DX.exclude present df++-- | Rename @old@ to @new@. No-op if @old@ is missing.+renameColumn :: Text -> Text -> DXD.DataFrame -> DXD.DataFrame+renameColumn old new df+ | old `elem` DX.columnNames df = DX.rename old new df+ | otherwise = df++-- ---------------------------------------------------------------------------+-- 内部: 列値の安全な取得 (型不一致時 Nothing)+-- ---------------------------------------------------------------------------++-- | Length of a named column (0 if absent).+colLength :: Text -> DXD.DataFrame -> Int+colLength name df = case DXD.getColumn name df of+ Just c -> DXC.columnLength c+ Nothing -> 0++-- | Is the @i@-th cell null? Returns 'True' for missing columns.+isNullAt :: Text -> Int -> DXD.DataFrame -> Bool+isNullAt name i df = case DXD.getColumn name df of+ Just c -> DXC.columnElemIsNull c i+ Nothing -> True++-- | [日本語]: 列を @[a]@ として安全に取り出す。型不一致や例外 (Hackage が+-- @error "fromMaybeVec: Nothing slot"@ 等を投げるケース) も 'Nothing' で吸収。+-- 'force' でリスト要素まで NF にしてから捕捉する。+-- [English]: Safely extracts a column as @[a]@. Absorbs into+-- 'Nothing' even type mismatches or exceptions (e.g. the case where+-- Hackage throws @error "fromMaybeVec: Nothing slot"@ etc). 'force'+-- is used to reduce list elements to NF before catching.+tryColumnAsList+ :: forall a. (DXC.Columnable a, NFData a)+ => Text -> DXD.DataFrame -> Maybe [a]+tryColumnAsList name df = unsafePerformIO $ do+ r <- try (evaluate (force (DX.columnAsList (DX.col @a name) df)))+ :: IO (Either SomeException [a])+ return $ case r of+ Right xs -> Just xs+ Left _ -> Nothing++-- ---------------------------------------------------------------------------+-- 欠損値処理+-- ---------------------------------------------------------------------------++-- | Per-column missing count. Columns without a null bitmap contribute+-- 0; columns with a bitmap contribute their null count. Text columns+-- additionally count cells whose value is in 'defaultNAStrings' (for+-- CSV-source compatibility).+countMissing :: DXD.DataFrame -> [(Text, Int)]+countMissing df =+ [ (n, countOne n) | n <- DX.columnNames df ]+ where+ countOne n =+ let len = colLength n df+ nulls = length [ () | i <- [0 .. len - 1], isNullAt n i df ]+ texts = case tryColumnAsList @Text n df of+ Just xs -> length (filter isNAString xs)+ Nothing -> 0+ in nulls + texts++-- | Drop rows where any of the listed columns is null. NA strings in+-- Text columns are also treated as missing.+--+-- Phase 11b (2026-05-14): cache per-column Text @Vector@ once instead+-- of calling @tryColumnAsList@ + @xs !! i@ inside the inner row loop.+-- The previous version was O(rows² × cols); the cached version is+-- O(rows × cols).+dropMissingRows :: [Text] -> DXD.DataFrame -> DXD.DataFrame+dropMissingRows targets df =+ let cols = targets+ n = if null cols then 0 else maximum (map (`colLength` df) cols)+ -- One pass per column: Maybe (Vector Text) of NA-eligible entries.+ textCache :: [(Text, Maybe (V.Vector Text))]+ textCache =+ [ (c, fmap V.fromList (tryColumnAsList @Text c df))+ | c <- cols ]+ isTextNAVec mv i = case mv of+ Just v -> i < V.length v && isNAString (V.unsafeIndex v i)+ Nothing -> False+ rowMissing i =+ any (\(c, mv) -> isNullAt c i df || isTextNAVec mv i) textCache+ keep = [ i | i <- [0 .. n - 1], not (rowMissing i) ]+ in selectRows keep df++-- | [日本語]: インデックス集合で全列を縦スライス。+-- [English]: Vertically slices every column by an index set.+selectRows :: [Int] -> DXD.DataFrame -> DXD.DataFrame+selectRows idxs df = foldr ins DX.empty (DX.columnNames df)+ where+ ins name acc =+ case sliceColumn name df idxs of+ Just c -> DX.insertColumn name c acc+ Nothing -> acc++-- | [日本語]: 列を indices で取り出して新しい Column を作る。+-- BoxedColumn / UnboxedColumn のどちらでも columnAsList 経由で安全に処理する。+-- [English]: Extracts a column by indices and builds a new Column.+-- Handled safely via columnAsList for either BoxedColumn or+-- UnboxedColumn.+sliceColumn :: Text -> DXD.DataFrame -> [Int] -> Maybe DX.Column+sliceColumn name df idxs = case DXD.getColumn name df of+ Nothing -> Nothing+ Just _ ->+ -- 型を順に試す。Maybe Double → Double → Maybe Int → Int → Text の順。+ tryAs @(Maybe Double)+ (tryAs @Double+ (tryAs @(Maybe Int)+ (tryAs @Int+ (tryAs @Text Nothing))))+ where+ -- Phase 11b (2026-05-14): convert the column to a @Vector@ once and+ -- use 'unsafeIndex'. The previous @xs !! i@ in a list-comprehension+ -- was O(i) per index, so 'sliceColumn' on n indices was O(n²).+ tryAs+ :: forall a. (DXC.Columnable a, NFData a,+ DXC.ColumnifyRep (DXT.KindOf a) a)+ => Maybe DX.Column -> Maybe DX.Column+ tryAs fallback = case tryColumnAsList @a name df of+ Just xs ->+ let v = V.fromList xs+ len = V.length v+ in Just (DX.fromList+ [ V.unsafeIndex v i | i <- idxs, i < len ])+ Nothing -> fallback++-- | Impute missing values with a constant and homogenize to a 'Double'+-- column.+imputeConstant :: Text -> Double -> DXD.DataFrame -> Maybe DXD.DataFrame+imputeConstant name fill df = case readMaybeDoubleColumn name df of+ Nothing -> Nothing+ Just xs ->+ let filled = map (maybe fill id) xs+ in Just (DX.insertColumn name (DX.fromList filled) df)++-- | Impute missing values with the mean of the present cells. Returns+-- 'Nothing' when the column has no non-missing cells.+imputeMean :: Text -> DXD.DataFrame -> Maybe DXD.DataFrame+imputeMean name df = case readMaybeDoubleColumn name df of+ Nothing -> Nothing+ Just xs ->+ let nums = [ x | Just x <- xs ]+ in if null nums+ then Nothing+ else+ let m = sum nums / fromIntegral (length nums)+ in imputeConstant name m df++-- | Impute missing values with the median. Returns 'Nothing' when the+-- column has no non-missing cells.+imputeMedian :: Text -> DXD.DataFrame -> Maybe DXD.DataFrame+imputeMedian name df = case readMaybeDoubleColumn name df of+ Nothing -> Nothing+ Just xs ->+ let s = sort [ x | Just x <- xs ]+ in if null s+ then Nothing+ else imputeConstant name (s !! (length s `div` 2)) df++-- | [日本語]: Text / Double / Maybe Double / Int / Maybe Int のいずれかを+-- @[Maybe Double]@ に正規化して取り出す。Text 列の NA 文字列・parse 失敗は+-- Nothing として扱う。+--+-- 注意: Hackage 'DX.columnAsList' は @Maybe a@ 列に対して @col @a@ を要求しても+-- 例外を投げず、null セルを 0 などのデフォルト値で埋めて返す。そのため null は+-- 必ず @isNullAt@ (= columnElemIsNull) で別途マスクする。+-- [English]: Reads any of Text / Double / Maybe Double / Int / Maybe+-- Int, normalizing it to @[Maybe Double]@. NA strings and parse+-- failures in a Text column are treated as Nothing.+--+-- Note: Hackage's 'DX.columnAsList' does not throw even when @col @a@+-- is requested against a @Maybe a@ column; it fills null cells with+-- a default such as 0. Therefore nulls must always be separately+-- masked via @isNullAt@ (= columnElemIsNull).+readMaybeDoubleColumn :: Text -> DXD.DataFrame -> Maybe [Maybe Double]+readMaybeDoubleColumn name df = fmap (maskNulls . zip [0..]) raw+ where+ maskNulls = map (\(i, x) -> if isNullAt name i df then Nothing else x)+ raw =+ case tryColumnAsList @(Maybe Double) name df of+ Just xs -> Just xs+ Nothing -> case tryColumnAsList @(Maybe Int) name df of+ Just xs -> Just (map (fmap fromIntegral) xs)+ Nothing -> case tryColumnAsList @Double name df of+ Just xs -> Just (map Just xs)+ Nothing -> case tryColumnAsList @Int name df of+ Just xs -> Just (map (Just . fromIntegral) xs)+ -- Phase 60.3: Integer 列の黙殺根治 ([[numericcols-integer-silent-drop]])。+ -- 判定列に Integer / Maybe Integer が無く、 df |-> hbm の group 列が+ -- Integer 型だと dataNamed が黙って空になっていた。+ Nothing -> case tryColumnAsList @Integer name df of+ Just xs -> Just (map (Just . fromIntegral) xs)+ Nothing -> case tryColumnAsList @(Maybe Integer) name df of+ Just xs -> Just (map (fmap fromIntegral) xs)+ Nothing -> case tryColumnAsList @Text name df of+ Just xs -> Just+ [ if isNAString t+ then Nothing+ else readMaybe (T.unpack t)+ | t <- xs ]+ Nothing -> Nothing++-- | Convert a Text column into a Double column. Returns 'Nothing' if+-- any cell is missing or fails to parse.+parseNumericColumn :: Text -> DXD.DataFrame -> Maybe DXD.DataFrame+parseNumericColumn name df =+ case tryColumnAsList @Double name df of+ Just _ -> Just df+ Nothing -> case tryColumnAsList @Text name df of+ Nothing -> Nothing+ Just xs -> do+ ds <- mapM (readMaybe . T.unpack) xs+ return (DX.insertColumn name (DX.fromList (ds :: [Double])) df)++-- ---------------------------------------------------------------------------+-- 行フィルタ (DataRow ベース、レガシー API)+-- ---------------------------------------------------------------------------++-- | Expand a DataFrame into a list of 'DataRow'. NA strings become+-- 'VMissing'.+rowsOf :: DXD.DataFrame -> [DataRow]+rowsOf df =+ let cols = DX.columnNames df+ n = if null cols then 0 else maximum (map (`colLength` df) cols)+ in [ Map.fromList [ (c, cellAt c i) | c <- cols ] | i <- [0 .. n - 1] ]+ where+ cellAt c i+ | isNullAt c i df = VMissing+ | otherwise = case readMaybeDoubleColumn c df of+ Just xs | i < length xs ->+ case xs !! i of+ Just d -> VNum d+ Nothing ->+ case tryColumnAsList @Text c df of+ Just ts | i < length ts ->+ let t = ts !! i+ in if isNAString t then VMissing else VText t+ _ -> VMissing+ _ -> case tryColumnAsList @Text c df of+ Just ts | i < length ts ->+ let t = ts !! i+ in if isNAString t then VMissing else VText t+ _ -> VMissing++-- | Keep only the rows for which the predicate evaluates to 'True'.+filterRows :: (DataRow -> Bool) -> DXD.DataFrame -> DXD.DataFrame+filterRows p df =+ let keep = [ i | (i, r) <- zip [0..] (rowsOf df), p r ]+ in selectRows keep df++-- | Keep only the rows for which a numeric column satisfies the+-- predicate.+filterRowsByNumeric :: Text -> (Double -> Bool) -> DXD.DataFrame -> DXD.DataFrame+filterRowsByNumeric name p df =+ case readMaybeDoubleColumn name df of+ Nothing -> df+ Just xs ->+ let keep = [ i | (i, Just x) <- zip [0..] xs, p x ]+ in selectRows keep df++-- ---------------------------------------------------------------------------+-- 派生列+-- ---------------------------------------------------------------------------++-- | Apply @f@ element-wise to a numeric column. The column is left+-- unchanged when its type is not @Double@.+mapNumeric :: Text -> (Double -> Double) -> DXD.DataFrame -> DXD.DataFrame+mapNumeric name f df = case tryColumnAsList @Double name df of+ Just xs -> DX.insertColumn name (DX.fromList (map f xs)) df+ Nothing -> df++-- | Derive a new numeric column from each row.+deriveNumeric :: Text -> (DataRow -> Double) -> DXD.DataFrame -> DXD.DataFrame+deriveNumeric newName f df =+ let vals = map f (rowsOf df)+ in DX.insertColumn newName (DX.fromList (vals :: [Double])) df++-- | Derive a new text column from each row.+deriveText :: Text -> (DataRow -> Text) -> DXD.DataFrame -> DXD.DataFrame+deriveText newName f df =+ let vals = map f (rowsOf df)+ in DX.insertColumn newName (DX.fromList (vals :: [Text])) df++-- | Replace or insert a column (Hackage's 'DX.insertColumn' replaces an+-- existing column).+replaceColumn :: Text -> DX.Column -> DXD.DataFrame -> DXD.DataFrame+replaceColumn = DX.insertColumn++-- | Append a new column (or replace if the name already exists).+addColumn :: Text -> DX.Column -> DXD.DataFrame -> DXD.DataFrame+addColumn = DX.insertColumn++-- ---------------------------------------------------------------------------+-- groupBy / aggregate+-- ---------------------------------------------------------------------------++-- | [日本語]: 与えられた関数で数値列を text キー列単位に集約する。+-- カスタム集約 (任意の @[Double] -> Double@) を扱うため、Hackage の+-- @groupBy + aggregate@ ではなく独自バケット実装。決まった集約は+-- 'groupByMean' 等を経由した方が高速。+-- [English]: Aggregates a numeric column with the given function,+-- grouped by a text key column. To handle custom aggregation+-- (an arbitrary @[Double] -> Double@), this uses a custom bucket+-- implementation rather than Hackage's @groupBy + aggregate@. For+-- fixed aggregations, going through 'groupByMean' etc. is faster.+groupByAggregate+ :: Text -- ^ [日本語]: グループ列。 [English]: Group column.+ -> Text -- ^ [日本語]: 集約対象列。 [English]: Column to aggregate.+ -> ([Double] -> Double) -- ^ [日本語]: 集約関数。 [English]: Aggregation function.+ -> DXD.DataFrame+ -> Maybe DXD.DataFrame+groupByAggregate gCol nCol agg df =+ case (tryColumnAsList @Text gCol df, readMaybeDoubleColumn nCol df) of+ (Just gs, Just nsM) ->+ let pairs = [ (g, x) | (g, Just x) <- zip gs nsM ]+ buckets = collectInOrder pairs+ groups = map fst buckets+ aggVals = map (agg . snd) buckets+ in Just $+ DX.insertColumn nCol (DX.fromList (aggVals :: [Double])) $+ DX.insertColumn gCol (DX.fromList (groups :: [Text]))+ DX.empty+ _ -> Nothing++-- | [日本語]: 出現順を保った group→[value] 蓄積。+--+-- Phase Q3 (2026-05-14): 旧実装は @foldl@ + @lookup@ + @vs ++ [v]@ の三重で+-- O(n²) (n=50000 で 1.2 s / 10.4 GB alloc を観測)。Map で初出順 index と+-- 累積値を保持し、最後に index 順に並べる O(n log n) 実装に置換。+-- 蓄積は @v :@ で先頭 cons → 最後に @reverse@ するため per-element O(1)。+-- [English]: Order-preserving group→[value] accumulation.+--+-- Phase Q3 (2026-05-14): the old implementation was O(n²) via a+-- triple combination of @foldl@ + @lookup@ + @vs ++ [v]@ (observed+-- 1.2 s / 10.4 GB alloc at n=50000). It was replaced with an+-- O(n log n) implementation that keeps a first-occurrence index and+-- accumulated values in a Map, sorting by index order at the end.+-- Accumulation is per-element O(1) since it front-conses with @v :@+-- and only @reverse@s at the end.+collectInOrder :: Ord k => [(k, v)] -> [(k, [v])]+collectInOrder kvs =+ let go (!nextIdx, !mp) (k, v) =+ case Map.lookup k mp of+ Just (i, rev) -> (nextIdx, Map.insert k (i, v : rev) mp)+ Nothing -> (nextIdx + 1, Map.insert k (nextIdx, [v]) mp)+ (_, finalMp) = foldl' go (0 :: Int, Map.empty) kvs+ bucketsByIdx = Data.List.sortBy+ (Data.Ord.comparing (fst . snd))+ (Map.toList finalMp)+ in [ (k, reverse rev) | (k, (_, rev)) <- bucketsByIdx ]++-- | Group-by aggregation with the per-group mean.+groupByMean :: Text -> Text -> DXD.DataFrame -> Maybe DXD.DataFrame+groupByMean g n = groupByAggregate g n meanD++-- | Group-by aggregation with the per-group sum.+groupBySum :: Text -> Text -> DXD.DataFrame -> Maybe DXD.DataFrame+groupBySum g n = groupByAggregate g n sum++-- | Group-by aggregation with the per-group minimum.+groupByMin :: Text -> Text -> DXD.DataFrame -> Maybe DXD.DataFrame+groupByMin g n = groupByAggregate g n minimum++-- | Group-by aggregation with the per-group maximum.+groupByMax :: Text -> Text -> DXD.DataFrame -> Maybe DXD.DataFrame+groupByMax g n = groupByAggregate g n maximum++-- | Group-by aggregation with the per-group median.+groupByMedian :: Text -> Text -> DXD.DataFrame -> Maybe DXD.DataFrame+groupByMedian g n = groupByAggregate g n medianD++-- | Per-group row count. The output column is named @\"count\"@.+groupByCount :: Text -> DXD.DataFrame -> Maybe DXD.DataFrame+groupByCount gCol df = case tryColumnAsList @Text gCol df of+ Nothing -> Nothing+ Just gs ->+ let buckets = collectInOrder [ (g, ()) | g <- gs ]+ keys = map fst buckets+ counts = map (fromIntegral . length . snd) buckets+ in Just $+ DX.insertColumn "count" (DX.fromList (counts :: [Double])) $+ DX.insertColumn gCol (DX.fromList (keys :: [Text]))+ DX.empty++meanD :: [Double] -> Double+meanD [] = 0+meanD xs = sum xs / fromIntegral (length xs)++medianD :: [Double] -> Double+medianD [] = 0+medianD xs = let s = sort xs in s !! (length s `div` 2)++-- ---------------------------------------------------------------------------+-- Wide → Long 変形 (melt / pivot_longer)+-- ---------------------------------------------------------------------------++-- | [日本語]: Wide-form の DataFrame を long-form に展開する (R/pandas の pivot_longer+-- / melt 相当)。+--+-- @meltLonger idCols valueCols varName valueName parseVarAsDouble df@:+--+-- * @idCols@ そのまま残す (繰返しコピー) 列。+-- * @valueCols@ 縦方向に展開する列。これらの列名が新しい @varName@ 列の値になる。+-- * @varName@ 新しい variable 列の名前 (例: \"t\")。+-- * @valueName@ 新しい value 列の名前 (例: \"y\")。+-- * @parseVarAsDouble@+-- True なら variable 列の中身 (= 元 wide 列名) を Double として+-- parse して数値列に。Parse 失敗時は Text 列のまま。+--+-- 元セルが NA (null bitmap or NA 文字列) の行は出力から除外される。+--+-- 例:+--+-- @+-- name x1 1 2 3 -- name x1 t y+-- a 1 10 20 - → a 1 1 10+-- b 2 - 30 60 a 1 2 20+-- b 2 2 30+-- b 2 3 60+-- @+-- [English]: Expands a wide-form DataFrame into long-form (equivalent+-- to R/pandas' pivot_longer / melt).+--+-- @meltLonger idCols valueCols varName valueName parseVarAsDouble df@:+--+-- * @idCols@ Columns left as-is (repeated/copied).+-- * @valueCols@ Columns expanded vertically. Their names become+-- the values of the new @varName@ column.+-- * @varName@ Name of the new variable column (e.g. \"t\").+-- * @valueName@ Name of the new value column (e.g. \"y\").+-- * @parseVarAsDouble@+-- If True, parses the variable column's content+-- (= the original wide column names) as Double+-- into a numeric column. Stays as a Text column+-- on parse failure.+--+-- Rows whose original cell is NA (null bitmap or NA string) are+-- excluded from the output.+--+-- Example:+--+-- @+-- name x1 1 2 3 -- name x1 t y+-- a 1 10 20 - → a 1 1 10+-- b 2 - 30 60 a 1 2 20+-- b 2 2 30+-- b 2 3 60+-- @+meltLonger+ :: [Text] -- ^ [日本語]: id 列 (そのまま残す)。 [English]: id columns (left as-is).+ -> [Text] -- ^ [日本語]: wide 列 (縦展開する)。 [English]: wide columns (expanded vertically).+ -> Text -- ^ [日本語]: 新しい variable 列名。 [English]: New variable column name.+ -> Text -- ^ [日本語]: 新しい value 列名。 [English]: New value column name.+ -> Bool -- ^ [日本語]: True: variable 列を Double に parse。 [English]: True: parses the variable column to Double.+ -> DXD.DataFrame+ -> DXD.DataFrame+meltLonger idCols valueCols varName valueName parseVar df =+ let nrows = fst (DX.dimensions df)+ -- 各 id 列を [Maybe Text] / [Maybe Double] として取り出す+ idTexts =+ [ (n, idColAsText n) | n <- idCols ]+ -- id 列を [Text] として取り出す: Maybe Text → Text → Maybe Double → Double → Maybe Int → Int の順に試行+ idColAsText n =+ case tryColumnAsList @(Maybe Text) n df of+ Just xs -> Just (map (maybe "" id) xs)+ Nothing -> case tryColumnAsList @Text n df of+ Just xs -> Just xs+ Nothing -> case tryColumnAsList @(Maybe Double) n df of+ Just xs -> Just (map showMaybeD xs)+ Nothing -> case tryColumnAsList @Double n df of+ Just xs -> Just (map showD xs)+ Nothing -> case tryColumnAsList @(Maybe Int) n df of+ Just xs -> Just (map showMaybeI xs)+ Nothing -> case tryColumnAsList @Int n df of+ Just xs -> Just (map (T.pack . show) xs)+ Nothing -> Nothing+ showMaybeD Nothing = ""+ showMaybeD (Just d) = showD d+ showD d+ | d == fromInteger (round d) = T.pack (show (round d :: Integer))+ | otherwise = T.pack (show d)+ showMaybeI Nothing = ""+ showMaybeI (Just i) = T.pack (show i)+ -- valueCols のセル値を [Maybe Double] で取り出す+ valData =+ [ (n, valueAsMaybeDouble n df, varValue n)+ | n <- valueCols ]+ varValue n+ | parseVar = case readMaybe (T.unpack n) :: Maybe Double of+ Just d -> Right d+ Nothing -> Left n+ | otherwise = Left n+ -- 全 (id行 × value列) ペアから NA でない物だけ残す+ indices = [(i, j) | i <- [0 .. nrows - 1], j <- [0 .. length valueCols - 1]]+ keep = [ (i, j, v)+ | (i, j) <- indices+ , let (_, vs, _) = valData !! j+ , Just v <- [vs !! i]+ ]+ -- id 列を keep 行数ぶん展開+ mkIdCol (n, mxs) =+ let xs = case mxs of+ Just xs0 -> xs0+ Nothing -> replicate nrows ""+ ys = [ xs !! i | (i, _, _) <- keep ]+ in (n, ys)+ -- variable 列+ varValues = [ thd ((valData !! j)) | (_, j, _) <- keep ]+ where thd (_,_,c) = c+ -- value 列 (Double)+ valValues = [ v | (_, _, v) <- keep ]+ idColsOut = map mkIdCol idTexts+ df0 = foldl insertText DX.empty idColsOut+ df1 = case (parseVar, sequence (map varEither varValues)) of+ (True, Just ds) ->+ DX.insertColumn varName (DX.fromList (ds :: [Double])) df0+ _ ->+ let texts = map (either id (T.pack . show)) varValues+ in DX.insertColumn varName (DX.fromList texts) df0+ df2 = DX.insertColumn valueName (DX.fromList (valValues :: [Double])) df1+ in df2+ where+ insertText d (n, xs) = DX.insertColumn n (DX.fromList (xs :: [Text])) d+ varEither (Right d) = Just d+ varEither (Left _) = Nothing+ showCell Nothing = ""+ showCell (Just t) = t++-- | [日本語]: 列を 'Maybe Double' のリストとして取り出すヘルパ (内部用)。+-- 数値 / Maybe Double / Int / Maybe Int / Text 列のいずれでも対応。+-- [English]: Internal helper that extracts a column as a list of+-- 'Maybe Double'. Handles numeric / Maybe Double / Int / Maybe Int /+-- Text columns alike.+valueAsMaybeDouble :: Text -> DXD.DataFrame -> [Maybe Double]+valueAsMaybeDouble name df = case readMaybeDoubleColumn name df of+ Just xs -> xs+ Nothing -> replicate (fst (DX.dimensions df)) Nothing++-- ---------------------------------------------------------------------------+-- Long-form regrid (Phase G3): 歯抜けの long-form データを共通 grid に揃える+-- ---------------------------------------------------------------------------++-- | [日本語]: 共通 z 範囲の決定方式。+-- [English]: The method for determining the common z range.+data ZBoundsMode+ = ZIntersection -- ^ [日本語]: 全 id で観測がある区間: (max_id min_z, min_id max_z) — 外挿なし。+ -- [English]: The interval observed across all ids:+ -- (max_id min_z, min_id max_z) — no extrapolation.+ | ZUnion -- ^ [日本語]: 全 id をカバー: (min_id min_z, max_id max_z) — 外挿あり。+ -- [English]: Covers all ids: (min_id min_z,+ -- max_id max_z) — with extrapolation.+ deriving (Show, Eq)++-- | [日本語]: 'regridLong' の設定。+-- [English]: 'regridLong' settings.+data RegridOpts = RegridOpts+ { roInterp :: !Hanalyze.Stat.Interpolate.InterpKind+ , roGridKind :: !Hanalyze.Stat.AdaptiveGrid.GridKind+ , roN :: !Int+ , roZBoundsMode :: !ZBoundsMode+ , roCoarseN :: !Int -- ^ [日本語]: adaptive 用粗 grid サイズ (default 200)。+ -- [English]: Coarse grid size for adaptive mode (default 200).+ , roEpsRatio :: !Double -- ^ [日本語]: adaptive 用平坦部最低密度比 (default 0.05)。+ -- [English]: Minimum density ratio for flat regions in+ -- adaptive mode (default 0.05).+ } deriving (Show, Eq)++-- | [日本語]: 推奨デフォルト (PCHIP / Adaptive / N=30 / Intersection / coarse=200 / ε=0.05)。+-- [English]: Recommended defaults (PCHIP / Adaptive / N=30 /+-- Intersection / coarse=200 / ε=0.05).+defaultRegridOpts :: RegridOpts+defaultRegridOpts = RegridOpts+ { roInterp = Hanalyze.Stat.Interpolate.PCHIP+ , roGridKind = Hanalyze.Stat.AdaptiveGrid.Adaptive+ , roN = 30+ , roZBoundsMode = ZIntersection+ , roCoarseN = 200+ , roEpsRatio = 0.05+ }++-- | [日本語]: id ごとの統計 (G4 のレポートで使用)。+-- [English]: Per-id statistics (used by the G4 report).+data PerIdStat = PerIdStat+ { piId :: !Text+ , piNObserved :: !Int -- ^ [日本語]: 元観測点数。 [English]: Original observation count.+ , piZMin :: !Double -- ^ [日本語]: 観測 z 最小。 [English]: Observed z minimum.+ , piZMax :: !Double -- ^ [日本語]: 観測 z 最大。 [English]: Observed z maximum.+ , piExtrapBelow :: !Double -- ^ [日本語]: 共通 grid zmin が観測 zmin より小さい量 (>0 なら外挿)。+ -- [English]: The amount by which the common grid's zmin is+ -- smaller than the observed zmin (>0 means extrapolation).+ , piExtrapAbove :: !Double -- ^ [日本語]: 共通 grid zmax が観測 zmax より大きい量 (>0 なら外挿)。+ -- [English]: The amount by which the common grid's zmax is+ -- larger than the observed zmax (>0 means extrapolation).+ , piResidualMax :: !Double -- ^ [日本語]: 補間関数を観測 z に再投入したときの最大残差。+ -- [English]: The maximum residual when the interpolation+ -- function is re-evaluated at the observed z values.+ } deriving (Show, Eq)++-- | [日本語]: regridLong の戻り値。data + レポート用統計。+-- [English]: 'regridLong''s return value: data + statistics for the report.+data RegridResult = RegridResult+ { rrDataFrame :: !DXD.DataFrame+ , rrZGrid :: ![Double]+ , rrZMin :: !Double+ , rrZMax :: !Double+ , rrPerIdStats :: ![PerIdStat]+ , rrIds :: ![Text]+ , rrPerIdInterp :: ![(Text, [(Double, Double)], Double -> Double)]+ -- ^ [日本語]: id ごとに (id, 元観測点, 補間関数)。レポートのオーバーレイ用。+ -- [English]: Per id, (id, original observations, interpolation+ -- function). Used for report overlays.+ , rrDensity :: ![(Double, Double)] -- ^ [日本語]: adaptive 時の (z, density) ペア (空: uniform 時)。+ -- [English]: (z, density) pairs for adaptive mode+ -- (empty for uniform mode).+ }++-- | [日本語]: 歯抜けの long-form @[idCol, zCol, yCol]@ を共通 grid に揃える。+--+-- 1. idCol で groupBy → id ごとに (z, y) ペア取得 (NA は除外)+-- 2. ZBoundsMode に従って共通 (zmin, zmax) を決定+-- 3. 'Hanalyze.Stat.AdaptiveGrid.makeGrid' で N 点 grid を生成+-- 4. 各 id を 'Hanalyze.Stat.Interpolate.interp1d' で補間し grid 上で評価+-- 5. id × grid の long-form DataFrame を返す+--+-- 観測点が < 2 の id は補間できないため除外され、レポートに記録される。+-- [English]: Resamples a jagged long-form @[idCol, zCol, yCol]@ onto+-- a common grid.+--+-- 1. groupBy on idCol → get (z, y) pairs per id (NA excluded).+-- 2. Determine the common (zmin, zmax) according to ZBoundsMode.+-- 3. Generate an N-point grid via 'Hanalyze.Stat.AdaptiveGrid.makeGrid'.+-- 4. Interpolate each id via 'Hanalyze.Stat.Interpolate.interp1d'+-- and evaluate it on the grid.+-- 5. Return an id × grid long-form DataFrame.+--+-- Ids with fewer than 2 observed points can't be interpolated, so+-- they're excluded and recorded in the report.+regridLong+ :: Text -- ^ [日本語]: id 列名。 [English]: id column name.+ -> Text -- ^ [日本語]: z 列名。 [English]: z column name.+ -> Text -- ^ [日本語]: y 列名。 [English]: y column name.+ -> RegridOpts+ -> DXD.DataFrame+ -> RegridResult+regridLong idCol zCol yCol opts df =+ let -- 列を取り出す+ ids = case tryColumnAsList @Text idCol df of+ Just xs -> xs+ Nothing -> case tryColumnAsList @(Maybe Text) idCol df of+ Just xs -> map (maybe "" id) xs+ Nothing -> case tryColumnAsList @Double idCol df of+ Just xs -> map (T.pack . show) xs+ Nothing -> case tryColumnAsList @Int idCol df of+ Just xs -> map (T.pack . show) xs+ Nothing -> []+ zs = valueAsMaybeDouble zCol df+ ys = valueAsMaybeDouble yCol df+ -- (id, [(z, y)]) にグループ化、NA 行は除外+ triples = [ (i, z, y)+ | (i, mz, my) <- zip3 ids zs ys+ , Just z <- [mz]+ , Just y <- [my] ]+ grouped =+ let m = foldl (\acc (i, z, y) -> Map.insertWith (++) i [(z, y)] acc)+ Map.empty triples+ in [ (i, sortBy (Data.Ord.comparing fst) pts)+ | (i, pts) <- Map.toList m+ , length pts >= 2 ]+ idsKept = map fst grouped+ perIdPts = map snd grouped+ -- z 範囲+ ranges = [ (minimum (map fst pts), maximum (map fst pts)) | pts <- perIdPts ]+ (zmin, zmax) = case roZBoundsMode opts of+ ZIntersection ->+ if null ranges+ then (0, 1)+ else (maximum (map fst ranges), minimum (map snd ranges))+ ZUnion ->+ if null ranges+ then (0, 1)+ else (minimum (map fst ranges), maximum (map snd ranges))+ -- 共通 grid+ gridSpec = Hanalyze.Stat.AdaptiveGrid.GridSpec+ { Hanalyze.Stat.AdaptiveGrid.gsKind = roGridKind opts+ , Hanalyze.Stat.AdaptiveGrid.gsN = roN opts+ , Hanalyze.Stat.AdaptiveGrid.gsInterpKind = roInterp opts+ , Hanalyze.Stat.AdaptiveGrid.gsCoarseN = roCoarseN opts+ , Hanalyze.Stat.AdaptiveGrid.gsEpsRatio = roEpsRatio opts+ }+ grid = Hanalyze.Stat.AdaptiveGrid.makeGrid perIdPts (zmin, zmax) gridSpec+ -- id ごとに補間関数 + grid 上の y を評価+ interpFns = [ (i, pts, Hanalyze.Stat.Interpolate.interp1d (roInterp opts) pts)+ | (i, pts) <- grouped ]+ perIdY = [ map f grid | (_, _, f) <- interpFns ]+ -- 統計+ stats = [ let zMn = fst rg+ zMx = snd rg+ extL = max 0 (zMn - zmin)+ extU = max 0 (zmax - zMx)+ residMax = if null pts then 0+ else maximum [ abs (f z - y) | (z, y) <- pts ]+ in PerIdStat+ { piId = i+ , piNObserved = length pts+ , piZMin = zMn+ , piZMax = zMx+ , piExtrapBelow = extL+ , piExtrapAbove = extU+ , piResidualMax = residMax+ }+ | ((i, pts, f), rg) <- zip interpFns ranges+ ]+ -- 出力 long DataFrame: 行数 = nIds × len grid+ n = length grid+ idsOut = concat [ replicate n i | i <- idsKept ]+ zsOut = concat (replicate (length idsKept) grid)+ ysOut = concat perIdY+ dfOut = DX.insertColumn yCol (DX.fromList ysOut)+ $ DX.insertColumn zCol (DX.fromList zsOut)+ $ DX.insertColumn idCol (DX.fromList idsOut)+ $ DX.empty+ -- adaptive density (レポート用): coarse grid 上の (z, density)+ density = case roGridKind opts of+ Hanalyze.Stat.AdaptiveGrid.Uniform -> []+ Hanalyze.Stat.AdaptiveGrid.Adaptive -> computeDensity perIdPts (roInterp opts)+ (roCoarseN opts) zmin zmax+ in RegridResult+ { rrDataFrame = dfOut+ , rrZGrid = grid+ , rrZMin = zmin+ , rrZMax = zmax+ , rrPerIdStats = stats+ , rrIds = idsKept+ , rrPerIdInterp = interpFns+ , rrDensity = density+ }+ where+ sortBy = Data.List.sortBy++-- | [日本語]: 内部: adaptive レポート用の (z, max_id |dy/dz|) 列を再計算 (G4 の R3 で表示)。+-- [English]: Internal: recomputes the (z, max_id |dy/dz|) column for+-- the adaptive report (shown in G4's R3).+computeDensity+ :: [[(Double, Double)]] -> Hanalyze.Stat.Interpolate.InterpKind -> Int+ -> Double -> Double+ -> [(Double, Double)]+computeDensity perIdPts kind coarseN zmin zmax =+ let coarse = Hanalyze.Stat.AdaptiveGrid.uniformGrid coarseN zmin zmax+ ysPerId = [ map (Hanalyze.Stat.Interpolate.interp1d kind pts) coarse+ | pts <- perIdPts, length pts >= 2 ]+ slopeAbsLocal zs ys =+ let n = length zs+ zarr = zs+ yarr = ys+ in [ if n < 2 then 0+ else if i == 0 then abs ((yarr !! 1 - yarr !! 0) /+ (zarr !! 1 - zarr !! 0))+ else if i == n - 1 then abs ((yarr !! (n-1) - yarr !! (n-2)) /+ (zarr !! (n-1) - zarr !! (n-2)))+ else abs ((yarr !! (i+1) - yarr !! (i-1)) /+ (zarr !! (i+1) - zarr !! (i-1)))+ | i <- [0 .. n-1] ]+ slopes = map (slopeAbsLocal coarse) ysPerId+ peak = if null slopes+ then replicate coarseN 0+ else [ maximum [ s !! i | s <- slopes ] | i <- [0 .. coarseN - 1] ]+ in zip coarse peak++-- 既存モジュールでの import 追加+-- (tryColumnAsList などは元々 import 済み、Map.insertWith / Data.List.sortBy /+-- Data.Ord.comparing も import 済み)++-- 補助 import (修飾名で参照するため)+{-# NOINLINE _placeholderRegridImports #-}+_placeholderRegridImports :: ()+_placeholderRegridImports = ()
+ src/Hanalyze/DataIO/Reshape.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.DataIO.Reshape+-- Description : Hackage dataframe に無い reshape 操作 (pivotWider・oneHot・lag/lead・rolling)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- Data-frame reshaping helpers that are missing in Hackage+-- @dataframe@:+--+-- * 'pivotWider' — long → wide reshape (inverse of @meltLonger@).+-- * 'oneHot' — one-hot encoding of a categorical column.+-- * @lag@ / @lead@ — shift a numeric column for time-series feature+-- engineering.+-- * 'rollingMean' / 'rollingSum' — fixed-window rolling stats.+--+-- For @join@, @sortBy@, @meltLonger@ etc., use the upstream+-- @DataFrame@ API directly — those are first-class there.+module Hanalyze.DataIO.Reshape+ ( pivotWider+ , oneHot+ , lagColumn+ , leadColumn+ , rollingMean+ , rollingSum+ , rollingApply+ ) where++import qualified Data.Text as T+import qualified Data.Vector as V+import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX+import qualified DataFrame.Operations.Subset as DX+import qualified DataFrame.Internal.DataFrame as DXD+import qualified Hanalyze.DataIO.Convert as Conv+import Data.Maybe (fromMaybe)+import qualified Data.Set as Set++-- ---------------------------------------------------------------------------+-- Pivot wider+-- ---------------------------------------------------------------------------++-- | Reshape a long-form DataFrame into wide form. Inverse of+-- @meltLonger@.+--+-- Given:+--+-- * a DataFrame with rows like @(id, name, value)@,+-- * @namesFrom@ = the column whose distinct values become new+-- column names,+-- * @valuesFrom@ = the column holding the values to spread,+-- * @idCols@ = identifier columns kept as the row key.+--+-- Produces a DataFrame where each unique value of @namesFrom@ becomes+-- a new column. Missing combinations are filled with NaN (as Double).+--+-- Example: long-form @[(1, "x", 10), (1, "y", 20), (2, "x", 30)]@ →+-- wide-form @[(1, 10, 20), (2, 30, NaN)]@ with columns+-- @[id, x, y]@.+pivotWider+ :: [T.Text] -- ^ Identifier columns.+ -> T.Text -- ^ Column with new column names (@namesFrom@).+ -> T.Text -- ^ Column with values to spread (@valuesFrom@).+ -> DXD.DataFrame+ -> DXD.DataFrame+pivotWider idCols namesFrom valuesFrom df =+ let nameVec = fromMaybe (error ("pivotWider: column '"+ ++ T.unpack namesFrom+ ++ "' not found"))+ (Conv.getTextVec namesFrom df)+ valueVec = fromMaybe (error ("pivotWider: column '"+ ++ T.unpack valuesFrom+ ++ "' not found"))+ (Conv.getDoubleVec valuesFrom df)+ n = V.length nameVec+ -- Distinct names (preserves order of first appearance).+ distinct = orderedUnique (V.toList nameVec)+ -- Get id-column values per row as a tuple key.+ idColVecs = [ fromMaybe (error ("pivotWider: id col '"+ ++ T.unpack c ++ "' not found"))+ (Conv.getTextVec c df+ `mappendMaybe`+ fmap (V.map (T.pack . show))+ (Conv.getDoubleVec c df))+ | c <- idCols ]+ -- Group rows by id-key.+ keyOf i = [vec V.! i | vec <- idColVecs]+ keys = orderedUnique [keyOf i | i <- [0..n-1]]+ -- For each (key, name) compute the value (NaN if missing).+ lookup1 key name =+ let matching = [ V.unsafeIndex valueVec i+ | i <- [0..n-1]+ , keyOf i == key+ , V.unsafeIndex nameVec i == name+ ]+ in case matching of+ [] -> 0/0 -- NaN+ (v:_) -> v+ -- Build wide DataFrame.+ keyToTexts k = k -- already [Text]+ idCols' = [ (c, V.fromList [V.unsafeIndex (idColVecs !! ci) i+ | i <- rowIndices])+ | (ci, c) <- zip [0..] idCols ]+ rowIndices = [ head [i | i <- [0..n-1], keyOf i == k] | k <- keys ]+ _ = idCols'+ _ = keyToTexts+ -- Wide columns.+ wideCols = [ (name,+ V.fromList [lookup1 k name | k <- keys])+ | name <- distinct ]+ -- Build via DX.fromList so the dataframe knows column types.+ idColData = [ (c, DX.fromList (V.toList (V.fromList+ [V.unsafeIndex (idColVecs !! ci) i+ | i <- rowIndices])))+ | (ci, c) <- zip [0..] idCols ]+ wideColData = [ (name,+ DX.fromList (V.toList vs))+ | (name, vs) <- wideCols ]+ in DX.fromNamedColumns (idColData ++ wideColData)++-- | Append the second 'Maybe' as a fallback if the first is Nothing.+mappendMaybe :: Maybe a -> Maybe a -> Maybe a+mappendMaybe (Just x) _ = Just x+mappendMaybe Nothing y = y++-- ---------------------------------------------------------------------------+-- One-hot encoding+-- ---------------------------------------------------------------------------++-- | One-hot encode a categorical text column. Returns a DataFrame+-- with the original column dropped and one new 0/1 indicator column+-- per category (named "@<col>_<category>@").+--+-- @dropFirst@ controls whether to omit the first category (= drop+-- redundant column for use in regression to avoid multicollinearity).+oneHot+ :: Bool -- ^ Drop first category?+ -> T.Text -- ^ Categorical column name.+ -> DXD.DataFrame+ -> DXD.DataFrame+oneHot dropFirst colName df =+ let vec = fromMaybe (error ("oneHot: column '"+ ++ T.unpack colName ++ "' not found"))+ (Conv.getTextVec colName df)+ n = V.length vec+ cats = orderedUnique (V.toList vec)+ keep = if dropFirst then drop 1 cats else cats+ indicator c =+ DX.fromList [ if V.unsafeIndex vec i == c then (1 :: Double)+ else 0+ | i <- [0..n-1] ]+ newCols = [(colName <> "_" <> c, indicator c) | c <- keep]+ withoutOrig = DX.exclude [colName] df+ in foldr (\(name, col) d -> DX.insertColumn name col d)+ withoutOrig newCols++-- ---------------------------------------------------------------------------+-- Lag / Lead+-- ---------------------------------------------------------------------------++-- | Shift a numeric column @k@ positions forward (lag). The first @k@+-- entries become NaN. Useful for time-series feature engineering.+lagColumn+ :: Int -- ^ k (positive).+ -> T.Text -- ^ Source column.+ -> T.Text -- ^ Output column name.+ -> DXD.DataFrame+ -> DXD.DataFrame+lagColumn k src out df =+ let vec = fromMaybe (error ("lagColumn: column '"+ ++ T.unpack src ++ "' not found"))+ (Conv.getDoubleVec src df)+ n = V.length vec+ shifted = V.fromList+ [ if i < k then 0/0+ else V.unsafeIndex vec (i - k)+ | i <- [0..n-1] ]+ in DX.insertColumn out (DX.fromList (V.toList shifted)) df++-- | Shift a numeric column @k@ positions backward (lead). The last+-- @k@ entries become NaN.+leadColumn+ :: Int+ -> T.Text+ -> T.Text+ -> DXD.DataFrame+ -> DXD.DataFrame+leadColumn k src out df =+ let vec = fromMaybe (error ("leadColumn: column '"+ ++ T.unpack src ++ "' not found"))+ (Conv.getDoubleVec src df)+ n = V.length vec+ shifted = V.fromList+ [ if i + k >= n then 0/0+ else V.unsafeIndex vec (i + k)+ | i <- [0..n-1] ]+ in DX.insertColumn out (DX.fromList (V.toList shifted)) df++-- ---------------------------------------------------------------------------+-- Rolling window+-- ---------------------------------------------------------------------------++-- | Rolling mean with a fixed window size. The first @(window-1)@+-- entries are NaN.+rollingMean+ :: Int -- ^ Window size.+ -> T.Text -- ^ Source column.+ -> T.Text -- ^ Output column.+ -> DXD.DataFrame+ -> DXD.DataFrame+rollingMean win src out =+ rollingApply win mean src out+ where+ mean xs = sum xs / fromIntegral (length xs)++-- | Rolling sum with a fixed window size.+rollingSum+ :: Int+ -> T.Text+ -> T.Text+ -> DXD.DataFrame+ -> DXD.DataFrame+rollingSum win = rollingApply win sum++-- | Apply an arbitrary aggregation @f :: [Double] -> Double@ over a+-- rolling window. The first @(window-1)@ entries become NaN.+rollingApply+ :: Int+ -> ([Double] -> Double)+ -> T.Text+ -> T.Text+ -> DXD.DataFrame+ -> DXD.DataFrame+rollingApply win f src out df =+ let vec = fromMaybe (error ("rollingApply: column '"+ ++ T.unpack src ++ "' not found"))+ (Conv.getDoubleVec src df)+ n = V.length vec+ results = V.fromList+ [ if i + 1 < win then 0/0+ else f [V.unsafeIndex vec (i - win + 1 + j) | j <- [0..win-1]]+ | i <- [0..n-1] ]+ in DX.insertColumn out (DX.fromList (V.toList results)) df++-- ---------------------------------------------------------------------------+-- Internal helpers+-- ---------------------------------------------------------------------------++-- | Distinct values, preserving order of first appearance.+orderedUnique :: Ord a => [a] -> [a]+orderedUnique = go Set.empty+ where+ go _ [] = []+ go seen (x:xs)+ | Set.member x seen = go seen xs+ | otherwise = x : go (Set.insert x seen) xs
+ src/Hanalyze/DataIO/Sniff.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Hanalyze.DataIO.Sniff+-- Description : CSV の delimiter・comment・header 有無・NA 候補を先頭 8KB から推測する+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- Auto-detect a CSV's delimiter, comment lines, presence of header,+-- and NA candidates by inspecting the first 8 KB. While @LoadOpts@ lets+-- the user state these explicitly, this module adds a layer that guesses+-- when nothing is specified.+--+-- Design notes:+--+-- * 8 KB is assumed to be enough to decide structure (we don't stream+-- huge files).+-- * Inference results live in a 'Sniff' record. Supporting evidence+-- (per-delimiter scores etc.) is recorded in 'sfNotes' and emitted+-- as Info codes through @LogReport@.+-- * Sniffing is best-effort and decoupled from the strict path: users+-- can disable it entirely with @--no-sniff@, or escalate any+-- mismatch to an error with @--strict@.+module Hanalyze.DataIO.Sniff+ ( -- * 型+ Sniff (..)+ , defaultSniff+ -- * Inference+ , sniffBytes+ , sniffFile+ -- * Per-check helpers (exposed for tests)+ , detectDelimiter+ , detectHasHeader+ , detectSkip+ , detectCommentChar+ ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Char (ord, isDigit)+import Data.List (sortBy, maximumBy)+import Data.Ord (comparing)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Read (readMaybe)++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++-- | Result of sniffing a file's structure.+data Sniff = Sniff+ { sfDelim :: !Char -- ^ Inferred delimiter+ -- (@\",\" \";\" \"\\t\" \" \" \"|\"@).+ , sfHasHeader :: !Bool -- ^ Does the file appear to have a+ -- header row? When 'False', generate+ -- @col0@-style names.+ , sfSkip :: !Int -- ^ Number of leading rows to skip+ -- (comments / metadata).+ , sfCommentChar :: !(Maybe Char) -- ^ Comment-line prefix character, if+ -- detected.+ , sfNotes :: ![Text] -- ^ Human-readable notes on the+ -- inference (used by @LogReport@).+ } deriving (Eq, Show)++-- | Default sniff result: comma-delimited, header present, no skip, no+-- comment char.+defaultSniff :: Sniff+defaultSniff = Sniff+ { sfDelim = ','+ , sfHasHeader = True+ , sfSkip = 0+ , sfCommentChar = Nothing+ , sfNotes = []+ }++-- ---------------------------------------------------------------------------+-- 公開 API+-- ---------------------------------------------------------------------------++-- | Sniff a file by reading its first 8 KB.+sniffFile :: FilePath -> IO Sniff+sniffFile path = do+ bs <- BS.readFile path+ return (sniffBytes (BS.take 8192 bs))++-- | Sniff a byte buffer directly (for testing or non-file sources).+sniffBytes :: BS.ByteString -> Sniff+sniffBytes bs0 =+ let bs = stripBOM bs0+ ls0 = filter (not . BS.null) (BS.split (fromIntegral (ord '\n')) bs)+ ls = map stripCR ls0+ (skipN, mComment) = detectSkip ls+ dataLines = drop skipN ls+ delim = detectDelimiter dataLines+ hasHdr = detectHasHeader delim dataLines+ notes = mconcat+ [ ["delimiter = " <> renderDelim delim]+ , ["header = " <> if hasHdr then "yes" else "no"]+ , [ "skip = " <> T.pack (show skipN)+ | skipN > 0 ]+ , [ "comment = '" <> T.singleton c <> "'"+ | Just c <- [mComment] ]+ ]+ in Sniff+ { sfDelim = delim+ , sfHasHeader = hasHdr+ , sfSkip = skipN+ , sfCommentChar = mComment+ , sfNotes = notes+ }++renderDelim :: Char -> Text+renderDelim '\t' = "tab"+renderDelim ' ' = "space"+renderDelim c = "'" <> T.singleton c <> "'"++-- ---------------------------------------------------------------------------+-- delimiter 推論+-- ---------------------------------------------------------------------------++-- | [日本語]: 候補 delimiter ('`,;\t|`') について各行での出現数を取り、+-- 「行ごとの分散が小さい」 + 「中央値の出現数が多い」を優先する。+-- そもそも空入力やシングル行の場合は ',' を返す。+-- [English]: For each candidate delimiter (@,;\t|@), takes the+-- per-line occurrence count, preferring "low variance across lines"+-- + "high median occurrence count". Returns ',' for empty input or a+-- single line to begin with.+detectDelimiter :: [BS.ByteString] -> Char+detectDelimiter [] = ','+detectDelimiter ls =+ let candidates = ',' : ';' : '\t' : '|' : []+ score c =+ let counts = map (BS.count (fromIntegral (ord c))) (take 20 ls)+ in (median counts, varianceD counts) -- (大→良, 小→良)+ -- variance を最優先で昇順 (= 列数が安定している = 確実な delimiter)、+ -- 次に median を降順 (出現数が多いほど良い)。+ -- median 優先だと "1,5;2,5;3,0" のような文字列で comma が 3 出るために+ -- 誤って comma が選ばれてしまう。+ cmp a b =+ let (ma, va) = score a+ (mb, vb) = score b+ in compare va vb <> compare mb ma+ ranked = sortBy cmp candidates+ in case ranked of+ (c:_) | fst (score c) >= 1 -> c+ _ -> ','++median :: [Int] -> Int+median xs =+ let s = sortBy compare xs+ n = length s+ in if n == 0 then 0 else s !! (n `div` 2)++-- | [日本語]: 整数除算で潰さない分散 (Double で計算)。+-- [English]: Variance computed in 'Double' so integer division doesn't+-- truncate it to zero.+varianceD :: [Int] -> Double+varianceD xs =+ let n = length xs+ m = (fromIntegral (sum xs) :: Double) / fromIntegral (max 1 n)+ in if n <= 1 then 0+ else sum [ (fromIntegral x - m) ** 2 | x <- xs ] / fromIntegral (n - 1)++-- ---------------------------------------------------------------------------+-- ヘッダ有無の推論+-- ---------------------------------------------------------------------------++-- | [日本語]: 1 行目の各セルが全て numeric token なら「ヘッダ無し」と判断する。+-- それ以外 (text を含む) は「ヘッダ有り」。空入力は True を返す+-- (Hackage が空 CSV を弾くため、あとはそちら側で扱う)。+-- [English]: If every cell in the first line is a numeric token,+-- judges the file to have "no header". Otherwise (containing text)+-- it's judged to "have a header". Empty input returns True (Hackage+-- rejects empty CSVs, so that case is handled on that side).+detectHasHeader :: Char -> [BS.ByteString] -> Bool+detectHasHeader _ [] = True+detectHasHeader delim (l:_) =+ let cells = BS.split (fromIntegral (ord delim)) l+ tokens = map (T.strip . decodeAscii) cells+ isNum t = case readMaybe (T.unpack t) :: Maybe Double of+ Just _ -> True+ Nothing -> False+ in not (all isNum tokens)+ || null tokens+ || all T.null tokens++-- ---------------------------------------------------------------------------+-- 先頭 skip / コメント文字の推論+-- ---------------------------------------------------------------------------++-- | [日本語]: 先頭から「コメント文字」で始まる行が連続する数を skip 候補とする。+-- コメント文字は @#@ / @!@ / @;@ / @\/\/@ のどれか。検出文字も返す。+-- [English]: The number of consecutive lines from the top starting+-- with a "comment character" is taken as the skip candidate. The+-- comment character is one of @#@ / @!@ / @;@ / @\/\/@. The detected+-- character is also returned.+detectSkip :: [BS.ByteString] -> (Int, Maybe Char)+detectSkip ls =+ let candidates = ['#', '!']+ n c = length (takeWhile (startsWith c) ls)+ best = maximumBy (comparing (\c -> n c)) candidates+ k = n best+ in if k > 0+ then (k, Just best)+ else (0, Nothing)++startsWith :: Char -> BS.ByteString -> Bool+startsWith c bs =+ let bs' = BS.dropWhile (\b -> b == fromIntegral (ord ' ')+ || b == fromIntegral (ord '\t')) bs+ in case BS.uncons bs' of+ Just (h, _) -> h == fromIntegral (ord c)+ Nothing -> False++-- | [日本語]: 'detectSkip' の結果からコメント文字だけ取り出すラッパ。+-- [English]: A wrapper that extracts just the comment character from+-- 'detectSkip''s result.+detectCommentChar :: [BS.ByteString] -> Maybe Char+detectCommentChar = snd . detectSkip++-- ---------------------------------------------------------------------------+-- ユーティリティ+-- ---------------------------------------------------------------------------++stripCR :: BS.ByteString -> BS.ByteString+stripCR bs+ | BS.null bs = bs+ | BS.last bs == fromIntegral (ord '\r') = BS.init bs+ | otherwise = bs++stripBOM :: BS.ByteString -> BS.ByteString+stripBOM bs+ | BS.length bs >= 3+ , BS.index bs 0 == 0xEF+ , BS.index bs 1 == 0xBB+ , BS.index bs 2 == 0xBF = BS.drop 3 bs+ | otherwise = bs++decodeAscii :: BS.ByteString -> Text+decodeAscii = T.pack . BS8.unpack++-- 未使用ワーニング抑止+_unusedRefs :: ([Char], Char -> Bool)+_unusedRefs = ("?", isDigit)