Vampire numbers 1

[brisray]

This is a bit long, but I'd appreciate the help.

I've been messing about with number series, and now I've managed to confuse myself.

Vampire numbers are those numbers that have an even number of digits. The digits can be mixed and split so that each pair of numbers when multiplied together give the vampire number. For example, 1,435 is a vampire number as you can get 35 * 41 from it, so is 2,187 (27 * 81)

I've managed to write a program to work out the vampire numbers for 4 digit numbers, now I'm working on the 6 digit ones. These are going to have 2, 3 digit numbers as the "fangs". Which give this number series its name.

I've got the numbers into a string then split the string into individual digits and put these into an array using

VampLen = LEN(LTRIM$(VampStr$))
FOR Count = 1 TO VampLen
VampAry$(Count) = MID$(VampStr$, Count, 1)
NEXT Count

I used a bunch of SWAP statements to change the order of the array when creating and testing the 2 digit numbers for the 4 figure vampire numbers.

ReCurs = ReCurs + 1

SELECT CASE ReCurs

CASE 1
SWAP VampAry$(1), VampAry$(2)
CASE 2
SWAP VampAry$(1), VampAry$(2)
SWAP VampAry$(3), VampAry$(4)
CASE 3
SWAP VampAry$(1), VampAry$(2)
CASE 4
SWAP VampAry$(1), VampAry$(2)
SWAP VampAry$(2), VampAry$(3)
CASE 5
SWAP VampAry$(3), VampAry$(4)
CASE 6
SWAP VampAry$(1), VampAry$(2)
CASE 7
SWAP VampAry$(3), VampAry$(4)
CASE 8
SWAP VampAry$(1), VampAry$(2)
SWAP VampAry$(2), VampAry$(4)
CASE 9
SWAP VampAry$(3), VampAry$(4)
CASE 10
SWAP VampAry$(1), VampAry$(2)
CASE 11
SWAP VampAry$(3), VampAry$(4)
END SELECT

If I try to do this creating the 2, 3 digit numbers for 6 digit vampire numbers I'm going to end up writing at least 350 swap statements. Can anyone suggest a quicker way of creating all the possible position variations for these numbers? I know I'm going to have to do at least 405,450 calculataions for these numbers, and over 40 million if I extend the program to 8 digit numbers, so any help will be greatly appreciated.

If I've managed to confuse anyone besides myself, think of this. I want all possible positional combinations of the string ABCDEF, such as ACBDEF, ACDBEF etc. etc. For my purposes ABC DEF is the same as DEF ABC but I can take care of the duplications myself.

If you'd like to know more about vampire numbers then see

http://www.grenvillecc.ca/faculty/jchilds/vampire.htm

and

http://www.madras.fife.sch.uk/maths/amazingnofacts/fact020.html

Ray

 

[Tranman]

Ray,
You're sick! SICK, I tell you!

I never heard of vampire numbers, but this is the kind of thing that can keep you up late and make your wife think you're nuts.

Let me tell you a story. Back in the late 80's I was a mainframe COBOL programmer at a bank. Every day all of us programmers got to work about 20 minutes early and, being programmers, we played. One of the things we did was to race to work out the "Jumble" game on the cartoon page of the newspaper. Well, I was pretty good at Jumble, but I figured, "What the heck, I'll cheat!".

