Liberty BASIC Community Forum
« [RC] Fibonacci Word and Fractal »

Welcome Guest. Please Login or Register.
Jan 22nd, 2018, 6:04pm

Rules|Home|Help|Search|Recent Posts|Notification

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 sticky  Author  Topic: [RC] Fibonacci Word and Fractal  (Read 232 times)

member is offline


Homepage PM

Gender: Male
Posts: 1179
xx [RC] Fibonacci Word and Fractal
« Thread started on: Dec 15th, 2016, 2:45pm »

Fibonacci Word and Fibonacci Word Fractal

As with many beginner-programmers with maths interests I played with things like displaying numbers in the Fibonacci series, fascinated by how quickly they diverge and become huge.
1 1 2 3 5 8 13 21 34 55 89 144 ... etc

I only recently noticed on Rosetta Code these two extensions, and spent a happy few hours coding them. Agreeably, LB is particularly easy for the graphic version..

Basically you are generating longer and longer strings from the concatenation of their two precedent strings, and mapping the zeros and ones to a moving turtle. Gives pretty results! RC also wants the entropy calculating...

User Image

( The following graphic is worth looking at at full size if your browser reduced it)
User Image

I rather lost interest in putting up RC solutions on their site- and there are still many unimplemented in LB yet quite easy to code. I may separate out the two bits from the following code and put them on, but here's the code for anyone interested.

    mainwin 140 60

    WindowWidth  =1240
    WindowHeight = 800

    open "Fibonacci Word Fractal" for graphics_nsb as #wg

    #wg "trapclose quit"

    global N, usedChar$

    fib$ =""
    dim countOfChar( 255)

    for i =0 to 26
        print using( "###", i +1); "  ";

        select case i
            case 0
                fib$        ="1"
                prevBy2$    ="1"
            case 1
                fib$        ="0"
                prebBy1$    ="0"
            case else
                prevBy1$    =fib$
                fib$        =prevBy1$ +prevBy2$
                prevBy2$    =prevBy1$

        end select

        N       =len( fib$)

        if N <80 then
            print using( "##########", N); "  "; using( "#.############", entropy( fib$)); "  "; fib$ 
            print using( "##########", N); "  "; using( "#.############", entropy( fib$)); "  "; left$( fib$, 70) +"...etc..."
        end if

        call drawIt fib$

    next i

    print: print " Done!": wait    '   _____________________________________________________________________________________________

    function entropy( i$)
        charCount  =len( i$)
        usedChar$  =""

        for k =0 to 255
            countOfChar( k) =0
        next k

        for i =1 to charCount
            ch$             =mid$( i$, i, 1)
            if not( instr( usedChar$, ch$)) then usedChar$ =usedChar$ +ch$
            j               =instr( usedChar$, ch$)
            countOfChar( j) =countOfChar( j) +1
        next i

        'l               =len( usedChar$)
        probability     =0

        for i =1 to len( usedChar$)
            probability =countOfChar( i) /charCount
            entropy     =entropy -( probability *log( probability) /log( 2))
        next i

    end function

sub drawIt fib$
    'The  first digit is     "0", so draw a vertical segment and turn right.
    'The  second  digit  is  "1"  so  draw  a  horizontal  segment,
    'the  third  digit  is   "0"  so  continue horizontally and turn right.
    'The fourth digit is     "0" so draw a vertical segment and turn left..
    '   etc etc

    st  =1
    #wg "up ; cls ; goto 1200 710 ; down ; fill black ; north"
    for i =1 to len( fib$)
        red =int( 128 +127 *cos( i *0.057))
        grn =int( 128 +127 *cos( 0.5 +i *0.023))
        blu =int( 128 +127 *sin( i *0.037))
        #wg "color "; str$( red); " "; str$( grn); " "; str$( blu)
        #wg "go "; st
        ch$     =mid$( fib$, i, 1)
        n       =val( ch$)

        if ch$ ="0" then
            isEven  =( ( i /2) =int( i /2))
            if isEven then #wg "turn 90" else #wg "turn -90"
        end if

    next i
end sub

sub quit h$
    close #wg
end sub
User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls