HomePage | Optical Illusions | War Stories | QBasic | Dads Navy Days | Bristol | Bristol, USA | Bristol, Canada | Terre Haute | Miscellany | Web Stuff | About Ray | Site Map | Site Search | Messages | Credits | Links | Web Rings

QBasic | Errors | 40lb Weight | Bits | Chance | Colours | Dates | Delays | File Dialog | Files | Input | Matching | Menus | Mouse | Numbers | SeqNo | SIRDS | Sorts | Text | Timer | DLoads

My wife likes mathematics. She's got a MS in it, she teaches it at degree level and one of her pastimes is solving mathematical puzzles. This page is dedicated to her. Having said that, any mistakes in the programs on this page are all my fault.

"**Well, if I called the wrong number, why did you answer?**" James Thurber, New
Yorker, June 5th 1937.

**PI :-**

Oddly enough there isn't a built in constant for PI, but it's easily calculated yourself. You can define a number variable as a SINGLE or LONG and use ATN(1) * 4

For example using

DIM PI AS SINGLE

PI = ATN(1) * 4

will give PI as 3.141593, using

DIM PI AS DOUBLE

PI = ATN(1) * 4

will give PI as 3.141592653589793

**nth Roots :-**

QBasic hasn't a built in function for finding the nth root of a number, but it isn't too hard to find the nth root of any number yourself. This is due to the fact that the nth root of a number is the number raised to the (1/n) power

'nRoot.bas Ray Thomas April 2002 'The nth root of a number is the number raised to the (1/n) power: DIM Num AS DOUBLE DIM Root AS DOUBLE DIM Count AS INTEGER CLS PRINT INPUT "Please input the number you want the roots of"; Num PRINT PRINT " n", " nth root", , " nth root ^ n" PRINT FOR Count = 1 TO 10 Root = Num ^ (1 / Count) PRINT Count, Root, Root ^ Count NEXT Count END

The program also demonstrates how errors creep into calculations, even when the numbers used are DIM'd as DOUBLES.

**Number Bases :-**

This program is able to convert from any number to any other number base. It has a flaw in it. Although the program can convert to any base number, I'm not sure what happens after Base 37, this is because after the decimal system in order to add the extra figures needed to the number series, A = 10, B = 11, C = 12 etc. I've no idea what happens after Z is reached, so I've left the program adding the characters from the ASCII table.

Q: Why do mathematicians often confuse Halloween and Christmas?

A: Because Oct 31 = Dec 25

To convert a decimal number to another base it's best to make a list of the powers of that base :-

... X^{10}
,
X^{9},
X^{8},
X^{7},
X^{6},
X^{5},
X^{4},
X^{3},
X^{2},
X^{1},
X^{0}

Any number to the power of 0 is 1, any number to the power of 1 is that number. For Base 3 the powers are :-

... 19683, 6561, 2187, 729, 243, 81, 27, 9, 3, 1

Say you want to see what 169 is to base 3, the largest number that can go into 169 is 81 which goes into it twice, remainder 7. 27 and 9 can't go into 7 so these positions become 0's. The next power that can go into 7 is 3, which goes into it twice, remainder 1. This means that 169 as Base 3 is 20021. What is happening is that we are doing a long division.

To change a number in a Base back to decimal we once again write the powers of that base and write the number beneath it. We then can then count off the number as a decimal.

Screenshot of Numbase.bas

'NumBase Ray Thomas March 2002 OPTION BASE 1 '*** Calculation variables *** DIM Bases(5) AS INTEGER 'Array to hold the base numbers DIM NumArray(5) AS STRING 'Array to hold converted numbers DIM UserNum AS DOUBLE 'User supplied number as decimal DIM TempNum AS DOUBLE 'Temporary number variable DIM BaseNum AS INTEGER 'Base to do the conversion to DIM ModNum AS INTEGER 'Remainder from the calculations DIM StrNum AS STRING 'Used to hold a number as a string DIM Count AS INTEGER 'Loop counter DIM OutNum AS DOUBLE 'Output from to Decimal routine DIM Counter AS INTEGER 'Loop Counter DIM PosnNum AS STRING 'Character at a position inside a string DIM ConvNum AS INTEGER 'Numeric of PosNum '*** Menu variables *** DIM MenuItem(6) AS STRING * 25 'Define the menu item array DIM ChooseItem AS INTEGER 'Currently chosen menu item DIM XMenuposn AS INTEGER 'Controls the menu item X positions DIM YMenuPosn AS INTEGER 'Controls the menu item Y positions DIM EndMenu AS INTEGER 'F, Enter or Alt keys pressed DATA 10,2,8,16 DATA F1 - Decimal, F2 - Binary, F3 - Octal DATA F4 - Hexadecimal, F5 - Choose a base, F6 - Quit the program ChooseItem = 1 'Starting point of highlighted menu item XMenuposn = 20 'X starting point of menu YMenuPosn = 10 'Y starting point of menu '*** Fill the bases array *** FOR Count = 1 TO 4 READ Bases(Count) NEXT Count '*** Fill the MenuItme Array *** FOR Count = 1 TO UBOUND(MenuItem$) READ MenuItem(Count) NEXT Count CLS PRINT PRINT " A program to find the binary, octal and hexadecimal" PRINT " representations of a decimal number." PRINT PRINT " Use the Enter key to choose the highlighted menu item or" PRINT " Press the F number key associated with the menu item or" PRINT " Press the Alt key and the capitalised letter of the menu item" GOSUB DrawMenu '*** get cursor key movements and redraw menu *** DO DO Cmmnd$ = (INKEY$) IF LEN(Cmmnd$) = 2 THEN Cmmnd$ = RIGHT$(Cmmnd$, 1) IF Cmmnd$ = "8" OR Cmmnd$ = CHR$(72) THEN GOSUB MoveUp IF Cmmnd$ = "2" OR Cmmnd$ = CHR$(80) THEN GOSUB MoveDown IF Cmmnd$ = "7" OR Cmmnd$ = CHR$(71) THEN ChooseItem = 1 IF Cmmnd$ = "1" OR Cmmnd$ = CHR$(79) THEN ChooseItem = UBOUND(MenuItem) IF Cmmnd$ = CHR$(13) THEN EndMenu = 1 IF Cmmnd$ = CHR$(59) OR Cmmnd$ = CHR$(32) THEN ChooseItem = 1 EndMenu = 1 END IF IF Cmmnd$ = CHR$(60) OR Cmmnd$ = CHR$(48) THEN ChooseItem = 2 EndMenu = 1 END IF IF Cmmnd$ = CHR$(61) OR Cmmnd$ = CHR$(24) THEN ChooseItem = 3 EndMenu = 1 END IF IF Cmmnd$ = CHR$(62) OR Cmmnd$ = CHR$(35) THEN ChooseItem = 4 EndMenu = 1 END IF IF Cmmnd$ = CHR$(63) OR Cmmnd$ = CHR$(46) THEN ChooseItem = 5 EndMenu = 1 END IF IF Cmmnd$ = CHR$(64) OR Cmmnd$ = CHR$(16) THEN ChooseItem = 6 EndMenu = 1 END IF GOSUB DrawMenu LOOP UNTIL EndMenu = 1 '*** Reset variables, there are problems if this is not done *** FOR Count = 1 TO 5 NumArray$ = "" NEXT Count TempNum = 0 StrNum$ = "" BaseNum = 0 ModNum = 0 UserNum = 0 EndMenu = 0 OutNum = 0 ConvNum = 0 EndMenu = 0 IF ChooseItem = 6 THEN EXIT DO COLOR 7, 0 IF ChooseItem = 5 THEN GOSUB GetBase ELSE GOSUB GetNumber IF ChooseItem <> 1 THEN GOSUB ToDecimal GOSUB ToBase GOSUB Results END IF LOOP UNTIL ChooseItem = 6 END DrawMenu: '*** Draw the menu *** LOCATE YMenuPosn, XMenuposn FOR Count = 1 TO UBOUND(MenuItem$) IF Count = ChooseItem THEN COLOR 4, 2 ELSE COLOR 2, 4 LOCATE CSRLIN, XMenuposn PRINT MenuItem$(Count) NEXT Count RETURN MoveUp: IF ChooseItem = 1 THEN ChooseItem = UBOUND(MenuItem$) ELSE ChooseItem = ChooseItem - 1 END IF RETURN MoveDown: IF ChooseItem = UBOUND(MenuItem$) THEN ChooseItem = 1 ELSE ChooseItem = ChooseItem + 1 END IF RETURN ToBase: '*** Do Decimal to other bases *** '*** The code below will work for ANY base *** '*** It needs the number as a numeric to work *** FOR Count = 2 TO UBOUND(Bases) IF Bases(Count) = 0 THEN EXIT FOR TempNum = VAL(NumArray(1)) BaseNum = Bases(Count) StrNum$ = "" '*** Take the number, and keep dividing by the base number *** '*** Add the results to the output string *** DO ModNum = TempNum MOD BaseNum TempNum = FIX(TempNum / BaseNum) IF ModNum > 9 THEN StrNum$ = CHR$(ModNum + 55) + StrNum ELSE StrNum$ = STR$(ModNum) + StrNum$ END IF StrNum$ = LTRIM$(RTRIM$(StrNum$)) IF TempNum < BaseNum THEN IF TempNum > 9 THEN StrNum$ = CHR$(TempNum + 55) + StrNum$ ELSE StrNum$ = STR$(TempNum) + StrNum$ END IF END IF StrNum$ = LTRIM$(RTRIM$(StrNum$)) LOOP UNTIL TempNum < BaseNum IF LEFT$(StrNum$, 1) = "0" THEN StrNum$ = MID$(StrNum$, 2) NumArray(Count) = StrNum$ NEXT Count RETURN ToDecimal: '*** Do Base to Decimal *** '*** The code below will work for ANY base *** '*** It needs the number as a string to work *** BaseNum = Bases(ChooseItem) StrNum$ = NumArray(ChooseItem) FOR Count = 1 TO LEN(StrNum$) '*** Convert the current character to a number *** PosnNum$ = MID$(StrNum$, Count, 1) IF ASC(PosnNum$) > 59 THEN ConvNum = ASC(PosnNum$) - 55 ELSE ConvNum = VAL(PosnNum) END IF '*** Get the value of that base at that position *** '*** the series goes ... n^5, n^4, n^3, n^2, n, 1 *** IF Count = LEN(StrNum$) THEN TempNum = 1 ELSE TempNum = BaseNum FOR Counter = 1 TO (LEN(StrNum$) - Count - 1) TempNum = TempNum * BaseNum NEXT Counter END IF OutNum = OutNum + (TempNum * ConvNum) NEXT Count NumArray$(1) = LTRIM$(STR$(OutNum)) RETURN GetBase: LOCATE 17, 3 PRINT SPACE$(60) LOCATE 17, 3 INPUT "What number base do you want to use ", UserNum Bases(5) = UserNum MenuItem$(5) = "F5 - Chosen base" + STR$(UserNum) LOCATE 17, 3 PRINT SPACE$(60) RETURN GetNumber: LOCATE 17, 3 PRINT SPACE$(60) LOCATE 17, 3 INPUT "What number do you want to convert ", UserNum NumArray(ChooseItem) = STR$(UserNum) LOCATE 17, 3 PRINT SPACE$(60) RETURN Results: LOCATE 17, 3 PRINT "Decimal"; TAB(20); NumArray$(1) LOCATE 18, 3 PRINT "Binary"; TAB(20); NumArray$(2) LOCATE 19, 3 PRINT "Octal"; TAB(20); NumArray$(3) LOCATE 20, 3 PRINT "Hexadecimal"; TAB(20); NumArray$(4) IF NumArray$(5) <> "" THEN LOCATE 21, 3 PRINT "Your base"; Bases(5); TAB(20); NumArray$(5) END IF '*** Check the results *** LOCATE 19, 40 PRINT "OCT$ "; OCT$(VAL(NumArray$(1))) LOCATE 20, 40 PRINT "HEX$ "; HEX$(VAL(NumArray$(1))) LOCATE 23, 3 PRINT "Press any key to continue ..." DO LOOP UNTIL INKEY$ <> "" FOR Count = 17 TO 23 LOCATE Count, 3 PRINT SPACE$(60) NEXT Count RETURN

