建模一个依赖性计算任务?

huangapple go评论67阅读模式
英文:

Modeling a dependent computation task?

问题

我需要建模一个计算任务,一些子任务依赖于它:

首先运行一个任务,如果失败了,那就结束了。如果成功了,那么运行一堆子任务(零个或多个),其中任何一个都可能失败或成功,并且如果成功了,可以运行零个或多个子子任务。所以在Haskell中大致如下:

data DepTask a b = Fail a | Success b [DepTask a b] deriving (Functor)

然而,我不是Haskell程序员,只是发现用Haskell来描述我的问题更容易。
我的问题是,我如何“折叠”这个结构?比如在Html中漂亮地打印它。
ChatGPT建议我可以将这种结构定义为固定点,这样我就可以利用cata来折叠它。

data ComplexF a b next = FailF a | SuccessF b [next] deriving (Functor)
type Complex a b = Fix (ComplexF a b)

是否有任何Haskell库(也许还有TypeScript的等效物)我可以采用?

注:对不起,我的英语不太好,因为我不是母语说英语的人。

英文:

I need to model a computation task and some sub-tasks depend on it:

First I run a task, if it fails then it's over. If it succeeds then run a bunch of sub-tasks(zero or many), any of them can fail or succeed, and can run zero or many sub-sub-tasks if it succeeds. So it is roughly in Haskell:

data DepTask a b = Fail a | Success b [DepTask a b] deriving (Functor)

However, I am not a Haskell programmer, just find it is easier to describe my problem in Haskell.
My problem is, how could I "fold" this structure? Such as pretty-print it in Html.
ChatGPT suggests that I could define this kind of structure as fixed point, so that I can make use of cata to fold it.

data ComplexF a b next = FailF a | SuccessF b [next] deriving (Functor)
type Complex a b = Fix (ComplexF a b)

Is there any Haskell library (maybe also TypeScript equivalent) I can adopt?

ps: Sorry for my bad English since I am not a native English speaker.

答案1

得分: 2

以下是您要翻译的部分:

data Task = Task Int (Either String [Task]) deriving (Show)

这是一个Task数据类型的定义,它包含一个整数Int和一个要么是字符串String要么是任务列表[Task]的要素。

data Result = Failure String | Success [Task]

这是一个可选的定义,将Either类型替换为自己的成功/失败类型Result

failures :: Task -> [(Int, String)]

这是一个用于提取失败任务及其相关错误的函数。

flatten :: Task -> [(Int, Bool)]

这是一个用于提取所有任务的ID以及相关成功标志的函数。

asHtml :: [Task] -> String

这是一个将结果渲染为HTML的函数。

foldTask :: (Int -> Either String [a] -> a) -> Task -> a

这是一个用于执行折叠操作的函数。

cata :: (Functor f) => (f a -> a) -> Fix f -> a

这是一个用于执行抽象 catamorphism 操作的函数。

main :: IO ()

这是一个包含一些示例的主函数。

以上是您要翻译的代码部分。

英文:

If you want to implement this in Haskell as a relatively new Haskell programmer, then it would be best to keep things simple. If you want to identify tasks by integers and represent error messages as strings, then you can use the following simple data type to model your problem:

data Task = Task Int (Either String [Task]) deriving (Show)

That is, a Task identified by an Int either fails with an error String or succeeds with a list of subtasks, [Task].

(You could, optionally, replace the Either type with your own success/failure type:

data Result = Failure String | Success [Task]

but the use of Either for this purpose, including the use of Left for failure and Right for success, is pretty well established in the Haskell world.)

Equipped with Task, if you want a list of failed tasks and their associated errors, just write a plain old recursive function using pattern matching:

failures :: Task -> [(Int, String)]
failures (Task n (Left err))   = [(n, err)]
failures (Task _ (Right tsks)) = concatMap failures tsks

If you want a flattened list of all tasks by IDs with an associated success flag, write another plain old recursive function using pattern matching:

flatten :: Task -> [(Int, Bool)]
flatten (Task n (Left _))    = [(n, False)]
flatten (Task n (Right tsks))  = (n, True) : concatMap flatten tsks

If you want to render the results as HTML, then an ad hoc pretty printer would look something like this:

asHtml :: [Task] -> String
asHtml = ul ""
  where ul pfx body = pfx ++ "<ul>\n"
                          ++ concatMap (li (pfx ++ "  ")) body ++
                      pfx ++ "</ul>\n"
        li pfx (Task n result) = pfx ++ "<li>Task #" ++ show n
          ++ case result of
               Left err -> " failed, the error message is \"" ++ err ++ "\"\n"
               Right [] -> " succeeded with no subtasks\n"
               Right tsks -> " succeeded, invoking subtasks:\n" ++ ul pfx tsks

This will be the most straightforward approach.

After you've written 10 or 15 useful functions, you could give some consideration to "abstracting" out the common fold (AKA catamorphism), but you'll probably find it doesn't buy you much. A fold for Task would look something like this:

