Message Boards Message Boards

2
|
5360 Views
|
3 Replies
|
2 Total Likes
View groups...
Share
Share this post:

Smallest possible number that can be C-compiled

Posted 4 years ago

I need to calculate a probability matrix that involves several matrix elements that are very small, that is, of the order of 10^-100 or more. What I remarked is that when numbers occur that are smaller than about 10^-18 an error occurs when the compiled function is ececuted. However, in C++ real numbers can be as small as about 10^-308 so I don't think that the problem is my compiler (Visual Studio 10). So how can I tell Mathematica to use double typed numbers in the compiling? A simplified version of the code I use is

Bmatrix = Compile[{{m, _Real}, {t, _Integer}}, Module[{b, B},
   B = ConstantArray[0., {t, t}];
   Do[b = m (i + j); 
    If[b > 10^-19, B[[i, j]] = b], {i, 1, Floor[t/2]}, {j, i, t - i}];
   Return[B]],
  {{b, _Real}, {B, _Real, 2}},
  CompilationTarget -> "C"]

In order to accelerate matrix multiplication, I need to set to zero matrix elements smaller than 10^-100, which is done in If. But as you can verify this is not possible beyond 10^-18. So how to decrease this at least to 10^-100?

POSTED BY: Ulrich Utiger
3 Replies

Compile handles machine doubles. The issue is not in this case about absolute size but rather relative sizes.Mantissas have 53 bits so a scale difference of 2^54 or so will be problematic. I am guessing this is what causes trouble for you (absent a specific example it is hard to tell).

There are other things to consider. For one, it is easier to set small values to zero using Chop. For another, matrix multiplication for the case of machine doubles will be done under the hood using fast BLAS code. So setting some values to zero will not offer any improvement unless (i) most become zero and (ii) an explicit SparseArray is then created from the matrix.

It might be useful to post a full example and give a clear indication of what is the desired behavior/result.

POSTED BY: Daniel Lichtblau
Posted 4 years ago

Hi Daniel, maybe you'r right and the problem is elsewhere. Here is the full code:

Bmatrix = 
 Compile[{{a, _Integer}, {t, _Integer}, {m, _Real}}, 
  Module[{n, p, q, B},
   n = 1 - m; p = m/a; q = m (1 - 1/a); B = ConstantArray[0., {t, t}];
   Do[B[[i, j]] = 
     1/Gamma[1 + i] p^(-i + j) ((n + p) (n + q))^
      i Gamma[1 + j] Hypergeometric2F1Regularized[-i, j - t, 
       1 - i + j, (p q)/((n + p) (n + q))] If[t >= i + j, (n + p)^(
       t - i - j), (n + q)^-(t - i - j)], {i, 1, Floor[t/2]}, {j, i, 
     t - i}];
   Do[B[[i, j]] = 
     1/Gamma[1 + i] p^(-i + j) ((n + p) (n + q))^(-j + t)
       Gamma[1 + j] Hypergeometric2F1Regularized[-i, j - t, 
       1 - i + j, (p q)/((n + p) (n + q))] If[t >= i + j, (n + p)^(
       t - i - j), (n + q)^-(t - i - j)], {j, Ceiling[t/2], 
     t - 1}, {i, t - j + 1, j}];
   Do[B[[i, t]] = p^(-i + t) (n + q)^i Binomial[t, i], {i, 1, t}];
   Do[B[[j, i]] = (q/p)^(j - i)
       B[[i, j]] Binomial[t, j]/Binomial[t, i], {i, 1, t}, {j, i + 1, 
     t}];
   Return[B]],
  {{n, _Real}, {p, _Real}, {q, _Real}, {B, _Real, 2}},
  CompilationTarget -> "C"]

With Bmatrix[4, 21, 4 10^-8] it works without error. With Bmatrix[4, 22, 4 10^-8] it generates "numerical error encountered". I need to calculated this matrix for up to t=600. I guessed that this has something to do with too small numbers, which is why I intended to set a lower limit. Or maybe something with Catch and Throw must be coded. I don't know. I am physicist not a computer scientist. Can you tell me what I could try out?

