Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Quantum Random Numbers from Web

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Quantum Random Numbers from Web

    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.

    '
    Code:
    #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
    '

    Last edited by Stuart McLachlan; 4 Aug 2020, 06:58 AM.

  • #2
    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.

    '
    Code:
    #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
    '

    Comment


    • #3
      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.
      Christopher P. Becker
      signal engineer in the defense industry
      Abu Dhabi, United Arab Emirates

      Comment


      • #4
        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
        '
        Code:
        '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
        '

        Comment

        Working...
        X