Replace any recursion by unlimited iteration with own stack

fxm
Posts: 9559
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Replace any recursion by unlimited iteration with own stack

To avoid limitation due to the system stack size, you can always (more or less easily) replace a recursive algorithm by an iterative algorithm by pushing the parameters that would normally be passed to the recursive function onto an own unlimited stack. In fact, you are replacing the program stack by one of your own (not limited in size):

- Just make the accumulator variable a local one.

- Just check which values are saved across recursive calls, those are the ones that have to be local to the recursive function, and replace the calls with a cycle where you will push them on a stack.

- When the stack is empty the recursive function would have been terminated.

Example: Computation of the combination coefficients nCp (binomial coefficients calculation) and display of the Pascal's triangle

In the following example, I used as stack the one that I proposed in a previous topic of this forum:
UDT: Dynamic Queue/Stack for data-type (numeric/string/user)
http://www.freebasic.net/forum/viewtopic.php?t=18415

The first function 'Combination_recursion' is the recursive form.
(not a tail recursion because there are two recursive calls with summation in the last active statement)

The second function 'Combination_iteration_stack' is the iterative form using an own stack.

In the two functions, I conserved a similar structure to enlighten the conversion method.
From recursive function to iterative stacking function:
- Ahead, declaration adding of 3 local variables for parameters stacking (2) plus the accumulator (1).
- Pushing the two initial parameters values in the stack.
- Entering in the Do While ... Loop to empty the stack.
- Pulling parameters from the stack.
- 'Return 1' of the 'Then' is replaced by 'cumul = cumul + 1'.
- 'Return Combination_recursion(n - 1, p) + Combination_recursion(n - 1, p - 1)' of the 'Else' is replaced by 'S.stack_push(ns - 1) : S.stack_push(ps) : S.stack_push(ns - 1) : S.stack_push(ps - 1)'.

Code: Select all

`Function Combination_recursion (Byval n As Uinteger, Byval p As Uinteger) As Longint  If p = 0 Or p = n then    Return 1  Else    Return Combination_recursion(n - 1, p) + Combination_recursion(n - 1, p - 1)  End IfEnd Function'---------------------------------------------------------------------------#Include "UDT_dynamic_queue_stack.bi"UDT_dynamic_queue_stack(Uinteger)Dim Shared S As UDT_dynamic_queue_stack_UintegerFunction Combination_iteration_stack (Byval n As Uinteger, Byval p As Uinteger) As Longint  Dim cumul As Longint = 0  Dim ns As Uinteger  Dim ps As Uinteger  S.stack_push(n)  S.stack_push(p)  Do While S.size > 0    ps = S.stack_pull    ns = S.stack_pull    If ps = 0 Or ps = ns then      cumul = cumul + 1    Else      S.stack_push(ns - 1)      S.stack_push(ps)      S.stack_push(ns - 1)      S.stack_push(ps - 1)    End If  Loop  Return cumulEnd Function'---------------------------------------------------------------------------Sub Display(Byval Combination As Function (Byval n As Uinteger, Byval p As Uinteger) As Longint, Byval n As Integer)  For I As Uinteger = 0 To n    For J As Uinteger = 0 To I      Locate , 6 * J + 3 * (n - I) + 3      Print Combination(I, J);    Next J    Print  Next IEnd Sub'---------------------------------------------------------------------------Screen 12PrintPrint " recursion";Display(@Combination_recursion, 12)PrintPrintPrint " iteration with own stack";Display(@Combination_iteration_stack, 12)Sleep`

A classic iteration without using stack does not seem to be easy to code (because it is not a tail recursion), if not all completely recalculate the Pascal's triangle for any nCp value requested!
See below this third function 'Combination_iteration_classic' added to the previous program:

Code: Select all

