-- | Probnet 0.1.0.0
-- | Usage : probnet 1 [1,2,3,5,8,13]
-- | Result : [1,2,3,5,8,13,21]

module Probnet (
   percents,
   predict1, 
   predict, 
   probnet, 
) where

import Data.List
import Data.Ratio -- for the case of inputs with Ratio or Rational list elements

-- | Element value of 'list' nearest to 'n'
nearnum :: RealFrac a => a -> [a] -> a
nearnum :: a -> [a] -> a
nearnum a
n = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy a -> a -> Ordering
nearer
   where
   nearer :: a -> a -> Ordering
nearer a
x a
y = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a
forall a. Num a => a -> a
abs (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
n)) (a -> a
forall a. Num a => a -> a
abs (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
n))

-- | Ratios between consecutive elements (logarithmic differences). 
percents :: RealFrac a => [a] -> [a]
percents :: [a] -> [a]
percents [a]
dat = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Fractional a => a -> a -> a
quotient [a]
dat ([a] -> [a]
forall a. [a] -> [a]
tail [a]
dat)
   
   where 
   quotient :: a -> a -> a
quotient a
y = (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y)

-- | Get ratio element
ratio1 :: [a] -> Int -> a
ratio1 [a]
d Int
f = [a] -> [a]
forall a. RealFrac a => [a] -> [a]
percents [a]
d [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
f

-- | This is to assume that the next ratio is close to that of the element 
-- with the closest value to the last element; in case of monotonic data 
-- (always increasing or always decreasing) it is the last ratio. 


predict1 :: RealFrac a => [a] -> a
predict1 :: [a] -> a
predict1 [a]
dat  
   | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
lastper = ([a] -> Int -> a
forall a. RealFrac a => [a] -> Int -> a
ratio1 ([a]
dat) (Int
elemlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall a. [a] -> a
last [a]
dat 
   | Bool
otherwise = ([a] -> Int -> a
forall a. RealFrac a => [a] -> Int -> a
ratio1 [a]
dat Int
eleml) a -> a -> a
forall a. Num a => a -> a -> a
* [a] -> a
forall a. [a] -> a
last [a]
dat
   where
   Just Int
eleml = a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
ned [a]
dat
   ned :: a
ned = a -> [a] -> a
forall a. RealFrac a => a -> [a] -> a
nearnum ([a] -> a
forall a. [a] -> a
last [a]
dat) ([a] -> [a]
forall a. [a] -> [a]
init [a]
dat)
   l :: a
l = [a] -> a
forall a. [a] -> a
last ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
init [a]
dat
   lastper :: a
lastper = [a] -> a
forall a. [a] -> a
last [a]
dat 


-- | Generates new prediction
predict :: (Integral b, RealFrac a) => Int -> [a] -> [b]
predict :: Int -> [a] -> [b]
predict Int
layers [a]
dat 
   | Int
layers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1   = Int -> [a] -> [b]
forall b a. (Integral b, RealFrac a) => Int -> [a] -> [b]
predict (Int
layers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
out -- execute next in the serie
   | Bool
otherwise    = (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round [a]
out
   where
   out :: [a]
out = [[a] -> a
forall a. RealFrac a => [a] -> a
predict1 [a]
dat] 

-- | Generate new prediction with error prediction 
probnet :: (Integral b, RealFrac a) => Int -> [a] -> [b]
probnet :: Int -> [a] -> [b]
probnet Int
layers [a]
dat
   | Int
layers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1   = Int -> [Double] -> [b]
forall b a. (Integral b, RealFrac a) => Int -> [a] -> [b]
probnet (Int
layers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Double] -> [b]) -> [Double] -> [b]
forall a b. (a -> b) -> a -> b
$ (a -> Double) -> [a] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x-> Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round a
x)) [a]
out 
   | Bool
otherwise    = (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round [a]
out
   where
   out :: [a]
out = [a]
dat [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [([a] -> a
forall a. RealFrac a => [a] -> a
predict1 [a]
dat a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> a
forall a. RealFrac a => [a] -> a
prerr [a]
dat)]

-- | This is the next prediction for the difference between each 
-- original element and its prediction based on previous elements
prerr :: RealFrac a => [a] -> a
prerr :: [a] -> a
prerr [a]
dat 
   | [a] -> a
forall a. [a] -> a
last [a]
err a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0   = a
0 
   | Bool
otherwise       = [a] -> a
forall a. RealFrac a => [a] -> a
predict1 ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
2 [a]
err
   where  
   err :: [a]
err   = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
subtract [a]
pred [a]
dat -- differences between elements and its predictions
   pred :: [a]
pred  = ([a] -> a) -> [[a]] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. RealFrac a => [a] -> a
predict1 ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
dat -- 2 first inits have 0 and 1 elements, will be dropped



-- | Encode data sequence
-- convert data sequence to f = (index,frac1,frac2,frac3,longitude)
-- TODO convert data secuence to a function / symbol dictionary and replace sequence patterns for the symbol
-- example parse 1,2,3,4,5,8,16.... / output -> (.,30,1,1,1),(,,10,2,4,8) .....,,
-- the idea is convert different values in the same symbol, in decode moment replace the function symbol by the element in the index of the data sequence.
--
encode :: [a] -> (Int, a, a, a)
encode [a]
dat = (Int
l,a
f2a -> a -> a
forall a. Num a => a -> a -> a
-a
f1,a
f3a -> a -> a
forall a. Num a => a -> a -> a
-a
f2,a
f4a -> a -> a
forall a. Num a => a -> a -> a
-a
f3)
   where
   l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
dat
   f1 :: a
f1 = [a]
dat [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
0
   f2 :: a
f2 = [a]
dat [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
1
   f3 :: a
f3 = [a]
dat [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
2
   f4 :: a
f4 = [a]
dat [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
3
   -- add split patterns function to the dictionary
   -- rewrite sequence to new function symbols
   -- rewrite base for encoding
   -- output dictionary + rewrited symbols sequence
   -- return imposible to encode if no improve in the encodening comparing bit size are detected


-- | Encode function for files + lzma
--



-- | Decode data sequence
-- convert encoded probnet function parameters to data sequence
-- TODO convert encoded data sequence to real data converting each symbol by his element in the function data secuence in the dictionary.
decode :: [Int] -> [b]
decode [Int]
encoded = Int -> [Double] -> [b]
forall b a. (Integral b, RealFrac a) => Int -> [a] -> [b]
probnet (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
encodedInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f1,Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f2,Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f3,Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f4]
	where
	i :: Int
i = [Int]
encoded[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!Int
0
	f1 :: Int
f1 = [Int]
encoded[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!Int
1
	f2 :: Int
f2 = [Int]
encoded[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!Int
2
	f3 :: Int
f3 = [Int]
encoded[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!Int
3
	f4 :: Int
f4 = [Int]
encoded[Int] -> Int -> Int
forall a. [a] -> Int -> a
!!Int
4
	-- get dictionary function
	-- replace funcion data secuence by function elements to generate the real data sequence
	-- output results
	-- return no function dictionary was found , or no functionon decoding for this sequence




-- | Decode file to a file
-- 


-- | Property of Cobalt Technologies Panamá
-- | Authors : Vicent Nos Ripolles (Main Author)
-- | Enrique Santos (Refactor Code)