What I did was to write a program that accepted console input of up to eight characters, and returned *every* possible combination of the characters (sounds familiar, doesn't it?). Then, I fed the combinations to a spell checker and it told me the word in question. All of this happened in about 4 seconds, and I was really smoking the competition, until they figured out that I was not really *that* smart.

The upshoot of all of this is that I still have the COBOL source to that program. The whole thing amounts to about 150 lines of code, and could be done in considerably less with QB/VB. I don't really have time to translate the thing, but if you know Cobol, or know someone that does, it would be pretty simple to convert.

Even if you don't know Cobol, you could probably figure this out, because it is not really complicated--like most good computer code, it is elegant because of its simplicity.

One good thing about it is that it already handles strings of 6 and 8 characters, and you could take it up to 10 digits with only 18 lines of code.

Let me know if you want that code. Either way, good luck with your play.

Paul (Tranman)

 

[brisray]

lol, both myself and wife ROFLAO at your opening words. She teaches college level maths and I've been bugging her for a month about number series. "THE PROJECT" started out because someone asked one of those "homework" questions in another forum about programming the Fibonacci series. Knowing I could do that, I wrote a program for my own amusement to do it, then I found a whole bunch of other number series. Now the program can calculate (within limits), Factorials, Fibonacci, Mersenne Primes, Perfect, Primes, Square, Triangular and Vampire numbers. I'm now working on the Catalan, Epsilon, Harmonic and Pascal series.

The program is getting a bit out of hand as it can not only calculate the series but can also calculate if a user supplied number is part of any of the series. It's on my site at

http://members.lycos.co.uk/brisray/qbasic/qnumber.htm

if you'd care to take a look at it.

I'd like to look at your COBOL code. It sounds like you're a bit like me as I've also kept code that was written a little while ago. Don't think I can beat 19 years though! Oh, the fun I've had translating COBOL into VB, but it's always nice to see how other programmers tackle a problem.

Ray

 

[Tranman]

Ray,
I am a little bit anal about code that I've written. Unfortunately I am not quite so anal about hardware. I found that source, but it is on a 5.25 floppy (don't have one of those anymore), so I'll have to take it to work and get this engineer who is anal about hardware to take it home and copy it. I should have it in a couple of days.

If the disk doesn't work anymore, I have a printed copy so I'll scan and OCR it. Either way, you should have it in a few days.

If the yahoo address on your web site is still ok, I'll send that source there as an attachment.

I enjoyed your site. I'm a Vietnam vet, and I always feel more comfortable dealing with people that have pictures of themselves holding machine guns.

I'll be in touch soon,
Paul

 

[hardkor1001110]

this piqued my interest enough to check out the link. it looked to me like a vampire number is a number where the product of the two numbers has the same distribution of digits contained in the two multipliers. heres a quick hack that gave me a small list of vampire numbers when I set the inital values of a and b to 21 and 87. it would probably run quite a while to get all of them for 6 digit numbers.


CLS
DIM c AS LONG
DIM n1(9) AS INTEGER
DIM n2(9) AS INTEGER
Dim A as Long, B as Long

FOR A = 1 TO 999

B = 0
10

FOR B = B + 1 TO 999
ERASE n1

f$ = STR$(A) + LTRIM$(STR$(B))'put the two digits in the string to build a digit distribution table

FOR i = 1 TO 6 'create a distribution list of the digits(how many 1s, 2s, etc,

c = VAL(MID$(f$, i, 1))'digits that don't exist will have a value of 0 in the n1 array,

n1(c) = n1(c) + 1 'which will trigger the breakout of the loop later
NEXT


f$ = STR$(a * b)
ERASE n2

FOR i = 1 TO 6
c = VAL(MID$(f$, i, 1))'create a distribution list of the product
n2(c) = n2(c) + 1
NEXT

FOR i = 0 TO 9 'compare the product distribution with the original digits
IF n1(i) <> n2(i) THEN GOTO 10 'the product has a digit that is not in the other two, or more than a certain digit
NEXT i

PRINT &quot;Vampire number:&quot; + STR$(a) + &quot; * &quot; + STR$(b) + &quot; = &quot; + STR$(a * b)'if flow is here there is a vampire number

NEXT
NEXT

 

[hardkor1001110]

actually since you want 6 digit products each of the two multipliers will be 3 digit numbers so you can just change the

FOR a = 1 to 999
to
FOR a = 100 to 999

and b = 0
to
b = 99.