`Function Combination_recursion (Byval n As Uinteger, Byval p As Uinteger) As Longint  If p = 0 Or p = n then    Return 1  Else    Return Combination_recursion(n - 1, p) + Combination_recursion(n - 1, p - 1)  End IfEnd Function'---------------------------------------------------------------------------#Include "UDT_dynamic_queue_stack.bi"UDT_dynamic_queue_stack(Uinteger)Dim Shared S As UDT_dynamic_queue_stack_UintegerFunction Combination_iteration_stack (Byval n As Uinteger, Byval p As Uinteger) As Longint  Dim cumul As Longint = 0  Dim ns As Uinteger  Dim ps As Uinteger  S.stack_push(n)  S.stack_push(p)  Do While S.size > 0    ps = S.stack_pull    ns = S.stack_pull    If ps = 0 Or ps = ns then      cumul = cumul + 1    Else      S.stack_push(ns - 1)      S.stack_push(ps)      S.stack_push(ns - 1)      S.stack_push(ps - 1)    End If  Loop  Return cumulEnd Function'---------------------------------------------------------------------------Function Combination_iteration_classic (Byval n As Uinteger, Byval p As Uinteger) As Longint  Dim array(n, n) As Longint  For I As Uinteger = 0 To n    For J As Uinteger = 0 To I      If J = 0 Or J = I Then        array(I, J) = 1      Else        array(I, J) = array(I - 1, J) + array(I - 1, J - 1)      End If    Next J  Next I  Return array(n, p)End Function'---------------------------------------------------------------------------Sub Display(Byval Combination As Function (Byval n As Uinteger, Byval p As Uinteger) As Longint, Byval n As Integer)  For I As Uinteger = 0 To n    For J As Uinteger = 0 To I      Locate , 6 * J + 3 * (n - I) + 3      Print Combination(I, J);    Next J    Print  Next IEnd Sub'---------------------------------------------------------------------------Screenres 640, 480PrintPrint " recursion";Display(@Combination_recursion, 12)PrintPrintPrintPrint " iteration with own stack";Display(@Combination_iteration_stack, 12)PrintPrintPrintPrint " iteration without stack";Display(@Combination_iteration_classic, 12)Sleep`

Other graphical example

Code: Select all

`Sub Draw_circle_recursion(Byval x As Integer, Byval y As Integer, Byval r As Integer)  Circle (x, y), r  If r > 16 Then    Draw_circle_recursion(x + r / 2, y, r / 2)    Draw_circle_recursion(x - r / 2, y, r / 2)    Draw_circle_recursion(x, y + r / 2, r / 2)    Draw_circle_recursion(x, y - r / 2, r / 2)  End IfEnd Sub'---------------------------------------------------------------------------#Include "UDT_dynamic_queue_stack.bi"UDT_dynamic_queue_stack(Integer)Dim Shared S As UDT_dynamic_queue_stack_IntegerSub Draw_circle_iteration_stack(Byval x As Integer, Byval y As Integer, Byval r As Integer)  Dim xs As Integer  Dim ys As Integer  Dim rs As Integer  S.stack_push(x)  S.stack_push(y)  S.stack_push(r)  Do While S.size > 0    rs = S.stack_pull    ys = S.stack_pull    xs = S.stack_pull    Circle (xs, ys), rs    If rs > 16 Then      S.stack_push(xs + rs / 2)      S.stack_push(ys)      S.stack_push(rs / 2)      S.stack_push(xs - rs / 2)      S.stack_push(ys)      S.stack_push(rs / 2)      S.stack_push(xs)      S.stack_push(ys + rs / 2)      S.stack_push(rs / 2)      S.stack_push(xs)      S.stack_push(ys - rs / 2)      S.stack_push(rs / 2)    End If  LoopEnd Sub'---------------------------------------------------------------------------Screen 12Locate 2, 2Print "recursion"Draw_circle_recursion(160, 160, 150)Locate 10, 60Print "iteration with stack"Draw_circle_iteration_stack(480, 320, 150)Sleep`

Structure of the function 'Combination_iteration_stack' slightly modified to better fit with the recursive structure of the function 'Combination_recursion', in order to well enlighten the principle of replacing a recursive algorithm by an iterative stacking algorithm (see explanation above).
Last edited by fxm on Sep 05, 2011 17:59, edited 4 times in total.
dafhi
Posts: 1335
Joined: Jun 04, 2005 9:51
I love your work. Not that I understand any of it
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi fxm
Nice work, I like your recursive combinations.
I'm still trying to avoid eating stack by other methods (work in progress).

However, I'm sure that you would be disappointed if I didn't return some brutish code, you normally despair at it, this time combinations, desperately handled, but will show you the number of devils who have lived in this world right up to the present date.
(A bit of fun remember, mutually exclusive of your work)

@Dafhi, excluding yourself of course.

Code: Select all

