LB Booster
Programming >> Compatibility with LB4 >> Fun Code
http://lbb.conforums.com/index.cgi?board=compatibility&action=display&num=1460392229
Fun Code
Post by Jack Kelly on Apr 11th, 2016, 4:30pm

Richard,

The following is a distillation of the code posted on the LB forum by Malraud, under the heading "Fun Code". It generates the correct output under JB and presumably LB45. However it doesn't work correctly in LBB. I have spend a few hours unsuccessfully trying to figure out why. Is this something that needs to be investigated?

Jack

Code:
[start]
input "Number: "; n
n=int(abs(n))
if n=0 then print "Program Complete.": end
if n>=4000 then n=3999
print "Roman numeral: "; romain$(n)
goto [start]

function romain$(nomb)
    for i = 1 to len(str$(nomb))
        w=val(mid$(str$(nomb), i, 1))
        x=w mod 5
        y=(w>=5)
        z=len(str$(nomb))-i+1
        u=(x=4)
        v=(x<>4)
        romain$ = romain$ + _
            trim$(chr$(asc((mid$(word$("VX LC DM", z, " "), y+u, 1)))*v) + _
            (mid$(word$("III XXX CCC MMM", z, " "), 1, x^v)) + _
            chr$(asc((mid$(word$("VX LC DM", z, " "), y+u, 1)))*u))
    next i
end function
Re: Fun Code
Post by tsh73 on Apr 11th, 2016, 5:37pm

Quote:
It generates the correct output under JB and presumably LB45. However it doesn't work correctly in LBB.

Please post numbers there it differ.
Re: Fun Code
Post by Richard Russell on Apr 11th, 2016, 6:56pm

on Apr 11th, 2016, 4:30pm, Jack Kelly wrote:
However it doesn't work correctly in LBB.

In fact it does work correctly - I'm afraid it's another case of RTFM! All that is required to make it work is to select 'Emulate Slicing' in the LBB Options menu.

I would refer you to the following comment in the LBB Help documentation: "The Emulate Slicing command alternately enables and disables the full emulation of Liberty BASIC's LEFT$, MID$ and RIGHT$ functions when the length parameter is negative. In that case LB4 returns an empty string. Since emulating the negative-length case significantly slows execution of the functions, and since very few programs rely on this behaviour, it is not enabled by default".

http://www.lbbooster.com/lbb.html#slicing

Richard.
Re: Fun Code
Post by Jack Kelly on Apr 11th, 2016, 8:32pm

'Emulate Slicing' -- who would have thought! I still learn something new every day...
Re: Fun Code
Post by Richard Russell on Apr 11th, 2016, 9:23pm

on Apr 11th, 2016, 8:32pm, Jack Kelly wrote:
'Emulate Slicing' -- who would have thought!

The official Liberty BASIC documentation is ambiguous about what happens if you pass a negative value as the 'length' parameter to one of the string slicing functions. In the case of LEFT$() it is explicit: "If number is zero or less, then "" (an empty string) will be returned". But with MID$() and RIGHT$() it is silent about what happens in the 'negative length' case.

I don't think most programmers would choose to rely on it. Ideally one should code 'conservatively' and never pass a negative value as the length parameter. In that case LBB will work the same as LB without needing to invoke the option.

But when writing obfuscated or highly abbreviated code it may be possible to take advantage of LB's specific behaviour, which is the case for the Roman Numeral code. So then one has to enable the extra compatibility layer in LBB.

Richard.
Re: Fun Code
Post by Richard Russell on Apr 11th, 2016, 10:21pm

Anyway, there's no need to use such convoluted code to convert a number in the range 1 to 3999 to Roman numerals. The function below does it a lot more elegantly (in my opinion):

Code:
    do
      input "Number : "; n
      if n < 1 or n >= 4000 then end
      print "Roman numeral : "; Roman$(n)
    loop until 0

function Roman$(n)
    Roman$ = word$("M MM MMM",int(n/1000)); _
             word$("C CC CCC CD D DC DCC DCCC CM",int((n mod 1000)/100)); _
             word$("X XX XXX XL L LX LXX LXXX XC",int((n mod 100)/10)); _
             word$("I II III IV V VI VII VIII IX",n mod 10)