foldTask :: (Int -> Either String [a] -> a) -> Task -> a
foldTask f (Task n (Left err)) = f n (Left err)
foldTask f (Task n (Right tsks)) = f n (Right (map (foldTask f) tsks))

If you reimplement your functions in terms of this fold, they will no longer be explicitly recursive, but the result is not noticeably more concise or readable than the original:

failures' :: Task -> [(Int, String)]
failures' = foldTask f
  where f n (Left err) = [(n, err)]
        f _ (Right tsks) = concat tsks

flatten' :: Task -> [(Int, Bool)]
flatten' = foldTask f
  where f n (Left _) = [(n, False)]
        f n (Right tsks) = (n, True) : concat tsks

ChatGPT's advice seems pretty stupid. It's suggesting you reimplement
your Task' as a fixed point of a functor TaskF:

data TaskF a = TaskF Int (Either String [a]) deriving (Functor)
data Fix f = Fix { unFix :: f (Fix f) }
type Task' = Fix TaskF

so you can implement an abstract catamorphism:

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata k = k . fmap (cata k) . unFix

that can be used as follows:

failures'' :: Task' -> [(Int, String)]
failures'' = cata f
  where f (TaskF n (Left err)) = [(n, err)]
        f (TaskF _ (Right tsks)) = concat tsks

flatten'' :: Task' -> [(Int, Bool)]
flatten'' = cata f
  where f (TaskF n (Left _)) = [(n, False)]
        f (TaskF n (Right tsks)) = (n, True) : concat tsks

This is perhaps of some theoretical interest, and there are some cool related libraries, like recursion-schemes, but this isn't particular useful to a new Haskell programmer implementing a simple model like this.

Anyway, here's a complete file with sample code:

module DepTask where

--
-- Implementation for normal humans
--

data Task = Task Int (Either String [Task]) deriving (Show)

failures :: Task -> [(Int, String)]
failures (Task n (Left err))   = [(n, err)]
failures (Task _ (Right tsks)) = concatMap failures tsks

flatten :: Task -> [(Int, Bool)]
flatten (Task n (Left _))    = [(n, False)]
flatten (Task n (Right tsks))  = (n, True) : concatMap flatten tsks

asHtml :: [Task] -> String
asHtml = ul ""
  where ul pfx body = pfx ++ "<ul>\n"
                          ++ concatMap (li (pfx ++ "  ")) body ++
                      pfx ++ "</ul>\n"
        li pfx (Task n result) = pfx ++ "<li>Task #" ++ show n
          ++ case result of
               Left err -> " failed, the error message is \"" ++ err ++ "\"\n"
               Right [] -> " succeeded with no subtasks\n"
               Right tsks -> " succeeded, invoking subtasks:\n" ++ ul pfx tsks

--
-- Unnecessary abstraction of the fold
--

foldTask :: (Int -> Either String [a] -> a) -> Task -> a
foldTask f (Task n (Left err)) = f n (Left err)
foldTask f (Task n (Right tsks)) = f n (Right (map (foldTask f) tsks))

failures' :: Task -> [(Int, String)]
failures' = foldTask f
  where f n (Left err) = [(n, err)]
        f _ (Right tsks) = concat tsks

flatten' :: Task -> [(Int, Bool)]
flatten' = foldTask f
  where f n (Left _) = [(n, False)]
        f n (Right tsks) = (n, True) : concat tsks

--
-- ChatGPTs crazy advice
--

data TaskF a = TaskF Int (Either String [a]) deriving (Functor)
data Fix f = Fix { unFix :: f (Fix f) }
type Task' = Fix TaskF

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata k = k . fmap (cata k) . unFix

failures'' :: Task' -> [(Int, String)]
failures'' = cata f
  where f (TaskF n (Left err)) = [(n, err)]
        f (TaskF _ (Right tsks)) = concat tsks

flatten'' :: Task' -> [(Int, Bool)]
flatten'' = cata f
  where f (TaskF n (Left _)) = [(n, False)]
        f (TaskF n (Right tsks)) = (n, True) : concat tsks

--
-- Some examples
--

main :: IO ()
main = do
  let ex1 = [ Task 1 (Left "file not found")
            , Task 2 (Right [ Task 3 (Right [])
                            , Task 4 (Right [Task 5 (Left "bad parameter")])])
            , Task 3 (Right []) ]
  putStrLn $ asHtml ex1

  let ex2 = Task 0 (Right ex1)

  print $ failures ex2
  print $ failures' ex2

  let task n r = Fix (TaskF n r)
      ex2' = task 0 (Right
        [ task 1 (Left "file not found")
        , task 2 (Right [ task 3 (Right [])
                        , task 4 (Right [task 5 (Left "bad parameter")])])
        , task 3 (Right []) ])

  print $ failures'' ex2'

huangapple
  • 本文由 发表于 2023年7月18日 00:19:07
  • 转载请务必保留本文链接:https://go.coder-hub.com/76706372.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定