Quantum Random Numbers from Web

[Stuart McLachlan]

ETH Zurich, the Swiss university provides a web API to a high resolution Quantum Random Number Generator
See http://qrng.ethz.ch/#welcome-to-quantum-rng-for-openqu

This code populates an array of true random QUADs or EXTs with a single web GET.

'

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "WIN32API.INC"

GLOBAL extRand() AS EXT
GLOBAL qRand() AS QUAD
GLOBAL sVals() AS STRING

FUNCTION PBMAIN () AS LONG
    LOCAL qMin,qMax AS QUAD
    LOCAL qty, x AS LONG
    LOCAL s AS STRING

    'Get some random quads
    qMin = 1: qMax = 1000: qty = 2000
    IF GetRandQuads(qMin,qMax,qty)  THEN
        IF qty > 200 THEN qty = 200 'just show first 200 at most
        FOR x = 0 TO qty -1
            s+= STR$(qRand(x))
        NEXT
        ? s
    ELSE
        ? "Problem retrieving Quantum Randon Integers"
    END IF

     'Get some random Exts between 0 and 1
     s=""
     qty = 2000
     IF GetRandExts(qty)  THEN
        IF qty > 200 THEN qty = 200 'just show first 200 at most
        FOR x = 0 TO qty -1
            s+= STR$(extRand(x),18)
        NEXT
        ? s
    ELSE
        ? "Problem retrieving Quantum Random Exts"
    END IF
END FUNCTION

FUNCTION GetRandQuads(minval AS QUAD,maxval AS QUAD,qty AS LONG) AS LONG
    LOCAL v1        AS VARIANT
    LOCAL v2        AS VARIANT
    LOCAL v3        AS VARIANT
    LOCAL vResult   AS VARIANT
    LOCAL vResponse AS VARIANT
    LOCAL oHttp     AS DISPATCH
    LOCAL sResponse AS STRING
    LOCAL ResultHeader AS STRING
    LOCAL x         AS LONG
    ResultHeader  = "{""result"":"
    IF ABS(minval) > 999999999999999 OR ABS(maxval) > 999999999999999 THEN
         ? "Number out of range. Maximum 15 digits!"
    EXIT FUNCTION
    END IF
    ON ERROR GOTO errtrap 'in case  HTTP  call fails!
    SET oHttp = NEWCOM "Msxml2.XMLHTTP"
    v1 = "GET"
    v2 = "http://random.openqu.org/api/randint?min=" & FORMAT$(minval) & _
              "&max=" & FORMAT$(maxval) & "&size=" & FORMAT$(qty)
    v3 = 0
    OBJECT CALL oHttp.Open(v1, v2, v3) TO vResult
    OBJECT CALL oHttp.Send(v1) TO vResult
    OBJECT GET  oHttp.Responsetext TO vResponse
    oHttp = NOTHING
    sResponse = VARIANT$(vResponse)
    IF LEFT$ (sResponse,10) = Resultheader THEN
         sResponse = TRIM$(MID$(sResponse,10),ANY " :{[[]}")
         REDIM qRand(0 TO qty-1)
         REDIM sVals(1 TO qty)
         PARSE sResponse,sVals()
         FOR x = 1 TO qty
             qRand(x-1) = VAL(sVals(x))
         NEXT
         RESET sVals()
         FUNCTION =-1
    END IF
errtrap:
END FUNCTION

