gat*_*ado 6 haskell fixed-point-iteration fixpoint-combinators
我正在寻找一个库,它将计算一组变量arity运算符下的集合的固定点/闭包.例如,
fixwith [(+)] [1]
Run Code Online (Sandbox Code Playgroud)
对于整数应该计算所有N(自然1..).我试着去写它,但有些东西是缺乏的.它效率不高,我觉得我对多功能的处理并不是最优雅的.此外,是否可以使用内置fix函数而不是手动递归来编写?
class OperatorN ? ? | ? -> ? where
wrap_op :: ? -> (Int, [?] -> ?)
instance OperatorN ? (() -> ?) where
wrap_op f = (0, \[] -> f ())
instance OperatorN ? (? -> ?) where
wrap_op f = (1, \[x] -> f x)
instance OperatorN ? ((?, ?) -> ?) where
wrap_op f = (2, \[x, y] -> f (x, y))
instance OperatorN ? ((?, ?, ?) -> ?) where
wrap_op f = (3, \[x, y, z] -> f (x, y, z))
instance OperatorN ? ((?, ?, ?, ?) -> ?) where
wrap_op f = (4, \[x, y, z, w] -> f (x, y, z, w))
type WrappedOp ? = (Int, [?] -> ?)
fixwith_next :: Eq ? => [WrappedOp ?] -> [?] -> [?]
fixwith_next ops s = List.nub (foldl (++) s (map g ops)) where
g (0, f) = [f []]
g (arity, f) = do
x <- s
let fx = \xs -> f (x:xs)
g (arity - 1, fx)
fixwith ops s
| next <- fixwith_next ops s
, next /= s
= fixwith ops next
fixwith _ s = s
Run Code Online (Sandbox Code Playgroud)
例子,
> fixwith [wrap_op $ uncurry (*)] [-1 :: Int]
[-1,1]
> fixwith [wrap_op $ uncurry (*)] [1 :: Int]
[1]
> fixwith [wrap_op $ max 3, wrap_op $ \() -> 0] [1 :: Int]
[1,3,0]
Run Code Online (Sandbox Code Playgroud)
这并没有提高性能,但我想我只需要弄清楚如何减少计算量,使其实际上更快.
import qualified Control.RMonad as RMonad
class OperatorN ? ? | ? -> ? where
wrap_op :: ? -> (Int, [?] -> ?)
instance OperatorN ? (() -> ?) where
wrap_op f = (0, \[] -> f ())
instance OperatorN ? (? -> ?) where
wrap_op f = (1, \[x] -> f x)
instance OperatorN ? ((?, ?) -> ?) where
wrap_op f = (2, \[x, y] -> f (x, y))
instance OperatorN ? ((?, ?, ?) -> ?) where
wrap_op f = (3, \[x, y, z] -> f (x, y, z))
instance OperatorN ? ((?, ?, ?, ?) -> ?) where
wrap_op f = (4, \[x, y, z, w] -> f (x, y, z, w))
type WrappedOp ? = (Int, [?] -> ?)
fixwith_next :: Ord ? => [WrappedOp ?] -> Set ? -> Set ?
fixwith_next ops s = Set.unions $ s : map g ops where
g (0, f) = RMonad.return $ f []
g (arity, f) = s RMonad.>>= \x ->
g (arity - 1, \xs -> f (x:xs))
fixwith' ops s
| next <- fixwith_next ops s
, next /= s
= fixwith' ops next
fixwith' _ s = s
fixwith ops s = Set.toList $ fixwith' ops (Set.fromList s)
Run Code Online (Sandbox Code Playgroud)
我常常RMonad把它清理一下,并且像丹尼尔建议的那样使它变得懒惰.我认为大部分时间都花在了实际的乘法程序上,遗憾的是,所以我没有看到这种改变带来任何性能上的好处.虽然懒惰很酷.
notin :: Ord ? => Set ? -> Set ? -> Set ?
notin = flip Set.difference
class Ord ? => OperatorN ? ? | ? -> ? where
next_values :: ? -> Set ? -> Set ?
instance Ord ? => OperatorN ? (? -> ?) where
next_values f s = notin s $ s RMonad.>>= \x -> RMonad.return (f x)
instance Ord ? => OperatorN ? (? -> ? -> ?) where
next_values f s = s RMonad.>>= \x -> next_values (f x) s
instance Ord ? => OperatorN ? (? -> ? -> ? -> ?) where
next_values f s = s RMonad.>>= \x -> next_values (f x) s
instance Ord ? => OperatorN ? (? -> ? -> ? -> ? -> ?) where
next_values f s = s RMonad.>>= \x -> next_values (f x) s
-- bind lambdas with next_values
fixwith_next :: Ord ? => [Set ? -> Set ?] -> Set ? -> Set ?
fixwith_next nv_bnd s = Set.unions $ map (\f -> f s) nv_bnd -- bound next values
fixwith' :: Ord ? => [Set ? -> Set ?] -> Set ? -> [?]
fixwith' ops s@(fixwith_next ops -> next)
| Set.size next == 0 = []
| otherwise = (Set.toList next) ++ fixwith' ops (Set.union s next)
fixwith ops s = (Set.toList s) ++ fixwith' ops s
fixwith_lst ops = fixwith ops . Set.fromList
Run Code Online (Sandbox Code Playgroud)
例
> take 3 $ fixwith [next_values (+2)] (Set.fromList [1])
[1,3,5]
Run Code Online (Sandbox Code Playgroud)
我不得不失去一元手术,但这不是交易杀手.
| 归档时间: |
|
| 查看次数: |
210 次 |
| 最近记录: |