**Number Series :-**

Number series are fascinating. They take a simple concept and from that a whole
series of numbers can be generated. Take Prime Numbers, the series starts off with the fact that some numbers are only divisible
by themselves and 1. I've no idea what the largest prime number that has been so far calculated is, but, there is a class of
prime numbers known as the Mersenne Primes. These take the form 2^{p} - 1. In plain English, they are 2 to the power of
a prime number - 1. As the Prime Number series runs 2, 3, 5, 7 ... the Mersenne Prime Number series runs 3, 7, 31, 127 ... The
first in the series is 3 = 2^{2} - 1, followed by 7 = (2^{3}) - 1 = (2 * 2* 2) - 1, then 31 = 2^{5} - 1
= (2 * 2 * 2 * 2 * 2) - 1, followed by 127 = 2^{7} - 1 = (2 * 2 * 2 * 2 * 2 * 2 * 2) - 1. The largest Mersenne
Prime calculated so far is the 39th in the series and is 2^{13,466,917}-1 which I'm not going to put here as it's
got over 4 MILLION digits. Want to earn yourself $100,000? Then calculate and prove a 10 MILLION digit prime number. The
information on Mercenne Primes was taken from
Mersenne Prime Search.

The number series I've included in the program, numser.bas, are Catalan, Factional, Fibonacci, Harmonic, Mersenne Prime, Pascal, Prime, Square, Triangular and Vampire.

Catalan Numbers :-

The Catalan series is the series of derived from the factors of the central numbers from Pascal's Triangle. These are the numbers marked in purple in the diagram below.

11 1 1 2 1 1 3 3 1 1 4 6 4 1 1 5 10 10 5 1 1 6 15 20 15 6 1 1 7 21 35 35 21 7 1 1 8 28 56 70 56 28 8 1

The Catalan numbers can be explained as below : -

1 = 1 x **1
**2 = 2 x

Another way of looking at them is that they are Catalan numbers are a binomial series,
BINOMIAL [2n, n]/(n + 1). To find the number series 1, 2, 6 20, 70 ... the formula ^{n}C_{r}
or n! / (n - r)! r! or used. Where to work out the series r increases by 2 and n by 1 for each number in the series. Using the
formula n! / (n - r)! r! / (n+1) the Catalan numbers are found. The nth Catalan number counts the ways of dissecting a polygon
with n+2 sides into triangles by drawing nonintersecting diagonals.

The series runs 1, 2, 5, 14, 42, 132, 429, 1430, 4862, 16796 ...

The program is flawed because of the way QBasic deals with DOUBLE'd numbers. Some numbers aren't calculated to whole numbers and give a lot of decimals. It should be easy enough to spot what the numbers should be.

Factional Series :-

The numbers in this series are the product of the previous numbers multiplied by the position in the series. The common way of writing this is n!

The series runs :- 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800 ... Which is

1 * 1, 1 * 2, 2 * 3, 6 * 4, 24 * 5, 120 * 6, 720 * 7, 5040 * 8, 40320 * 9, 362880 * 10 ...

As you can see this number series gets very big very quickly.

Fibonacci Series :-

Leonardo Fibonacci (Leonardo da Pisa) was born in Pisa, Italy in 1175. He died in 1250.

The series of numbers that he calculated was 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987 ...

The members of this series are the sum of the previous two numbers. There is another interesting thing about this series. Look at the difference between the numbers. The difference between 2 and 3 is 1, between 3 and 5 is 2, between 5 and 8 is 3 and so on. Ignoring the 0, 1, 1 at the start of the series, the differences between the Fibonacci numbers is another series, it is 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233 ... Can you see what is happening? The difference between the numbers of the Fibonacci series, is another Fibonacci series.

Harmonic Series :-

This is the series 1 + 1/2 + 1/3 + 1/4 + 1/5 ... 1/n. The series (when factorised) runs ...

1, 3/2, 11/6, 25/12, 137/60, 49/20, 363/140, 761/280, 7129/2520, 7381/2520 ...

The program factorises the numbers it produces, but this slows it down considerably. I've indicated which parts of the Harmon subroutine that can be REM'd out to let it run as quickly as it can. The program also calculates mixed fractions, so that 25/12 becomes 2 1/12. Because this uses the MOD command and some of the numbers used get very big without the factorisation then this part of the code has to be REM'd out too. For an explanation of the MOD problem see the Mersenne Prime section below.

If "C" (test if your number is part of the series) is chosen from the main menu, then the number to be input has to be in the form of a decimal number. One way to allow fractions to be input is to take the input as string. Everything before the / can be taken as the numerator and everything after as the denominator. A simple calculation will turn this back into a decimal so that the comparison in the Harmon subroutine can be made. Suppose the user wants to see if the fraction 12345/6789 is a Harmonic number, using a variable called UserStr$ :-