It didn't cause an error before because I think MID$ will let you go above the length of the string for the index, but will not let you read MID$(f$,0,1).

Hope that helps... have fun

 

[dharmon]

I was also curiouse, so I coded it myself. Although not with
basic, but with Pascal. And do you realize that the four
digit level is really fun. After about 20 minutes that is

I made strings out of all three numbers
a , b , a*b
Using a for loop for StringA, I took each character and if
I found that character in StringAB then remove that character from StringAB. Do the same for StringB. When I'm
all done and the length of StringAB is zero ,then it's a vampire number.

for i = 10 to 99
for j = i to 99
rem no duplication
2 digits : 7 vampire numbers
3 digits : 156 vampire numbers
4 digits : 3399 vampire numbers dl_harmon@yahoo.com

http://danielh7.tripod.com

 

[dharmon]

I ran it for five digit base numbers and after ten minutes of number calculations. It finally gave me one.
10130 * 99701 = 1009971130
I didn't want to wait for any more. dl_harmon@yahoo.com

http://danielh7.tripod.com

 

[brisray]

It's an interesting problem isn't it? Which is why I'm spending more time than I should messing around with this.

That's a good idea about the distribution list, I hadn't thought about that at all, or at least the solution I came up with was different.

What I did was to turn append the two multipliers to a string and make the product of them another string, then use INSTR to check each digit in the multipliers against each digit in the product. Once the digit was found I turned it into a non-number digit so it couldn'r be found again.

DivStr$ = LTRIM$(STR$(Div1)) + LTRIM$(STR$(Div2))

'*** Test to see if the Div numbers are part of VampTest ***

FOR Count = 1 TO LEN(DivStr$)

DivChar$ = MID$(DivStr$, Count, 1)
DivFnd = INSTR(VampStr$, DivChar$)
IF DivFnd > 0 THEN
MID$(VampStr$, DivFnd, 1) = &quot;X&quot;
ELSE
VampFnd = 1
END IF
NEXT Count

I've reached the point where I can produce a good list (around 20,000) of Vampire numbers, but have now hit QBasics environment limits for dealing with numbers. The next step is to use either multiple arrays for each number, so I can work on the digits individually or start processing numbers as strings or I can, if I really felt like it, use another programming language without some of the limits of QBasic. Any of these is going to take the program into the &quot;Big Boys&quot; league of number crunching.

I'm going to spend a bit more time looking at this, then I think I want to try my hand at progamming very large numbers as strings.

Ray

 

[Guest_imported]

.
Brisray,

This was certainly an interesting exercise. Glad I visited.

I am posting this info in the event others would like the sequences to check against if they decide to write their own program.

A four digit program is fairly rudimentary but a six digit program, while simple, requires a verification process that bogs it down. Just to produce the 10 numbers shown took about 45 seconds.

There are 7 four Digit Vampire Numbers. There are 148 six Digit numbers and 3228 eight Digit numbers.

The 7 four Digit numbers are 1260, 1395, 1435, 1530, 1827, 2187, 6880

The first few 6 Digit numbers are 102510, 104260, 105210, 105264, 105750, 108135, 110758, 115672, 116725, 117067, etc.

If anyone's interested, I shall post the six digit program. It's painfully slow and I want to try to speed it up before doing that.

I know I'll never attempt an 8 Digit program.

Dr. Jon

 

[dharmon]

I was searching the web and found a site about vampire numbers and I realized I made an error. Someof my results were repeated. Also the site said that this is not a vampire number because it is cheating : 126000 = 210 * 600. It is a repeat of 21*60=1260 with a couple of zeros. I don't know, but Dr Jon has the actual results.
dl_harmon@yahoo.com

http://danielh7.tripod.com

 

[brisray]

Glad to see the original post seems to have sparked some interest.

Dr. Jon is right, the checking that needs to be done on these numbers is horrendous. I've managed to work on about eight different number series now, with a couple more to go and have found that the Vampire numbers are amongst the slowest to be produced. All this because someone asked a homework question about programming the Fibonacci numbers about a month ago, I should have quit while I was ahead.

