Qbasicnews.com
August 25, 2019, 11:25:22 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: 1 [2] 3 4 5
  Print  
Author Topic: Challenge: Validate a code  (Read 16857 times)
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #15 on: July 27, 2003, 10:46:50 PM »

Sure, you can treat a transvestite as a real women too. But that doesn't mean it is :p

My code reads binary files where each 4 bytes represents a long and the next 4 bytes another one etc etc. However, i with little modification it works with ASCII files as well. So here you go. Oh and i thought it was obvious that you have to use the /ah option. Well if it wasn't, now you know.

Code:

''
'' If i had to chose i'd use a number in the range
'' 0 to 32767 for effciency. If the number was
'' bigger then that i wouldn't use qb.
'' Use the /ah option or you won't be able to compile
'' or run.
''
''
defint a-z

const KEYMIN&   = 0&
const KEYMAX&   = 99999&
const VALIDKEY  = -1

declare sub loadKeyTable   ( filename as string )
declare function checkKey% ( keyToCheck as long )


'$dynamic
dim shared keyTable( KEYMAX \ 16384&, 16383 ) as integer
'$static


    ''
    '' Entry point
    ''
    dim keyToCheck as long    
   
    ''
    '' This is not part of the main program
    '' it's just setup.
    ''
    loadKeyTable "valid.txt"
   
   
    do
        input "Enter a key or -1 to exit: ", keyToCheck
       
        if ( checkKey( keyToCheck ) = 0 ) then
            print "Invalid key, quiting"
            exit do
        else
            print "Valid key"
        end if
    loop





'' :::::::::
'' name: checkKey
'' desc: Checks if a key is valid
''
'' :::::::::
defint a-z
function checkKey% ( keyToCheck as long ) static
    dim indxa as integer
    dim indxb as integer    
   
    ''
    '' Check range
    ''
    if ( (keyToCheck < KEYMIN) or (keyToCheck > KEYMAX) ) then
        checkKey% = 0
        exit function
    end if
   
    ''
    '' Check key
    ''    
    indxa = keyToCheck  \  16384&
    indxb = keyToCheck and 16383&
    checkKey% = keyTable( indxa, indxb )
end function



'' :::::::::
'' name: loadKeyTable
'' desc: Loads a bunch of valid keys
'' note: This is to be run BEFORE starting to time
''
'' :::::::::
defint a-z
sub loadKeyTable ( filename as string ) static
    dim currKey as long
    dim keysRead as long
    dim keysInFile as long
   
    dim i as integer, j as integer
    dim indxa as integer, indxb as integer
   
   
    open filename for input as #1    
   
    ''
    '' Clear table and load keys
    ''
    for  i = 0 to KEYMAX \ 16384&
        for  j = 0 to 16383
            keyTable( i, j ) = 0
        next j
    next i    

    while ( not eof( 1 ) )
        input #1, currKey
       
        if ( (currKey < KEYMIN) or (currKey > KEYMAX) ) then
            print "Error: Invalid key in file..."
            end
        end if
       
        ''
        '' Put key in table
        ''        
        indxa = currKey  \  16384&
        indxb = currKey and 16383&
        keyTable( indxa, indxb ) = VALIDKEY
    wend
       
    close #1
end sub
Logged

oship me and i will give you lots of guurrls and beeea
Moneo
Na_th_an
*****
Posts: 1971


« Reply #16 on: July 27, 2003, 10:59:36 PM »

BLITZ,
Got the same "subscript out of range" error in the same place as before.
P.S.: I'm compiling using BC without any switches. Is that ok?

BTW: I don't understand why you set up a two dimensional array, and why you use the values 16384 and 16383. What are you trying to do?
*****
Logged
Meg
Ancient QBer
****
Posts: 483


« Reply #17 on: July 27, 2003, 11:10:22 PM »

meh.

*peace*

Meg.
Logged
Moneo
Na_th_an
*****
Posts: 1971


« Reply #18 on: July 27, 2003, 11:17:09 PM »

MEG,
The idea is not to loop and read in more values. The idea is to read in all the valid codes ONCE, and store them in memory to your liking (and obviously they have to fit). Then for each code that the user inputs, validate against what you have in memory.