DIM UserNum AS DOUBLE UserStr$ = "12345/6789" Posn = INSTR(UserStr$, "/") Num = VAL(LEFT$(UserStr$, Posn - 1)) Den = VAL(MID$(UserStr$, Posn + 1)) UserNum = Num / Den

I've also limited the program to only run the Harmon subroutine when "C" is chosen and when the number input is less than 4. This is again due to the factorisation. If a number great than 4 is input the program takes an age to do the calculations. If this code to do this is removed then there is now reason for the limitation on numbers less than 4. However, the program will take a long, long to reach the number that the user input.

Mersenne Prime Numbers :-

This is a prime number series of numbers which is given by 2^{p} - 1,
where p is a prime number and so is the Mersenne Prime derived from it. Whilst writing the program I came across a limit of the
MOD command in QBasic. The limit is that it only works for numbers less or equal than 2,147,483,647, which is the limit for a
long integer, oddly enough this is also a Mersenne Prime. If you've a couple of hours or days you don't mind leaving your
computer running you may like to replace the lines

IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!! MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1

that appear in the Mersenne subroutine with the following code

NewNum = (MersTest / MersDiv) * 1000 NewStr$ = STR$(NewNum) IF RIGHT$(NewStr$, 3) = "000" THEN MersPrime = 1

You'll also need to define NewNum as a DOUBLE.

This has the same result as IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 but can deal with very large numbers. The problem is that the program is VERY slow to run. For this reason I've limited the program to calculating the first 8 numbers in the series.

The series is 3, 7, 31, 127, 8191, 131071, 524287, 2147483647, 170141183460469231731687303715884105727 ...

These are Mersenne Primes from the normal primes of 2, 3, 5, 7, 13, 17, 19, 31 and 61

Pascal Numbers :-

This is the series of numbers which are the sums of the numbers in each line of Pascal's Triangle. This is a wonderful of construct of numbers in which can be seen the Magic 11's, the Fibonacci sequence, Catalan numbers, Triangular numbers, Square numbers and the polygonal numbers. Although all these number series can be seen, it is very simple.

1 1 1 1 2 1 1 3 3 1 1 4 6 4 1 1 5 10 10 5 1 1 6 15 20 15 6 1 1 7 21 35 35 21 7 1 1 8 28 56 70 56 28 8 1

Can you see how it is made? Each number is the sum of the two numbers above and to either side of it, apart from the outside numbers which are always 1. The sum of the rows is very easy to work out. If the top row is called row 0, then for each row the sum of the numbers in that row is 2^row number. In fact the series is just the powers of two ...

1, 2, 4, 8, 16, 32, 64, 128, 256, 512 ...

Perfect Numbers :-

This is the series of numbers which are equal to the sum of all of its positive divisors, excluding itself.

The first in the series is 6 (1+2+3), the second is 28 (1+2+4+7+14)

The series is 6, 28, 496, 8128, 33550336, 8589869056, 137438691328, 2305843008139952128, 2658455991569831744654692615953842176, 191561942608236107294793378084303638130997321548169216 ...

Perfect numbers can be calculated by using 2^{m-1}(2^{m}-1) where m is a Mersenne
prime number.

As you can see these numbers get very big very quickly, so once again I've limited the number that are generated by the program.

Prime Numbers :-

This is the series of numbers that can only be divided by themselves and 1 (without leaving fractions or a remainder).

The series is 2, 3, 5, 7, 11, 13, 17, 19, 23, 29 ...

Square Numbers :-

This is the series of numbers whose square roots are integers (in the mathematical sense, not the programming sense where integers run from -32,768 to +32,767).

The series is 1, 4, 9, 16, 25, 36, 49, 64, 81, 100 ...

Can you see the differences in the series? They run 3, 5, 7, 9, 11, 13, 15, 17, 19 ...

There are also cubed (1, 8, 27, 64, 125 ...), quad (1, 16, 81, 256, 625 ...), quint (1, 32, 243, 1024, 3125 ...) numbers and so on.

Triangular Numbers :-

This is the series of numbers that are able to make up a triangle from dots. Perhaps a diagram will make it clearer.

1 o 3 o 6 o 10 o 15 o o o o o o o o o o o o o o o o o o o o o o o o o o o o o o o

The series is 1, 3, 6, 10, 15, 21, 28, 36, 45, 55 ...

Once again there is a series in the difference in the numbers of the series, they run 2, 3, 4, 5, 6, 7, 8, 9 ...

Vampire Numbers :-

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). There are a couple of rules when producing vampire numbers. 150 x 930 = 139,500 (150 * 930) isn't a vampire number because 1395 (15 * 93) IS. The number 125,460 will produce two sets of numbers, 204 * 615 and 246 * 510, but it is only counted once in the series.

The series runs 1260, 1395, 1435, 1530, 1827, 2187, 6880, 102510, 104260, 105210 ... which is

21 * 60, 15 * 93, 35 * 41, 30 * 51, 21 * 87, 27 * 81, 80 * 86, 201 * 510, 260 * 401, 210 * 501 ...

There are two methods of calculating Vampire Numbers.

1) Produce a number and by testing ALL variations of the digits within that number test to see if any combination can produce the initial number. For example take the numbers 1001 to 9999 in turn and test them. Suppose we are up to the number 5678. All the variations for that number are 56*78, 56*87, 57*68, 57*86, 58*67, 58*85, 65*78, 65*87, 67*58, 67*85, 68*57, 68*75, 75*68, 75*86, 76*58, 76*85, 78*67, 78*76, 85*67, 85*76, 86*57, 86*75, 87*56 and 87*65. The work is made slightly easier by the fact we can remove half of these 24 variations, this is because 56*78 is the same as 78*56. This doesn't seem so bad as now we've only 12 possibilities, which can be done using SWAP statements within the program. However, think what happens when we get to 6 digit numbers. We now end up with 720 possible combinations. With that many SWAP statements to write it's probably quicker and more accurate to sit down with pen, paper and calculator and do the sums yourself. One advantage to this method of programming is that the numbers appear smallest to largest. Here's some code to show this method.

VampTest = 1000 Count = 0 ReCurs = 0 VampStr$ = LTRIM$(STR$(VampTest)) VampLen = LEN(LTRIM$(VampStr$)) Fact1 = 0 Fact2 = 0 VampFnd = 0 ReCurs = 0 FOR Count = 1 TO VampLen VampAry$(Count) = MID$(VampStr$, Count, 1) NEXT Count DO IF VampLen = 4 THEN IF VampTest MOD 100 = 0 THEN EXIT DO Div1 = VAL(VampAry$(1) + VampAry$(2)) IF Div1 <> 0 THEN IF VampTest MOD Div1 = 0 THEN Fact1 = 1 END IF Div2 = VAL(VampAry$(3) + VampAry$(4)) IF Div2 <> 0 THEN IF VampTest MOD Div2 = 0 THEN Fact2 = 1 END IF IF Fact1 = 1 AND Fact2 = 1 THEN IF Div1 * Div2 = VampTest THEN VampFnd = 1 END IF IF VampFnd = 0 THEN 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 END IF END IF LOOP UNTIL ReCurs > 11 OR VampFnd = 1

2) The second method is to multiply a sequence of numbers then see if the product is a Vampire number. The first number only needs to start from 33, 333, 3333 etc. This is because 33 * 10 is only 330, 333 * 100 is only 33300, which are an odd number of digits long. The same can't be done to the second number as 300 * 334 = 102200, then 400 * 250 = 100000, 500 * 200 = 100000, 600 * 167 = 100200, 700 * 143 = 100100, 800 * 125 = 100000 and 900 * 112 = 100800. When the first number reaches 1000, it is increased to 3333 and the second number becomes 1000. The product of these numbers are then tested to see if they are Vampire numbers.

There are a couple of problems with this method.

Some Vampire numbers have spare "fangs", but are only counted as Vampire numbers once. For example 125460 can be produced from 204 * 615 or 246 * 510 but it's only counted once.

The second and more serious is the fact that Vampire numbers are NOT produced in numerical order. The first seven of the series are calculated in the following order 1435, 1530, 1260, 2187, 6880, 1827 and 1395. This is because of the way the numbers are incremented, in fact the order of finding these numbers are 41*35, 51*30, 60*21, 81*27, 80*86, 87*21 and 93*15. Even if these multiples were reversed they still wouldn't give the right order. For this reason the numbers are put into an array and sorted before being displayed.

