B4J Question Look-and-say sequence, not that speedy

madru

Active Member
Licensed User
Longtime User
Hi guys,

any idea to optimise this code as the performance is very very bad....

B4X:
    Dim num As String = "1"
    For a=1 To 50
        count =a
        Log(num)
        num= Conway(num)
    Next

Sub Conway(number As String)As String

    res =""
    Dim repeat As String = number.CharAt(0)
    number = sf.mid(number,1+1,number.Length-1)&" "
    Dim a() As Char =  bc.ToChars(number)
    Dim times As Int = 1

    For Each actual As String In a
        If actual <> repeat Then
            res=res&times&repeat
            times=1
            repeat=actual
        Else
            times = times +1
        End If 
    Next
    Return res
End Sub


from: https://en.wikipedia.org/wiki/Look-and-say_sequence
 

Daestrum

Expert
Licensed User
Longtime User
I see what you mean - I tried re-writing in B4J code , but gave up waiting for the last line to show.
I re-wrote it using jNashorn and it tool 4.5 seconds to complete all 50 iterations, which was so much faster.
This was the code I used (needs jNashorn library)
B4X:
       (Class Globals)
        ...
    Dim nash As jInvokeNashorn
    Dim script As String
End Sub

Sub AppStart (Form1 As Form, Args() As String)
    MainForm = Form1
    'MainForm.RootPane.LoadLayout("Layout1") 'Load the layout file.
    MainForm.Show
    script = _
$"
function Conway(a){
    var res = ""
    var cnt = 1
    var chars = a.split('')
    var initial = chars[0]
    var max = 0+chars.length
    for (var c=0;c<max;c++){
        if (max == 1){
            res +="1"+initial
            return res
        }
        if (chars[c] == chars[c+1]){
            cnt++
        }else{
            res += cnt+initial
            cnt=1
            initial = chars[c+1]
        }
    }
    return res
}
"$
    nash.InitInvocable(script)
    Dim num As String = "1"
    Dim st As Long = DateTime.Now
    For a = 1 To 50
        Log("num ="&num)
        num = nash.Invoke("Conway",Array(num))
    Next
    Log("time taken "&((DateTime.Now-st)/1000)&" seconds")
time taken 4.434 seconds
 
Upvote 0

madru

Active Member
Licensed User
Longtime User
THX, this I even faster ( a little ;)), but all this does not explain why we have such a big difference in execution time between B4x and JavaScript. My original attempt was to speedup the B4x code, but ....


B4X:
function Conway(t) {

    if (t == "") {
    return "0"
    }
    var r = ""
    var idx = 0
    while (idx < t.length){
    for(i=1; t.charAt(idx+i) == t.charAt(idx); i++) {}
    r += i + t.charAt(idx)
    idx += i
 }
    return r
}
 
Upvote 0

Erel

B4X founder
Staff member
Licensed User
Longtime User
Going to JavaScript is never the correct solution.

Strings are immutable objects. Building lengthy strings like this is an O(n^2) operation where n = string length.
You should instead use StringBuilder.
My solution takes 180 ms with the logs and 130 ms without them:
B4X:
Sub AppStart (Args() As String)
   Dim n As Long = DateTime.Now
   Dim num As String = "1"
   For a=1 To 50
       Log(num)
       num= Conway(num)
   Next
   Log(DateTime.Now - n)
End Sub

Sub Conway(t As String) As String
   Dim r As StringBuilder
   r.Initialize
   Dim idx As Int = 0
   Do While idx < t.Length
       Dim i As Int = 1
       Do While idx + i < t.Length And t.CharAt(idx + i) = t.CharAt(idx)
           i = i + 1
       Loop
       r.Append(i).Append(t.CharAt(idx))
       idx = idx + i
   Loop
   Return r.ToString
End Sub
 
Upvote 0

Erel

B4X founder
Staff member
Licensed User
Longtime User
Another solution that takes 12ms without printing the logs:
B4X:
Sub Process_Globals
   Private buffer1(10 * 1024 * 1024) As Byte
   Private buffer2(10 * 1024 * 1024) As Byte
End Sub

Sub AppStart (Args() As String)
   Dim buffers As List = Array(buffer1, buffer2)
   Dim n As Long = DateTime.Now
   buffer2(0) = 1
   Dim len As Int = 1
   For a = 1 To 50
       Dim Input() As Byte = buffers.Get(a Mod 2)
       Dim Output() As Byte = buffers.Get((a + 1) Mod 2)
       len = Conway (Input, len, Output)
'       Dim r As StringBuilder
'       r.Initialize
'       For i = 0 To len - 1
'           r.Append(Output(i))
'       Next
'       Log(r)
   Next
   Log(DateTime.Now - n)
End Sub

Sub Conway(buff() As Byte, len As Int, output() As Byte) As Int
   Dim index As Int
   Dim idx As Int = 0
   Do While idx < len
       Dim i As Int = 1
       Do While idx + i < buff.Length And buff(idx + i) = buff(idx)
           i = i + 1
       Loop
       output(index) = i
       output(index + 1) = buff(idx)
       index = index + 2
       idx = idx + i
   Loop
   Return index
End Sub
 
Upvote 0
Top