Come on, the hard part is stuffing the codes into as little memory as possible. That's the whole idea of the challenge!
*****
Logged
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #19 on: July 27, 2003, 11:51:15 PM »

Ok listen, both my entry and antonis need to be compiled with the /Ah option. If you don't compile it with that option you will get subscript out of range.
Logged

oship me and i will give you lots of guurrls and beeea
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #20 on: July 28, 2003, 06:34:16 AM »

Moneo:
My program uses huge (more than 64K) arrays, as does Blitz's. In the IDE they are activated with /AH, don't know what is  the equivalent switch in BC.
Logged

Antoni
Agamemnus
x/ \z
*****
Posts: 3491



« Reply #21 on: July 28, 2003, 08:16:05 AM »

Preprocessing is cheating!

Question!!!!!! QUESTION!!!!!!! The user inputs 20,000 numbers and tests if any of them exist out of the other 20,000 numbers in the file?!?!?!?!

Wouldn't it be better just to use TWO files, then???!!!!
Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #22 on: July 28, 2003, 08:46:40 AM »

the /ah switch is the same in bc. And you should compile with vbdos. It's better with LONGs.
Logged

oship me and i will give you lots of guurrls and beeea
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #23 on: July 28, 2003, 08:50:31 AM »

Quote from: "Moneo"
BTW: I don't understand why you set up a two dimensional array, and why you use the values 16384 and 16383. What are you trying to do?
*****


End the challenge first and i'll explain. Smiley
Logged

oship me and i will give you lots of guurrls and beeea
Agamemnus
x/ \z
*****
Posts: 3491



« Reply #24 on: July 28, 2003, 08:57:34 AM »

WAIT!!!!!!!!!
Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war."

Visit www.neobasic.net to see rubbish in all its finest.
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #25 on: July 28, 2003, 10:14:14 AM »

I did a benchmark between mine and antonis, i think he'll agree that they're very fair. Here they are.


Code:

defint a-z

const KEYMIN&   = 0&
const KEYMAX&   = 99999&
const VALIDKEY  = -1

declare sub loadKeyTable   ( filename as string )
declare function checkKey% ( keyToCheck as long )


