Liberty BASIC Community Forum
« Search Results »

Welcome Guest. Please Login or Register.
Sep 27th, 2016, 1:53pm


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

--Liberty BASIC Resources--
Liberty BASIC Community WikiSpace
Frequently Asked Questions
Bay Six Software Forum
Liberty BASIC Home Page
Carl Gundel's Blog
Official Liberty BASIC Support
Liberty BASIC Programmer's Encyclopedia
Liberty BASIC on Rosetta Code

Search Results

Total results: 10


 1   Open Source Projects / Re: [RC] ABC Problem  on: Yesterday at 08:56am
Started by Jack Kelly | Post by Jack Kelly
Here's a link to the GUI version of ABC Problem. It's much easier to use for testing than the MainWin version.

http://basic.wikispaces.com/Rosetta+Code+-+ABC+Problem%2C+GUI

I'll leave it to you all to retrofit the midSub$() if you want to run it on LB45.

Jack
 
  Reply Quote Notify of replies

 2   Open Source Projects / [RC] Factors of an integer  on: Yesterday at 03:35am
Started by Jack Kelly | Post by Jack Kelly
http://rosettacode.org/wiki/Factors_of_an_integer

How about this? Any thoughts?

Code:
print "ROSETTA CODE - Factors of an integer"
'A simpler approach for smaller numbers
[Start]
print
input "Enter an integer (< 1,000,000): "; n
n=abs(int(n)): if n=0 then goto [Quit]
if n>999999 then goto [Start]
FactorCount=FactorCount(n)
select case FactorCount
    case 1: print "The factor of 1 is: 1"
    case else
        print "The "; FactorCount; " factors of "; n; " are: ";
        for x=FactorCount to 1 step -1
            print " "; Factor(x);
        next x
        if FactorCount=2 then print " (Prime)" else print
end select
goto [Start]

[Quit]
print "Program complete."
end

function FactorCount(n)
    dim Factor(100)
    for y=1 to n
        if y>sqr(n) and FactorCount=1 then
'If no second factor is found by the square root of n, then n is prime.
            FactorCount=2: Factor(FactorCount)=1: exit function
        end if
        z=n/y
        if z=int(z) then
            FactorCount=FactorCount+1
            Factor(FactorCount)=z
        end if
    next y
end function
 

 
  Reply Quote Notify of replies

 3   Game and Graphic Programming / Re: Resizing a graphicbox?  on: Sep 25th, 2016, 6:07pm
Started by MKnarr | Post by cundo
Thanks tsh, I wasn't aware of that, or I forgot it, not sure.
 
  Reply Quote Notify of replies

 4   Open Source Projects / Re: [RC] ABC Problem  on: Sep 25th, 2016, 12:42pm
Started by Jack Kelly | Post by tenochtitlanuk
I'll have a look, but flying off for a few weeks in the States tomorrow so won't be on the Forum much.

Both your and the RC 'solutions' seem very long.
But alternative approaches are always(?) possible!

