4
$\begingroup$

I want that Mathematica decides randomly if a given variable, gets multiplied or divided by a random number in a given range.

The "naive" idea to just use

RandomReal[{1/10,10}]*X;

fails because most of the time RandomReal[{1/10,10}] is a number bigger than one because the interval from 1 to 10 is much bigger than the interval from 1/10 to 1, at least for Mathematica. In other words, using this code most of the time the X gets multiplied by a number, i.e. RandomReal[{1/10,10}]>1 and almost never gets divided, i.e. RandomReal[{1/10,10}]<1. In pseudocode, what I want is

RandomReal[{1,10}] Random[{*,/}]* X
$\endgroup$
0

6 Answers 6

17
$\begingroup$

I would approach this from the fact that both are forms of multiplication, but one has a negative exponent.

So

RandomReal[{1, 20}]^RandomChoice[{1, -1}]

will randomly be either 1/x or x, where x is a random number between 1 and 20.

$\endgroup$
6
$\begingroup$

Depending on the distribution desired, you could use the log-normal (or a similar transformation of whatever distribution has a mean of 0). It is transformed distribution such that a value -y < 0 of the underlying distribution is transformed to 1/x iff the value y > 0 is transformed to x (i.e., Exp[-y] == 1/x where x = Exp[y]). The "underlying" distribution for LogNormalDistribution[0, s] is NormalDistribution[0, s], which is symmetrically distributed about 0. Thus x is as likely as 1/x in sampling from LogNormalDistribution[0, 1].

RandomVariate[LogNormalDistribution[0, 1]]
RandomVariate[LogNormalDistribution[0, 1], 10]

Transform the uniform distribution:

logUniformD = TransformedDistribution[Exp[x],
  x \[Distributed] UniformDistribution[{-2, 2}]]
(*
  TransformedDistribution[E^\[FormalX], \[FormalX] \[Distributed] 
    UniformDistribution[{-2, 2}]]
*)

RandomVariate[logUniformD]
RandomVariate[logUniformD, 10]

or just simply use Exp@RandomReal[{-2, 2}, 10].

They're roughly just as fast as each other:

RandomVariate[LogNormalDistribution[0, 1], 10^6]; // RepeatedTiming
RandomVariate[logUniformD, 10^6]; // RepeatedTiming
Exp@ RandomReal[{-2, 2}, 10^6]; // RepeatedTiming
(*
  {0.031, Null}
  {0.015, Null}
  {0.010, Null}
*)

Here's a visualization of some distributions (JasonB's uniform joined with its inverse, log normal, and log uniform), with binning according with the symmetry x -> 1/x:

Show[#, Ticks -> {Charting`ScaledTicks[{Log, Exp}], Automatic}] & /@ 
  Histogram /@ Log /@
    {RandomReal[{1, 10}, 1000]^RandomChoice[{1, -1}, 1000],
     RandomVariate[LogNormalDistribution[0, 0.85], 1000],
     Exp@RandomReal[{-Log[10], Log[10]}, 1000]} // GraphicsRow

Mathematica graphics

$\endgroup$
4
  • $\begingroup$ This is what I was going to say. Note, though, that this distribution is "continuously" weighted rather than discretely weighted; for example, it's much less likely to pick a number between 9 and 10 than between 1 and 2, and less likely to pick a number between 0.9 and 1 than between 0.1 and 0.2. It's not 100% clear from the question whether this is acceptable. (It does have a certain elegance to it, though.) $\endgroup$ Commented Jan 14, 2016 at 19:15
  • $\begingroup$ @MichaelSeifert Yes, that is what I meant by "depending on the distribution desired" which wasn't clear to me either. Since you can't pick numbers uniformly throughout the interval from 1/A to A to get the property the OP seeks, it would be strange to me to require that the distribution be uniform in a subinterval, say, [1, A]. In any case, I was just showing there are many ways to do it, which might be of more general interest than the OP's particular aims. $\endgroup$
    – Michael E2
    Commented Jan 14, 2016 at 19:26
  • 1
    $\begingroup$ Thank god, someone came up with Exp@*RandomReal, +1 $\endgroup$
    – LLlAMnYP
    Commented Jan 14, 2016 at 23:16
  • $\begingroup$ @MichaelE2 thank you for introducing me to Charting`ScaledTicks[ ]+ 1 $\endgroup$
    – ubpdqn
    Commented Jan 15, 2016 at 6:19
4
$\begingroup$

One way:

 RandomChoice[{Times[x, #] &, Divide[x, #] &}][RandomReal[{1, 20}]]

To repeat, use a Table or Do expression, etc.

$\endgroup$
1
  • 2
    $\begingroup$ Or more compactly, RandomChoice[{Times, Divide}][x, RandomReal[{1, 20}]] $\endgroup$
    – Bob Hanlon
    Commented Jan 14, 2016 at 17:45
2
$\begingroup$

You can accomplish something very similar to your pseudo-code by defining a function:

rand := RandomChoice[{Times, Divide}]

Now every time you call the rand function, it either multiplies or divides its two arguments. For example,

rand[3, 4]

returns 12 half the time and 3/4 the other half. Now you can replace the "4" with a randomly chosen number and replace the "3" with your x.

$\endgroup$
1
$\begingroup$

This gives slightly different results than the other solutions ( if you Listplot large data points)

RandomChoice[{RandomReal[{1/10, 1}], RandomReal[{1, 10}]}]
$\endgroup$
3
  • $\begingroup$ More importantly, it gives a different distribution. The inverse of an uniformly distributed variable is not uniformly distributed. $\endgroup$
    – celtschk
    Commented Jan 14, 2016 at 17:27
  • $\begingroup$ @celtschk Looks like the distribution in this answer is more uniform for each interval (1/10 to 1 and 1 to 10). I checked the means and it gives around .55 for interval 1/10 to 1 and around 5.5 for interval 1 to 10. $\endgroup$ Commented Jan 14, 2016 at 17:32
  • $\begingroup$ Yes, exactly: You multiply with an uniform distribution between 0.1 and 1. Which is not the same as dividing by an uniform distribution between 1 and 10. $\endgroup$
    – celtschk
    Commented Jan 14, 2016 at 19:39
0
$\begingroup$

Interesting problem.

Let us dwell a little bit on that and calculate the distribution function (PDF) of the two-fold random factor given by

t = u^v

where u is assumed here - as an example - to be exponentially distributed and v takes the values +1 or -1 with equal probability 1/2.

The PDF is given by

f[t_] := Integrate[
  Exp[-u] (DiracDelta[t - u] + DiracDelta[t - 1/u])/2, {u, 0, \[Infinity]}]

One by one we have

Integrate[((1/2)*DiracDelta[t - u])/E^u, {u, 0, Infinity}]

(* Out[340]= ConditionalExpression[1/2 E^-t HeavisideTheta[t], t \[Element] Reals] *)

Integrate[((1/2)*DiracDelta[t - 1/u])/E^u, {u, 0, Infinity}]

(* Out[341]= ConditionalExpression[(E^(-1/t) Boole[t > 0])/(2 Abs[t]^2), t > 0] *)

Together, and simplified we find for the PDF

f2 = Simplify[% + %%, t > 0]

(* Out[342]= 1/2 (E^-t + E^(-1/t)/t^2) *)

f2 is finite for all t, and it has a small local minimum close to t = 0.

The normalization is ok

Integrate[f2, {t, 0, \[Infinity]}]

(* Out[343]= 1 *)

But it can be easily shown that higher moments do no exist because of the long tail of the distribution.

Addendum

I have noticed on more careful reading the answers that Michael E2 has considered explicit distributions earlier. But I think the developments complement each other.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.