To tell the truth, I'm not even sure that with some of the other series my results are all that accurate. Try this little bit of code and you'll see what I mean.

DIM Num AS DOUBLE
DIM Root AS DOUBLE
DIM Count AS INTEGER

CLS
PRINT
INPUT &quot;Please input the number you want the roots of&quot;; Num
PRINT

PRINT &quot; n&quot;, &quot; nth root&quot;, , &quot; nth root ^ n&quot;
PRINT

FOR Count = 1 TO 10
Root = Num ^ (1 / Count)
PRINT Count, Root, Root ^ Count
NEXT Count
END

Programming these series is an interesting problem though, but I still haven't had a good reply to the original post, perhaps the answer is another number series?

As I said I've a few more number series I want to work on, then I'm going to calculate a billion places of PI, what's the formula again? 22/7?

Ray

 

[Guest_imported]

As mentioned, this is painfully slow. To process all of the numbers constitutes about an hour on my very slow computer (466MHz). I use PDS 7 as my language, which means it may be much slower for those of you using QBASIC. After you see the first few numbers, that should be just about enough for anyone, anyway.

This program relies almost exclusively on String$ manipulation. The only use of Arrays or SWAP's in the program occurs when a comparison is made between a result and a main number. 3 digits times 3 digits may produce a correct result but if all the numbers do not match the original number then that is the incorrect answer. That is the trick to this. All numbers must be used once. And only once.

Is it perfect? Probably not. After writing the program, I called up a site that mentioned the 7 numbers used in the 4 Digit sequence. I compared them to mine and realized that this was actually working. This version is only for 6 Digit sequences.

All in all, this was a total waste of time but I enjoyed it immensely.

Dr. Jon



' 6 Digit Vampire Numbers

DEFINT G-Z: DEFSTR A-F
CLEAR : CLS : SCREEN 12: COLOR 4
PRINT &quot;Vampire Numbers&quot;: PRINT STRING$(80, 196)
VIEW PRINT 4 TO 25
FOR g = 0 TO 640
FOR h = 23 TO 24 + (RND * 4 * RND * 8): PSET (g, h), 4
NEXT: NEXT
COLOR 7

' 102510 is the first possible hit. 939658 is the last possible hit.
' To see more activity, start with 125000.
FOR g! = 102510! TO 939658!
a = MID$(STR$(g!), 2)

' REM out the following line. It's for initial display only
' and adds to the processing time.
LOCATE 25, 1: PRINT g!;

' These lines create every 3 digit combo from the 6 digit number.
' As you can imagine, this is what slows up the processing.
' I welcome any improvement to this routine.
q$ = &quot;&quot;

FOR l = 1 TO 6: FOR m = 1 TO 6: FOR n = 1 TO 6
IF l <> m AND l <> n AND m <> n THEN r$ = MID$(a, l, 1) + MID$(a, m, 1) + MID$(a, n, 1)
r$ = STRING$(3 - LEN(r$), 48) + r$
IF LEFT$(r$, 1) <> &quot;0&quot; AND INSTR(q$, r$) = 0 THEN q$ = q$ + r$ + &quot;:&quot;
NEXT: NEXT: NEXT

' un-REM the following line to see the combos
' PRINT q$

' The following lines look at all combos, starting with the first number.
' It divides that number into the main number and searches for a number
' that will create the result. If there is no result, it uses &quot;***&quot; to
' delete the number; and continues looking at other numbers in the list.
FOR k = 1 TO LEN(q$) STEP 4
x1$ = MID$(q$, k, 3): x1! = VAL(x1$)
IF x1! < 100 THEN GOTO nextk
MID$(q$, k, 3) = &quot;***&quot; 'erase the number
x2! = INT(g! / x1!) 'divide number into the main number
IF x2! = x1! OR x2! < 100 OR x2! > 999 THEN GOTO nextk
IF (x2! * x1!) <> g! THEN GOTO nextk
x2$ = MID$(STR$(x2!), 2): x2$ = STRING$(3 - LEN(x2$), 48) + x2$
x22! = INSTR(q$, x2$): x$ = x1$ + x2$

