How to optimize this haskell snippet - optimization

I'm trying to create a small module for doing decimal-based calculations. A number is stored as an integer mantisse, with a precision value specified by an int:
data APNum =
{ getMantisse :: Integer
, getPrecision :: Int }
For instance:
APNum 123 0 -> 123
APNum 123 1 -> 1.23
APNum 123 2 -> 12.3
...
(negative precision is not allowed).
Now I wrote this function, which adjusts the precision automatically by stripping as many trailing zero's as possible:
autoPrecision :: APNum -> APNum
autoPrecision x#(APNum m p) = if p > maxPrecision
then autoPrecision $ setPrecision x maxPrecision
else autoPrecision' m p where
autoPrecision' m p = let (m',r) = m `divMod` 10 in
if r /= 0 || p <= 0 then APNum m p else autoPrecision' m' (pred p)
(MaxPrecision and setPrecision are obvious, I think).
The problem is, this snippet has a very bad performance, specially n numbers with more then 10000 digits. Are there any simple optimizations?

You can use binary search to find the highest power of 10 which divides m, instead of trying all consecutive values.
import Numeric.Search.Range
import Data.Maybe
data APNum = APNum{getMantisse :: Integer, getPrecission :: Int} deriving Show
setPrecision (APNum m _) x = APNum m x
maxPrecission = 200000
findDiv x = pred $ fromJust $ searchFromTo (p x) 0 maxPrecission where
p x n = x `mod` 10^n /= 0
autoPrecision :: APNum -> APNum
autoPrecision x#(APNum m p)
= if p > maxPrecission then
autoPrecision $ setPrecision x maxPrecission else APNum m' p'
where d = min (findDiv m) p
p' = p - d
m' = m `div` 10^d
I'm using the binary-search package here which provides searchFromTo :: Integral a => (a -> Bool) -> a -> a -> Maybe a. This should give you a big speedup.

