Hello Daniel,<br><br>Regarding your solution, can I apply {-# SPECIALISE ... #-} statements to datatypes I define?<br>And if so, I am not able to import the datatypes to the module where binarySearch is.<br>The problem is that if I import them a circular dependency is detected and the compiler gives an error.<br>
Is there a way of importing a datatype from another module do avoid this circular dependency?<br><br>Thank you,<br><br>Arnoldo<br><br><div class="gmail_quote">On Thu, Mar 18, 2010 at 10:48 PM, Daniel Fischer <span dir="ltr">&lt;<a href="mailto:daniel.is.fischer@web.de">daniel.is.fischer@web.de</a>&gt;</span> wrote:<br>
<blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">Am Donnerstag 18 März 2010 21:57:34 schrieb Daniel Fischer:<br>
<div class="im">&gt;<br>
&gt; Contrary to my expectations, however, using unboxed arrays is slower<br>
&gt; than straight arrays (in my tests).<br>
&gt;<br>
<br>
</div>However, a few {-# SPECIALISE #-} pragmas set the record straight.<br>
Specialising speeds up both, boxed and unboxed arrays, significantly, but<br>
now, for the specialised types, unboxed arrays are faster (note, however,<br>
that when the code for the binary search is in the same module as it is<br>
used, with optimisations, GHC will probably specialise it itself. If<br>
binarySearch is not exported, AFAIK, you can delete &quot;probably&quot;.).<br>
<div class="im"><br>
{-# LANGUAGE BangPatterns #-}<br>
module SATBinSearch (binarySearch) where<br>
<br>
import Data.Array.IArray<br>
import Data.Array.Base (unsafeAt)<br>
import Data.Bits<br>
<br>
</div>{-# SPECIALISE binarySearch :: Double -&gt; Array Int Double -&gt; Int #-}<br>
{-# SPECIALISE binarySearch :: Int -&gt; Array Int Int -&gt; Int #-}<br>
{-# SPECIALISE binarySearch :: Bool -&gt; Array Int Bool -&gt; Int #-}<br>
{-# SPECIALISE binarySearch :: Char -&gt; Array Int Char -&gt; Int #-}<br>
{-# SPECIALISE binarySearch :: Float -&gt; Array Int Float -&gt; Int #-}<br>
<div class="im">binarySearch :: Ord a =&gt; a -&gt; Array Int a -&gt; Int<br>
binarySearch q a = go l h<br>
      where<br>
        (l,h) = bounds a<br>
        go !lo !hi<br>
            | hi &lt; lo   = -(lo+1)<br>
            | otherwise = case compare mv q of<br>
                            LT -&gt; go (m+1) hi<br>
                            EQ -&gt; m<br>
                            GT -&gt; go lo (m-1)<br>
              where<br>
</div>                -- m = lo + (hi-lo) `quot` 2<br>
<div class="im">                m = (lo .&amp;. hi) + (lo `xor` hi) `shiftR` 1<br>
                mv = a `unsafeAt` m<br>
<br>
</div>Use Data.Array.Unboxed and UArray if possible.<br>
Now the bit-fiddling instead of arithmetics makes a serious difference,<br>
about 20% for unboxed arrays, 17% for boxed arrays (Double), so I&#39;d<br>
recommend that.<br>
</blockquote></div><br>