' At this point the program &quot;may&quot; have a match and needs to
' check the 6 digit answer against the main number.
' The verify sequence has the only use of arrays or swaps.
' Essentially, it sorts all numbers and does a quick comparison.
FOR o = 1 TO 6: a(o) = MID$(a, o, 1): x$(o) = MID$(x$, o, 1): NEXT
FOR m = 1 TO 5: FOR n = m TO 6
IF a(m) >= a THEN SWAP a(m), a
IF x$(m) >= x$ THEN SWAP x$(m), x$
NEXT: NEXT

a1 = &quot;&quot;: x1$ = &quot;&quot;
FOR o = 1 TO 6: a1 = a1 + a(o): x1$ = x1$ + x$(o): NEXT

IF a1 <> x1$ THEN GOTO nextk

' This line shows how many hits. It also shows the numbers used
' and the result. Lastly, you are shown the main number for
' verification purposes.
IF x22! <> 0 THEN q! = q! + 1: LOCATE 25, 1: PRINT USING &quot; #### ### * ### = ###,### / ###,###&quot;; q!; x1!; x2!; g!; (x1! * x2!): GOTO nextg

nextk:
NEXT
nextg:
a = INKEY$: IF a <> &quot;&quot; THEN END ' An exit but it slows down processing.
NEXT

 

[qbasicking]

Don't compare Fibonacci numbers to vampire numbers. Fibonacci can be done in less than 10 lines, Vampires are much harder (I tried this once, but failed). I applaud for your venture in these complex number games.

You gotta have a fast computer, or alot of spare time to do a billion places of PI or e. Here's something I've never seen done, see if you can make some sort of graphing program with i

 

[brisray]

I know, but it was because of a question about the Fibonacci numbers that I ended up thinking about other number series. Once you know what the numbers are you're supposed to be producing none of them are particularly hard to produce, it's the size of the numbers and the amount of calculation that's involved that more or less kills off these programs. I've never let the program I've written run it's full course, it's just too tedious to bear.

I keep a list of things I'd like to code and half finished programs I'd like to finish when I get the time and inclination, among them is an equation solver / grapher.

Here's something I started a little while ago

SCREEN 12
StepX = 10
StepY = 10

DO
EndProg = 0

FOR Count = 1 TO 50 STEP .05
Y = SIN(Count)
PSET ((Count * StepX), (Y * StepY) + 200), 2
NEXT Count

DO
UserIn$ = INKEY$
IF UserIn$ = CHR$(0) + CHR$(72) THEN EndProg = 1
IF UserIn$ = CHR$(0) + CHR$(80) THEN EndProg = 1
IF UserIn$ = CHR$(0) + CHR$(75) THEN EndProg = 1
IF UserIn$ = CHR$(0) + CHR$(77) THEN EndProg = 1

IF UserIn$ = CHR$(27) THEN EndProg = 1

LOOP UNTIL EndProg = 1

FOR Count = 1 TO 50 STEP .05
Y = SIN(Count)
PSET ((Count * StepX), (Y * StepY) + 200), 0
NEXT Count

IF UserIn$ = CHR$(0) + CHR$(72) THEN StepY = StepY - .5
IF UserIn$ = CHR$(0) + CHR$(80) THEN StepY = StepY + .5
IF UserIn$ = CHR$(0) + CHR$(75) THEN StepX = StepX - .5
IF UserIn$ = CHR$(0) + CHR$(77) THEN StepX = StepX + .5

LOOP UNTIL UserIn$ = CHR$(27)
END