re mid$( as an assignment, it's easily accomodated within LB4.5 eg
Code:
    x$  ="RosettaCodeIsGreatFun"
    for i =1 to len( x$)
        print midSub$( x$, i, 1, "X")
    next i

    end

    function midSub$( in$, posn, numch, subs$)
        midSub$   =left$( left$( in$, posn -1) +subs$ +mid$( in$, posn +numch), len( in$))
    end function

 

which prints out
Code:
XosettaCodeIsGreatFun
RXsettaCodeIsGreatFun
RoXettaCodeIsGreatFun
RosXttaCodeIsGreatFun
RoseXtaCodeIsGreatFun
RosetXaCodeIsGreatFun
RosettXCodeIsGreatFun
RosettaXodeIsGreatFun
RosettaCXdeIsGreatFun
RosettaCoXeIsGreatFun
RosettaCodXIsGreatFun
RosettaCodeXsGreatFun
RosettaCodeIXGreatFun
RosettaCodeIsXreatFun
RosettaCodeIsGXeatFun
RosettaCodeIsGrXatFun
RosettaCodeIsGreXtFun
RosettaCodeIsGreaXFun
RosettaCodeIsGreatXun
RosettaCodeIsGreatFXn
RosettaCodeIsGreatFuX
 

EDIT Of course passing the length is redundant since it can be derived from length of the replacing string.
 
  Reply Quote Notify of replies

 5   Open Source Projects / [RC] ABC Problem  on: Sep 25th, 2016, 05:00am
Started by Jack Kelly | Post by Jack Kelly
http://rosettacode.org/wiki/ABC_Problem

OK. Have a look at this one. I have a nagging suspicion that it may report 'false' under certain block/word combinations. Perhaps involving n blocks having letters on both sides that are needed in the word, and n+1 letters remaining to fit (or something like that). But I can't find a test case to make it fail.

Code:
w$(1)="A"
w$(2)="BARK"
w$(3)="BOOK"
w$(4)="TREAT"
w$(5)="COMMON"
w$(6)="SQUAD"
w$(7)="CONFUSE"
for x=1 to 7
    print ">>> can_make_word("; chr$(34); w$(x); chr$(34); ")"
    if CanMakeWord(w$(x)) then print "True" else print "False"
next x
end

function CanMakeWord(x$)
global DoneWithWord, BlocksUsed, LetterOK, Possibility
dim block$(20,2), block(20,2)
'numeric blocks, col 0 flags used block
block(1,1)=asc("B")-64: block(1,2)=asc("O")-64
block(2,1)=asc("X")-64: block(2,2)=asc("K")-64
block(3,1)=asc("D")-64: block(3,2)=asc("Q")-64
block(4,1)=asc("C")-64: block(4,2)=asc("P")-64
block(5,1)=asc("N")-64: block(5,2)=asc("A")-64
block(6,1)=asc("G")-64: block(6,2)=asc("T")-64
block(7,1)=asc("R")-64: block(7,2)=asc("E")-64
block(8,1)=asc("T")-64: block(8,2)=asc("G")-64
block(9,1)=asc("Q")-64: block(9,2)=asc("D")-64
block(10,1)=asc("F")-64: block(10,2)=asc("S")-64
block(11,1)=asc("J")-64: block(11,2)=asc("W")-64
block(12,1)=asc("H")-64: block(12,2)=asc("U")-64
block(13,1)=asc("V")-64: block(13,2)=asc("I")-64
block(14,1)=asc("A")-64: block(14,2)=asc("N")-64
block(15,1)=asc("O")-64: block(15,2)=asc("B")-64
block(16,1)=asc("E")-64: block(16,2)=asc("R")-64
block(17,1)=asc("F")-64: block(17,2)=asc("S")-64
block(18,1)=asc("L")-64: block(18,2)=asc("Y")-64
block(19,1)=asc("P")-64: block(19,2)=asc("C")-64
block(20,1)=asc("Z")-64: block(20,2)=asc("M")-64

x$=upper$(x$)
for x=1 to len(x$)
    y$=mid$(x$,x,1)
    if y$>="A" and y$<="Z" then w$=w$+y$
next x
if w$="" then exit function
DoneWithWord=0: BlocksUsed=0
l=len(w$)
dim LetterOK(l)
dim alphabet(26,1) 'clear letter-usage array
for x=1 to 20 'load block letters into letter-usage array col 0
    alphabet(block(x,1),0)+=1
    alphabet(block(x,2),0)+=1
next x
for x=1 to l 'load current word into letter-usage aray col 1
    wl$=mid$(w$,x,1): w=asc(wl$)-64
    alphabet(w,1)+=1
next x

for x=1 to 26 ' test for more of any letter in the word than in the blocks
    if alphabet(x,1)>alphabet(x,0) then exit function
next x

[NextLetter]
if wl<l then wl=wl+1 else goto [DoneWithWord]
wl$=mid$(w$,wl,1): w=asc(wl$)-64
LetterOK=0
' if there's only one of the letter in the blocks then you must use that block
if alphabet(w,0)=1 then
    call OnlyBlock w
    LetterOK(wl)=1
    if DoneWithWord then goto [DoneWithWord] else goto [NextLetter]
end if
' if more than one of the letter in the blocks, then try to use one that has
' an unused letter on other side (a "Free Block")
call FindFreeBlock w
if LetterOK then LetterOK(wl)=1
goto [NextLetter]

[DoneWithWord]
if BlocksUsed=l then CanMakeWord=1: exit function
if DoneWithWord then exit function
for x=1 to l
    if not(LetterOK(x)) then
        NumericLetter=asc(mid$(w$,x,1))-64
        LetterOK=0
        call OnlyBlock NumericLetter
        if LetterOK then LetterOK(x)=1 else exit for
    end if
next x
goto [DoneWithWord]
end function

sub OnlyBlock NumericLetter
    for x=1 to 20
        if (block(x, 1)=NumericLetter or block(x, 2)=NumericLetter) _
                and block(x, 0)=0 then
            call UseBlock x, NumericLetter
            exit sub
        end if
    next x
    DoneWithWord=1
end sub

sub FindFreeBlock NumericLetter
    Possibility=0
    for x=1 to 20
        if block(x, 0)=0 then 'block not used
            if block(x,1)=NumericLetter then
                if alphabet(block(x,2),1)=0 then
                    call UseBlock x, NumericLetter
                    exit sub
                end if
                Possibility=Possibility+1
            end if
            if block(x,2)=NumericLetter then
                if alphabet(block(x,1),1)=0 then
                    call UseBlock x, NumericLetter
                    exit sub
                end if
                Possibility=Possibility+1
            end if
        end if
    next x
end sub

sub UseBlock BlockNumber, NumericLetter
    block(BlockNumber, 0)=1 'Mark block as used
    BlocksUsed=BlocksUsed+1
    LetterOK=1
end sub
 

I have a GUI version, but I don't think it will run on LB45. It uses string substitution assignment -- mid$(x$,2,1)="X".

Regards,
Jack
 
  Reply Quote Notify of replies

 6   General Board / Re: Help with ideas?  on: Sep 24th, 2016, 4:45pm
Started by ElEdwards | Post by tenochtitlanuk
Searching the 'net is an art.
Surprised you didn't find for example my entries at http://libertybasic.conforums.com/index.cgi?board=LB3&action=display&num=1468265910 and anatoly's thread http://libertybasic.conforums.com/index.cgi?board=open&action=display&num=1433923780

What I'm saying is simply that you help the LB community more by posting your versions here. It's not about bragging rights for being 'first to put it on RC'. In the examples I coded I got valuable suggestions, and, yes, improvements, from this community before posting.

But anything boosting LB on Rosetta Code is good.

EDIT I seem to have posted here re Rosetta Code 113 times in the last five years.
 
  Reply Quote Notify of replies

 7   General Board / Re: Help with ideas?  on: Sep 24th, 2016, 2:45pm
Started by ElEdwards | Post by tsh73
Quote:
but there hasn't been any [RC] entries there in six years.

Huh? I see year 2015
 
  Reply Quote Notify of replies

 8   General Board / Re: Help with ideas?  on: Sep 24th, 2016, 1:55pm
Started by ElEdwards | Post by Jack Kelly
Don't panic -- I have no plans to change any existing RC Liberty BASIC solutions in the foreseeable future.

I've put up five solutions so far. Array Length, Convert Seconds, Find the last Sundays, Babbage Problem, and ABC Problem. All but Array Length will run on JB.

I'm working on four more related solutions. Factors of an Integer, Proper Divisors, Number Classifications (Abundant, et al), and Aliquot Sequences.

I'll give some thought to posting in the Open Source Section of this forum, but there hasn't been any [RC] entries there in six years. Thanks for letting me know about it though.

Jack
 
  Reply Quote Notify of replies

 9   General Board / Re: Help with ideas?  on: Sep 24th, 2016, 10:45am
Started by ElEdwards | Post by tenochtitlanuk
Glad you find Rosetta Code such an interesting site. Many of us do!

You will of course have seen the many entries here, in the 'Open Source Projects' section, prefaced with [RC] and with links to the task.

Please put up HERE any changes you make to existing solutions, so we can learn where yours is an improvement, not just on RC, and please use the format of earlier RC solutions pasted here in the past. Just pick up the thread where it was posted on here. The forum search will find these contributions, 'tho I prefer to use Google to search just the LB site. More versatile and thorough...

I had a big burst of doing RC solutions, but then eased off, actually 'solving' them, but leaving them for others to do. My version would have an un-requested GUI front end, or chase the task in new directions for my fun. If you are changing 'my' solutions I'd particularly like to learn of your improvements! I'm certainly not perfect...

I've learned a lot by looking at solutions in other languages- ancient friends like Fortran, other BASICs, FORTH, and especially Python. Anyone intending a professional career in computing today needs a mixture of C ( C#,or C++), Java(script), PHP, SQL data querying, etc, etc.

Happy coding!


 
  Reply Quote Notify of replies

 10   General Board / Re: open a subdirectory in defaultDir without API  on: Sep 23rd, 2016, 10:31am
Started by Zabo | Post by Zabo
Hello Chris ,

it works.


FAQ : Is it possible to open many folders of records
at the same time to compare the files and
change the files in the folders , even if there
are many hundred of -recordfolders existing ?

Yes , that is the main reason for that database
It is possible.


ZABO


 
  Reply Quote Notify of replies


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