FUNCTION GetRandExts(qty AS LONG) AS LONG
    LOCAL v1        AS VARIANT
    LOCAL v2        AS VARIANT
    LOCAL v3        AS VARIANT
    LOCAL vResult   AS VARIANT
    LOCAL vResponse AS VARIANT
    LOCAL oHttp     AS DISPATCH
    LOCAL sResponse AS STRING
    LOCAL ResultHeader AS STRING
    LOCAL x         AS LONG
    ResultHeader  = "{""result"":"
    ON ERROR GOTO errtrap ''in case  HTTP  call fails!
    SET oHttp = NEWCOM "Msxml2.XMLHTTP"
    v1 = "GET"
    v2 = "http://random.openqu.org/api/rand?size=" & FORMAT$(qty)
    v3 = 0
    OBJECT CALL oHttp.Open(v1, v2, v3) TO vResult
    OBJECT CALL oHttp.Send(v1) TO vResult
    OBJECT GET  oHttp.Responsetext TO vResponse
    oHttp = NOTHING
    sResponse = VARIANT$(vResponse)
    IF LEFT$ (sResponse,10) = Resultheader THEN
         sResponse = TRIM$(MID$(sResponse,10),ANY " :{[[]}")
         REDIM sVals(1 TO qty)
         REDIM extRand(0 TO qty-1)
         PARSE sResponse,sVals()
         FOR x = 1 TO qty
             extRand(x-1) = VAL(sVals(x))
         NEXT
         RESET sVals()
         FUNCTION =-1
    END IF
errtrap:
END FUNCTION
'

[Stuart McLachlan]

As a practical example, using the quantum randoms to shuffle a deck of cards using Knuth/Fisher-Yates. It overcomes the limitation of RND() not being able to return all possible permutations of 52 cards as discussed in previous threads.

'

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "WIN32API.INC"

GLOBAL gDeck() AS LONG
GLOBAL gCardname() AS STRING

FUNCTION PBMAIN () AS LONG
     LOCAL x ,y AS LONG
     LOCAL strT AS STRING
     LOCAL lngReturn AS LONG
     'Init Deck
     DIM gDeck (1 TO 52)
     DIM gCardName(1 TO 52)
     FOR x = 1 TO 52
         gDeck(x) = x
         gCardName(x) = CHOOSE$((x-1) MOD 13 + 1,"2","3","4","5","6","7","8","9","10","J","Q","K","A") & CHOOSE$(1 + FIX((x-1)/13),"C","D","H","S")
     NEXT

     'Show initial deck
     strT = "Unshuffled Deck" & $CRLF
     FOR x = 1 TO 52
         strT += gCardName(gDeck(x)) & " " &  IIF$(x MOD 13= 0,$CRLF,"")
     NEXT
     ? strT
     'Shuffles
    FOR y = 1 TO 3
        lngReturn = ShuffleDeck
         'Show shuffled deck
         strT = CHOOSE$(lngReturn + 1,"Shuffle Failed","Quantum Random Shuffle","Pseudo Random SHuffle") & $CRLF
         FOR x = 1 TO 52
             strT += gCardName(gDeck(x)) & " " &  IIF$(x MOD 13= 0,$CRLF,"")
         NEXT
         ? strT
    NEXT
END FUNCTION

FUNCTION ShuffleDeck() AS LONG
    LOCAL v1           AS VARIANT
    LOCAL v2           AS VARIANT
    LOCAL v3           AS VARIANT
    LOCAL vResult      AS VARIANT
    LOCAL vResponse    AS VARIANT
    LOCAL oHttp        AS DISPATCH
    LOCAL sResponse    AS STRING
    LOCAL ResultHeader AS STRING
    LOCAL x,L,U        AS LONG
    DIM rnds(1 TO 51)  AS EXT
    DIM sVals(1 TO 51) AS STRING

    ResultHeader  = "{""result"":"

    'Get 51 Random numbers in range x -> 52
    TRY 'Get quantum randoms
        SET oHttp = NEWCOM "Msxml2.XMLHTTP"
        v1 = "GET"
        v2 = "http://random.openqu.org/api/rand?size=51"
        v3 = 0
        OBJECT CALL oHttp.Open(v1, v2, v3) TO vResult
        OBJECT CALL oHttp.Send(v1) TO vResult
        OBJECT GET  oHttp.Responsetext TO vResponse
        oHttp = NOTHING
        sResponse = VARIANT$(vResponse)
        IF LEFT$ (sResponse,10) <> Resultheader THEN ERROR 151
         sResponse = TRIM$(MID$(sResponse,10),ANY " :{[[]}")
         PARSE sResponse,sVals()
         FOR x = 1 TO 51
             rnds(x) = FIX((52 - x + 1) * VAL(sVals(x))  + x)
         NEXT
         FUNCTION = 1
    CATCH ' use RND()
        RANDOMIZE
        FOR x = 1 TO 51
            rnds(x) = RND(x,52)
        NEXT
        FUNCTION = 2
    END TRY
    'Knuth/Fisher-Yates Shuffle
    FOR x = 1 TO 51
          SWAP gDeck(x),gDeck(rnds(x))
    NEXT
