Anonymous user
Minkowski question-mark function: Difference between revisions
→{{header|Haskell}}: added solution
Alextretyak (talk | contribs) (Added 11l) |
(→{{header|Haskell}}: added solution) |
||
Line 366:
0.7182818280000092 0.1213141516171819
</pre>
=={{header|Haskell}}==
=== Exact rational function using Farey tree ===
In a lazy functional language Minkowski question mark function can be implemented using one of it's basic properties:
?(p+r)/(q+s) = 1/2 * ( ?(p/q) + ?(r/s) ), ?(0) = 0, ?(1) = 1.
where p/q and r/s are fractions, such that |ps - rq| = 1.
This recursive definition can be implemented as lazy corecursion, i.e. by generating two infinite binary trees: '''mediant'''-based Farey tree, containing all rationals, and '''mean'''-based tree with corresponding values of Minkowsky ?-function. There is one-to-one correspondence between these two trees so both {{math|?(x)}} and {{math|?<sup>-1</sup>(x)}} may be implemented as mapping between them.
First we define tools to handle trees.
<lang haskell>import Data.List (unfoldr)
import Data.Ratio
import Data.Tree (Tree (..), levels, unfoldTree)
import Control.Monad.Zip (mzip)
mkTree :: (a -> a -> a) -> a -> a -> Tree a
mkTree f a b = unfoldTree go (a, b)
where
go (a,b) = let m = f a b in (m, [(a,m), (m,b)])
pathBy :: Ord b => (a -> b) -> Tree a -> b -> [Either a a]
pathBy f (Node a [l,r]) x =
case x `compare` f a of
LT -> Left a : pathBy f l x
EQ -> [Right a]
GT -> Right a : pathBy f r x</lang>
Now it is possible to define two trees:
<lang haskell>farey = toRatio <$> mkTree mediant (0, 1) (1, 1)
minkowski = toRatio <$> mkTree mean (0, 1) (1, 1)
mediant (a,b) (c,d) = (a + c, b + d)
mean (a,b) (c,d) = (a*d + c*b, 2*b*d)
toRatio (a, b) = a % b</lang>
<pre>λ> mapM_ print $ take 4 $ levels farey
[1 % 2]
[1 % 3,2 % 3]
[1 % 4,2 % 5,3 % 5,3 % 4]
[1 % 5,2 % 7,3 % 8,3 % 7,4 % 7,5 % 8,5 % 7,4 % 5]
λ> mapM_ print $ take 4 $ levels minkowski
[1 % 2]
[1 % 4,3 % 4]
[1 % 8,3 % 8,5 % 8,7 % 8]
[1 % 16,3 % 16,5 % 16,7 % 16,9 % 16,11 % 16,13 % 16,15 % 16]</pre>
Here is symmetric definitions of {{math|?(x)}} and {{math|?<sup>-1</sup>(x)}} for rational numbers:
<lang haskell>minkowskiQR :: Ratio Integer -> Ratio Integer
minkowskiQR = fromFraction . fmap transform . properFraction
where
transform = oddFunc $ lookupTree (mzip farey minkowski)
invMinkowskiQR :: Ratio Integer -> Ratio Integer
invMinkowskiQR = fromFraction . fmap transform . properFraction
where
transform = oddFunc $ lookupTree (mzip minkowski farey)
fromFraction (i, f) = fromIntegral i + f
lookupTree :: Ord a => Tree (a, c) -> a -> c
lookupTree t =
snd . either id id . last . pathBy fst t
oddFunc f 0 = 0
oddFunc f x = signum x * f (abs x)</lang>
<pre>λ> minkowskiQR (1/2)
1 % 2
λ> minkowskiQR (2/7)
3 % 16
λ> minkowskiQR (-22/7)
(-193) % 64
λ> invMinkowskiQR (3/16)
2 % 7
λ> invMinkowskiQR (13/256)
5 % 27</pre>
=== Floating point function using Farey tree ===
Paths leading to numbers in Farey tree, give diadic representation of corresponding value of Minkowski ?-function and vice versa. So it is possible to use Farey tree to define Minkowski function and it's inverse for floating point numbers.
<lang haskell>minkowskiQF :: Double -> Double
minkowskiQF = oddFunc $ fromDiadic . fmap transform . properFraction
where
transform 0 = []
transform f = track (fromRational <$> farey) f
invMinkowskiQF :: Double -> Double
invMinkowskiQF = oddFunc $ fromFraction . fmap transform . toDiadic
where
transform [] = 0
transform f = follow (fromRational <$> farey) f
fromDiadic :: (Int, [Int]) -> Double
fromDiadic = fromFraction . fmap (foldr go 0 . take 55)
where
go x r = (r + fromIntegral x)/2
toDiadic :: Double -> (Int, [Int])
toDiadic = fmap (unfoldr go) . properFraction
where
go x = case properFraction (x * 2) of
(0, 0) -> Nothing
(i, f) -> Just (i `mod` 2, f)
track :: Ord a => Tree a -> a -> [Int]
track t = fmap (either (const 0) (const 1)) . pathBy id t
follow :: Tree a -> [Int] -> a
follow t lst = rootLabel $ foldl (\t -> (subForest t !!)) t $ init lst</lang>
<pre>λ> minkowskiQF (1/2)
0.5
λ> minkowskiQF (2/7)
0.1875
λ> minkowskiQF (-22/7)
-3.015625
λ> invMinkowskiQF (3/16)
0.2857142857142857
λ> invMinkowskiQF (13/256)
0.18518518518518517
λ> minkowskiQF (sqrt 2)
1.4000000000003183</pre>
The task and tests:
<lang haskell>-- sequence of all positive rationals
sternBrocot = toRatio <$> mkTree mediant (0, 1) (1, 0)
rationals = concat (levels sternBrocot)
testEq f g = all (\x -> f x == g x)
testEqF f g = all (\x -> abs (f x - g x) < 1e-11)
testIds :: [[Ratio Integer] -> Bool]
testIds =
[ testEq (invMinkowskiQR . minkowskiQR) id
, testEq (minkowskiQR . invMinkowskiQR) id . fmap minkowskiQR
, testEqF (invMinkowskiQF . minkowskiQF) id . fmap fromRational
, testEqF (minkowskiQF . invMinkowskiQF) id . fmap fromRational
, testEq (minkowskiQF . fromRational) (fromRational . minkowskiQR) ]</lang>
λ> minkowskiQF $ (sqrt 5 + 1) / 2
1.6666666666678793
λ> 5/3
1.6666666666666667
λ> invMinkowskiQF (-5/9)
-0.5657414540893351
λ> (sqrt 13 - 7)/6
-0.5657414540893352
λ> sequence testIds $ take 1000 rationals
[True,True,True,True,True]</pre>
=={{header|Julia}}==
| |||