This leads to another problem, you can't tell if you've got all the Vampire numbers until you've calculated them all for a certain number of digits. For example, if you tell the program to produce the first 10 Vampire numbers, it gives all the 4 digit numbers in the correct order as there are only seven of them. The first three 6 digit Vampire numbers are given as 104260, 135837 and 140350. This is wrong, they should be 102510, 104260 and 105210, but these aren't calculated until positions 26, 9 and 24 respectively. There are 7 Vampire numbers with 4 digits, 148 with 6 digits, 3226 with 8 digits and 108577 with 10 digits, this means to get them all, you need to enter at least 7, 155, 3371 or 111948. I say at least, as don't forget the first problem, some numbers are calculated as Vampire numbers twice.

When using this program remember, the results are only accurate until the next step in the number of digits in the Vampire number is reached. This brings us to yet another problem with this program. Because the QuickSort I've used uses the numbers in an array, and QBasic won't allow more than an arrays longer than 10,000 as a LONG then that's all the numbers it can cope with. The program is therefore only accurate in producing up to 6 digit Vampire numbers.

The program, numser.bas is able to print, within the limits shown under the various sections above, the first part of each of the series, the series up to a number that is input and can check whether a number is part of any of the series. It is able to do this because of the way computer programs can use loops. Because of the length of the program it is at the bottom of the page, after Further Reading.

**Further Reading :-**

Amazing Number Facts - All sorts of things about numbers

Fibonacci Numbers and the Golden Section - includes easy and hard puzzle pages

GIMPS - Searching for Mersenne Primes

Introduction to Catalan Numbers

Kryss Tal - a good maths site

Largest Known - The largest known Perfect and Prime numbers

Pascal's Triangle and its Patterns

Pascal's Triangle and related triangles

Patterns in Pascal's Triangle *

Perfect Number Journey - Perfect numbers, Primes and Mersenne Primes

Perfect, Amicable and Sociable Numbers

Prime Pages - Perfect numbers, Primes and Mersenne Primes