Looks like even straightforward string operation is still faster:
maxPrecision = 2000000
autoPrecision (APNum m p) =
let p' = min p maxPrecision
(n',ds) = genericDropNWhile (=='0') p' $ reverse $ show m
in APNum (read $ reverse ds) n'
where
genericDropNWhile p n (x:xs) | n > 0 && p x = genericDropNWhile p (n-1) xs
genericDropNWhile _ n xs = (n,xs)
Test with this:
main = print $ autoPrecision $ APNum (10^100000) (100000-3)
EDIT: Oops, faster only for numbers with lots of zeroes. Otherwise this double conversion is definitely slower.

also x mod 10 == 0 implies x mod 2 == 0, and that is cheaper to test for

Related

Why does this program print some kind of AST in the REPL?

import Data.Nat.Views
total toBinary : Nat -> String
toBinary k with (halfRec k)
toBinary Z | HalfRecZ = ""
toBinary (n + n) | (HalfRecEven rec) = (toBinary n | rec) ++ "0"
toBinary (S (n + n)) | (HalfRecOdd rec) = (toBinary n | rec) ++ "1"
When testing the above function in the REPL with the expression toBinary 2, the following gets printed out.
prim__concat (with block in Exercises.toBinary 1
(with block in with block in Data.Nat.Views.halfRec 0
(half 0)
(Access (\z, zLTy =>
Prelude.WellFounded.sizeAccessible, acc Nat
2
(constructor of Prelude.WellFounded.Sized (\meth =>
meth))
1
z
(lteTransitive zLTy
(LTESucc LTEZero))))))
"0" : String
When I run :exec toBinary 2, the expected result of "10" gets printed out.
Could anyone please explain what's happening?

Why does rewrite not change the type of the expression in this case?

In (*1) one can read next
rewrite prf in expr
If we have prf : x = y, and the required type for expr is some property of x, the rewrite ... in syntax will search for x in the required type of expr and replace it with y.
Now, I have next piece of code (you can copy it to editor and try ctrl-l)
module Test
plusCommZ : y = plus y 0
plusCommZ {y = Z} = Refl
plusCommZ {y = (S k)} = cong $ plusCommZ {y = k}
plusCommS : S (plus y k) = plus y (S k)
plusCommS {y = Z} = Refl
plusCommS {y = (S j)} {k} = let ih = plusCommS {y=j} {k=k} in cong ih
plusComm : (x, y : Nat) -> plus x y = plus y x
plusComm Z y = plusCommZ
plusComm (S k) y =
let
ih = plusComm k y
prfXeqY = sym ih
expr = plusCommS {k=k} {y=y}
-- res = rewrite prfXeqY in expr
in ?hole
below is how hole looks like
- + Test.hole [P]
`-- k : Nat
y : Nat
ih : plus k y = plus y k
prfXeqY : plus y k = plus k y
expr : S (plus y k) = plus y (S k)
-----------------------------------------
Test.hole : S (plus k y) = plus y (S k)
The Question.
It looks to me like expr (from *1) in commented line equals to S (plus y k) = plus y (S k). And prf equals to plus y k = plus k y where x is plus y k and y is plus k y. And rewrite should search for x (namely for plus y k) in expr (namely S (plus y k) = plus y (S k) and should replace x with y (namely with plus k y). And result (res) should be S (plus k y) = plus y (S k).
But this does not work.
I have next answer from idris
rewriting plus y k to plus k y did not change type letty
I could guess rewrite is intended to change type of the resulting expression only. So, it is not working within body of let expression, but only in it's 'in' part. Is this correct?
(*1) http://docs.idris-lang.org/en/latest/proofs/patterns.html
PS. Example from tutorial works fine. I'm just curious to know why the way I've tried to use rewrite didn't work.
Though not stated explicitly stated in the docs, rewrite is syntax-sugary invocation of an Elab tactics script (defined around here).
To why your example does not work: the "required type of expr" isn't found; with just res = rewrite prfXeqY in expr alone, it is unclear, which type res should have (even the unifier could resolve this with let res = … in res.) If you specify the required type, it works as expected:
res = the (S (plus k y) = plus y (S k)) (rewrite prfXeqY in expr)
Unfortunately you did not provide the exact line which makes your code misbehave, somehow you must have done something strange, since with your reasoning you outlined above the code works well:
let
ih = plusComm k y -- plus k y = plus y k
px = plusCommS {k=k} {y=y} -- S (plus y k) = plus y (S k)
in rewrite ih in px

How to find the value of integer k efficiently for which q divides b ^ k finitely?

We have given two integers b and q, and we want to find the minimum value of an integer 'k' for which q completely divides b^k or k does not exist. Can we find out the value of k efficiently? Not just iterating each value of k (0, 1, 2, 3, ...) and checking (b^k) % q == 0) where q <= k or q >= k.
First of all, k will never equal zero unless q=1. k will never equal one unless q=b.
Next, if you can factorize q and b, then you can reason about them.
If there are any prime factors of b that are not factors of q at all, then k does not exist. Otherwise, k has to be large enough so that every factor of b^k is represented in q.
Here's some pseudo-code:
if (q==1) return 0;
if (q==b) return 1;
// qfactors and bfactors are arrays, one element per factor
let qfactors = prime_factorization(q);
let bfactors = prime_factorization(b);
let kmin=0;
foreach (f in bfactors.unique) {
let bcount = bfactors.count(f);
let qcount = qfactors.count(f);
if (qcount==0 || qcount < bcount) return -1; // k does not exist
kmin_f = ceiling(bcount/qcount);
if (kmin_f > kmin) let kmin = kmin_f;
}
return kmin;
If q = 1 ; k = 0
If b = q ; k = 1
If b > q and factors ; k = 1
If b < q and factors ; k != I
If b != q and not factors ; k != I
We know,
Dividend = Divisor x Quotient + Reminder
=> Dividend = Divisor x Quotient [Here, Reminder = 0]
Now go for calculation of Maxima and Minima as lower the value of Quotient is lower the value of 'k'.
If you consider the Quotient as 1 (lowest but spl case) then your formula for 'k' becomes,
k = log q/log b
I found a solution-
If q divides pow(b,k) then all prime factors of q are prime factors of b. Now we can do iterations q = q ÷ gcd(b,q) while gcd(q,b)≠1. If q≠1 after iterations, there are prime factors of q which are not prime factors of b then k doesn't exist else k = no of iteration.

using rewrite in Refl

I am working through Chapter 8 Type Driven Development with Idris, and I have a question about how rewrite interacts with Refl.
This code is shown as an example of how rewrite works on an expression:
myReverse : Vect n elem -> Vect n elem
myReverse [] = []
myReverse {n = S k} (x :: xs)
= let result = myReverse xs ++ [x] in
rewrite plusCommutative 1 k in result
where plusCommutative 1 k will look for any instances of 1 + k and replace it with k + 1.
My question is with this solution to rewriting plusCommutative as part of the exercies as myPlusCommutes with an answer being:
myPlusCommutes : (n : Nat) -> (m : Nat) -> n + m = m + n
myPlusCommutes Z m = rewrite plusZeroRightNeutral m in Refl
myPlusCommutes (S k) m = rewrite myPlusCommutes k m in
rewrite plusSuccRightSucc m k in Refl
I am having trouble with this line:
myPlusCommutes Z m = rewrite plusZeroRightNeutral m in Refl
because from what I can understand by using Refl on its own in that line as such:
myPlusCommutes Z m = Refl
I get this error:
When checking right hand side of myPlusCommutes with expected type
0 + m = m + 0
Type mismatch between
plus m 0 = plus m 0 (Type of Refl)
and
m = plus m 0 (Expected type)
Specifically:
Type mismatch between
plus m 0
and
m
First off, one thing I did not realize is that it appears Refl works from the right side of the = and seeks reflection from that direction.
Next, it would seem that rewriting Refl results in a change from plus m 0 = plus m 0 to m = plus m 0, rewriting from the left but stopping after the first replacement and not going to so far as to replace all instances of plus m 0 with m as I would have expected.
Ultimately, that is my question, why rewriting behaves in such a way. Is rewriting on equality types different and in those cases rewrite only replaces on the left side of the =?
To understand what is going on here we need to take into account the fact that Refl is polymorphic:
λΠ> :set showimplicits
λΠ> :t Refl
Refl : {A : Type} -> {x : A} -> (=) {A = A} {B = A} x x
That means Idris is trying to ascribe a type to the term Refl using information from the context. E.g. Refl in myPlusCommutes Z m = Refl has type plus m 0 = plus m 0. Idris could have picked the LHS of myPlusCommutes' output type and tried to ascribe the type m = m to Refl. Also you can specify the x expression like so : Refl {x = m}.
Now, rewrite works with respect to your current goal, i.e. rewrite Eq replaces all the occurrences of the LHS of Eq with its RHS in your goal, not in some possible typing of Refl.
Let me give you a silly example of using a sequence of rewrites to illustrate what I mean:
foo : (n : Nat) -> n = (n + Z) + Z
foo n =
rewrite sym $ plusAssociative n Z Z in -- 1
rewrite plusZeroRightNeutral n in -- 2
Refl -- 3
We start with goal n = (n + Z) + Z, then
line 1 turns the goal into n = n + (Z + Z) using the law of associativity, then
line 2 turns the current goal n = n + Z (which is definitionally equal to n = n + (Z + Z)) into n = n
line 3 provides a proof term for the current goal (if we wanted to be more explicit, we could have written Refl {x = n} in place of Refl).

Idris proof of less than

I'm very new to Idris (and dependent types). I was trying to do write a program to check if a string is a palindrome of not. To do that, I decided to compute the length of the string, and compute
q,r = (strlen `div` 2, strlen `mod` 2)
and then split the string as follows:
lhalf,rhalf = (substr 0 (q+r) str, substr (q-r) (q+r) str)
This takes care of both odd and even length strings. The problem is that Idris needs a proof that r < q since both q and r are Nat.
My question is: How do I express the fact that r
Here's the full sample of my code:
module Main
isPalindrome : (str : String) -> String
isPalindrome str =
let split = half_half str
in show ((fst split) == reverse (snd split))
where
strlen : Nat
strlen = length str
divMod : Nat -> Nat -> (Nat,Nat)
divMod x y = (x `div` y, x `mod` y)
half_half : String -> (String, String)
half_half "" = ("","")
half_half x = let
(q,r) = divMod strlen 2
in
(substr 0 (q+r) x,
substr (q-r) (q+r) x)
main : IO ()
main = repl "> " isPalindrome
You can't proof that r ≤ q because it's not true. For example, given the string "a" you have strlen = 1 and therefore q = 0 and r = 1. In this example r ≤ q is clearly false.
Note that you can implement isPalindrome simply by
isPalindrome: String -> Bool
isPalindrome str = str == reverse str