Liberty BASIC Community Forum
« [RC] Water collected between towers »

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


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


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 sticky  Author  Topic: [RC] Water collected between towers  (Read 268 times)
tenochtitlanuk
Moderator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1179
xx [RC] Water collected between towers
« Thread started on: Dec 19th, 2016, 08:17am »

see Rosetta Code

Task
'In a two-dimensional world, we begin with any bar-chart (or row of close-packed 'towers', each of unit width), and then it rains, completely filling all convex enclosures in the chart with water. '

A fun one to play with! Reminds me of the recent falling-snow ones. And the examples on RC in other languages seem complicated and output in ASCII!!

User Image

I've applied the same algorithm two different ways. Will post code in a few days in case anyone fancies starting this one 'cold'!

EDIT
Code:
    data "1,5,3,7,2", "5,3,7,2,6,4,5,9,1,2", "2,6,3,5,2,8,1,4,2,2,5,3,5,7,4,1", "5,5,5,5", "5,6,7,8", "8,7,7,6", "6,7,10,7,6"

    nomainwin

    dim array$( 20, 20)

    WindowWidth  = 400
    WindowHeight = 500

    open "Water Towers" for graphics_nsb as #wg

    #wg "trapclose quit"

    #wg "down ; fill darkblue"
    #wg "font Ubuntu_Mono 15 bold"

    for k =1 to 7
        rain =0
        read wt$

        towersIn    =1
        for i =1 to len( wt$)
            if mid$( wt$, i, 1) ="," then towersIn =towersIn +1
        next i

        #wg "cls"

        gosub [clearArray]

        for i =1 to towersIn
            v =val( word$( wt$, i, ","))
            for j =0 to 20
                if j <v then array$( i, j) ="red" else array$( i, j) ="white" '  red if tower, white if empty
                #wg "backcolor "; array$( i, j)
                #wg "    color "; array$( i, j)
                #wg "up ; goto "; 20 +i *20; " "; 450 -20 *j; " ; down ; boxfilled "; 40 +i *20; " "; 430 -20 *j
            next j
        next i

       call delay 1000

       #wg "getbmp scr 0 0 400 500"
       bmpsave "scr", "rain" +str$( k) +"a.bmp"

        for i =2 to towersIn -1
            for v =0 to 19
                me$     =array$( i, v)
                left$   =array$( i -1, v)

                right$   =""
                for w =i +1 to towersIn
                    if array$( w, v) ="red" then right$ ="red"
                next w

                if ( me$ ="white" and left$ ="red" and right$ ="red") or ( me$ ="white" and left$ ="cyan" and right$ ="red") then
                    array$( i, v) ="cyan": rain =rain +1
                end if

                #wg "backcolor "; array$( i, v)
                #wg "    color "; array$( i, v)
                #wg "up ; goto "; 20 +i *20; " "; 450 -20 *v; " ; down ; boxfilled "; 40 +i *20; " "; 430 -20 *v

            next v
        next i

        #wg "up ; goto 100 80 ; down ; color black"
        #wg "\" +"Run "; k; "  Rain ="; rain

       #wg "getbmp scr 0 0 400 500"
       bmpsave "scr", "rain" +str$( k) +"b.bmp"

       call delay 1000

    next k

    wait

    end

    sub quit h$
        close #wg
        end
    end sub

[clearArray]
    for i =0 to 10
        for j =0 to 20
            array$( i, j) =""   '   state not known
        next j
    next i
 
« Last Edit: Dec 28th, 2016, 10:16am by tenochtitlanuk » User IP Logged

tsh73
Moderator
ImageImageImageImageImage


member is offline

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1732
xx Re: [RC] Water collected between towers
« Reply #1 on: Dec 28th, 2016, 08:55am »

scanned line by line
(ascii)
Code:
'[RC] Water collected between towers
'http://rosettacode.org/wiki/Water_collected_between_towers
'tsh73 dec 2016
data "1,5,3,7,2"
data "5,3,7,2,6,4,5,9,1,2"
data "2,6,3,5,2,8,1,4,2,2,5,3,5,7,4,1"
data "5,5,5,5"
data "5,6,7,8"
data "8,7,7,6"
data "6,7,10,7,6"
data "XIZZY"

while 1
    read a$
    if a$="XIZZY" then print "*Over*":end
    i$ = "*"
    i = 0
    while 1
        i=i+1
        i$=word$(a$, i, ",")
        if i$="" then exit while
    wend
    n = i-1
    print "n= ";n
    dim a(n)
    mn = 1e10
    mx = 0
    for i = 1 to n
        v=val(word$(a$, i, ","))
        a(i) = v
        if v < mn then mn = v
        if v > mx then mx = v
    next
    print "mn= ";mn
    print "mx= ";mx
    filled=0
    cls
    'for r = mn to mx
    for r = 1 to mx
    if r = 4 then
        a=a'breakpoint
    end if
        fill = 0
        preFill = 0
        'left border - fill starts. Right border - fill ends
        'for c = 1 to n
            'find left wall
            'find next empty
            'fill up to next left wall
         c = 1
         while 1
             while c <=n
                if a(c)< r then call prt c,r,".":c=c+1 else exit while
             wend
             if c > n then exit while
             while c <=n
                if a(c)>= r then call prt c,r, "#":c=c+1 else exit while
             wend
             if c > n then exit while
             'here we are after wall
             aw=c
             while c <=n
                if a(c)< r then preFill=preFill+1:call prt c,r, "~": c=c+1 else exit while
             wend
             if c > n then for i = aw to n:call prt i,r,".":next:exit while   'prefill lost from right edge
             'else
             filled=filled+preFill
             preFill = 0
        wend
    next
    locate 1, 21
    print "filled= ";filled
    input "press Enter to continue"; dummy$
wend

end

function string$(n, a$)
    string$ = ""
    for i = 1 to n
        string$ = string$ + a$
    next
end function

sub prt c,r,a$ 
    'locate r,c
    locate c, 20-r
    print a$
end sub
 
User IP Logged

damned Dog in the Manger
tenochtitlanuk
Moderator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1179
xx Re: [RC] Water collected between towers
« Reply #2 on: Dec 28th, 2016, 10:18am »

Thanks Anatoly- another interesting one!
I ought to re-visit to consider towers which do not have integral heights- RC does not specify they are integral, 'tho answers all assume it.
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