`Function minus(NUM1 As String,NUM2 As String) As String    Dim  SUBQmod(0 To 19) As Ubyte    Dim SUBbool(0 To 19) As Ubyte    For z As Integer=0 To 19    SUBQmod(z)=Cubyte(z Mod 10+48)    SUBbool(z)=Cubyte(-(10>z))Next z         Dim As Byte swapflag                    Dim sign As String * 1        Dim bigger As Byte      Dim As Long  lenf=Len(NUM1)      Dim As Long  lens=Len(NUM2)         #macro compare(numbers)If Lens>lenf Then bigger= -1:Goto fin    If Lens<lenf Then bigger =0:Goto fin    If NUM2>NUM1 Then         bigger=-1    Else        bigger= 0    End If    fin:#endmacrocompare(numbers)If bigger Then sign="-"Swap NUM2,NUM1Swap lens,lenfswapflag=1Endif                Dim diff As Long=lenf-lens-Sgn(lenf-lens)        Dim As String three=NUM1       Dim As String  two=String(lenf-lens,"0")+NUM2        Dim As String one=NUM1        Dim As Long n2        Dim As Ubyte takeaway,subtractcarry        Dim As Ubyte ten=10        subtractcarry=0        Do         For n2=lenf-1 To diff Step -1            takeaway= one[n2]-two[n2]+ten-subtractcarry           three[n2]=SUBQmod(takeaway)            subtractcarry=SUBbool(takeaway)        Next n2         If subtractcarry=0 Then Exit Do        If n2=-1 Then Exit Do        For n2=n2 To 0 Step -1             takeaway= one[n2]-two[n2]+ten-subtractcarry            three[n2]=SUBQmod(takeaway)            subtractcarry=SUBbool(takeaway)            Next n2        Exit Do        Loop        three=Ltrim(three,"0")        If three="" Then Return "0"        If swapflag=1 Then Swap NUM1,NUM2       Return sign+threeEnd FunctionFunction _divide(n1 As String,n2 As String,decimal_places As Long,dpflag As String="s") As String          Dim As String number=n1,divisor=n2     If dpflag<>"s" Then dpflag="raw"            Dim runcount As Long        '_______  LOOK UP TABLES ______________        Dim Qmod(0 To 19) As Ubyte:Dim atQmod As Ubyte Pointer        Dim bool(0 To 19) As Ubyte:Dim atbool As Ubyte Pointer        For z As Integer=0 To 19    Qmod(z)=Cubyte(z Mod 10+48)    bool(z)=Cubyte(-(10>z))Next zatQmod=@Qmod(0)atbool=@bool(0) Dim answer As String   'THE ANSWER STRING   Dim atanswer As Ubyte Pointer '_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______Dim As String part1,part2#macro set(decimal)#macro insert(s,char,position)If position > 0 And position <=Len(s) Then part1=Mid\$(s,1,position-1) part2=Mid\$(s,position) s=part1+char+part2 Endif #endmacro insert(answer,".",decpos)  answer=thepoint+zeros+answer If dpflag="raw" Then    answer=Mid(answer,1,decimal_places)    Endif #endmacro '______________________________________________ '__________ SPLIT A STRING ABOUT A CHARACTRR __________ Dim As String var1,var2    Dim pst As Long      #macro split(stri,char,var1,var2)    pst=Instr(stri,char)    var1="":var2=""    If pst<>0 Then    var1=Rtrim(Mid(stri,1,pst),".")    var2=Ltrim(Mid(stri,pst),".")Else    var1=stri    Endif    #endmacro           #macro Removepoint(s)       split(s,".",var1,var2)#endmacro'__________ GET THE SIGN AND CLEAR THE -ve __________________Dim sign As String          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"            If Left(number,1)="-" Then  number=Ltrim(number,"-")            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")              'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISIONDim As Long lennint,lenddec,lend,lenn,difflensplit(number,".",var1,var2)lennint=Len(var1)split(divisor,".",var1,var2)lenddec=Len(var2)If Instr(number,".") Then     Removepoint(number)    number=var1+var2    EndifIf Instr(divisor,".") Then     Removepoint(divisor)    divisor=var1+var2    EndifDim As Long numzerosnumzeros=Len(number)number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")numzeros=numzeros-Len(number)lend=Len(divisor):lenn=Len(number)If lend>lenn Then difflen=lend-lennDim decpos As Long=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATOR'Dim answer As String   'THE ANSWER STRINGDim _sgn As Byte=-Sgn(decpos) If _sgn=0 Then _sgn=1 Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF) Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009 If Len(zeros) =0 Then dpflag="s" Dim As Long runlength If Len(zeros) Then      runlength=decimal_places     answer=String(Len(zeros)+runlength+10,"0")     atanswer=@answer[0]     'atanswer=@answer    If dpflag="raw" Then         runlength=1        answer=String(Len(zeros)+runlength+10,"0")        atanswer=@answer[0]        'atanswer=@answer        If decimal_places>Len(zeros) Then            runlength=runlength+(decimal_places-Len(zeros))            answer=String(Len(zeros)+runlength+10,"0")            atanswer=@answer[0]            'atanswer=@answer            Endif            Endif Elsedecimal_places=decimal_places+decposrunlength=decimal_placesanswer=String(Len(zeros)+runlength+10,"0")atanswer=@answer[0] Endif'___________DECIMAL POSITION DETERMINED (A  pure joy!) _____________'SET UP THE VARIABLES AND START UP CONDITIONSnumber=number+String(difflen+decimal_places,"0")        Dim count As Short'=0        Dim temp As String        Dim copytemp As String        Dim topstring As String        Dim copytopstring As String        Dim As Long lenf,lens        Dim As Ubyte takeaway,subtractcarry        Dim As Ubyte ten=10        Dim As Ubyte fortyeight=48        Dim As Ubyte zero=0        Dim As Ubyte _one=1        Dim As Ubyte Pointer ptemp        Dim As Long n3,diff        Dim As String one,two       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"           lens=Len(divisor)         topstring=Left(number,lend)         copytopstring=topstring        Do            count=zero        Do            count=count+_one            copytemp=temp                Do '___________________ QUICK SUBTRACTION loop _________________                          lenf=Len(topstring)If Not lens<lenf Then If Lens>lenf Thentemp= "done" Exit DoEndifIf divisor>topstring Then temp= "done"Exit DoEndifEndif  diff=lenf-lens-Sgn(lenf-lens)                temp=topstring        ptemp=@temp[0]        two=String(lenf-lens,"0")+divisor        one=topstring        subtractcarry=zero                For n3=lenf-1 To diff Step -1            takeaway= one[n3]-two[n3]+ten-subtractcarry            ptemp[n3]=atQmod[takeaway]            subtractcarry=atbool[takeaway]        Next n3         If subtractcarry=zero Then Exit Do         If n3=-1 Then Exit Do        For n3=n3 To 0 Step -1             takeaway= one[n3]-two[n3]+ten-subtractcarry             ptemp[n3]=atQmod[takeaway]            subtractcarry=atbool[takeaway]            'if subtractcarry=zero then exit do            Next n3        Exit Do                Loop 'single run        temp=Ltrim(temp,"0")                If temp="" Then temp= "0"                           topstring=temp        Loop Until temp="done"     ' INDIVIDUAL CHARACTERS CARVED OFF ________________               runcount=runcount+1       If count=1 Then           topstring=copytopstring+Mid(number,lend+runcount,1)           Else       topstring=copytemp+Mid(number,lend+runcount,1)   End If       copytopstring=topstring       topstring=Ltrim(topstring,"0")       atanswer[runcount-1]=count-_one+fortyeight 'build the answer by the pointer       If topstring="" And runcount>Len(n1)+1 Then           Exit Do           Endif   Loop Until runcount=runlength+1   ' END OF RUN TO REQUIRED DECIMAL PLACES   set(decimal) 'PUT IN THE DECIMAL POINT  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER  'NOW GET RID OF IT IF IT IS REDUNDANT       answer=Rtrim(answer,"0")       answer=Rtrim(answer,".")       answer=Ltrim(answer,"0")       If answer="" Then Return "0"   Return sign+answerEnd Function#macro plus(_num1,_num2)Do    _flag=0    #macro finish()    answer=Ltrim(answer,"0")    If _flag=1 Then Swap _num2,_num1    Exit Do    #endmacro    If Len(_num2)>Len(_num1) Then         Swap _num2,_num1        _flag=1    Endif                diff=Len(_num1)-Len(_num2)        answer="0"+_num1        addcarry=0        For n_=Len(_num1)-1 To diff Step -1             addup=_num2[n_-diff]+_num1[n_]-96            answer[n_+1]=ADDQmod(addup+addcarry)            addcarry=ADDbool(addup+addcarry)        Next n_         If addcarry=0 Then             finish()        Endif            If n_=-1 Then                 answer[0]=addcarry+48                finish()            Endif                For n_=n_ To 0 Step -1                     addup=_num1[n_]-48                    answer[n_+1]=ADDQmod(addup+addcarry)                    addcarry=ADDbool(addup+addcarry)                Next n_                answer[0]=addcarry+48                finish()                Exit Do            Loop            #endmacro#macro mult(num1,num2)            flag=0            If Len(num2)>Len(num1) Then                flag=1                Swap num2,num1            End If            three="0"&num1            accum="0"            For n1 As Integer=Len(num2)-1 To 0 Step -1                multcarry=0                For n2 As Integer=Len(num1)-1 To 0 Step -1                     multadd=multaddtable(num2[n1],num1[n2])                    three[n2+1]= threetable(multadd,multcarry)                    multcarry=multcarrytable(multadd,multcarry)                 Next n2                three[0]=multcarry+48                plus(three,accum)                accum=answer                three=three+"0"            Next n1            If flag=1 Then Swap num2,num1            #endmacroFunction Factorial( n As String) As StringDim  As Ubyte multcarrytable( 81,9),threetable( 81,9),multaddtable(48 To 57,48 To 57)Dim As Ubyte ADDQmod(0 To 19),ADDbool(0 To 19)                 For x As Integer=48 To 57                    For y As Integer=48 To 57                        multaddtable(x,y)=(x-48)*(y-48)                    Next y                Next x                For x As Integer=0 To 81                    For y As Integer=0 To 9                        threetable(x,y)=((x + y) Mod 10)+48                        multcarrytable(x,y)=(x+y-(x+y) Mod 10)\10                    Next y                Next x                 For z As Integer=0 To 19                    ADDQmod(z)=(z Mod 10+48)                    ADDbool(z)=(-(10<=z))                Next z                                 Dim  As Ubyte addup,addcarry                Dim As Integer multadd,multcarry,diff,n_                Dim As Byte flag,_flag                Dim As String accum,three,answer,z="0",fact="1",one=fact                If Ltrim(n,"0")="" Then Return fact                Do                    plus(z,one)                    z=answer                    mult(fact,z)                    fact = accum                Loop Until z=n                Return fact            End Function                        Function combination_brute(b  As String,s As String) As String                If b = "0" Or b = s then return "1"                Dim As String temp1,temp2,temp3,ans               Dim  As Ubyte multcarrytable( 81,9),threetable( 81,9),multaddtable(48 To 57,48 To 57)Dim As Ubyte ADDQmod(0 To 19),ADDbool(0 To 19)                 For x As Integer=48 To 57                    For y As Integer=48 To 57                        multaddtable(x,y)=(x-48)*(y-48)                    Next y                Next x                For x As Integer=0 To 81                    For y As Integer=0 To 9                        threetable(x,y)=((x + y) Mod 10)+48                        multcarrytable(x,y)=(x+y-(x+y) Mod 10)\10                    Next y                Next x                 For z As Integer=0 To 19                    ADDQmod(z)=(z Mod 10+48)                    ADDbool(z)=(-(10<=z))                Next z                                 Dim  As Ubyte addup,addcarry                Dim As Integer multadd,multcarry,diff,n_                Dim As Byte flag,_flag                Dim As String accum,three,answer,z="0",fact="1",one=fact                'ANS=factorial(big)/factorial(small)*factorial(big-small)                temp1=factorial(b)     'factorial (big)                temp2=factorial(s)     'factorial (small)                temp3=minus(b,s)       '(big-small)                temp3=factorial(temp3) 'factorial(big-small)                mult(temp2,temp3)                  temp3=accum            'factorial(small)*factorial(big-small)                ans=_divide(temp1,temp3,10)'ANS                Return ans                End Function                        Dim As Double t1,t2            Dim As String ans            t1=Timer            ans=combination_brute("2011","666")            t2=Timer            print            Print ans            print            Print "Time ";t2-t1            Sleep            `
fxm
Posts: 9559
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
Quick Sort algorithm: recursion replaced by iteration with own unlimited stack

