需要帮助分析代码和分析结果

Question

我试图让一个功能更高效，但我把它做得最糟糕，我不明白为什么。有人能看出原因并向我解释吗？

原始函数：

substringsSB s = substringsSB' Set.empty s
substringsSB' m s = substrings' m s
  where
    substrings' m s  = {-# SCC "substrings'" #-}if (Set.member s m) then m else foldl' insertInits m (init . B.tails $ s)
    insertInits m s = {-# SCC "insertInits" #-}if (Set.member s m) then m else foldl' doInsert m (tail . B.inits $ s)
    doInsert m k = {-# SCC "doInsert" #-}Set.insert k m

分析结果：

    total time  =        3.14 secs   (157 ticks @ 20 ms)
    total alloc = 1,642,067,360 bytes  (excludes profiling overheads)

COST CENTRE                    MODULE               %time %alloc

doInsert                       Main                  95.5   92.1
insertInits                    Main                   2.5    7.8
substringsSB'                  Main                   1.9    0.0


                                                                                               individual    inherited
COST CENTRE              MODULE                                               no.    entries  %time %alloc   %time %alloc

MAIN                     MAIN                                                   1           0   0.0    0.0   100.0  100.0
 main                    Main                                                 280           1   0.0    0.0   100.0  100.0
  substringsSB           Main                                                 281           1   0.0    0.0   100.0  100.0
   substringsSB'         Main                                                 282           1   1.9    0.0   100.0  100.0
    doInsert             Main                                                 285     1233232  95.5   92.1    95.5   92.1
    insertInits          Main                                                 284        1570   2.5    7.8     2.5    7.8
    substrings'          Main                                                 283           1   0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Handle.FD                                     211           3   0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Encoding.Iconv                                169           2   0.0    0.0     0.0    0.0
 CAF                     GHC.Conc.Signal                                      166           1   0.0    0.0     0.0    0.0

据我所知，我们不能在 foldfoldl 中提前退出，因此该函数可能会花费大量时间仅调用 < code>Set.member s m 并在 substrings' 中返回 m。因此，我将函数转换为使用递归：

substringsSB s = substringsSB' Set.empty s
substringsSB' m str = substrings' m (init . B.tails $ str)
  where
    substrings' m [] = m
    substrings' m (s:ss) | Set.member s m = m
                         | otherwise      = {-# SCC "substrings'" #-}substrings' insertTail ss
                         where insertTail = insertInits m $ reverse $ (tail . B.inits $ s)
    insertInits m [] = m
    insertInits m (s:ss) | Set.member s m = m
                         | otherwise      = {-# SCC "insertInits" #-}insertInits (doInsert s m) ss
    doInsert k m = {-# SCC "doInsert" #-}Set.insert k m

分析结果：

    total time  =        5.16 secs   (258 ticks @ 20 ms)
    total alloc = 1,662,535,200 bytes  (excludes profiling overheads)

COST CENTRE                    MODULE               %time %alloc

doInsert                       Main                  54.7   90.5
substringsSB'                  Main                  43.8    9.5
insertInits                    Main                   1.6    0.0


                                                                                               individual    inherited
COST CENTRE              MODULE                                               no.    entries  %time %alloc   %time %alloc

MAIN                     MAIN                                                   1           0   0.0    0.0   100.0  100.0
 main                    Main                                                 280           1   0.0    0.0   100.0  100.0
  substringsSB           Main                                                 281           1   0.0    0.0   100.0  100.0
   substringsSB'         Main                                                 282           1  43.8    9.5   100.0  100.0
    doInsert             Main                                                 285     1225600  54.7   90.5    54.7   90.5
    insertInits          Main                                                 284     1225600   1.6    0.0     1.6    0.0
    substrings'          Main                                                 283        1568   0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Handle.FD                                     211           3   0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Encoding.Iconv                                169           2   0.0    0.0     0.0    0.0
 CAF                     GHC.Conc.Signal                                      166           1   0.0    0.0     0.0    0.0

但这比原始版本花费更多时间。 为什么要在 substringsSB' 上花费如此多的时间？ 它只是在执行 init 。 B.tails $ str 原始版本也称为... 或者我犯了一个错误，这两个函数在逻辑上不相等？

main = do
  s <- getLine
  let m = substringsSB $ B.pack s
  print $ Set.size m
  return ()

有输入：

asjasdfkjasdfjkasdjlflaasdfjklajsdflkjasvdadufhsaodifkljaiduhfjknhdfasjlkdfndbhfisjglkasnjjfgklsadmsjnhsjdflkmsnajjkdlsmfnjsdkfljasd;fjlkasdjfklasjdfnasdfjjnsadfjsadfhasjdfjlaksdfjlkasdfjljkasdflasidfjlaisjdflaisdjflaisjdfliasjdgfouqhagdfsia;klsjdfnklajsdfkhkasfhjdasdfhaskdflhjaklsdfh;kjlasdfh;jlaksdflkhajsdfkjahsdfkjhasdfkkasdfkjlkasfdkljasdfkhljkasdkflkjasdfasdlfkajsdlfkjaslkdfjjaksdjgujhgjhghjbjnbghjghhgfghfghvfgfgjhgjhdfjfjhgfjgvjhgvjhgvjhgvjhgvjhgvjhasdkfjkasdjfklajsdfklkahsdfjklhjklhghjhkhgfvcghjkjhghjkjhhvjkl/ljklkjlkjlkjlkjaslkdfjasd;lkfjas;dlfkjas;dflkjas;dflkjas;dflkjas;dflkja;slkdfja;sdlkjfa;sdlkfja;lsdfkjas;ldkfja;sdlkfja;skldfja;slkdjfa;slkdfja;sdklfjas;dlkfjas;dklfjas;dlkfjas;dfkljas;dflkjas;lkdfja;sldkfj;aslkdfja;sldkfja;slkdfj;alksdjf;alsdkfj;alsdkfja;sdflkja;sdflkja;sdlfkja;sdlfkja;sldkfja;sdlkfja;sldfkj;asldkfja;sldkfja;lsdkfja;sldfkja;sdlfjka;sdlfjkas;dlkfjas;ldkfjas;dlfkjasfd;lkjasd;fljkads;flkjasdf;lkjasdf;lkajsdf;lkajsdf;aksljdf;alksjdfa;slkdjfa;slkdjfa;slkdfja;sdflkjas;dflkjasd;flkjasd;flkjasdf;lkjasdf;ljkasdf;lkajdsf;laksjf;asldfkja;sdfljkads;flkjasd;fljkasdf;lkjasdf;ljkadfs;fljkadfs;ljkasdf;lajksdf;lkajsdf;lajsfd;laksdfgvjhgvjhgvjhcfjhgcjfgvjkgvjjgfjghfhgkhkjhbkjhbkjhbkybkkugtkydfktyufctkyckxckghfvkuygjkhbykutgtvkyckjhbliuhgktuyfkvuyjbjkjygvkuykjdjflaksdjflkajsdlkfjalskdjflkasjdflkjasdlkfjalksdjfklajsdflkjasdlkjfalksdjflkasjdflkjasdlfkjaslkdjflaksjdflkajsdlfkjasdlkfjalsdjflkasjdflkasjdflajsdfjsfuhaduvasdyhaweuisfnaysdfiuhasfdnhaksjdfahsdfiujknsadfhbaiuhdfjknahbdshfjksnashdfkjnsadfiukjfnhsdfkjnasdfikjansdfhnaksdjfaisdfkn

Answer 1

可悲的事实是 Set.member 也很昂贵。

在第一个版本中，您检查每个尾部是否以前见过，如果是，则忽略它，否则插入其所有非空初始化。如果输入足够不规则，则需要 O(n) 次成员资格测试和 O(n^2) 次插入，总共为 O(n^2*log n)（假设比较的平均成本为 O(1)）。如果输入是周期性的，具有最短（正）周期 p，则只有前 p 个尾部会导致插入，因此需要 O(n) 次测试和 O(p*n) 次插入，总体来说为 O(p*n*log n)（即有点受骗，如果 p > 1，则比较的平均成本可能高达 O(p)；如果 p == 1，则比较的平均成本可能高达 O(n)，但如果周期本身不规则，则比较的平均成本为 O(1)。 ）。

在第二步中，

substringsSB s = substringsSB' Set.empty s
substringsSB' m str = substrings' m (init . B.tails $ str)
  where
    substrings' m [] = m
    substrings' m (s:ss) | Set.member s m = m
                         | otherwise      = substrings' insertTail ss
                           where
                             insertTail = insertInits m $ reverse $ (tail . B.inits $ s)

您检查每条尾巴是否以前见过，如果是则停止。这很好，但比第一个并没有获得太多在第一个中，如果之前已经看到了一条尾部，那么之前也已经看到了所有进一步的尾部，所以你最多只能跳过 O(n) 成员资格测试，O(n*记录n)个操作。对于通常不规则的输入，之前只见过一些最短的尾部，因此只跳过了很少的测试 - 增益很小。

    insertInits m [] = m
    insertInits m (s:ss) | Set.member s m = m
                         | otherwise      = insertInits (doInsert s m) ss
    doInsert k m = {-# SCC "doInsert" #-}Set.insert k m

如果还没有看到尾部（正常），则开始插入它的 init - 从最长到最短 - 如果之前已经看到过的话，则中断（因为所有较短的 init 之前也已经见过）。如果许多长初始化多次发生，那就太好了，但如果不是，那么您所拥有的只是 O(n^2) 次额外的成员资格测试。

对于普通的不规则输入，长子串不会多次出现，但会出现许多短子串，并且保存的少量插入不能补偿额外的成员资格测试，从而使第二种方法慢一个常数因子。
（成员资格测试比插入便宜，因此该因子应小于 2。）

对于周期性输入，第一种方法也避免了不必要的插入，第二种方法在外循环中节省了 O(n) 次测试，但增加了 O(p*n ）在内循环中进行测试，使其比不规则情况下的情况稍差。

但是对于某些输入，第二种方法可能要好得多。 您可以通过

main = do
    let x = substringsSB $ B.pack $ replicate 9999 97 ++ [98]
    print (Set.size x)

在插入后用便宜的 size 比较替换插入前昂贵的 member 来改进第二个版本，

substringsSB str = go 0 Set.empty (init $ B.tails str)
  where
    go sz m (s:ss)
        | Set.member s m = m
        | otherwise      = go nsz nm ss
          where
            (nsz,nm) = insInits sz m (reverse . tail $ B.inits s)
    go _ m [] = m
    insInits sz m (s:ss)
        | sz1 == sz     = (sz,m)
        | otherwise     = insInits sz1 nm ss
          where
            nm = Set.insert s m
            sz1 = Set.size nm
    insInits sz m [] = (sz,m)

这使其接近第一个版本通用情况，使其比 concat $replicate n "abcde" 的第一个版本稍好一些（此处），并且对于上面的邪恶示例要好得多。