'Numser.bas Ray Thomas April 2002 OPTION BASE 1 DECLARE SUB Menu () DECLARE SUB Catalan () DECLARE SUB Facts () DECLARE SUB Fibon () DECLARE SUB Harmon () DECLARE SUB Mersenne () DECLARE SUB Pascal () DECLARE SUB Perfect () DECLARE SUB Primes () DECLARE SUB QSort (SortArray() AS LONG, Low AS INTEGER, High AS DOUBLE) DECLARE SUB Square () DECLARE SUB Triang () DECLARE SUB Vampire () DECLARE SUB Continue () DIM SHARED UserIn AS STRING 'User input DIM SHARED UserNum AS DOUBLE 'User number DIM SHARED Count AS DOUBLE 'Loop counter DIM SHARED OldNum AS DOUBLE 'Previous number generated DO Menu Catalan Continue Facts Continue Fibon Continue IF UserIn = "C" AND UserNum < 4 THEN Harmon Continue END IF Mersenne Continue Pascal Continue Perfect Continue Primes Continue Square Continue Triang Continue Vampire Continue LOOP UNTIL UserIn$ = CHR$(27) END SUB Catalan '*** Catalan series *** DIM Cat AS DOUBLE DIM Row AS DOUBLE DIM RowFact AS DOUBLE DIM Num AS DOUBLE DIM NumFact AS DOUBLE DIM NumRow AS DOUBLE DIM InterMed AS DOUBLE CLS PRINT PRINT "CATALAN NUMBERS" PRINT PRINT "Catalan numbers are a binomial series, BINOMIAL [2n, n]/(n + 1)" PRINT IF UserIn$ = "A" THEN '*** First n of a series *** PRINT "These are the first"; UserNum; "Catalan numbers." PRINT PRINT 1; '*** I can't calculate this *** Row = 0 Num = 0 FOR Count = 1 TO UserNum Num = Num + 1 Row = Row + 2 NumFact = 1 RowFact = 1 NumRow = 1 '*** Calculate the factorials *** FOR Counter = 1 TO Num NumFact = NumFact * Counter NEXT Counter FOR Counter = 1 TO Row RowFact = RowFact * Counter NEXT Counter FOR Counter = 1 TO Row - Num NumRow = NumRow * Counter NEXT Counter '*** Do the sums *** '*** Intermed is the series from Pascal's Triangle *** '*** 1, 2, 6, 20, 70 ... *** InterMed = RowFact / (NumFact * NumRow) Cat = InterMed / (Num + 1) PRINT Cat; IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count END IF IF UserIn$ = "B" THEN '*** Series up to a number *** PRINT "These are the Catalan numbers up to"; UserNum PRINT PRINT 1; '*** I can't calculate this *** Row = 0 Num = 0 Count = 1 DO Num = Num + 1 Row = Row + 2 NumFact = 1 RowFact = 1 NumRow = 1 '*** Calculate the factorials *** FOR Counter = 1 TO Num NumFact = NumFact * Counter NEXT Counter FOR Counter = 1 TO Row RowFact = RowFact * Counter NEXT Counter FOR Counter = 1 TO Row - Num NumRow = NumRow * Counter NEXT Counter '*** Do the sums *** '*** Intermed is the series from Pascal's Triangle *** '*** 1, 2, 6, 20, 70 ... *** InterMed = RowFact / (NumFact * NumRow) Cat = InterMed / (Num + 1) PRINT Cat; Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Cat >= UserNum PRINT PRINT PRINT "There are"; Count; "Catalan numbers less than or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number in a series? *** Row = 0 Num = 0 Count = 1 DO Num = Num + 1 Row = Row + 2 NumFact = 1 RowFact = 1 NumRow = 1 OldNum = Cat '*** Calculate the factorials *** FOR Counter = 1 TO Num NumFact = NumFact * Counter NEXT Counter FOR Counter = 1 TO Row RowFact = RowFact * Counter NEXT Counter FOR Counter = 1 TO Row - Num NumRow = NumRow * Counter NEXT Counter '*** Do the sums *** '*** Intermed is the series from Pascal's Triangle *** '*** 1, 2, 6, 20, 70 ... *** InterMed = RowFact / (NumFact * NumRow) Cat = InterMed / (Num + 1) Count = Count + 1 LOOP UNTIL Cat >= UserNum IF Cat = UserNum THEN PRINT UserNum; "is a Catalan number" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a Catalan number" PRINT PRINT "The next smallest number is"; OldNum; "the next Catalan number is"; Cat END IF END IF END SUB SUB Continue '*** Press any key to continue *** PRINT PRINT PRINT "Press any key to continue ..." DO LOOP UNTIL INKEY$ <> "" PRINT END SUB SUB Facts '*** Factorials *** DIM Fact AS DOUBLE DIM NewMax AS DOUBLE NewMax = UserNum IF UserNum > 169 THEN NewMax = 169 CLS PRINT PRINT "FACTORIAL NUMBERS" PRINT PRINT "Factorial numbers are the product of the numbers 1 to n" PRINT PRINT "These numbers get very big very quckly" PRINT IF UserIn$ = "A" THEN '*** First n of a series *** PRINT "These are the first"; NewMax; "factorial numbers." PRINT Fact = 1 FOR Count = 0 TO NewMax Fact = Fact + (Fact * Count) PRINT Fact; IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count END IF IF UserIn$ = "B" THEN '*** Series up to a number *** PRINT "These are factorial numbers up to"; UserNum PRINT Fact = 1 Count = 0 DO Fact = Fact + (Fact * Count) IF Fact > UserNum THEN EXIT DO PRINT Fact; Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Fact >= UserNum PRINT PRINT PRINT "There are"; Count; "factorials under or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number in a series? *** Fact = 1 Count = 0 DO OldNum = Fact Fact = Fact + (Fact * Count) Count = Count + 1 LOOP UNTIL Fact >= UserNum IF Fact = UserNum THEN PRINT UserNum; "is a Factorial" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a factorial" PRINT PRINT "The next smallest number is"; OldNum; "the next factorial is"; Fact END IF END IF END SUB SUB Fibon '*** Fibonacci numbers *** DIM Num AS DOUBLE DIM SumNum AS DOUBLE DIM NewNum AS DOUBLE CLS PRINT PRINT "FIBONACCI NUMBERS" PRINT PRINT "Fibonacci numbers are the series of numbers where the next number generated" PRINT "is the sum of the previous two numbers." PRINT PRINT "These numbers get very big very quckly" PRINT IF UserIn$ = "A" THEN '*** First n of the series *** PRINT "The first"; UserNum; "numbers in the Fibonacci series are :-" PRINT SumNum = 0 OldNum = 0 NewNum = 1 Count = 0 DO PRINT SumNum; SumNum = OldNum + NewNum NewNum = OldNum OldNum = SumNum Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Count = UserNum END IF IF UserIn$ = "B" THEN '*** Series up to a number *** PRINT "The Fibonacci series up to and including"; UserNum; "are :-" PRINT SumNum = 0 OldNum = 0 NewNum = 1 Count = 0 DO PRINT SumNum; SumNum = OldNum + NewNum NewNum = OldNum OldNum = SumNum Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL SumNum >= UserNum PRINT PRINT PRINT "There are"; Count; "Fibonacci numbers under or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number in a series? *** SumNum = 0 OldNum = 0 NewNum = 1 Count = 0 DO OldNum = SumNum SumNum = OldNum + NewNum NewNum = OldNum Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL SumNum >= UserNum IF SumNum = UserNum THEN PRINT UserNum; "is a Fibonacci number" PRINT PRINT "It is"; Count + 1; "in the series" ELSE PRINT UserNum; "is not a Fibonacci number" PRINT PRINT "The next smallest number is"; OldNum; "the next Fabonacci number is"; SumNum END IF END IF END SUB SUB Harmon DIM HarmDen AS DOUBLE 'Harmonic denominator DIM HarmNum AS DOUBLE 'Harmonic numerator DIM HarmSum AS DOUBLE 'The sum of the series, as a decimal DIM NewDen AS DOUBLE 'Next denominator DIM NewNum AS DOUBLE 'Next numerator to be added DIM CmnDen AS DOUBLE 'Common denominator DIM WholeNum AS INTEGER 'Integer part of numerator / denominator DIM Counter AS LONG 'Loop counter DIM OldDen AS DOUBLE 'Old denominator DIM Harm AS DOUBLE 'Result of numerator / denominator CLS PRINT PRINT "HARMONIC NUMBERS" PRINT PRINT "Harmonic numbers are the series 1 + 1/2 + 1/3 + 1/4 + 1/5 etc. to 1/n" PRINT IF UserIn$ = "A" THEN '*** First n of a series *** PRINT "These are the first"; UserNum; "Harmonic numbers." PRINT PRINT 1 HarmDen = 1 HarmNum = 1 NewDen = 1 CmnDen = 0 FOR Count = 2 TO UserNum NewDen = NewDen + 1 CmnDen = HarmDen * NewDen HarmNum = HarmNum * NewDen NewNum = HarmDen HarmNum = HarmNum + NewNum HarmDen = CmnDen PRINT STR$(HarmNum); "/"; LTRIM$(STR$(HarmDen)); '*** To improve the speed of the program REM (or use ') *** '*** From the line below to the line '********************* '*** Factorise the Harmonic fraction *** FOR Counter = HarmDen TO 2 STEP -1 IF HarmNum MOD Counter = 0 AND HarmDen MOD Counter = 0 THEN HarmNum = HarmNum / Counter HarmDen = HarmDen / Counter PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF IF HarmNum MOD 2 = 0 AND HarmDen MOD 2 = 0 THEN HarmNum = HarmNum / 2 HarmDen = HarmDen / 2 PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF NEXT Counter '*** Produce a mixed number *** WholeNum = INT(HarmNum / HarmDen) PRINT " ="; WholeNum; LTRIM$(STR$(HarmNum MOD HarmDen)); "/"; LTRIM$(STR$(HarmDen)); '********************************************************** PRINT " ="; HarmNum / HarmDen IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count END IF IF UserIn$ = "B" THEN '*** Harmonic series up to and including a number *** PRINT "These are Harmonic numbers up to"; UserNum PRINT PRINT 1 HarmDen = 1 HarmNum = 1 NewDen = 1 CmnDen = 0 Count = 0 DO NewDen = NewDen + 1 CmnDen = HarmDen * NewDen HarmNum = HarmNum * NewDen NewNum = HarmDen HarmNum = HarmNum + NewNum HarmDen = CmnDen Count = Count + 1 IF HarmNum / HarmDen > UserNum THEN EXIT DO PRINT STR$(HarmNum); "/"; LTRIM$(STR$(HarmDen)); '*** To improve the speed of the program REM (or use ') *** '*** From the line below to the line '********************* '*** Factorise the Harmonic fraction *** FOR Counter = HarmDen TO 2 STEP -1 IF HarmNum MOD Counter = 0 AND HarmDen MOD Counter = 0 THEN HarmNum = HarmNum / Counter HarmDen = HarmDen / Counter PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF IF HarmNum MOD 2 = 0 AND HarmDen MOD 2 = 0 THEN HarmNum = HarmNum / 2 HarmDen = HarmDen / 2 PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF NEXT Counter '*** Produce a mixed number *** WholeNum = INT(HarmNum / HarmDen) PRINT " ="; WholeNum; LTRIM$(STR$(HarmNum MOD HarmDen)); "/"; LTRIM$(STR$(HarmDen)); '********************************************************** PRINT " ="; HarmNum / HarmDen IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL HarmNum / HarmDen >= UserNum PRINT PRINT "There are"; Count; "Harmonic numbers smaller or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number in the Harmonic series? *** HarmDen = 1 HarmNum = 1 NewDen = 1 CmnDen = 0 Count = 1 OldNum = 0 OldDen = 0 DO OldNum = HarmNum OldDen = HarmDen NewDen = NewDen + 1 CmnDen = HarmDen * NewDen HarmNum = HarmNum * NewDen NewNum = HarmDen HarmNum = HarmNum + NewNum HarmDen = CmnDen Count = Count + 1 Harm = HarmNum / HarmDen LOOP UNTIL Harm >= UserNum '*** To improve the speed of the program REM (or use ') *** '*** From the line below to the line '********************* IF Harm = UserNum THEN PRINT UserNum; "is a Harmonic Number" PRINT PRINT "It is"; Count; "in the series" PRINT PRINT STR$(HarmNum); "/"; LTRIM$(STR$(HarmDen)); ELSE PRINT UserNum; "is not a Harmonic number." PRINT PRINT "The next smallest number is"; STR$(OldNum); "/"; LTRIM$(STR$(OldDen)); SWAP OldNum, HarmNum SWAP OldDen, HarmDen END IF '*** To improve the speed of the program REM (or use ') *** '*** From the line below to the line '********************* '*** Factorise the Harmonic fraction *** FOR Counter = HarmDen TO 2 STEP -1 IF HarmNum MOD Counter = 0 AND HarmDen MOD Counter = 0 THEN HarmNum = HarmNum / Counter HarmDen = HarmDen / Counter PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF IF HarmNum MOD 2 = 0 AND HarmDen MOD 2 = 0 THEN HarmNum = HarmNum / 2 HarmDen = HarmDen / 2 PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF NEXT Counter '*** Produce a mixed number *** WholeNum = INT(HarmNum / HarmDen) PRINT " ="; WholeNum; LTRIM$(STR$(HarmNum MOD HarmDen)); "/"; LTRIM$(STR$(HarmDen)); '********************************************************** PRINT " ="; HarmNum / HarmDen IF Harm > UserNum THEN SWAP OldNum, HarmNum SWAP OldDen, HarmDen PRINT PRINT "The next largest is"; STR$(HarmNum); "/"; LTRIM$(STR$(HarmDen)); '*** To improve the speed of the program REM (or use ') *** '*** From the line below to the line '********************* '*** Factorise the Harmonic fraction *** FOR Counter = HarmDen TO 2 STEP -1 IF HarmNum MOD Counter = 0 AND HarmDen MOD Counter = 0 THEN HarmNum = HarmNum / Counter HarmDen = HarmDen / Counter PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF IF HarmNum MOD 2 = 0 AND HarmDen MOD 2 = 0 THEN HarmNum = HarmNum / 2 HarmDen = HarmDen / 2 PRINT " = "; LTRIM$(STR$(HarmNum)); "/"; LTRIM$(STR$(HarmDen)); END IF NEXT Counter '*** Produce a mixed number *** WholeNum = INT(HarmNum / HarmDen) PRINT " ="; WholeNum; LTRIM$(STR$(HarmNum MOD HarmDen)); "/"; LTRIM$(STR$(HarmDen)); '******************************************************** PRINT " ="; HarmNum / HarmDen END IF END IF END SUB SUB Menu '*** Introduction and menu to the program *** CLS PRINT PRINT " This program is an introduction to number series." PRINT PRINT " The series this program can calculate are :-" PRINT PRINT " Factorials, Fibonacci, Mersenne Primes, Pascal, Perfect, Primes," PRINT " Squares, Triangular and Vampire." PRINT PRINT PRINT PRINT " Choose what you want the program to do :-" PRINT PRINT PRINT " A = The first n numbers of the series." PRINT PRINT " B = The series up to and including your number." PRINT PRINT " C = Test if your number is part of the series." PRINT PRINT " Esc = Exit Program" PRINT DO UserIn$ = UCASE$(INKEY$) LOOP UNTIL INSTR(" ABC", UserIn$) > 1 OR UserIn$ = CHR$(27) IF UserIn$ = CHR$(27) THEN END PRINT PRINT PRINT " There are limits to the size of the numbers that can be displayed :-" PRINT PRINT " First 169 only in the Factorial series, first 8 only in Mersenne Primes" PRINT " and Perfect numbers, 6 digit Vampire numbers etc." PRINT INPUT ; " What is your number"; UserNum PRINT END SUB SUB Mersenne '*** Mersenne Prime Numbers *** DIM TestNum AS DOUBLE 'TestNum the number being tested DIM Prime AS INTEGER 'Switch to indicate a prime during testing DIM Divisor AS LONG 'Holds divisors DIM MersTest AS DOUBLE 'Mersenne test numbers DIM MersDiv AS DOUBLE 'Holds Mersenne divisors DIM MersPrime AS INTEGER 'Switch to indicate a Mersenne Prime Divisor = 2 Count = 2 CLS PRINT PRINT "MERSENNE PRIME NUMBERS" PRINT PRINT "Mersenne Prime numbers are those that take the form (2^p) - 1" PRINT PRINT "Where p and the Mersenne number produced are prime numbers" PRINT IF UserIn$ = "A" THEN '*** First n of the series *** PRINT "Here are the first"; UserNum; "Mersenne Prime numbers." PRINT PRINT 3; 7; '*** I can't find a way of calculating these *** TestNum = 3 Count = 2 DO '*** First of all find the Prime Numbers *** Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 '*** Now we've got a Prime, calculate the Mersenne Prime *** IF Prime = 0 THEN MersTest = (2 ^ TestNum) - 1 '*** Now test if MersTest is a Prime *** MersPrime = 0 MersDiv = 3 DO IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!!" MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 MersDiv = MersDiv + 2 IF MersDiv > SQR(MersTest) THEN EXIT DO LOOP UNTIL MersPrime = 1 IF MersPrime = 0 THEN Count = Count + 1 PRINT MersTest; END IF END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Count = UserNum END IF IF UserIn$ = "B" THEN '*** Mersenne Prime numbers up to and including a number *** PRINT "Here are the Mersenne Prime numbers up to or equal to"; UserNum PRINT PRINT 3; 7; '*** I can't find a way of calculating these *** TestNum = 3 Count = 2 DO '*** First of all find the Prime Numbers *** Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 '*** Now we've got a Prime, calculate the Mersenne Prime *** IF Prime = 0 THEN MersTest = (2 ^ TestNum) - 1 '*** Now test if MersTest is a Prime *** MersPrime = 0 MersDiv = 3 DO IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!!" MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest > UserNum THEN MersPrime = 1 EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 MersDiv = MersDiv + 2 IF MersDiv > SQR(MersTest) THEN EXIT DO LOOP UNTIL MersPrime = 1 IF MersPrime = 0 THEN Count = Count + 1 PRINT MersTest; END IF END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL MersTest >= UserNum PRINT PRINT PRINT "There are"; Count; "Mersenne Prime numbers smaller or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number is part of the series? *** TestNum = 3 Count = 2 DO '*** First of all find the Prime Numbers *** Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 '*** Now we've got a Prime, calculate the Mersenne Prime *** IF Prime = 0 THEN MersTest = (2 ^ TestNum) - 1 '*** Now test if MersTest is a Prime *** MersPrime = 0 MersDiv = 3 DO IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!!" MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 MersDiv = MersDiv + 2 IF MersDiv > SQR(MersTest) THEN EXIT DO LOOP UNTIL MersPrime = 1 IF MersPrime = 0 THEN Count = Count + 1 IF MersTest >= UserNum THEN EXIT DO IF MersTest < UserNum THEN OldNum = MersTest END IF END IF LOOP UNTIL MersPrime = 0 AND MersTest >= UserNum IF MersTest = UserNum THEN PRINT UserNum; "is a Mersenne Prime number" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a Mersenne Prime number" PRINT PRINT "The next smallest number is"; OldNum; "the next Mersenne Prime number is"; MersTest END IF END IF END SUB SUB Pascal '*** Pascal Numbers *** DIM PascNum AS DOUBLE CLS PRINT PRINT "PASCAL NUMBERS" PRINT PRINT "Pascal numbers are the sum of the numbers in each row of Pascal's Triangle" PRINT IF UserIn$ = "A" THEN '*** First n of a series *** PRINT "These are the first"; UserNum; "Pascal numbers." PRINT FOR Count = 0 TO UserNum - 1 PascNum = 2 ^ Count PRINT PascNum; IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count END IF IF UserIn$ = "B" THEN '*** Series up to a number *** PRINT "These are Pascal numbers up to"; UserNum PRINT PascNum = 0 Count = 0 DO PascNum = 2 ^ Count IF PascNum > UserNum THEN EXIT DO PRINT PascNum; Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Fact >= UserNum PRINT PRINT PRINT "There are"; Count; "Pascal less than or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number in a series? *** PascNum = 0 Count = 0 DO OldNum = PascNum PascNum = 2 ^ Count Count = Count + 1 LOOP UNTIL PascNum >= UserNum IF Fact = UserNum THEN PRINT UserNum; "is a Pascal number" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a Pascal number" PRINT PRINT "The next smallest number is"; OldNum; "the next Pascal number is"; PascNum END IF END IF END SUB SUB Perfect '*** Perfect Numbers *** DIM TestNum AS DOUBLE 'TestNum the number being tested DIM Prime AS INTEGER 'Switch to indicate a prime during testing DIM Divisor AS LONG 'Holds divisors DIM MersTest AS DOUBLE 'Mersenne test numbers DIM MersDiv AS DOUBLE 'Holds Mersenne divisors DIM MersPrime AS INTEGER 'Switch to indicate a Mersenne Prime DIM Perf AS DOUBLE 'Perfect Numbers Divisor = 2 Count = 2 CLS PRINT PRINT "PERFECT NUMBERS" PRINT PRINT "Perfect numbers are those whose positive divisors (except for" PRINT "itself) sum to itself. It is also a function of Mersenne Primes" PRINT "using (2^m-1)((2^m)-1)" PRINT IF UserIn$ = "A" THEN '*** First n of the series *** PRINT "Here are the first"; UserNum; "Perfect numbers." PRINT PRINT 6; 28; '*** I can't find a way of calculating these *** TestNum = 3 Count = 2 DO '*** First of all find the Prime Numbers *** Perf = 0 Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 '*** Now we've got a Prime, calculate the Mersenne Prime *** IF Prime = 0 THEN MersTest = (2 ^ TestNum) - 1 '*** Now test if MersTest is a Prime *** MersPrime = 0 MersDiv = 3 DO IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!!" MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 MersDiv = MersDiv + 2 IF MersDiv > SQR(MersTest) THEN EXIT DO LOOP UNTIL MersPrime = 1 '*** Now calculate the Perfect number *** IF MersPrime = 0 THEN Count = Count + 1 Perf = (2 ^ (TestNum - 1)) * MersTest PRINT Perf; END IF END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Count = UserNum END IF IF UserIn$ = "B" THEN '*** Perfect numbers up to and including a number *** PRINT "Here are the Perfect numbers up to or equal to"; UserNum PRINT PRINT 6; 28; '*** I can't find a way of calculating these *** TestNum = 3 Count = 2 DO '*** First of all find the Prime Numbers *** Prime = 0 Perf = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 '*** Now we've got a Prime, calculate the Mersenne Prime *** IF Prime = 0 THEN MersTest = (2 ^ TestNum) - 1 '*** Now test if MersTest is a Prime *** MersPrime = 0 MersDiv = 3 DO IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!!" MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 MersDiv = MersDiv + 2 IF MersDiv > SQR(MersTest) THEN EXIT DO LOOP UNTIL MersPrime = 1 IF MersPrime = 0 THEN Perf = (2 ^ (TestNum - 1)) * MersTest IF Perf > UserNum THEN EXIT DO PRINT Perf; Count = Count + 1 END IF END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Perf >= UserNum PRINT PRINT PRINT "There are"; Count; "Perfect numbers smaller or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number is part of the series? *** TestNum = 3 Count = 2 DO '*** First of all find the Prime Numbers *** Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 '*** Now we've got a Prime, calculate the Mersenne Prime *** IF Prime = 0 THEN MersTest = (2 ^ TestNum) - 1 '*** Now test if MersTest is a Prime *** MersPrime = 0 MersDiv = 3 DO IF MersTest > 2147483647 THEN PRINT PRINT PRINT "Routine aborted, MOD can't cope with big numbers !!!" MersPrime = 1 Count = UserNum EXIT DO END IF IF MersTest MOD MersDiv = 0 THEN MersPrime = 1 MersDiv = MersDiv + 2 IF MersDiv > SQR(MersTest) THEN EXIT DO LOOP UNTIL MersPrime = 1 IF MersPrime = 0 THEN Perf = (2 ^ (TestNum - 1)) * MersTest Count = Count + 1 IF Perf >= UserNum THEN EXIT DO IF Perf < UserNum THEN OldNum = Perf END IF END IF LOOP UNTIL MersPrime = 0 AND Perf >= UserNum IF Perf = UserNum THEN PRINT UserNum; "is a Perfect number" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a Perfect number" PRINT PRINT "The next smallest number is"; OldNum; "the next Perfect number is"; Perf END IF END IF END SUB SUB Primes '*** Prime Numbers *** DIM TestNum AS LONG 'TestNum the number being tested DIM Prime AS INTEGER 'Switch to indicate a prime during testing DIM Divisor AS LONG 'Holds divisors Divisor = 2 Count = 2 CLS PRINT PRINT "PRIME NUMBERS" PRINT PRINT "Prime numbers are those that are only divisible by themselves or 1" PRINT PRINT "The program can calculate the primes up to 1 million in around 90 seconds" PRINT IF UserIn$ = "A" THEN '*** First n of the series *** PRINT "Here are the first"; UserNum; "Prime numbers." PRINT PRINT 2; 3; '*** I can't find a way of calculating these *** TestNum = 3 Count = 2 DO Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 IF Prime = 0 THEN PRINT TestNum; Count = Count + 1 END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Count = UserNum END IF IF UserIn$ = "B" THEN '*** Prime numbers up to and including a number *** PRINT "Here are the Prime numbers up to or equal to"; UserNum PRINT PRINT 2; 3; '*** I can't find a way of calculating these *** TestNum = 3 Count = 2 DO Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 IF Prime = 0 THEN IF TestNum > UserNum THEN EXIT DO PRINT TestNum; Count = Count + 1 END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL TestNum >= UserNum PRINT PRINT PRINT "There are"; Count; "Prime numbers smaller or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number is part of the series? *** TestNum = 3 Count = 2 DO Prime = 0 Divisor = 3 TestNum = TestNum + 2 DO IF TestNum MOD Divisor = 0 THEN Prime = 1 Divisor = Divisor + 2 IF Divisor > SQR(TestNum) THEN EXIT DO LOOP UNTIL Prime = 1 IF Prime = 0 THEN Count = Count + 1 IF TestNum >= UserNum THEN EXIT DO IF TestNum < UserNum THEN OldNum = TestNum END IF LOOP UNTIL Prime = 0 AND TestNum >= UserNum IF TestNum = UserNum THEN PRINT UserNum; "is a Prime number" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a Prime number" PRINT PRINT "The next smallest number is"; OldNum; "the next Prime number is"; TestNum END IF END IF END SUB SUB QSort (SortArray() AS LONG, Low AS INTEGER, High AS DOUBLE) DIM Lower AS INTEGER DIM Higher AS INTEGER DIM RandIndex AS INTEGER DIM Partition AS DOUBLE 'QuickSort works by picking a random "pivot" element in SortArray, then 'moving every element that is bigger to one side of the pivot, and every 'element that is smaller to the other side. QuickSort is then called 'recursively with the two subdivisions created by the pivot. Once the 'number of elements in a subdivision reaches two, the recursive calls end 'and the array is sorted. IF Low < High THEN ' *** Only two elements in this subdivision *** ' *** Swap them if they are out of order, then end recursive calls: *** IF High - Low = 1 THEN IF SortArray(Low) > SortArray(High) THEN SWAP SortArray(Low), SortArray(High) END IF ELSE '*** Pick a pivot element at random, then move it to the end *** RandIndex = INT(RND * (High - Low + 1)) + Low SWAP SortArray(High), SortArray(RandIndex) Partition = SortArray(High) DO '*** Move in from both sides towards the pivot element *** Lower = Low Higher = High DO WHILE (Lower < Higher) AND (SortArray(Lower) <= Partition) Lower = Lower + 1 LOOP DO WHILE (Higher > Lower) AND (SortArray(Higher) >= Partition) Higher = Higher - 1 LOOP '*** If pivot element not reached, it means that *** '*** two elements on either side are out of order, *** '*** so swap them *** IF Lower < Higher THEN SWAP SortArray(Lower), SortArray(Higher) END IF LOOP WHILE Lower < Higher '*** Move the pivot element back to its proper place in the array *** SWAP SortArray(Lower), SortArray(High) '*** Recursively call the SortArray sub *** '*** Pass the smaller subdivision first to use less stack space *** IF (Lower - Low) < (High - Lower) THEN QSort SortArray(), Low, Lower - 1 QSort SortArray(), Lower + 1, High ELSE QSort SortArray(), Lower + 1, High QSort SortArray(), Low, Lower - 1 END IF END IF END IF END SUB SUB Square '*** Square numbers *** DIM SqrNum AS LONG 'Square number CLS PRINT PRINT "SQUARE NUMBERS" PRINT PRINT "Square numbers are those whose square roots are an interger " PRINT IF UserIn$ = "A" THEN '*** First n of the series *** PRINT "These are the first"; UserNum; "square numbers." PRINT SqrNum = 0 FOR Count = 1 TO UserNum SqrNum = SqrNum + 1 PRINT SqrNum * SqrNum; IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count END IF IF UserIn$ = "B" THEN '*** Square numbers up to a number *** PRINT "These are the Square Numbers smaller or equal to"; UserNum PRINT SqrNum = 0 Count = 0 DO SqrNum = SqrNum + 1 IF SqrNum * SqrNum > UserNum THEN EXIT DO PRINT SqrNum * SqrNum; Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL SqrNum * SqrNum >= UserNum PRINT PRINT PRINT "There are"; Count; "Square Numbers smaller or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** Number is a square number? *** SqrNum = 0 Count = 0 DO OldNum = SqrNum * SqrNum SqrNum = SqrNum + 1 IF SqrNum * SqrNum > UserNum THEN EXIT DO Count = Count + 1 LOOP UNTIL SqrNum * SqrNum >= UserNum IF SqrNum * SqrNum = UserNum THEN PRINT UserNum; "is a square number" PRINT PRINT "It is"; Count; "in the series" ELSE PRINT UserNum; "is not a square number" PRINT PRINT "The next smallest number is"; OldNum; "the next square number is"; SqrNum * SqrNum END IF END IF END SUB SUB Triang '*** Triangular numbers *** DIM Tri AS LONG 'The triangular number CLS PRINT PRINT "TRINGULAR NUMBERS" PRINT PRINT "Triangular numbers are a type of arithmetic progression" PRINT IF UserIn$ = "A" THEN '*** First n of the series *** PRINT "These are the first"; UserNum; "triangular numbers." PRINT Tri = 0 FOR Count = 1 TO UserNum Tri = Tri + Count PRINT Tri; IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count END IF IF UserIn$ = "B" THEN '*** Triangular numbers smaller or equal to UserNum *** PRINT "These are triangular numbers smaller or equal to"; UserNum PRINT Tri = 0 Count = 1 DO Tri = Tri + Count IF Tri > UserNum THEN EXIT DO PRINT Tri; Count = Count + 1 IF CSRLIN > 19 THEN Continue CLS PRINT END IF LOOP UNTIL Tri >= UserNum PRINT PRINT PRINT "There are"; Count - 1; "triangular numbers smaller or equal to"; UserNum END IF IF UserIn$ = "C" THEN '*** UserNum is a triangular number? *** Tri = 0 Count = 1 DO OldNum = Tri Tri = Tri + Count IF Tri > UserNum THEN EXIT DO Count = Count + 1 LOOP UNTIL Tri >= UserNum IF Tri = UserNum THEN PRINT UserNum; "is a triangular number" PRINT PRINT "It is"; Count - 1; "in the series" ELSE PRINT UserNum; "is not a triangular number" PRINT PRINT "The next smallest number is"; OldNum; "the next triangular number is"; Tri END IF END IF END SUB SUB Vampire DIM VampAry(10000) AS LONG 'Aray to hold Vampire numbers for sorting DIM VampTest AS DOUBLE 'Number to test DIM VampStr AS STRING 'String to hold VampTest DIM VampCnt AS DOUBLE 'Number of vampire numbers produced DIM Div1 AS LONG 'First divisor DIM Div2 AS LONG 'Second divisor DIM VampFnd AS INTEGER 'Vampire number found DIM DivStr AS STRING 'String to hold Div1 and Div2 DIM Div1Str AS STRING 'String to hold Div1 DIM Div2Str AS STRING 'String to hold Div2 DIM DivChar AS STRING * 1 'String to hold individual characters from DivStr$ DIM DivFnd AS INTEGER 'Character position of DivChar$ in VampStr$ DIM Div1Strt AS LONG 'Start number for Div1 DIM Div2Strt AS LONG 'Start number for Div2 DIM UniqVamp AS INTEGER 'Unique Vampire numbers produced DIM LastVamp AS LONG 'The last found Vampire number CLS PRINT PRINT "VAMPIRE NUMBERS" PRINT PRINT "Vampire numbers are numbers with an even number of digits. When mixed and" PRINT "each pair of numbers when multiplied together give the vampire number." PRINT PRINT "The results are only accurate until the next step in the number of digits" PRINT "in the Vampire number is reached." PRINT IF UserIn$ = "A" THEN '*** First n of a series *** PRINT "These are the first"; UserNum; "CALCULATED Vampire numbers." PRINT Div1 = 33 VampFnd = 0 Div1Strt = 33 Div2Strt = 10 VampCnt = 0 UniqVamp = 0 DO '*** Div1 does not have to start from 10, 100, 1000 etc. *** '*** It needs to start at 33, 333, 3333 etc. *** '*** Ensure that Div1 and Div2 are of equal length *** '*** If Div1 = 333, Div2 = 100, if Div1 = 3333, Div2 = 1000 etc. *** IF LEN(LTRIM$(STR$(Div1))) > LEN(LTRIM$(STR$(Div1Strt))) THEN Div1Strt = (Div1Strt * 10) + 3 Div1 = Div1Strt Div2Strt = Div2Strt * 10 END IF Div2 = Div2Strt DO VampFnd = 0 VampTest = Div1 * Div2 '*** Test VampTest for being a Vampire Number *** VampStr$ = LTRIM$(STR$(VampTest)) IF Div1 MOD 10 = 0 AND Div2 MOD 10 = 0 THEN VampFnd = 1 IF LEN(VampStr$) MOD 2 <> 0 THEN VampFnd = 1 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) = "X" ELSE VampFnd = 1 END IF NEXT Count '*** If VampFnd = 0 then VampTest is a Vampire Number *** IF VampFnd = 0 THEN VampCnt = VampCnt + 1 VampAry(VampCnt) = VampTest END IF Div2 = Div2 + 1 LOOP UNTIL Div2 > Div1 Div1 = Div1 + 1 LOOP UNTIL VampCnt >= UserNum '*** The Vampire numbers produced need to be sorted *** '*** and the duplicates discarded *** QSort VampAry(), 1, VampCnt FOR Count = 1 TO VampCnt IF VampAry(Count + 1) <> VampAry(Count) THEN PRINT VampAry(Count); UniqVamp = UniqVamp + 1 END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count PRINT PRINT PRINT "The sequence contains"; UniqVamp; "Vampire numbers." PRINT "There were"; VampCnt - UniqVamp; "discarded duplicates." END IF IF UserIn$ = "B" THEN '*** Calculated numbers up to and including UserNum *** PRINT "Here are the CALCULATED Vampire numbers up to or equal to"; UserNum PRINT Div1 = 33 VampFnd = 0 Div1Strt = 33 Div2Strt = 10 UniqVamp = 0 VampCnt = 0 DO '*** Div1 does not have to start from 10, 100, 1000 etc. *** '*** It needs to start at 33, 333, 3333 etc. *** '*** Ensure that Div1 and Div2 are of equal length *** '*** If Div1 = 333, Div2 = 100, if Div1 = 3333, Div2 = 1000 etc. *** IF LEN(LTRIM$(STR$(Div1))) > LEN(LTRIM$(STR$(Div1Strt))) THEN Div1Strt = (Div1Strt * 10) + 3 Div1 = Div1Strt Div2Strt = Div2Strt * 10 END IF Div2 = Div2Strt DO VampFnd = 0 VampTest = Div1 * Div2 '*** Test VampTest for being a Vampire Number *** VampStr$ = LTRIM$(STR$(VampTest)) IF Div1 MOD 10 = 0 AND Div2 MOD 10 = 0 THEN VampFnd = 1 IF LEN(VampStr$) MOD 2 <> 0 THEN VampFnd = 1 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) = "X" ELSE VampFnd = 1 END IF NEXT Count '*** If VampFnd = 0 then VampTest is a Vampire Number *** IF VampFnd = 0 THEN VampCnt = VampCnt + 1 VampAry(VampCnt) = VampTest END IF Div2 = Div2 + 1 LOOP UNTIL Div2 > Div1 Div1 = Div1 + 1 LOOP UNTIL VampTest >= UserNum '*** The Vampire numbers produced need to be sorted *** '*** and the duplicates discarded *** QSort VampAry(), 1, VampCnt FOR Count = 1 TO VampCnt IF VampAry(Count + 1) <> VampAry(Count) THEN PRINT VampAry(Count); UniqVamp = UniqVamp + 1 END IF IF CSRLIN > 19 THEN Continue CLS PRINT END IF NEXT Count PRINT PRINT PRINT "There are"; UniqVamp; "CALCULATED Vampire numbers smaller or equal to"; UserNum PRINT "There were"; VampCnt - UniqVamp; "discarded duplicates." END IF IF UserIn$ = "C" THEN '*** Number is part of the series? *** Div1 = 33 VampFnd = 0 Div1Strt = 33 Div2Strt = 10 DO '*** Div1 does not have to start from 10, 100, 1000 etc. *** '*** It needs to start at 33, 333, 3333 etc. *** '*** Ensure that Div1 and Div2 are of equal length *** '*** If Div1 = 333, Div2 = 100, if Div1 = 3333, Div2 = 1000 etc. *** IF LEN(LTRIM$(STR$(Div1))) > LEN(LTRIM$(STR$(Div1Strt))) THEN Div1Strt = (Div1Strt * 10) + 3 Div1 = Div1Strt Div2Strt = Div2Strt * 10 END IF Div2 = Div2Strt DO VampFnd = 0 VampTest = Div1 * Div2 '*** Test VampTest for being a Vampire Number *** VampStr$ = LTRIM$(STR$(VampTest)) IF Div1 MOD 10 = 0 AND Div2 MOD 10 = 0 THEN VampFnd = 1 IF LEN(VampStr$) MOD 2 <> 0 THEN VampFnd = 1 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) = "X" ELSE VampFnd = 1 END IF NEXT Count '*** If VampFnd = 0 then VampTest is a Vampire Number *** IF VampFnd = 0 THEN VampCnt = VampCnt + 1 VampAry(VampCnt) = VampTest LastVamp = VampTest END IF Div2 = Div2 + 1 LOOP UNTIL Div2 > Div1 Div1 = Div1 + 1 LOOP UNTIL LastVamp > UserNum '*** The Vampire numbers produced need to be sorted *** '*** and the duplicates discarded *** QSort VampAry(), 1, VampCnt Count = 0 DO Count = Count + 1 IF VampAry(Count + 1) <> VampAry(Count) THEN UniqVamp = UniqVamp + 1 LOOP UNTIL VampAry(Count) >= UserNum IF VampAry(Count) = UserNum THEN PRINT VampAry(Count); "is a Vampire Number," PRINT PRINT "it is"; Count - (UniqVamp - Count); "in the CALCULATED series" ELSE PRINT UserNum; "is not a CALCULATED Vampire number," PRINT IF Count > 1 THEN PRINT "the next smallest CALCULATED number is"; VampAry(Count - 1); PRINT END IF PRINT "the next largest CALCULATED Vampire number is"; VampAry(Count) END IF END IF END SUB

The programs on this page, like all the programs written for this site, can be downloaded from the DLoad page.

QBasic | Errors | 40lb Weight | Bits | Chance | Colours | Dates | Delays | File Dialog | Files | Input | Matching | Menus | Mouse | Numbers | SeqNo | SIRDS | Sorts | Text | Timer | DLoads

HomePage | Optical Illusions | War Stories | QBasic | Dads Navy Days | Bristol | Bristol, USA | Bristol, Canada | Terre Haute | Miscellany | Web Stuff | About Ray | Site Map | Site Search | Messages | Credits | Links | Web Rings