'$dynamic
dim shared keyTable( KEYMAX \ 16384&, 16383 ) as integer
'$static


    ''
    '' Entry point
    ''
    dim result as integer  
    dim keyToCheck as long    
    dim indxa as integer, indxb as integer
    dim tmrIni as single, tmrEnd as single
   
   
    ''
    '' This is not part of the main program
    '' it's just setup.
    ''
    loadKeyTable "valid.txt"    
    keyToCheck = 13
   
    tmrIni = timer
    for  i = 0 to 31999
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )

        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )

        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
       
        indxa = keyToCheck  \  16384&
        indxb = keyToCheck and 16383&
        result = keyTable( indxa, indxb )
    next i
    tmrEnd = timer
   
   
    print "Blitz code does" + str$(clng( 32000#*10# / (tmrEnd-tmrIni) )) + " searches per second"



'' :::::::::
'' name: loadKeyTable
'' desc: Loads a bunch of valid keys
'' note: This is to be run BEFORE starting to time
''
'' :::::::::
defint a-z
sub loadKeyTable ( filename as string ) static
    dim currKey as long
    dim keysRead as long
    dim keysInFile as long
   
    dim i as integer, j as integer
    dim indxa as integer, indxb as integer
   
   
    open filename for input as #1    
   
    ''
    '' Clear table and load keys
    ''
    for  i = 0 to KEYMAX \ 16384&
        for  j = 0 to 16383
            keyTable( i, j ) = 0
        next j
    next i    

    while ( not eof( 1 ) )
        input #1, currKey
       
        if ( (currKey < KEYMIN) or (currKey > KEYMAX) ) then
            print "Error: Invalid key in file..."
            end
        end if
       
        ''
        '' Put key in table
        ''        
        indxa = currKey  \  16384&
        indxb = currKey and 16383&
        keyTable( indxa, indxb ) = VALIDKEY
    wend
       
    close #1
end sub



And Antonis
Code:

DECLARE FUNCTION funFirstPrime% (threshold%)
DEFINT A-Z
CONST empty = -1&
CONST QBOFFSET = 16636
'-----------------------------setup------------------------------------
filename$ = "valid.txt"
OPEN filename$ FOR INPUT AS #1
codecnt = 0
WHILE NOT EOF(1)
codecnt = codecnt + 1
INPUT #1, CODE$
WEND

TABLESIZE = funFirstPrime(codecnt)

REDIM SHARED CODES(-QBOFFSET TO TABLESIZE - QBOFFSET) AS LONG
FOR I = LBOUND(CODES) TO UBOUND(CODES)
   CODES(I) = empty
NEXT

SEEK 1, 1

WHILE NOT EOF(1)
INPUT #1, CODE&
KEYINDEX = (CODE& MOD TABLESIZE)
WHILE CODES(KEYINDEX - QBOFFSET) <> empty
   IF CODES(KEYINDEX - QBOFFSET) = CODE& THEN PRINT "Repeated code in input": END
   IF KEYINDEX = TABLESIZE THEN
      KEYINDEX = 0
   ELSE
      KEYINDEX = KEYINDEX + 1
   END IF
WEND
CODES(KEYINDEX - QBOFFSET) = CODE&
WEND
CLOSE

'--------------------------main loop-------------------------------------
    dim result as integer  
    dim tmrIni as single, tmrEnd as single

    CODE& = 13
       
    tmrIni = timer
    for  i = 0 to 31999
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&
       
        KEYINDEX = (CODE& MOD TABLESIZE)
       
        WHILE CODES(KEYINDEX - QBOFFSET) <> CODE& AND CODES(KEYINDEX - QBOFFSET) <> empty
          IF KEYINDEX = TABLESIZE THEN
             KEYINDEX = 0
          ELSE
             KEYINDEX = KEYINDEX + 1
          END IF
        WEND
        result = CODES(KEYINDEX - QBOFFSET) = CODE&

    next i
    tmrEnd = timer
   
    print "Antonis code does" + str$(clng( 32000#*10# / (tmrEnd-tmrIni) )) + " searches per second"



END

FUNCTION funFirstPrime (threshold)

tp30 = INT((threshold * 1.3))
IF tp30 / 2 = tp30 \ 2 THEN
   tp30 = tp30 + 1
END IF
c = tp30 - 2
IF c < 1 THEN
   c = 1
END IF
t2& = threshold * 2&
DO
   c = c + 2
   FOR z = 3 TO SQR(c)
      ind = -1
      IF c / z = c \ z THEN
         ind = FALSE
         EXIT FOR
      END IF
   NEXT z
   IF ind THEN
      IF (c - 3) / 4 = INT((c - 3) / 4) OR c > t2& THEN
         funFirstPrime = c
         EXIT DO
      END IF
   END IF
LOOP
END FUNCTION



After running each 8 times during the exact same conditions my best was 6301538 and Antonis was 2925714.
Logged

oship me and i will give you lots of guurrls and beeea
Antoni Gual
Na_th_an
*****
Posts: 1434



WWW
« Reply #26 on: July 28, 2003, 10:26:00 AM »

Quote from: "Moneo"

Come on, the hard part is stuffing the codes into as little memory as possible. That's the whole idea of the challenge!


Oh, well, so you were asking for this!:

Code:

'user password validation using a bit array
'Antoni Gual 2003
'-----------------------------setup------------------------------------
DEFINT A-Z
DIM pwrsof2(15)
FOR i = 0 TO 14: pwrsof2(i) = 2 ^ i: NEXT: pwrsof2(15) = &H8000
filename$ = "valid.txt"
OPEN filename$ FOR INPUT AS #1
DIM codes(16636)

WHILE NOT EOF(1)
 LINE INPUT #1, A$
 code& = VAL(A$)
 byte = code& \ 16
 bit = code& MOD 16
 codes(byte) = codes(byte) OR pwrsof2(bit)
WEND
CLOSE

DO
 DO
INPUT "enter your code"; usr$
IF usr$ = "" THEN END
code& = VAL(usr$)
IF code& > 0 AND code& < 99999 THEN EXIT DO
PRINT "code must be in range 0 to 99999"
LOOP
byte = code& \ 16
bit = code& MOD 16
IF codes(byte) AND pwrsof2(bit) THEN
PRINT "Accepted"
ELSE
PRINT "Rejected"
END IF
LOOP
END




Blitz:
I agree Your code was faster. Maybe as fast than this new one Cheesy
Logged

Antoni
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #27 on: July 28, 2003, 01:01:30 PM »

Yeah, that one is much much faster. Although it's basically the same as my code except you used a bit array to be able to use a static array. If you put dynamic before it runs the same speed as mine. But yeah, it's faster then mine now. cheeeataarr! Tongue
Logged

oship me and i will give you lots of guurrls and beeea
Moneo
Na_th_an
*****
Posts: 1971


« Reply #28 on: July 28, 2003, 01:21:21 PM »

Quote from: "Agamemnus"
Preprocessing is cheating!

Question!!!!!! QUESTION!!!!!!! The user inputs 20,000 numbers and tests if any of them exist out of the other 20,000 numbers in the file?!?!?!?!

Wouldn't it be better just to use TWO files, then???!!!!


AGA,
In the range of 0 to 99999 there are 100,000 possible codes, of which there are 20,000 identified as valid in the VALID.TXT file. The idea is to read the valid codes and store them in memory somehow for later validation for each of the user input codes.

Yes, that's pre-processing, but it saves you from having to scan the entire VALID.TXT file everytime the user gives you a code.
*****
Logged
Blitz
I hold this place together
*****
Posts: 853



WWW
« Reply #29 on: July 28, 2003, 01:25:41 PM »

Alright, since we're playing it like that. Eat this Antoni, 36 million compared to your 24 Smiley

Code:

''
'' If i had to chose i'd use a number in the range
'' 0 to 32767 for effciency. If the number was
'' bigger then that i wouldn't use qb.
'' Use the /ah option or you won't be able to compile
'' or run.
''
''
defint a-z

const KEYMIN&   = 0&
const KEYMAX&   = 99999&

declare sub loadKeyTable   ( filename as string )
declare function checkKey% ( keyToCheck as long )

dim shared PowerOf2( 15 ) as integer
dim shared keyTable( (KEYMAX+1) \ 16 ) as integer


    ''
    '' Entry point
    ''
    dim indx as integer
    dim result as integer  
    dim keyToCheck as long
    dim tmrIni as single, tmrEnd as single
   
   
    ''
    '' This is not part of the main program
    '' it's just setup.
    ''
    loadKeyTable "valid.txt"    
    keyToCheck = 13
   
    tmrIni = timer
    for  j = 0 to 99
        for  i = 0 to 31999        
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
            result = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
        next i
    next j
    tmrEnd = timer
   
   
    print "Blitz code does" + str$(clng( 32000#*10#*100# / (tmrEnd-tmrIni) )) + " searches per second"


'' :::::::::
'' name: checkKey
'' desc: Checks if a key is valid
''
'' :::::::::
defint a-z
function checkKey% ( keyToCheck as long ) static

    checkKey% = keyTable( keyToCheck \ 16& ) and PowerOf2( keyToCheck and 15& )
   
end function



'' :::::::::
'' name: loadKeyTable
'' desc: Loads a bunch of valid keys
'' note: This is to be run BEFORE starting to time
''
'' :::::::::
defint a-z
sub loadKeyTable ( filename as string ) static
    dim currKey as long
    dim keysRead as long
    dim keysInFile as long
   
    dim i as integer, j as integer
    dim indxa as integer, indxb as integer
   
    for  i = 0 to 14
        PowerOf2( i ) = 2^i
    next i
    PowerOf2( i ) = &h8000    
   
    open filename for input as #1    
   
    ''
    '' Clear table and load keys
    ''
    for  i = 0 to KEYMAX \ 16&
        keyTable( i ) = 0
    next i    

    while ( not eof( 1 ) )
        input #1, currKey
       
        if ( (currKey < KEYMIN) or (currKey > KEYMAX) ) then
            print "Error: Invalid key in file..."
            end
        end if
       
        ''
        '' Put key in table
        ''        
        keyTable( currKey \ 16& ) = keyTable( currKey \ 16& ) or PowerOf2( currKey and 15& )
    wend
       
    close #1
end sub
Logged

oship me and i will give you lots of guurrls and beeea
Pages: 1 [2] 3 4 5
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!