Author |
Topic: Fun Code (Read 963 times) |
|
Jack Kelly
Full Member
member is offline
 
Gender: 
Posts: 106
|
 |
Fun Code
« Thread started 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
|
|
 Logged
|
|
|
|
tsh73
Full Member
member is offline
Gender:
Posts: 210
|
|
Re: Fun Code
« Reply #1 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.
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: Fun Code
« Reply #2 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.
|
|
|
|
Jack Kelly
Full Member
member is offline
Gender:
Posts: 106
|
|
Re: Fun Code
« Reply #3 on: Apr 11th, 2016, 8:32pm » |
|
'Emulate Slicing' -- who would have thought! I still learn something new every day...
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: Fun Code
« Reply #4 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.
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: Fun Code
« Reply #5 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.
|
|
Logged
|
|
|
|
Jack Kelly
Full Member
member is offline
Gender:
Posts: 106
|
|
Re: Fun Code
« Reply #6 on: Apr 12th, 2016, 12:29pm » |
|
Beautiful, Richard. That's a keeper! It's going into my Library File.
|
|
Logged
|
|
|
|
tsh73
Full Member
member is offline
Gender:
Posts: 210
|
|
Re: Fun Code
« Reply #7 on: Apr 12th, 2016, 6:25pm » |
|
Quote:| there's no need to use such convoluted code |
|
It was not need. It was fun. 
|
|
Logged
|
|
|
|
Optimax
New Member
member is offline
Posts: 11
|
|
Re: Fun Code
« Reply #8 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
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: Fun Code
« Reply #9 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.
|
|
Logged
|
|
|
|
Optimax
New Member
member is offline
Posts: 11
|
|
Re: Fun Code
« Reply #10 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
|
|
Logged
|
|
|
|
|