- Simple Quick Sort algorithm with pivot = left/right.
- 200 unsorted ubytes get by memory allocation, then random initialization.

Quick Sort by recursion:

Code: Select all

`Dim shared As Ubyte Ptr tt = Allocate(200 * Sizeof(Ubyte))RandomizeFor I As Integer = 0 To 199  t[i] = Int(Rnd * 256)Next ISub QuickSort_recursion(Byval L As Integer, Byval R As Integer)  Dim As Integer pivot = L  Dim As Integer I = L  Dim As Integer J = R  Do    If t[I] >= t[J] then      Swap t[I], t[J]      pivot = L + R - pivot    End If    If pivot = L then      J = J - 1    Else      I = I + 1    End If  Loop Until I = J  If L < I - 1 Then    QuickSort_recursion(L, I - 1)  End If  If R > J + 1 Then    QuickSort_recursion(J + 1, R)  End IfEnd SubPrint "raw memory"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KPrintQuickSort_recursion(0, 199)Print "sorted memory by recursion"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KSleepDeallocate(t)`

Quick Sort by iteration with stack (see my previous post for stack usage):
( http://www.freebasic.net/forum/viewtopic.php?t=18415 )

Code: Select all

`Dim shared As Ubyte Ptr tt = Allocate(200 * Sizeof(Ubyte))RandomizeFor I As Integer = 0 To 199  t[i] = Int(Rnd * 256)Next I#Include "UDT_dynamic_queue_stack.bi"UDT_dynamic_queue_stack(integer)Dim Shared As UDT_dynamic_queue_stack_integer SSub QuickSort_stacking(Byval L As Integer, Byval R As Integer)  Dim As Integer Ls  Dim As Integer Rs  S.stack_push(L)  S.stack_push(R)  Do While S.size > 0    Rs = S.stack_pull    Ls = S.stack_pull    Dim pivot As Integer = Ls    Dim As Integer I = Ls    Dim As Integer J = Rs    Do      If t[I] >= t[J] then        Swap t[I], t[J]        pivot = Ls + Rs - pivot      End If      If pivot = Ls then        J = J - 1      Else        I = I + 1      End If    Loop Until I = J    If Ls < I - 1 Then      S.stack_push(Ls)      S.stack_push(I - 1)    End If    If Rs > J + 1 Then      S.stack_push(J + 1)      S.stack_push(Rs)    End If  LoopEnd SubPrint "raw memory"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KPrintQuickSort_stacking(0, 199)Print "sorted memory by iteration with stack"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KSleepDeallocate(t)`

- Addition of a random initialization of the allocated memory, because when you allocate much memory the ubytes are often set to 0 or set to nonrandom values.
- Addition of memory deallocation (good practice!)
Last edited by fxm on Sep 03, 2011 8:42, edited 6 times in total.
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Some recursive routines can just use goto instead of recursion, yours seems to, but the Quicksort I normally use, I'm having difficulty with:
Here's yours.

Code: Select all

`Dim shared As Ubyte Ptr tt = Allocate(200 * Sizeof(Ubyte))Sub QuickSort_recursion(Byval L As Integer, Byval R As Integer)  Dim As Integer pivot = L  Dim As Integer I = L  Dim As Integer J = R  Do    If t[I] >= t[J] then      Swap t[I], t[J]      pivot = L + R - pivot    End If    If pivot = L then      J = J - 1    Else      I = I + 1    End If  Loop Until I = J  If L < I - 1 Then    QuickSort_recursion(L, I - 1)  End If  If R > J + 1 Then    QuickSort_recursion(J + 1, R)  End IfEnd SubSub QuickSort_GOTO(Byval L As Integer, Byval R As Integer)  Dim As Integer pivot = L  Dim As Integer I = L  Dim As Integer J = R  pivot=L  start:  I=L  J=R  Do    If t[I] >= t[J] then      Swap t[I], t[J]      pivot = L + R - pivot    End If    If pivot = L then      J = J - 1    Else      I = I + 1    End If  Loop Until I = J  If L < I - 1 Then      R=I-1      goto start      End If  If R > J + 1 Then      L=J+1      goto start      End IfEnd SubPrint "raw memory"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KPrintQuickSort_GOTO(0, 199)Print "sorted memory by GOTO"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KSleep `
fxm
Posts: 9559
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
dodicat wrote:Some recursive routines can just use goto instead of recursion, yours seems to, but the Quicksort I normally use, I'm having difficulty with:
Here's yours.

Code: Select all

`Dim shared As Ubyte Ptr tt = Allocate(2000 * Sizeof(Ubyte))RandomizeFor I As Integer = 0 To 1999  t[i] = Int(Rnd * 256)Next ISub QuickSort_recursion(Byval L As Integer, Byval R As Integer)  Dim As Integer pivot = L  Dim As Integer I = L  Dim As Integer J = R  Do    If t[I] >= t[J] then      Swap t[I], t[J]      pivot = L + R - pivot    End If    If pivot = L then      J = J - 1    Else      I = I + 1    End If  Loop Until I = J  If L < I - 1 Then    QuickSort_recursion(L, I - 1)  End If  If R > J + 1 Then    QuickSort_recursion(J + 1, R)  End IfEnd SubSub QuickSort_GOTO(Byval L As Integer, Byval R As Integer)  Dim As Integer pivot = L  Dim As Integer I = L  Dim As Integer J = R  pivot=L  start:  I=L  J=R  Do    If t[I] >= t[J] then      Swap t[I], t[J]      pivot = L + R - pivot    End If    If pivot = L then      J = J - 1    Else      I = I + 1    End If  Loop Until I = J  If L < I - 1 Then      R=I-1      goto start      End If  If R > J + 1 Then      L=J+1      goto start      End IfEnd SubPrint "raw memory"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KPrintQuickSort_GOTO(0, 199)Print "sorted memory by GOTO"For K As Integer = 0 To 199  Print Using "####"; t[K];Next KSleepDeallocate(t)`

Your 'GOTO' iteration does not work because it does not take into account the case of multiple-recursion:
- When both 'QuickSort_recursion(L, I - 1)' and 'QuickSort_recursion(J + 1, R)' are recursively called (case L < I - 1 and R > J + 1).
- Should be forced in this case a double GOTO reentering, each with the right associated parameters.

IMHO, there is no solution using 'GOTO' (idem for my two previous examples).
Only tail recursion (at more any one terminal recursion in the sequence) can be replaced by an iteration using only 'GOTO'.
The advantage of using a own stack is precisely the ability to emulate the re-entrance.

PS:
In my previous post (and yours above), I added a random initialization of the allocated memory, because when you allocate much memory the ubytes are often set to 0 or set to nonrandom values, plus memory deallocation (good practice!).
dodicat
Posts: 6390
Joined: Jan 10, 2006 20:30
Location: Scotland
Hi fxm
You are probably right about GOTO, however, it's fun trying to eke it out in various ways.
For example, conditions set just before leaving the sub will throw the partially sorted array back into touch , to have yet another purge.
I'm sure that these conditions could be optimized better than here.
It works ok, but slows down Quicksort, which defeats the purpose.
I'll post no more here for it is slightly off topic, I don't want to throw off would be members viewing your post.

Code: Select all

`sub qsort(a() as double,L as integer,R as integer)    dim as integer L2=L,R2=R  Dim As Integer pivot = L,I,J  dim as double max=-1e200,min=1e200  for z as integer=L to R      if max<a(z) then max=a(z)      if min>a(z) then min=a(z)  next z  start:   I = L  J = R  Do    If a(I) >= a(J) then      Swap a(I), a(J)      pivot = L + R - pivot    End If    If pivot = L then      J = J - 1    Else      I = I + 1    End If  Loop Until I = J  If L < I - 1 Then      R=I-1      goto start  End If  If R > J + 1 Then      L=J+1      goto start  End If   'END CONDITIONS  if a(Ubound(a))<> max or a(lbound(a))<> min then       L=L2:R=R2  goto start  end ifend subdim as integer n=10000'0dim  as double b(1 to N)for z as integer=1 to n    'b(z)=n-z    b(z)=(rnd*100)next zqsort(b(),lbound(b),ubound(b))for z as integer=1 to 20    print b(z)next zprint "..."printfor z as integer=ubound(b)-20 to ubound(b)    print b(z)next zprintSleep`
fxm
Posts: 9559
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
In my first post of this topic, I slightly modified the structure of the function 'Combination_iteration_stack' to better fit with the recursive structure of the function 'Combination_recursion', in order to well enlighten the principle of replacing a recursive algorithm by an iterative stacking algorithm.

My other examples ('Draw_circle_iteration_stack' and 'QuickSort_stacking') being already well structured.

In order to be more explicit, see below a second example based on the Fibonacci series : F(n) = F(n-1) + F(n-2), with F(0) = 0 and F(1) = 1.

Between the two functions, I conserved a similar structure to enlighten the conversion method.
From recursive function to iterative stacking function:
- Ahead, declaration adding of 2 local variables for parameter stacking plus the accumulator.
- Pushing the initial parameter value in the stack.
- Entering in the Do While ... Loop to empty the stack.
- Pulling parameter from the stack.
- 'Return n' of the 'Then' is replaced by 'cumul = cumul + ns'.
- 'Return Fibonacci_recursion(n - 1) + Fibonacci_recursion(n - 2)' of the 'Else' is replaced by 'S.stack_push(ns - 1) : S.stack_push(ns - 2)'.

Fibonacci series

Code: Select all

`Function Fibonacci_recursion (Byval n As Uinteger) As Longint  If n = 0 Or n = 1 then    Return n  Else    Return Fibonacci_recursion(n - 1) + Fibonacci_recursion(n - 2)  End IfEnd Function'---------------------------------------------------------------------------#Include "UDT_dynamic_queue_stack.bi"UDT_dynamic_queue_stack(Uinteger)Dim Shared S As UDT_dynamic_queue_stack_UintegerFunction Fibonacci_iteration_stack (Byval n As Uinteger) As Longint  Dim cumul As Longint = 0  Dim ns As Uinteger  S.stack_push(n)  Do While S.size > 0    ns = S.stack_pull    If ns = 0 Or ns = 1 then      cumul = cumul + ns    Else      S.stack_push(ns - 1)      S.stack_push(ns - 2)    End If  Loop  Return cumulEnd Function'---------------------------------------------------------------------------Function Fibonacci_iteration_classic (Byval n As Uinteger) As Longint  Dim array(n) As Longint  For I As Uinteger = 0 To n    If I = 0 Or I = 1 Then      array(I) = I    Else      array(I) = array(I - 1) + array(I - 2)    End If  Next I  Return array(n)End Function'---------------------------------------------------------------------------Sub Display(Byval Fibonacci As Function (Byval n As Uinteger) As Longint, Byval n As Integer)  For I As Uinteger = 0 To n    If I Mod 8 = 0 Then      Print    End If    Locate , 10 * (I Mod 8)    Print Fibonacci(I);  Next IEnd Sub'---------------------------------------------------------------------------'Screen 12PrintPrint " recursion";Display(@Fibonacci_recursion, 31)PrintPrintPrintPrint " iteration with own stack";Display(@Fibonacci_iteration_stack, 31)PrintPrintPrintPrint " iteration without stack";Display(@Fibonacci_iteration_classic, 31)PrintSleep`
see this previous post for stack usage:
http://www.freebasic.net/forum/viewtopic.php?t=18415

Fibonacci series linearizing

We can remark in the above example that the execution time duration for the highest values (recursive or iterative stacking algorithm) becomes no more negligible:
Indeed, to compute F(n), there are 2^(n-1) calls: about one milliard for n=31.

We can then try to linearize the recursive algorithm, using a recursive function which have 2 other parameters corresponding to the previous value and the last value of the series, let f(a, b, n).
We obtain:
for (n-1): a = F(n-2), b = F(n-1)
for (n): F(n-1) = b, F(n) = F(n-1) + F(n-2) = a + b
and
for (1): F(0) = 0 , F(1) = 1

Consequently, for this new function f(a, b, n), the recursion becomes f(b, a+b, n-1), and there are only (n-1) calls.
This iterative stacking algorithm is also modified accordingly.

Linearized Fibonacci series
(with even one more line computed)

Code: Select all

`Function Fibonacci_recursion_2 (Byval a As Uinteger, Byval b As Uinteger, Byval n As Uinteger) As Longint  If n <= 1 Then    Return b * n  Else    Return Fibonacci_recursion_2(b, a + b, n - 1)  End IfEnd FunctionFunction Fibonacci_recursion_L (Byval n As Uinteger) As longint  Function = Fibonacci_recursion_2( 0, 1, n)End Function'---------------------------------------------------------------------------#Include "UDT_dynamic_queue_stack.bi"UDT_dynamic_queue_stack(Uinteger)Dim Shared S As UDT_dynamic_queue_stack_UintegerFunction Fibonacci_iteration_stack_L (Byval n As Uinteger) As Longint  Dim cumul As Longint = 0  Dim an As Uinteger  Dim bn As Uinteger  Dim ns As Uinteger  S.stack_push(0)  S.stack_push(1)  S.stack_push(n)  Do While S.size > 0    ns = S.stack_pull    bn = S.stack_pull    an = S.stack_pull    If ns <= 1 then      cumul = cumul + bn * ns    Else      S.stack_push(bn)      S.stack_push(an + bn)      S.stack_push(ns - 1)    End If  Loop  Return cumulEnd Function'---------------------------------------------------------------------------Function Fibonacci_iteration_classic (Byval n As Uinteger) As Longint  Dim array(n) As Longint  For I As Uinteger = 0 To n    If I = 0 Or I = 1 Then      array(I) = I    Else      array(I) = array(I - 1) + array(I - 2)    End If  Next I  Return array(n)End Function'---------------------------------------------------------------------------Sub Display(Byval Fibonacci As Function (Byval n As Uinteger) As Longint, Byval n As Integer)  For I As Uinteger = 0 To n    If I Mod 8 = 0 Then      Print    End If    Locate , 10 * (I Mod 8)    Print Fibonacci(I);  Next IEnd Sub'---------------------------------------------------------------------------'Screen 12PrintPrint " recursion";Display(@Fibonacci_recursion_L, 39)PrintPrintPrintPrint " iteration with own stack";Display(@Fibonacci_iteration_stack_L, 39)PrintPrintPrintPrint " iteration without stack";Display(@Fibonacci_iteration_classic, 39)PrintSleep`

Adding of the Fibonacci series recursion linearizing method to improve the execution time duration.