# 根据所有先前术语计算列表的术语Computing a term of a list depending on all previous terms

1. Flajolet和Sedjewick在《分析组合》一书中对此进行了研究，该公式的图像是从那里获取的，因为stackoverflow不支持LaTeX。

2. sigma是一个数的除数之和

## 2 个回复2

### ===============>>#1 票数：8 已采纳

``````unfoldr :: (seed -> Maybe (value, seed)) -> seed -> [value]
``````

``````unfoldr coalg s = case coalg s of
Nothing       -> []
Just (v, s')  -> v : unfoldr coalg s'
``````

``````growList :: ([value] -> Maybe value) -> [value]
growList g = unfoldr coalg B0 where
coalg vz = case g vz of   -- I say "vz", not "vs" to remember it's reversed
Nothing  -> Nothing
Just v   -> Just (v, v : vz)
``````

``````ps = growList \$ \ pz -> Just (sum (zipWith (*) sigmas pz) `div` (length pz + 1))
sigmas = [sigma j | j <- [1..]]
``````

``````newtype Nu f = In (f (Nu f))
``````

``````ana :: Functor f => (seed -> f seed) -> seed -> Nu f
ana coalg s = In (fmap (ana coalg) (coalg s))
``````

``````newtype  K1 a      x  = K1 a                  -- constants (labels)
newtype  I         x  = I x                   -- substructure places
data     (f :+: g) x  = L1 (f x) | R1 (g x)   -- choice (like Either)
data     (f :*: g) x  = f x :*: g x           -- pairing (like (,))
``````

`Functor`实例

``````instance Functor (K1 a) where fmap f (K1 a) = K1 a
instance Functor I      where fmap f (I s) = I (f s)
instance (Functor f, Functor g) => Functor (f :+: g) where
fmap h (L1 fs) = L1 (fmap h fs)
fmap h (R1 gs) = R1 (fmap h gs)
instance (Functor f, Functor g) => Functor (f :*: g) where
fmap h (fx :*: gx) = fmap h fx :*: fmap h gx
``````

``````type ListF value = K1 () :+: (K1 value :*: I)
``````

``````seed -> (K1 () :+: (K1 value :*: I)) seed
``````

``````seed -> Either () (value, seed)
``````

``````seed -> Maybe (value, seed)
``````

``````list :: Nu (ListF a) -> [a]
list (In (L1 _))                = []
list (In (R1 (K1 a :*: I as)))  = a : list as
``````

``````grow :: (..where I am in a Nu f under construction.. -> f ()) -> Nu f
``````

``````class Bifunctor b where
bimap :: (c -> c') -> (j -> j') -> b c j -> b c' j'

newtype K2 a       c j = K2 a
data    (f :++: g) c j = L2 (f c j) | R2 (g c j)
data    (f :**: g) c j = f c j :**: g c j
newtype Clowns f   c j = Clowns (f c)
newtype Jokers f   c j = Jokers (f j)

instance Bifunctor (K2 a) where
bimap h k (K2 a) = K2 a
instance (Bifunctor f, Bifunctor g) => Bifunctor (f :++: g) where
bimap h k (L2 fcj) = L2 (bimap h k fcj)
bimap h k (R2 gcj) = R2 (bimap h k gcj)
instance (Bifunctor f, Bifunctor g) => Bifunctor (f :**: g) where
bimap h k (fcj :**: gcj) = bimap h k fcj :**: bimap h k gcj
instance Functor f => Bifunctor (Clowns f) where
bimap h k (Clowns fc) = Clowns (fmap h fc)
instance Functor f => Bifunctor (Jokers f) where
bimap h k (Jokers fj) = Jokers (fmap k fj)
``````

``````class (Functor f, Bifunctor (Diss f)) => Dissectable f where
type Diss f :: * -> * -> *
rightward   ::  Either (f j) (Diss f c j, c) ->
Either (j, Diss f c j) (f c)
``````

• 充满小丑的整个结构的左侧，或
• 结构中的一个洞，以及一个放入洞中的小丑

• 结构上的一个洞，以及从其中出来的小丑，或者
• 充满小丑的整个结构的权利。

``````divDiff f c j  =  (f c - f j) / (c - j)
``````

``````divDiff f c j * c - j * divDiff f c j  =  f c - f j
``````

``````f j + divDiff f c j * c  =  f c + j * divDiff f c j
``````

``````instance Dissectable (K1 a) where
type Diss (K1 a) = K2 Void
rightward (Left (K1 a)) = (Right (K1 a))
rightward (Right (K2 v, _)) = absurd v
``````

``````instance Dissectable I where
type Diss I = K2 ()
rightward (Left (I j))       = Left (j, K2 ())
rightward (Right (K2 (), c)) = Right (I c)
``````

``````instance (Dissectable f, Dissectable g) => Dissectable (f :+: g) where
type Diss (f :+: g) = Diss f :++: Diss g
rightward x = case x of
Left (L1 fj)      -> ll (rightward (Left fj))
Right (L2 df, c)  -> ll (rightward (Right (df, c)))
Left (R1 gj)      -> rr (rightward (Left gj))
Right (R2 dg, c)  -> rr (rightward (Right (dg, c)))
where
ll (Left (j, df)) = Left (j, L2 df)
ll (Right fc)     = Right (L1 fc)
rr (Left (j, dg)) = Left (j, R2 dg)
rr (Right gc)     = Right (R1 gc)
``````

``````instance (Dissectable f, Dissectable g) => Dissectable (f :*: g) where
type Diss (f :*: g) = (Diss f :**: Jokers g) :++: (Clowns f :**: Diss g)
rightward x = case x of
Left (fj :*: gj) -> ll (rightward (Left fj)) gj
Right (L2 (df :**: Jokers gj), c) -> ll (rightward (Right (df, c))) gj
Right (R2 (Clowns fc :**: dg), c) -> rr fc (rightward (Right (dg, c)))
where
ll (Left (j, df)) gj = Left (j, L2 (df :**: Jokers gj))
ll (Right fc)     gj = rr fc (rightward (Left gj))  -- (!)
rr fc (Left (j, dg)) = Left (j, R2 (Clowns fc :**: dg))
rr fc (Right gc)     = Right (fc :*: gc)
``````

`rightward`逻辑确保我们按照左侧的结构进行工作，然后，一旦完成，就从右侧开始工作。 标记为`(!)`的线是中间的关键时刻，我们从左侧结构的右侧出现，然后进入右侧结构的左侧。

``````rightward :: Either (f x) (Diss f Void x, Void) -> Either (x, Diss f Void x) (f Void)
``````

``````type Quotient f x = Diss f Void x
leftmost :: f x -> Either (x, Quotient f x) (f Void)
leftmost = rightward . Left
``````

``````type Fox f x = Diss f x ()
``````

``````grow :: Dissectable f => ([Fox f (Nu f)] -> f ()) -> Nu f
``````

``````grow g = go [] where
go stk = In (walk (rightward (Left (g stk)))) where
walk (Left ((), df)) = walk (rightward (Right (df, go (df : stk))))
walk (Right fm)      = fm
``````

### ===============>>#2 票数：5

``````p = [sum (zipWith (*) sigmas (reverse ps)) | ps <- inits p]
``````

2回复

1回复

1回复

2回复

2回复

4回复

4回复

2回复

1回复

2回复