Clipper - My Completed RATECRYPT() function included below

Author

My Completed RATECRYPT() function included below

Mel Smith

2006-08-17, 6:55 pm

Dear Friends,

Here is the 'final' version of my Hourly Rate 'obscurer' (Encryption)
function

Feel free to use it for your own purposes. If you find a fault, I'd
like to know about it.

btw, I have sacrificed elegance with clarity (elegance and speed was
never in my 'toolbox')

(I'll be making similar functions for Social Insurance Numbers, and
Birth Dates as my client directs.)

-Mel Smith

-------------------- Clip
here -------------------------------------------------
FUNCTION RATECRYPT(cCRYPT,nRATE,cEMPNUM)
// Author: Mel Smith, Aug 17, 2006
// With Lots of Help from the Guys on the c.l.g newsgroup

/*
My wish with this function is to create an encrypted rate which will
'fit' in the same field as the actual rate, but will have a value
that will be obvious (to my function) as either encrypted (or actual).

Thus, this function allows the programmer to 'obscure' an employee's
hourly
Rate from casual viewing (using database viewing software) by his peers.

The technique uses a pseudo Random Number generator copied/modified
from NanForum's rand1.prg

The mods include using the '%' operator (instead of the MOD() function),
and including an organization's own code (nORGCODE) to differentiate
it from other orgs who would also use this function.

I also have to deal with variously-structured 'Employee Numbers' which
require some extra coding below. *My* Employee numbers are (for now)
either, for example, 'R1234' or '59028'. So I have to use either
*all* digits or the right-most 4 digits.

*/

#define nB 31415621 // Good old 'PI' is used here
#define nM 100000000 // The widest possible range of values
#define nMIN 60000 // Minimum returned value from encryption
#define nMAX 99999 // Maximum returned value from encryption
#define nMININC 1000 // To 'boost' the nCODEBASE to within limits
#define nORGCODE 1234 // Choose Your own private org's code here --
NEVER CHANGE !
#define nMINLENEMP 5 // Minimum input allowable length of employee
number
#define nMINCODERATE 400 // Any value > nMINCODERATE is already encrypted

LOCAL I,nSEED,nEMPVAL,nCODEBASE,nCODERATE,cDIG
STR,nDECRYPRATE

GABORT := .T. // Global 'Abort' indicator for Calling routine
// Assume failure at the outset

IF EMPTY(nRATE) // I won't encrypt a 'zero' Rate
RETURN nRATE
ENDIF

cEMPNUM := ALLTRIM(cEMPNUM)
IF EMPTY(cEMPNUM) .OR. LEN(cEMPNUM) < nMINLENEMP // Faulty Employee Number
RETURN nRATE
ENDIF

// Try to use *both* the n-digit Employee Numbers and also
// the letter + (n-1)-digit Employee Numbers used by other related orgs.

IF ISDIGIT(cEMPNUM) // THEN WE CAN USE ALL n DIGITS
nEMPVAL := VAL(cEMPNUM)
ELSE // ELSE ONLY USE THE RIGHT-MOST n-1 DIGITS
IF .NOT. ISDIGIT(cDIGSTR:=SUBSTR(cEMPNUM,2,10)) // THEN WE HAVE A
NON-CONFORMING EMPNUM
RETURN nRATE
ENDIF
nEMPVAL := VAL(cDIGSTR)
ENDIF
// Now we have a proper Employee 'Number' to work with as part of our seed

cCRYPT := ALLTRIM(UPPER(cCRYPT))