end function

Richard.
Re: Fun Code
Post by Jack Kelly on Apr 12th, 2016, 12:29pm

Beautiful, Richard. That's a keeper! It's going into my Library File.
Re: Fun Code
Post by tsh73 on Apr 12th, 2016, 6:25pm

Quote:
there's no need to use such convoluted code

It was not need. It was fun. wink
Re: Fun Code
Post by Optimax on Apr 24th, 2016, 1:42pm

Bonjour,

I wrote something about roman to decimal numbers a long time ago, and I adapted it for LBB 3.04. This code is not as smart as the code with word$, but seems to work with very elementary insructions, which are not fundamentally different. Here comes the most elementary code. Errors warnings are gratefully accepted.

Code:
INPUT "Roman number ? "; R$
R$ = UPPER$(R$)
PRINT R$
D = 0

FOR i = 1 TO 13
	READ Rom$, Dec
	DO
		IF LEFT$(R$, LEN(Rom$)) = Rom$ THEN
			D = D + Dec
			R$ = MID$(R$, LEN(Rom$)+1)
		ELSE
			EXIT DO
		END IF
	LOOP
NEXT i

PRINT D

END

DATA "M", 1000, "CM", 900, "CD", 400, "D", 500, "XC", 90, "C", 100, "XL", 40, "L", 50, "X", 10, "IX", 9, "IV", 4, "V", 5, "I", 1


I wrote the same thing with some GUI, roman to decimal, and back:

Code:
' ROMAN-DECIMAL.BAS             LBB 3.04		
' ===================

'conversion from roman numbers to decimal numbers, and back
'positive integers only, max 9999 or "MMMMMMMMMCMXCIX"
'seems enough for quite a while

NOMAINWIN

'--- setting the controls

RadioButton #w.radio1, "ROMAN => DECIMAL", [EnterRomanNumber], , 20, 50, 150, 20
    StyleBits #w.radio1, _WS_BORDER, 0,0,0

TextBox #w.ROMAN, 180, 50, 160, 25
    StyleBits #w.ROMAN, _ES_UPPERCASE, 0, 0, 0

RadioButton #w.radio2, "DECIMAL => ROMAN", [EnterDecimalNumber], , 20, 100, 150, 20
    StyleBits #w.radio2, _WS_BORDER, 0,0,0

TextBox #w.DECIMAL, 180, 100, 160, 25
    StyleBits #w.DECIMAL, _ES_NUMBER, 0, 0, 0

Button #w.RAZ, "RESET", [Reset], UL, 50, 180, 50, 50
    StyleBits #w.RESET, _WS_DLGFRAME, 0, 0, 0

Button #w.Default, "CALC", [Toggle], UL, 155, 180, 50, 50
    StyleBits #w.Default, _WS_DLGFRAME, 0, 0, 0

Button #w.Quit, "QUIT", [EndProgram], UL, 260, 180, 50, 50
    StyleBits #w.Quit, _WS_DLGFRAME, 0, 0, 0

'--- opening the window

UpperLeftX = 100: UpperLeftY = 150: WindowHeight = 300: WindowWidth = 370

OPEN "ROMAN 2 DECIMAL  &  DECIMAL 2 ROMAN" FOR DIALOG AS #w
PRINT #w "Font Arial 10"
PRINT #w "TrapClose  [EndProgram]"

PRINT #w.radio1, "set"
PRINT #w.ROMAN, "!enable"
PRINT #w.ROMAN, "!setfocus"

WAIT

'--- and now the subroutines

[EnterRomanNumber]

D = 0
R$ = ""
PRINT #w.DECIMAL, ""
PRINT #w.DECIMAL, "!disable"          'avoiding unwanted input
PRINT #w.radio1, "set"
PRINT #w.ROMAN, "!enable"
PRINT #w.ROMAN, ""
PRINT #w.ROMAN, "!setfocus"

WAIT

[EnterDecimalNumber]

D = 0
R$ = ""
PRINT #w.ROMAN, ""
PRINT #w.ROMAN, "!disable"          	'avoiding unwanted input
PRINT #w.DECIMAL, "!enable"
PRINT #w.DECIMAL, "!setfocus"
PRINT #w.DECIMAL, ""

WAIT