Run it and see what happens when you press any of the arrow keys, try what happens when you change Y = SIN(Count) for Y = COS(Count) or Y = TAN(Count)

Lots of ideas, so little time ....

Ray

 

[logiclrd]

Beware the occasional line of code split across multiple lines of the post.
[tt]
DECLARE SUB hashResult (vampire&, fang1&, fang2&)
DECLARE FUNCTION hashFunction% (x&)
DECLARE SUB recurse (vampire&, fang1&, radix%, text%(), selected%(), numSelected%)
DECLARE SUB innerRecurse (vampire&, fang1&, fang2&, radix%, text%(), selected%(), numSelected%)

TYPE linkedVampireList
nextNodeIdx AS INTEGER
vampire AS LONG
fang1 AS LONG
fang2 AS LONG
END TYPE
DIM SHARED listNode(1 TO 500) AS linkedVampireList, lastNodeIdx%
DIM SHARED hashTable(100) AS INTEGER
DIM SHARED vampire(500) AS LONG, lastVampireIdx%

DIM text%(10), selected%(10)
st# = TIMER
firstVampire& = 100000 'must be even digits long and a power of 10
lastVampire& = firstVampire&
FOR thisVampire& = firstVampire& TO firstVampire& * 10 - 1
divider& = 1
radix% = 0
DO
radix% = radix% + 1
text%(radix%) = (thisVampire& \ divider&) MOD 10
divider& = divider& * 10&
LOOP WHILE thisVampire& > divider&
recurse thisVampire&, 0, radix%, text%(), selected%(), 0
IF (thisVampire& AND 255) = 0 THEN 'reduce floating point calcs
et# = TIMER
IF (et# > st# + 1) OR (et# < st#) THEN
IF et# < st# THEN st# = st# - 86400#
PRINT &quot;Tested&quot;; thisVampire& - firstVampire&; &quot;possible vampires (&quot;; INT((thisVampire& - lastVampire& + 1) / (et# - st#)); &quot;vampires/sec)&quot;
st# = et#
lastVampire& = thisVampire&
END IF
END IF
NEXT thisVampire&

FOR thisVampireIdx% = 1 TO lastVampireIdx%
thisVampire& = vampire(thisVampireIdx%)
hashIndex% = hashFunction%(thisVampire&)
listHead% = hashTable(hashIndex%)
IF listHead% THEN
trace% = listHead%
PRINT thisVampire&; &quot;:&quot;;
x& = POS(0) - 1
DO
PRINT listNode(trace%).fang1; &quot;x&quot;; listNode(trace%).fang2
trace% = listNode(trace%).nextNodeIdx
IF trace% = 0 THEN EXIT DO
PRINT SPACE$(x&);
LOOP
ELSE
PRINT &quot;Warning: somehow a dead vampire got into the list: &quot;; thisVampire&
END IF
NEXT thisVampireIdx%

FUNCTION hashFunction% (x&)
hashFunction% = (x& * 351 + 267) MOD 101
END FUNCTION

SUB hashResult (vampire&, fang1&, fang2&)
IF vampire(lastVampireIdx%) <> vampire& THEN
lastVampireIdx% = lastVampireIdx% + 1
vampire(lastVampireIdx%) = vampire&
END IF

hashValue% = hashFunction%(vampire&)
listHead% = hashTable(hashValue%)
IF listHead% THEN
trace% = listHead%
DO
IF listNode(trace%).vampire = vampire& THEN
fangTest& = listNode(trace%).fang1
IF (fangTest& = fang1&) OR (fangTest& = fang2&) THEN EXIT SUB 'already have this result
END IF
prevTrace% = trace%
trace% = listNode(trace%).nextNodeIdx
LOOP WHILE trace%
lastNodeIdx% = lastNodeIdx% + 1
listNode(prevTrace%).nextNodeIdx = lastNodeIdx%
ELSE
lastNodeIdx% = lastNodeIdx% + 1
hashTable(hashValue%) = lastNodeIdx%
END IF
listNode(lastNodeIdx%).vampire = vampire&
listNode(lastNodeIdx%).fang1 = fang1&
listNode(lastNodeIdx%).fang2 = fang2&
END SUB

SUB innerRecurse (vampire&, fang1&, fang2&, radix%, text%(), selected%(), numSelected%)
IF numSelected% < radix% THEN
fang2& = fang2& * 10
FOR i% = 1 TO radix%
IF selected%(i%) = 0 THEN
selected%(i%) = -1
innerRecurse vampire&, fang1&, fang2& + text%(i%), radix%, text%(), selected%(), numSelected% + 1
selected%(i%) = 0
END IF
NEXT i%
ELSE
IF fang2& < fang1& THEN EXIT SUB 'avoid duplicates
IF fang1& * fang2& = vampire& THEN hashResult vampire&, fang1&, fang2&
END IF
END SUB

SUB recurse (vampire&, fang1&, radix%, text%(), selected%(), numSelected%)
IF numSelected% + numSelected% < radix% THEN
fang1& = fang1& * 10
FOR i% = 1 TO radix%
IF selected%(i%) = 0 THEN
selected%(i%) = -1
recurse vampire&, fang1& + text%(i%), radix%, text%(), selected%(), numSelected% + 1
selected%(i%) = 0
END IF
NEXT i%
ELSE
innerRecurse vampire&, fang1&, 0, radix%, text%(), selected%(), numSelected%
END IF
END SUB
[/tt]

 

[codeworm]

Just dropped by to say &quot;HI&quot;

 

[codeworm]

CLS : 'Computes the 156 6-digit vampire numbers
FOR t1 = 100 TO 999
FOR t2 = t1 TO 999
FOR i = 0 TO 9: k%(i) = 0: NEXT i
t = t1 * t2
IF t > 99999 THEN
cntTOT = cntTOT + 1
s$ = RIGHT$(STR$(t1), 3) + RIGHT$(STR$(t2), 3)
FOR i = 1 TO 6
v = VAL(MID$(s$, i, 1)): k%(v) = k%(v) + 1
NEXT i
s$ = LTRIM$(STR$(t))
FOR i = 1 TO 6
v = VAL(MID$(s$, i, 1)): k%(v) = k%(v) - 1
NEXT i
v = 0
FOR i = 0 TO 9
IF k%(i) <> 0 THEN v = 1
NEXT i
IF v = 0 THEN PRINT t1, t2, t: cntVMP = cntVMP + 1
END IF
NEXT t2
NEXT t1
PRINT cntVMP, cntTOT
SYSTEM

 

[brisray]

Thanks for the code everybody. My PC was tied up for quite a while running these programs.

Ray

 

[logiclrd]

[tt]
DIM pow6&(10)
'Computes the 156 6-digit vampire numbers faster
pow6&(0) = 1
FOR i% = 1 TO 9
pow6&(i%) = 6& * pow6&(i% - 1)
NEXT i%
FOR fang1& = 100 TO 999
FOR fang2& = fang1& TO 999
vampire& = fang1& * fang2&
IF vampire& > 99999 THEN
cntTOT& = cntTOT& + 1&
fangs& = fang1& + 1000& * fang2&
k& = 0&
FOR i% = 1 TO 6
k& = k& + pow6&(fangs& MOD 10&) - pow6&(vampire& MOD 10&)
fangs& = fangs& \ 10&
vampire& = vampire& \ 10&
NEXT i%
IF k& = 0 THEN
PRINT fang1&; &quot;x&quot;; fang2&; &quot;=&quot;; fang1& * fang2&
cntVMP& = cntVMP& + 1&
END IF
END IF
NEXT fang2&
NEXT fang1&
PRINT cntVMP&; &quot;out of&quot;; cntTOT&; &quot;were vampires&quot;
[/tt]