POSTED BY: Ulrich Utiger
Posted 4 years ago

With Round to a multiple of 10^-100 for every Do loop it seems to work now. Thanks for your help.

Edit: No, it doesn't work. It took a while until I realized it. The compiled and uncompiled versions of the code below does not yield the same matrix for a=4, t=300 and m=4*10^-8:

Compilable code:

e = 100;
Bmatrix = 
  Compile[{{a, _Real}, {t, _Integer}, {m, _Real}}, Module[{n, p, q, B},
    n = 1 - m; p = m/a; q = m (1 - 1/a); B = ConstantArray[0., {t, t}];
    Do[B[[i, j]] = 
      Round[1/Gamma[1 + i] p^(-i + j) ((n + p) (n + q))^
        i Gamma[1 + j] Hypergeometric2F1Regularized[-i, j - t, 
         1 - i + j, (p q)/((n + p) (n + q))] If[t >= i + j, (n + p)^(
         t - i - j), (n + q)^-(t - i - j)], 10^-e], {i, 1, 
      Floor[t/2]}, {j, i, t - i}];
    Do[B[[i, j]] = 
      Round[1/Gamma[1 + i] p^(-i + j) ((n + p) (n + q))^(-j + t)
         Gamma[1 + j] Hypergeometric2F1Regularized[-i, j - t, 
         1 - i + j, (p q)/((n + p) (n + q))] If[t >= i + j, (n + p)^(
         t - i - j), (n + q)^-(t - i - j)], 10^-e], {j, Ceiling[t/2], 
      t - 1}, {i, t - j + 1, j}];
    Do[B[[i, t]] = 
      Round[p^(-i + t) (n + q)^i Binomial[t, i], 10^-e], {i, 1, t}];
    Do[B[[j, i]] = 
      Round[(q/p)^(j - i) B[[i, j]] Binomial[t, j]/Binomial[t, i], 
       10^-e], {i, 1, t}, {j, i + 1, t}];
    Return[B]],
   {{n, _Real}, {p, _Real}, {q, _Real}, {B, _Real, 2}},
   CompilationTarget -> "C"];

Non compiled code:

Bmatrix[a_, t_, m_] := Module[{n, p, q, B},
  n = 1 - m; p = m/a; q = m (1 - 1/a); B = ConstantArray[0., {t, t}];
  Do[B[[i, j]] = 
    Round[1/Gamma[1 + i] p^(-i + j) ((n + p) (n + q))^
      i Gamma[1 + j] Hypergeometric2F1Regularized[-i, j - t, 
       1 - i + j, (p q)/((n + p) (n + q))] If[t >= i + j, (n + p)^(
       t - i - j), (n + q)^-(t - i - j)], 10^-100], {i, 1, 
    Floor[t/2]}, {j, i, t - i}];
  Do[B[[i, j]] = 
    Round[1/Gamma[1 + i] p^(-i + j) ((n + p) (n + q))^(-j + t)
       Gamma[1 + j] Hypergeometric2F1Regularized[-i, j - t, 
       1 - i + j, (p q)/((n + p) (n + q))] If[t >= i + j, (n + p)^(
       t - i - j), (n + q)^-(t - i - j)], 10^-100], {j, Ceiling[t/2], 
    t - 1}, {i, t - j + 1, j}];
  Do[B[[i, t]] = 
    Round[p^(-i + t) (n + q)^i Binomial[t, i], 10^-100], {i, 1, t}];
  Do[B[[j, i]] = 
    Round[(q/p)^(j - i) B[[i, j]] Binomial[t, j]/Binomial[t, i], 
     10^-100], {i, 1, t}, {j, i + 1, t}];
  Return[B]];

With this code you can test the difference:

e = 2; ls = {};
Do[
  diff = Abs[B1[[i, j]] - B2[[i, j]]];
  If[diff > 10^-e, AppendTo[ls, {i, j, diff}]],
  {i, 1, t}, {j, 1, t}];
ls
Length[ls]

B1 is the matrix of the compiled code, B2 is the matrix of the uncompiled code using the same parameters. This yields 123 differences.

POSTED BY: Ulrich Utiger
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract