Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Inspired by Quality of random numbers I would like to set up a true random data generator in Mathematica.

My idea is to use the static from an open microphone. I recall reading about extracting the "most random" data from such a source but I do not remember the specifics. Presumably all recognizable patterns and frequencies would need to be filtered out, and the remaining data "balanced" (for lack of a better term) to get a uniform distribution.

I would like to know how this may be accomplished and what quality and quantity of random data I could expect to to gather. If the mic static idea is not valid, I would like to know what other options exist.

share|improve this question
1  
This is perhaps a better question for Cryptography... Admittedly, the Mathematica part is small and the question focuses more on "true random data generator" (not sure what that means), the "quality and quantity of random data" that can be generated by said method and other valid sources of pseudo-random noise — all of which fall in crypto's domain... –  rm -rf Mar 20 '12 at 17:33
2  
I think the physical issues here are rather unclear. It appears that you are thinking of a cheap competitor to quantis (idquantique.com/true-random-number-generator/…) and it seems to me that if this were really that simple they would be already out of business. –  Andrzej Kozlowski Mar 20 '12 at 17:44
1  
@Andrzej I appreciate your opinion on this. My hope is to be able to extract at least a small quantity of reasonably high quality random data. Expect that custom hardware is designed to generate large quantities of random data on demand. I know that software has used such things as mouse movement to (theoretically) improve the quality of random data for encryption key generation. In such an application one could capture hours of mouse movement to generate only a few thousand bits of data. I would hope to generate random data at a somewhat faster rate. –  Mr.Wizard Mar 20 '12 at 17:49
1  
SystemDialogInput["RecordSound"], suggested by @Searke, doesn't seem to work on OS X. If it did I'd have written up some code to play with the least significant bits of the input. These I would a priori expect to be random, but they could well be otherwise due to all sorts of things-so it would have been fun. Alas... –  acl Mar 20 '12 at 20:45
1  
Here is an interesting and inexpensive solution entropykey.co.uk based on semiconductor noise. –  s0rce Mar 21 '12 at 0:18
show 12 more comments

4 Answers

up vote 18 down vote accepted

Edit: this answer is now structured in two sections. The first deals about creating a candidate RNG from audio data. The second demonstrates some testing I performed on this RNG.


Creating the RNG

Okay, I'll got at it another way then. I recorded 10 seconds of ambient noise on my MacBook Pro internal speakers. I was possibly in the worst conditions for this: my quiet flat, at night. The generated wav file was then imported into Mathematica. At least for my own combination of hardware, this doesn't look too good:

data = Import["test.wav", "Data"];
Length[data]
ListPlot[data[[1]]]
Histogram[data[[1]], PlotRange -> {{-0.0004, 0.0004}, Automatic}]

The data array has two components of length 520192 (it's 48 kHz audio, so it's indeed raw data). But, they take only a handful of possible values:

enter image description here

That being said, maybe some randomness can be extracted if the signal oscillate between these values in some random manner. If that's the case, I expect each value will only bring very little entropy to the result, but collectively you can still get something out. And indeed, the Fourier transform is:

ListPlot[Abs@Fourier[data[[1]]]]

enter image description here

which shows some promising behaviour. We take the mantissa, which is still very far from being uniformly distributed:

Histogram[(MantissaExponent[#][[1]] &) /@ Abs@Fourier[data[[1]]]]

enter image description here

and we can further refine by keeping only least-significant bits:

Histogram[(BitAnd[Floor[MantissaExponent[#][[1]]*2^32], 2^8 - 1] &) /@ Abs@Fourier[data[[1]]]]

enter image description here

Each integer in this list is between 0 and 255 (inclusive), so it's a 8-bit integer. They look nicely equidistributed, which of course is the lowest possible criterion for any kind of random generator. They should be further tested for randomness.

Alternatively, we can make it into a RNG that creates floating-point numbers between 0 and 1. The following is my “final state” code:

data = Import["test.wav", "Data"][[1]];
Print["Raw data length (one channel): ", Length[data]];
randombytes = 
  BitAnd[Floor[MantissaExponent[#][[1]]*2^32], 2^8 - 1] & /@ 
   Abs@Fourier@data;
Print["Number of random bytes: ", Length[randombytes]];
randomint32s = 
  Table[randombytes[[i]] + randombytes[[i + 1]]*2^8 + 
    randombytes[[i + 2]]*2^16 + randombytes[[i + 3]]*2^24,
   {i, 1, Length[randombytes], 4}];
randomfloats = N[#/2^32] & /@ randomint32s;
n = Length[randomfloats];
Print["Number of random reals: ", n];

Testing this RNG

I'm not an expert, so I performed so basic randomness tests following the guidelines in John D. Cook’s “Testing a Random Number Generator” chapter in Beautiful Testing. It's not DIEHARD, or DIEHARDER, but it's a start!

The approach I followed is to compare the properties of our RNG to those of streams of Mathematica’s default RNG (with the same size). I thus generate 100 vectors of reference random numbers:

references = Table[Table[RandomReal[], {i, n}], {j, 100}];

Then, I compare their properties. For example, I compare the average of randomfloats to the distribution of averages of same-sized vectors returned by RandomReal. For our RNG to be decent, our average must fit somewhere in the distribution of averages from RandomReal, which I test by calculating the later’s standard deviation:

w = Mean[randomfloats]
t = Mean /@ references; Print[Min@t, " ", Mean@t, " ", Max@t, " ", StandardDeviation@t];
Print["DeltaMean over deviation: ", (w - Mean@t)/StandardDeviation@t];

which outputs:

0.499767
0.498 0.500117 0.502256 0.00081088
DeltaMean over deviation: -0.432063

so our result is at $-0.43\sigma$, and we can be happy about it! I did the same thing for the min ($-0.25\sigma$), max ($0.22\sigma$), and variance (slightly larger at $1.4\sigma$, but still no cause for concern). I skipped the book's bucket test, because we already established that using histograms.

Then, the Kolmogorov-Smirnov test:

Quiet@KolmogorovSmirnovTest[randomfloats, UniformDistribution[{0, 1}], "TestConclusion"]

The null hypothesis that the data is distributed according to the UniformDistribution[{0,1}] is not rejected at the 5. percent level based on the Kolmogorov-Smirnov test.

Here I'd be tempted to say: victory!


Obviously, if you've read until here, either you like what I write (and I'd appreciate an upvote) or you are an expert, in which case I welcome comments on my empirical investigation. Thanks!

share|improve this answer
    
Thank you. This looks like a good way to approach the analysis of usability. –  Mr.Wizard Mar 20 '12 at 23:55
    
If you unplug your microphone you might get better randomness if you sample the noise in your computer, however, it could be worse if there is periodic noise from your AC power or something. This is what I got with no microphone: plot –  s0rce Mar 21 '12 at 0:01
3  
Nice work! But please see my comment elsewhere on this thread, because it applies to microphones as well as webcams: although your microphone and your operating system might have yielded random-looking numbers (and kudos to you for testing them!), without understanding exactly how those bits are being generated and processed along the way, we have to be concerned that somebody else's hardware and software might not generate random bits at all. (In the worst case, they will sort of look random, but they won't be.) –  whuber Mar 21 '12 at 19:34
2  
@whuber I completely agree! I've done a “proof of concept” study, but details are entirely hardware and OS-dependent. –  F'x Mar 21 '12 at 19:36
1  
With that caveat in place, I'm happy to upvote this splendid answer. –  whuber Mar 21 '12 at 19:38
show 2 more comments

Here is my quick and dirty attempt based on: Cryptographic Key From Webcam Image. I've used an example image as I don't have a webcam on my desktop but you could simply use CurrentImage to grab the webcam image live if you have one.

Update using a webcam image from my laptop

image = CurrentImage[];
grayscale = ColorConvert[image, "Grayscale"];
imagedata = Round[ImageData@grayscale*(2^8 - 1)];
leastsigbit = Map[BitAnd[#, 1] &, imagedata, {2}];
n = 8;
flattened = Flatten@leastsigbit;
extra = Last@QuotientRemainder[Length@flattened, n];
trimmed = Drop[flattened, extra];
parted = Partition[trimmed, n];
randombytes = Map[Total[#*2^Range[0, n - 1]] &, parted]

I skipped the part where they use a circular route to generate the binary sequences and simply read it left to right, top to bottom (with Flatten) because it was so much easier, I have no idea the implication of this on the randomness quality.

Doesn't look all to random any more...

ArrayPlot@leastsigbit
Histogram@randombytes

Mathematica graphics

This is very far from my area of expertise and I'm not really sure how to apply better tests of randomness but I figured this is a start.

I also ran the code @F'x demonstated as a simple test:

randombytestrimmed = 
  Drop[randombytes, Last@QuotientRemainder[Length[randombytes], 4]];
randomint32s = 
  Table[randombytestrimmed[[i]] + randombytestrimmed[[i + 1]]*2^8 + 
    randombytestrimmed[[i + 2]]*2^16 + 
    randombytestrimmed[[i + 3]]*2^24, {i, 1, 
    Length[randombytestrimmed], 4}];
randomfloats = N[#/2^32] & /@ randomint32s;
references = Table[Table[RandomReal[], {i, n}], {j, 100}];
w = Mean[randomfloats]
t = Mean /@ references; Print[Min@t, " ", Mean@t, " ", Max@t, " ", 
 StandardDeviation@t];
Print["DeltaMean over deviation: ", (w - Mean@t)/StandardDeviation@t];
Quiet@KolmogorovSmirnovTest[randomfloats, UniformDistribution[{0, 1}],
   "TestConclusion"]

output:

0.492367

0.306043 0.516793 0.737207 0.0969204

DeltaMean over deviation: -0.252023

The null hypothesis that the data is distributed according to the
UniformDistribution[{0,1}] is rejected at the 5. percent level 
based on the Kolmogorov-Smirnov test.
share|improve this answer
    
Thank you. This and the linked article appear very applicable. –  Mr.Wizard Mar 20 '12 at 23:53
5  
The important thing to recognize is that you can't roll your own random number generator. Good people have tried and frequently failed. It's imperative that any attempt be theoretically supported and thoroughly tested. A major flaw of the referenced paper is that it assumes all webcams will work exactly like the (unspecified) one that was tested. (But note that its authors recognize the need for thorough testing.) It's conceivable that other webcam hardware or software could impose strong non-randomness in its output, even in the least significant bits. Caveat emptor! –  whuber Mar 21 '12 at 19:30
add comment

Here is another possibility based on mouse movements, updated with live histogram, further updated by hashing a combination of the mouse position and AbsoluteTime:

DynamicModule[{},
 positionlist = {};
 list = {};
 EventHandler[{Dynamic[
     Framed@Graphics[{Red, Line@positionlist, Point@positionlist}, 
       PlotRange -> 2]], 
    Dynamic@Histogram[(BitAnd[Floor[MantissaExponent[#][[1]]*2^32], 
          255] &) /@ Abs@Flatten@list]} // 
   TableForm, {"MouseMoved" :> 
    If[ListQ@
      MousePosition@"Graphics", {AppendTo[list, 
       Hash[{MousePosition@"Graphics", AbsoluteTime[]}, "SHA"]], 
      AppendTo[positionlist, MousePosition@"Graphics"]}]}]]

Mathematica graphics

Thanks to @F'x for some of his code.

share|improve this answer
1  
At least on Windows this does not appear to trend toward a uniform distribution, the most basic of checks. I think more processing is needed to extract the "most random" part of the data. If I knew how to do that correctly I wouldn't have asked this question. –  Mr.Wizard Mar 21 '12 at 16:15
1  
I tried, I remember that some cryptography software uses mouse movements to generate keys but I wasn't exactly sure how it worked. I think it might be better to use the relative change in position instead of the absolute position. It was fun to play with the EventHandler, I hadn't used the before. –  s0rce Mar 22 '12 at 0:37
add comment

OK, I'll gladly cheat and propose the following:

Clear[RandomByte, RandomByteState];
RandomByte[] := Module[{r},
  If[Not[Head[RandomByteState] == List] \[Or] Length[RandomByteState] == 0,
     RandomByteState = Import["http://www.random.org/cgi-bin/randbyte?nbytes=16384&format=f", "Binary"]];
  r = RandomByteState[[1]];
  RandomByteState = Rest[RandomByteState];
  Return[r];
]

Now, given my low Mathematica expertise, I expect there are ways to improve both style and efficiency of the above, but the idea is there :)

share|improve this answer
    
And before too many people try, I should link to the site’s automated clients policy –  F'x Mar 20 '12 at 20:06
    
I don't think Mr.Wizard was particularly interested in any random number generator/online entropy source. I think his question deals with implementing his idea in Mathematica and then rigorously testing for its efficiency. –  rm -rf Mar 20 '12 at 20:17
1  
“If the mic static idea is not valid, I would like to know what other options exist.” — Let's say I'm pointing at an unorthodox way of setting up “a true random data generator in Mathematica”. –  F'x Mar 20 '12 at 20:19
    
@R.M you're both right in a way; I would like a local generator that does not rely on a network source, but I don't mind what method that is. The mic feed is just the first that came to mind. F'x this is interesting, but I am going to hold my vote for now at least, in light of my intention. –  Mr.Wizard Mar 20 '12 at 23:04
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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