RosettaCode

(Topics Related to FBSL)

RosettaCode

Unread postby bugmagnet » Sun Apr 14, 2013 6:47 pm

Okay, have finished the posting on RosettaCode for the Reverse a String challenge.

bugmagnet.
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby Mike Lobanovsky » Mon Apr 15, 2013 1:53 am

Turned out to be rather impressive, didn't it?
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: RosettaCode

Unread postby bugmagnet » Mon Apr 15, 2013 5:52 am

Aye, did tha'

And it was fun to learn about DynC and DynASM in the process.

Bugmagnet.
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby bugmagnet » Mon Apr 15, 2013 6:35 am

Another solution completed at RosettaCode. Palindrome.
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby Mike Lobanovsky » Tue Apr 16, 2013 4:11 am

Hehe,

Very neat! :D

1. Apart from spaces, palindrome phrases can also contain other punctuation delimiters. :P

2. You can declare a For/Next index directly within the loop declaration to spare yourself an extra line:
Code: Select all
For Dim i = 0 To 9
...


3. Why don't you compare Mid% values directly to spare yourself yet another couple of declarations and assignments?
Code: Select all
If Mid%(sTemp,i) <> Mid%(sTemp,nLen-(i-1) Then Return False

and the If/Then one-liner could make the example yet two lines shorter.

I think such amendments might show off FBSL a little better.
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: RosettaCode

Unread postby bugmagnet » Tue Apr 16, 2013 9:21 am

Mike

I've put in code to strip out everything except lowercase letters. I've implemented the other modifications you suggested as well. Does this look like good idiomatic FBSL now?

Code: Select all
FUNCTION IsPalindrome( BYVAL s AS STRING) AS Integer
   dim sTemp as string = LCASE(s)
   dim n as integer = 1
   dim nLen = StrLen(sTemp)
   do
      if n >= nLen then exit do
      if sTemp{n} < "a" OR sTemp{n} > "z" then
         sTemp = StrDel(sTemp,n,1)
         nLen = StrLen(sTemp)
      else
         n = n + 1
      end if
      
   loop
      
   for Dim i = 1 to LEN \ 2 ' only check half of the string, if scanning from both ends
      if mid%(sTemp,i) <> mid%(sTemp,LEN-(i-1)) then return false
   next
   return true
END FUNCTION


Kind regards,
Bugmagnet
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby bugmagnet » Tue Apr 16, 2013 9:45 am

Mike

Belay that last one. Let's try this one. It works better for a start.

Code: Select all
#Option Strict
#AppType Console

FUNCTION IsPalindrome( BYVAL s AS STRING) AS Integer
   dim sTemp as string = LCASE(s)
   dim n as integer = 1
   dim nLen = StrLen(sTemp)
   do
      if n >= nLen then exit do
      if sTemp{n} < "a" OR sTemp{n} > "z" then
         sTemp = StrDel(sTemp,n,1)
         nLen = StrLen(sTemp)
      else
         n = n + 1
      end if
      
   loop
   
   for Dim i = 1 to StrLen(sTemp) \ 2 ' only check half of the string, if scanning from both ends
      if sTemp{i} <> sTemp{StrLen-(i-1)} then return false
   next
   return true
END FUNCTION


print IsPalindrome("a toyota")
print IsPalindrome("madam i'm adam")
print IsPalindrome("the rain in Spain falls mainly on the rooftops")


Kind regards,
Bugmagnet
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby Mike Lobanovsky » Wed Apr 17, 2013 12:14 am

Wow,

You're catching on real fast! :D

Perfect! :D
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: RosettaCode

Unread postby bugmagnet » Tue Apr 23, 2013 3:50 pm

I'm creating another example for RosettaCode, solving Primality by Trial Division

I've implemented the solution by porting both the BASIC and C++ versions.

Below is the code with GetTickCount to figure out which is the fastest. Now I would have thought, seeing as the second one does NOT use SQR() that it would be faster. However the first function consistently works faster than the second. Any clues why?

Kind regards,
Bugmagnet


Code: Select all
#APPTYPE CONSOLE
#OPTION STRICT

FUNCTION ISPRIME( n AS INTEGER ) AS INTEGER
   IF n = 2 THEN
      RETURN true
   ELSEIF n <= 1 OR n MOD 2 = 0 THEN
      RETURN false
   ELSE
      FOR DIM i = 3 TO SQR(n) STEP 2
         IF n MOD i = 0 THEN
            RETURN false
         END IF
      NEXT
      RETURN true
   END IF
END FUNCTION

FUNCTION ISPRIME2( N AS INTEGER) AS INTEGER
   IF N <= 1 THEN RETURN FALSE
   DIM I AS INTEGER = 2
   WHILE I * I <= N
      IF N MOD I = 0 THEN
         RETURN FALSE
      end if
      I = I + 1
   WEND
   RETURN TRUE
END FUNCTION
      
' Test and display primes 1 .. 50
DIM gtc AS INTEGER
DIM n as INTEGER
gtc = GetTickCount()
FOR n = 1 TO 10000
   IF ISPRIME(n) THEN
      'PRINT n, " ";
   END IF
NEXT
print ": ",GetTickCount() - gtc, " milliseconds"
gtc = GetTickCount()
FOR n = 1 TO 10000
   IF ISPRIME2(n) THEN
      'PRINT n, " ";
   end if   
NEXT
PRINT ": ",GetTickCount() - gtc, " milliseconds"

PAUSE
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby Mike Lobanovsky » Tue Apr 23, 2013 6:00 pm

Bruce,

Your assumption might not be true even for a native code compiler. Modern implementations of Sqrt() at the CPU level are quite efficient. And for an interpreter's virtual machine with all its own code to execute besides the user's instructions, Sqrt() is just one client-side instruction against four client-side instructions in the second example, namely:

-- multiply I by I;
-- check the product against N;
-- add 1 to I;
-- assign the sum to I.

OTOH, the For/Next loop in the first example runs completely on the server side, i.e. in pure machine code, except for a single client-side Sqrt() instruction. Also, the For/Next loop runs in steps of 2 which shortens its overhead still further.

Theoretically, you can speed up the first example still more if you use ORELSE instead of OR. OR is BASIC-style "inclusive" logic, i.e. regardless of "n <= 1" being TRUE "n MOD 2" will also be considered at all times. ORELSE is C-style "exclusive" logic whereby "n MOD 2" will only be considered if "n <= 1" is FALSE. Prefer to use "exclusive" logic whenever possible. You can get a noticeable boost in expressions where the probability of first operand being TRUE is equal to, or higher than, that of the second one. Another example of "exclusive" logic is ANDALSO vs. AND. Use it whenever the probability of first operand being FALSE is higher than, or equal to, that of the second one.

Please consider the following snapshots. The first one is for your "ELSEIF n <= 1 OR n MOD 2 = 0 THEN" statement in 100,000 iterations:

Or.PNG

The second one is for the condition reversed to "ELSEIF n MOD 2 = 0 ORELSE n <= 1 THEN" to promote the most probable one to the front using "exclusive" logic in 100,000 iterations:

OrElseRev.PNG
You do not have the required permissions to view the files attached to this post.
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: RosettaCode

Unread postby bugmagnet » Wed Apr 24, 2013 4:06 am

I didn't realise it before, but February actually has 31 days. Or at least that's what FBSL thinks.

In developing a solution to the Last Sunday of the Month I wrote the following

Code: Select all
#APPTYPE CONSOLE
#OPTION STRICT

dim date as integer
dim dayname as string
for dim i = 1 to 12
   for dim j = 31 to 1 step -1
      date = 20130000 + (i*100) + j
      'print date
      dayname = dateconv(date,"dddd")
      if dayname = "Sunday" then
         print 2013, " ", i, " ", j
         exit for
      end if
   next
next

pause

This works.
Code: Select all
2013 1 27
2013 2 31
2013 3 31
2013 4 28
2013 5 26
2013 6 30
2013 7 28
2013 8 25
2013 9 29
2013 10 27
2013 11 31
2013 12 29

When it comes to February, it tells me that February 31 was a Sunday. That is true: if February did have 31 days, then the 31st would have been a Sunday.

However, February does not have 31 days. Only rarely does it get above 28!

Something's amiss here!

Yours magnetically,
bugmagnet
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby bugmagnet » Wed Apr 24, 2013 10:24 am

Day of the week solved and posted. No complaints.

Kind regards,
bugmagnet
User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby Mike Lobanovsky » Wed Apr 24, 2013 11:23 am

Hold on Bruce,

Code: Select all
#APPTYPE CONSOLE
#OPTION STRICT

'In what years between 2008 and 2121 will the 25th of December be a Sunday?
DIM date AS INTEGER
DIM dayname AS STRING
FOR DIM year = 2008 TO 2121
   date = year * 10000 + 1225
   dayname = dateconv(date,"dddd")
   IF dayname = "Sunday" THEN
      PRINT "Christmas Day is on a Sunday in ", year
   END IF
NEXT

PAUSE
seems to be a palliation. I'll look into the source code and come up with my comments on its Zeller's congruence algorithm implementation.

I'll be back when I'm ready.

Regards,
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Re: RosettaCode

Unread postby bugmagnet » Wed Apr 24, 2013 3:30 pm

Have another solution, for Rot13. Thought I'd run it past you all first in case I've missed some optimisation that would speed it along.

Kind regards,
bugmagnet

Code: Select all
#Option Strict
#AppType CONSOLE

REM Create a CircularQueue object
REM CQ.Store item
REM CQ.Find items
REM CQ.Forward nItems
REM CQ.Get

REM So CQ init with "A" ... "Z"
REM CQ.Find "B"
REM QC.Forward 13
REM QC.Get

Class CircularQueue
    data[]
    head
    tail
    here
   
    Sub Initialize(dArray)
        head = 0
        tail = 0
        here = 0
        for dim i = LBound(dArray) to UBound(dArray)
            data[tail] = dArray[i]
            tail = tail + 1
        next
    End Sub
   
    Sub Terminate()
    End Sub
   
    Method Store(s as string)
        data[tail] = s
        tail = tail + 1
    End Method
   
    Method Find(s as string)
        for dim i = head to tail - 1
            if data[i] = s then
                here = i
                return true
            end if
        next
        return false
    End Method
       
    Method Move(n as integer)
        dim bound as integer = UBound(data)+1
        here = (here + n) mod bound
    End Method

    Method Retrieve()
          Return data[here]
    End Method
   
    Method Count()
        Return UBound(data)+1
    End Method
End Class

dim CQ as new CircularQueue({"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z"})

dim c as string
dim isLowercase as integer
dim s as string = "nowhere ABJURER"
for dim i = 1 to len(s)
    c = mid(s,i,1)
    isLowercase = lstrcmp( lcase(c), c )
    if CQ.Find(ucase(c)) then
        CQ.Move(13)
        print iif(isLowercase, ucase(CQ.Retrieve()), lcase(CQ.retrieve()));
    else
        print c;
    end if
next
pause

User avatar
bugmagnet
FBSL geek
FBSL geek
 
Posts: 174
Joined: Sat Apr 06, 2013 5:58 am
Location: Fremantle WA, Australia

Re: RosettaCode

Unread postby Mike Lobanovsky » Wed Apr 24, 2013 6:22 pm

Hey Bruce,

This is a neat piece of code and I must admit I liked it at the very first glance. :D And also thanks once again for your efforts to popularise FBSL at ResettaCode.

Just two small remarks:

1. There is already a Count() function in FBSL that returns the number of elements in an array but you shadowed (overloaded) it with your own method implementation (BTW I'd rather call it a read-only Property but never mind, FBSL would swallow both), which forced you to use a slower "UBound(data) + 1" implementation. "Data" is also an FBSL keyword and I'm not sure you had realised this until I pointed it out here. Evidently you're not using Eclecta to highlight the both keywords for you in blue which would mean they are already reserved by FBSL. Hint: you can compile a pre-v3.5 Eclecta into an executable with a pre-v3.5 Fbsl.exe and use it to develop your scripts until I release the new Eclecta.

2. I am not quite sure you realise that lstrcmp(), like every other C-derivative string function, returns 0 if the strings match otherwise it returns a non-zero value. In FBSL terms this is FALSE and TRUE respectively, weird as it may seem from a BASIC user's standpoint. Now by its very name, isLowercase implies it is a Boolean that is TRUE if a hypothetically reversed lstrcmp() returns TRUE, which the real lstrcmp() doesn't. So within the context of your script, isLowercase should IMHO be renamed into isNotLowercase, or isUppercase, and the remainder of the script adjusted accordingly to correspond to this new logic.

Otherwise, perfect! :)
Mike
"Я старый солдат, мадам, и не знаю слов любви."
"I am an old soldier, ma'am, and I don't know the words of love."
"Je suis un vieux soldat, madame, et je ne connais pas les mots d'amour."
"Ich bin ein alter Soldat, gnädige Frau, und ich weiß nicht die Worte der Liebe."

__________________________________________________________________________________________________________________________________________________
(3.2GHz i5 Core Quad, 8GB RAM / 2 x nVidia GTX 550Ti SLI-bridged, 2GB VRAM)
(x86 Win XP Pro Russian Sp3/x86 Win Vista Ultimate Sp2/x64 Win 7 Ultimate Sp1/Wine in x64 elementaryOS Luna)
User avatar
Mike Lobanovsky
FBSL Administrator
FBSL Administrator
 
Posts: 1823
Joined: Tue Apr 19, 2005 8:22 am
Location: Republic of Belarus

Next

Return to FBSL v3 Discussion Board

Who is online

Users browsing this forum: No registered users and 1 guest

cron