有懂Haskell的吗 [委屈]

HoshinoTented @ 2019-07-22 16:19:52

{-# LANGUAGE BangPatterns #-}

import qualified Data.Vector.Unboxed as V
import Data.Vector.Unboxed ((!), (//))

type UnionFind = V.Vector Int
type UnionFindM = State UnionFind

ask :: UnionFind -> Int -> (UnionFind, Int)
ask !vec !i = if vec ! i == i then (vec, i) else 
    let (!vec', !result) = ask vec $ vec ! i in
        (vec' // [(i, result)], result)

cat :: UnionFind -> Int -> Int -> UnionFind
cat !vec !x !y = let (!vec', !x') = ask vec x in
    let (!vec'', !y') = ask vec' y in
        vec // [(x', y')]

resolve :: Int -> UnionFind -> IO ()
resolve 0 _ = return ()
resolve !n !uf = do
    [!z, !x, !y] <- map read . words <$> getLine :: IO [Int]

    !uf' <- if z == 1 then return $ cat uf x y else 
        let (!vec, !x') = ask uf x
            (!vec', !y') = ask vec y in 
            putStrLn (if x' == y' then "Y" else "N") >>= const (return vec')

    resolve (n - 1) uf'

main :: IO ()
main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]

    resolve m $ V.generate (n + 1) id

    return ()

by HoshinoTented @ 2019-07-22 16:22:44

第七行应该删除（

by Faithqe @ 2019-07-22 16:42:39

Orz 巨佬（只在《算法新解》里看到过这种神奇的语言

by 千里冰封ice @ 2019-07-23 05:15:01

有的，只不过这些优化都非常非常的 tricky。我穷尽了我所有的（aka 五道口男子职业技术学院里面那几个怪物的百分之一） Haskell 性能调优知识，把这道题 AC 了。

首先我直接以萝莉这个题解为模板（因为 State Monad 的写法会和 Mutable Vector 需要的 RealWorld Monad 冲突，但我并不想在这个地方引入 Monad Transformer），试图在这上面进行性能优化。

我总共使用了 4 个（针对 Haskell 的特定）优化方式，才 AC 了这道题。

我分几条回复来发吧……感觉这个会写得比较长。

by 千里冰封ice @ 2019-07-23 05:24:11

Mutable Vector

首先 Haskell 的 Data.Vector.Unboxed 虽然已经是针对非 FFI 需求的特殊优化的版本了，它依然是较低性能的——对它进行写入，（疑似它）会返回一个新创建的 Vector。这导致了很大的拷贝开销，是我们不希望的。所以这个时候要使用可变数据结构+指针，也就是 Data.Vector.Unboxed.Mutable 里面的 MVector。

由于这是可变数据结构，所以不再是纯函数式的，因此需要在 Haskell 里面进行命令式编程，也就是使用 IO Monad（这也正是 MVector 的设计——你需要给它指定一个 IO 或者 ST 这种命令式专用的 Monad）。我拿 GHCi 试了试 （弱鸡操作实锤了） ，针对 IO 特化的 MVector 的类型是 MVector RealWorld a，而 IO Monad 包裹的是一个叫 RealWorld 的 Monad，位于 GHC.Prim 里面，所以我们需要使用的 vector 类型是：

import qualified Data.Vector.Unboxed.Mutable as V
import           GHC.Prim                    (RealWorld)

type UnionFind = V.MVector RealWorld Int

然后，所有的独写操作，全部需要包进 IO：

vec                 :: UnionFind
i, datum            :: Int
V.write vec i datum :: IO ()
V.read  vec i       :: IO Int

然后这里的 vec 是引用语义的，因此我们不需要四处传递这个 vec，只需要把它传给一些函数，让函数们操作这个 vec，不再需要让函数返回这个被操作过后的 vec。 类似一个 Rust 里面的 &mut，但是可以弄很多个。

by 千里冰封ice @ 2019-07-23 05:32:56

Text String

Haskell 的 String 类型是一个非常挥霍内存的类型，作为 [Char] 的类型别名，它可以直接被当作列表使用，因此有一大饼语法糖可以用；但是它里面的每一个字符都是一个【链表（而且还是个 tagged union 的链表）节点内部包裹一个 UTF-8 字符】，众所周知 UTF-8 是一个不定长的字符编码，本身把一大串字符存进一个完整的字节数组然后使用类似字节流的方式遍历（这也是为什么 Rust 的字符串推荐通过调用 chars() 的方式遍历的原因）比把每个字符分开存放进一个 char32_t[] 要高效得多。因此我们使用 Haskell 中更节省内存的类型 Data.Text，并使用它配套的 io 包 Data.Text.IO，可以避免同时在内存里存在大量的字符串（当然，在把字符串转换为 Int 时，还是必须转成 String 类型的，但这种时候每次只会同时存在一个 String，不会满内存都是 String——至少 words 的时候不需要整一堆 String 了）。

import qualified Data.Text                   as T
import qualified Data.Text.IO                as I

resolve :: Int -> UnionFind -> IO ()
resolve 0 _ = pure ()
resolve n uf = do
  [z, x, y] <- map (read . T.unpack) . T.words <$> I.getLine
  -- omitted

main :: IO ()
main = do
  [n, m] <- map (read . T.unpack) . T.words <$> I.getLine
  -- omitted

by 千里冰封ice @ 2019-07-23 05:36:39

读入优化

我自己不是很信任 read 的性能——它实际上是一个 Haskell object 的 Parser，而不是类似 scanf 那样的纯粹的数据读取器。 事实上，经过测试，这个读入优化是必须的。

这个读入优化和 C 系语言的 OI 读入优化思路差球不多，都是钦点读入数据一定是合法的 Int。

import           Data.Char

int :: String -> Int
int s = int' s 0
  where
    int' [    ] n = n
    int' (c:cs) n = int' cs $ n * 10 + (ord c - ord '0')

然后用这个读入优化替换 read：

resolve n uf = do
  [z, x, y] <- map (int . T.unpack) . T.words <$> I.getLine
  -- omitted

main = do
  [n, m] <- map (int . T.unpack) . T.words <$> I.getLine
  -- omitted

by 千里冰封ice @ 2019-07-23 05:43:28

调整优化的编译参数

惰性求值会妨碍尾递归优化，因此我们使用严格求值（此处应验了湛忠胜的知乎回答）：

{-# LANGUAGE Strict #-}

以及，这种场合似乎开 O2 优化有奇效，但是洛谷的那个“使用 O2 优化”的按钮非常的扭曲，作用好像就是在代码顶部加一句注释，而且这个注释还是 C 语法的注释，在 Haskell 里面算是一句语法错误的代码，因此我们使用这个办法加优化参数：

{-# GHC-OPTIONS -O2 #-}

by 千里冰封ice @ 2019-07-23 05:44:42

然后就 AC 啦 \~ 大概第二个点 300-400 ms 左右，应该比较正常。

我在 AC 后测试了一下，去掉那个看起来没什么卵用的读入优化，保持其他三个，依然会 TLE。

by 千里冰封ice @ 2019-07-23 05:58:19

另外萝莉，BangPatterns 是指定部分代码严格求值，而 Strict 是全局的

by HoshinoTented @ 2019-07-23 15:31:32

好的好的，十分感谢千里冰封大佬的留言