END FUNCTION
'

[Christopher Becker]

the limitation of RND() not being able to return all possible permutations of 52 cards

Interesting point. I hadn't considered that. A little math shows that we need 226 bits (or more than 29 bytes) of entropy to cover the domain space of 52 cards. EXT only gives us 10 bytes.

[Stuart McLachlan]

Just checked and the ETH Zurich site http://random.openqu.org does not appear to be operational any more.

But https://qrng.anu.edu.au works.

Here's code to return a string of quantum random bytes
'

'Returns a set of quantum random bytes from https://qrng.anu.edu.au
'as a byte string
'Note: displaying the with Print/Msgbox may be problematic
'since it may contain bytes in the range CHR$(0) to CHR$(31)

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "WIN32API.INC"  'Roca Includes

FUNCTION PBMAIN () AS LONG
    LOCAL qMin,qMax AS QUAD
    LOCAL qty, i AS LONG
    LOCAL s,s2 AS STRING
    LOCAL numbytes AS LONG
    numbytes = 64 '64 bytes = 512 bits
    s = GetRandBytes(numbytes)

    IF LEN(s) <> numbytes THEN
        ? "Problem retrieving Quantum Random bytes"
    ELSE
        FOR i = 1 TO numbytes
            s2 &= HEX$(ASC(s,i),2)
        NEXT
       ? "Random " & STR$(numbytes) & " byte string in Hex = " & $LF & s2
    END IF
END FUNCTION

FUNCTION GetRandBytes(qty AS LONG) AS STRING
    LOCAL v1        AS VARIANT
    LOCAL v2        AS VARIANT
    LOCAL v3        AS VARIANT
    LOCAL vResult   AS VARIANT
    LOCAL vResponse AS VARIANT
    LOCAL oHttp     AS DISPATCH
    LOCAL sResponse AS STRING
    LOCAL i         AS LONG
    LOCAL s AS STRING
    ON ERROR GOTO errtrap 'in case  HTTP  call fails!
    SET oHttp = NEWCOM "Msxml2.XMLHTTP"
    v1 = "GET"
    v2 = "https://qrng.anu.edu.au/API/jsonI.php?length=64&type=uint8&size=1
    v3 = 0
    OBJECT CALL oHttp.Open(v1, v2, v3) TO vResult
    OBJECT CALL oHttp.Send(v1) TO vResult
    OBJECT GET  oHttp.Responsetext TO vResponse
    oHttp = NOTHING
    sResponse = VARIANT$(vResponse)
    IF INSTR(sResponse,"""success"":true}") THEN
       s = MID$(sResponse,INSTR(sResponse,"[") + 1, INSTR(sResponse,"]") - INSTR(sResponse,"[")-1)
       DIM arrS(1 TO qty) AS STRING  'get numbers as strings
       PARSE s, arrS(), ","
       s=""
       FOR i = 1 TO qty
           s &= CHR$(VAL(arrS(i)))
       NEXT
       FUNCTION = s
       EXIT FUNCTION
    ELSE
        ? "Failed to get bytes" & $LF & sresponse
    END IF
errtrap:
END FUNCTION
'