IF cCRYPT == "E" // Means to 'E'ncrypt
IF nRATE > nMINCODERATE // Already encrypted
RETURN nRATE // It is 'already' encrypted -- a Programming Fault
:((
ENDIF

// Now Modify the 'Seed' for your own organization's purposes

nSEED := nEMPVAL + nORGCODE // The seed is different for each
different E
// Employee Number (+ the Org's own
code)

// This next line is from the NanForum 'Rand1.prg' module and
// authors Gary Baren and 'Glenn'
nCODEBASE := nMAX * (( (nSEED * nB + 1) % nM ) / nM)

// Now bring the nCODERATE within your org's limits
DO WHILE nCODEBASE < nMIN
nCODEBASE += nMININC
ENDDO

// I use this 'new' rounding routine provided by Fleming Ho in 1994
// (Substitute your 'own' rounding function in the next line)
nCODEBASE := NUROUND(nCODEBASE*.01,2) // Result 500.00 thru 999.99

nCODERATE := nCODEBASE - nRATE // and establish the Coded Rate

GABORT := .F. // Signal globally that this encryption worked.
RETURN nCODERATE // and Return this Coded Rate

ELSEIF cCRYPT="D" // MEANS 'D'ecrypt
IF nRATE <= nMINCODERATE // Already encrypted
RETURN nRATE // It is 'already' encrypted -- a Programming Fault
:((
ENDIF

// Now Modify the 'Seed' for your own organization's purposes

nSEED := nEMPVAL + nORGCODE // The seed is different for each
different E
// Employee Number (+ the Org's own
code)

// This next line is from the NanForum 'Rand1.prg' module and
// authors Gary Baren and 'Glenn'
nCODEBASE := nMAX * (( (nSEED * nB + 1) % nM ) / nM)

// Now bring the nCODERATE within your org's limits
DO WHILE nCODEBASE < nMIN
nCODEBASE += nMININC
ENDDO

// I use this 'new' rounding routine provided by Fleming Ho in 1994
// (Substitute your 'own' rounding function in the next line)
nCODEBASE := NUROUND(nCODEBASE*.01,2) // Result 500.00 thru 999.99

nDECRYPRATE := ABS(nRATE - nCODEBASE) // and establish the
Coded Rate

GABORT := .F. // Signal globally that this encryption worked.
RETURN nDECRYPRATE // and Return this Coded Rate

ENDIF
RETURN nRATE // Should Never Get Here -- Remove later

bill robertson

2006-08-17, 6:55 pm

Mel Smith wrote:
> Dear Friends,
>
>
> Here is the 'final' version of my Hourly Rate 'obscurer' (Encryption)
> function

Hi Mel

What is "I use this 'new' rounding routine provided by Fleming Ho in
1994". Just curious, thanks.

Mel Smith

2006-08-17, 9:55 pm

Bill said:

> What is "I use this 'new' rounding routine provided by Fleming Ho in
> 1994". Just curious, thanks.

Bill:

Here is what I've been using for *years* since early problems with
Clipper's older round() function:

** THIS IS A ROUNDING FUNCTION PROVIDED BY DELCOM INTERNATIONAL
** IN THEIR SUMMER 1994 CATALOGUE

FUNCTION NUROUND(NNUM,NDEC)
// AUTHOR: FLEMING HO

LOCAL NRET,CRET
NRET := NNUM + (5 * (10 ^ -(NDEC + 1)))
CRET := STR(NRET,LEN(STR(NRET)),NDEC+1)
CRET := LEFT(CRET,LEN(CRET)-1)
NRET := VAL(CRET)
RETURN NRET

bill robertson

2006-08-18, 3:55 am

Mel Smith wrote:
> Bill:
>
> Here is what I've been using for *years* since early problems with
> Clipper's older round() function:
>
> ** THIS IS A ROUNDING FUNCTION PROVIDED BY DELCOM INTERNATIONAL
> ** IN THEIR SUMMER 1994 CATALOGUE

Thanks for the routine Mel. I was interested because most rounding
functions do not round in an unbiased manner. This is not necessarily
bad; there are many rounding standards and you have to use different
standards for different applications.

If you look at a common rounding method it always rounds up so that
1.345 & 1.355 round to 1.35 and 1.36. This is a biased estimator because
it rounds up on 5 digits (5-9) and down on 4 digits (1-4). Zero, of
course, requires no rounding just truncation.

Another common method is to round towards zero (for positive numbers). I
love this method when I get to keep all the fractional parts. Rumor has
it that programmers have used this method to skim off small amounts that
can add up with a huge transaction base. The reverse of this is to
always round up. State tax use this method in the US.

An unbiased estimator will round up on 4.5 digits and down on 4.5
digits. A common method is to round toward even so you round down on
even digits and up on odd digits. This method would round the number
1.345 to 1.34 and 1.355 to 1.36. Negative numbers are stripped of their
sign and the sign is replaced after the rounding. Other methods, such as
round toward zero, round toward odd, round toward positive infinity, and
round toward negative infinity come to mind that are also unbiased.

The function by Fleming Ho is a biased estimator. It does give different
answers for negative numbers than Clipper or typical unbiased
estimators. Do you know what particular problem the Fleming Ho algorithm
solved? I have seen various reports of clipper rounding problems but
there are many different rounding methods and clipper chose a common
one. Maybe they used a different method early on but from what I see now
it's one of the most common biased estimators.

Since you seem interested in experimenting, I created a couple of
rounding choices for you to look at. The gaussian method (an unbiased
estimator) gives the same answer you would get using a standard c
compiler and printed with printf(%7.2f,x). It's not efficient or robust
but should be OK for an illustration. I compiled the program with
xHarbour, clipper v5.2 & v5.3 and got the same answers. With Clipper you
will need Clipper Tools or something for the floor() function.

/*----------------------------------------------------*/
Function Main()
LOCAL nValue1:= 1.345, nValue2:= 1.355

Clear screen

@ 5, 5 say "Str()"
@ 5,20 say "Fleming"
@ 5,35 say "Round()"
@ 5,50 say "Gaussian"

@ 6, 5 say Val( Str( nValue1, 6, 2 ) ) Picture "##.##"
@ 7, 5 say Val( Str( nValue2, 6, 2 ) ) Picture "##.##"
@ 8, 5 say Val( Str(-nValue1, 6, 2 ) ) Picture "##.##"
@ 9, 5 say Val( Str(-nValue2, 6, 2 ) ) Picture "##.##"

@ 6,20 say nuround( nValue1, 2 ) Picture "##.##"
@ 7,20 say nuround( nValue2, 2 ) Picture "##.##"
@ 8,20 say nuround(-nValue1, 2 ) Picture "##.##"
@ 9,20 say nuround(-nValue2, 2 ) Picture "##.##"

@ 6,35 say Round( nValue1, 2 ) Picture "##.##"
@ 7,35 say Round( nValue2, 2 ) Picture "##.##"
@ 8,35 say Round(-nValue1, 2 ) Picture "##.##"
@ 9,35 say round(-nValue2, 2 ) Picture "##.##"

@ 6,50 say gaussian( nValue1, 2 ) Picture "##.##"
@ 7,50 say gaussian( nValue2, 2 ) Picture "##.##"
@ 8,50 say gaussian(-nValue1, 2 ) Picture "##.##"
@ 9,50 say gaussian(-nValue2, 2 ) Picture "##.##"

Return 0

/* ------------------------------------------------------------
* THIS IS A ROUNDING FUNCTION PROVIDED BY DELCOM INTERNATIONAL
* IN THEIR SUMMER 1994 CATALOGUE by Fleming Ho
*/
Function NUROUND(NNUM,NDEC)
LOCAL NRET,CRET
NRET := NNUM + (5 * (10 ^ -(NDEC + 1)))
CRET := STR(NRET,LEN(STR(NRET)),NDEC+1)
CRET := LEFT(CRET,LEN(CRET)-1)
NRET := VAL(CRET)
RETURN NRET

/* ---------------------------------------------------------------------
* Gaussian rounding is a method of statistically unbiased rounding.
* It ensures against bias when rounding at x.5 by rounding x.5 towards
* the nearest even number. Regular rounding has a built-in upwards
* bias.
*
* function floor() requires Clipper Tools library which is included in
* Harbour or xHarbour
*/
Function gaussian( x, nDec )
LOCAL nAbsX := Abs(x)
LOCAL nSign := If( x < 0, -1, 1 )
LOCAL nFloor:= floor( nAbsX * 10^nDec )

If ( nAbsX*10^nDec - nFloor ) != 0.5
Return Round( nAbsX, nDec) * nSign
END If

If nFloor % 2 == 1
// Closest even is up.
Return Round( nAbsX, nDec ) * nSign
END if

// Closest even is down.
return nFloor/10^nDec * nSign;

Mel Smith

2006-08-18, 7:55 am

Bill:

Your explanation of 'rounding' is interesting, and later I may try some
tests with your rounding evaluator.

I don't know what Fleming HO was 'curing' back in the earlier '90s' but
I just took the code and used it.

Since, in the future, I will be converting my apps to xHarbour, I would
like to ensure that my current 'rounding' technique (i.e., FlemingHo's
method) will be the same in xHarbour, so maybe right now, I should revert to
Clipper's standard Round() function ??

In any case, I've made some 'final' cleanups in my code (most especially
in removing the duplicate code when creating the nCODEBASE value) and will
be posting that tomorrow. Again, I'm golfing at a tournament later today put
on by my client :)))

Thanks for your tips on rounding !

-Mel Smith

Sponsored Links