[Toggle]

PRINT #w.ROMAN, "!contents? R$";
IF R$ <> "" THEN GOTO [Rom2Dec]
PRINT #w.DECIMAL, "!contents? D$";
IF D$ <> "" THEN GOTO [Dec2Rom]

WAIT

''' --------------------------- ROMAN TO DECIMAL -----------------

[Rom2Dec]

RESTORE [RomanData]
D = 0

FOR i = 1 TO 13
	READ Rom$, Dec
	DO
		IF LEFT$(R$, LEN(Rom$)) = Rom$ THEN
			D = D + Dec
			R$ = MID$(R$, LEN(Rom$)+1)
		ELSE
			EXIT DO
		END IF
	LOOP
NEXT i

IF R$ <> "" THEN
     NOTICE "Error" + CHR$(13) + "Wrong Roman Number"
ELSE
     PRINT #w.DECIMAL, "!enable"
     PRINT #w.DECIMAL, STR$(D)
END IF

WAIT

''' -------------------- DECIMAL TO ROMAN ------------

[Dec2Rom]

R$ = ""
D = VAL(D$)

RESTORE [DecimalData]

FOR i = 1 TO 13
	IF D = 0 THEN EXIT FOR
	READ Rom$, Dec
	DO
		IF D >= Dec  THEN
			R$ = R$ + Rom$
			D = D - Dec
		ELSE
			EXIT DO
		END IF
	LOOP
NEXT i

PRINT #w.ROMAN, "!enable"
PRINT #w.ROMAN, R$

WAIT

[Reset]

PRINT #w.radio2, "reset"
PRINT #w.radio1, "set"
PRINT #w.DECIMAL,  ""
PRINT #w.ROMAN, "!enable"
PRINT #w.ROMAN, ""
PRINT #w.ROMAN, "!setfocus"
R$ = ""
D = 0

WAIT

[EndProgram]

CLOSE #w
END

[RomanData]
DATA "M", 1000, "CM", 900, "CD", 400, "D", 500, "XC", 90, "C", 100, "XL", 40, "L", 50, "X", 10, "IX", 9, "IV", 4, "V", 5, "I", 1

[DecimalData]
DATA "M", 1000, "CM", 900, "D", 500, "CD", 400,  "C", 100, "XC", 90,  "L", 50, "XL", 40, "X", 10, "IX", 9, "V", 5, "IV", 4, "I", 1

Re: Fun Code
Post by Richard Russell on Apr 24th, 2016, 3:53pm

on Apr 24th, 2016, 1:42pm, Optimax wrote:
I wrote the same thing with some GUI, roman to decimal, and back

I'm pleased to see that it accepts the alternative forms of 4 (IV or IIII) and 9 (IX or VIIII). You will commonly see IIII used on clock faces, although Big Ben is an exception.

Some of the less common variations (e.g. MDCDIII for 1903) are, unsurprisingly, not accepted. The Wikipedia article discusses these.

It would be an interesting challenge to write a Roman-to-Decimal converter which would accept all reasonable alternatives.

Richard.
Re: Fun Code
Post by Optimax on Apr 25th, 2016, 06:37am

I've read that article with great interest, thanks for the reference.

Well, I could add in the DATA (at the right place), MDCD = 1900, and IIX = 8 ("the subtractive").

MDCCCC = 1900 (for editors), XXXXXX = 60, IIIII = 5, ..., are already accepted.

Works now also with MDCDIII =1903, or CXIIX =118, with the "subtractive" IIX = 8.

Code:
INPUT "Roman number ? "; R$
R$ = UPPER$(R$)
PRINT R$
D = 0

FOR i = 1 TO 15
	READ Rom$, Dec
	DO
		IF LEFT$(R$, LEN(Rom$)) = Rom$ THEN
			D = D + Dec
			R$ = MID$(R$, LEN(Rom$)+1)
		ELSE
			EXIT DO
		END IF
	LOOP
NEXT i

PRINT D

END

DATA "MDCD", 1900,"M", 1000, "CM", 900, "CD", 400, "D", 500, "XC", 90, "C", 100, "XL", 40, "L", 50,  "X", 10, "IIX", 8, "IX", 9, "IV", 4, "V", 5, "I", 1