Sort Challenge
-
- Site Admin
- Posts: 128
- Joined: Sat Nov 13, 2004 8:36 am
- Location: Vashon Wa
- Contact:
Sort Challenge
Post your entries to the Sort Challenge here.
- Attachments
-
- SortFile.zip
- Common file for the Sort Challenge.
- (11.89 KiB) Downloaded 564 times
John Davidson
e-me: johnshomeport@yahoo.com
My JB Page: http://john.jbusers.com/
Did ya Libby yet? http://lblibby.com/
e-me: johnshomeport@yahoo.com
My JB Page: http://john.jbusers.com/
Did ya Libby yet? http://lblibby.com/
Sort challenge entry
I'm not absolutely sure what kind of sort this is, extraction? I find the lowest record in a pool of ever reducing records and build up the sorted file.
Nice distraction, thank you for hosting the challenge. All other projects delayed yet again
Nice distraction, thank you for hosting the challenge. All other projects delayed yet again
Code: Select all
'Sort challenge for Just Basic April 2005
'Entry by Rod Bird
'
'Useage - call function with comma delimited file name and column sort order string.
'Any comma delimited file can be sorted on as many columns as exist, in any order.
'i.e. "1"=sort on column 1. "14"=sort on column 1 followed by column 4
time=SortFile("SortFile.dat","1")
print "Sorted file in ";time;" seconds."
wait
function SortFile(f$,order$)
'if there is no order default to col one
if order$="" then order$="1"
open f$ for input as #Inp
'get the number of lines in the file
print "Opening file."
record=0
while eof(#Inp) = 0
line input #Inp, nextRecord$
record=record+1
wend
'get the number of fields in the file
entry=1
nextEntry$=word$(nextRecord$,entry,",")
while nextEntry$<>""
entry=entry+1
nextEntry$=word$(nextRecord$,entry,",")
wend
entry=entry-1
close #Inp
'now dimension a temp array and read in the file
open f$ for input as #Inp
dim temparray$(record,entry)
for r = 1 to record
line input #Inp, nextRecord$
for e = 1 to entry
temparray$(r,e)=word$(nextRecord$,e,",")
next e
next r
close #Inp
'now sort the file according to the column order requested.
'we put the lowest record found at the top of the file.
'we then find the lowest record in the remaining records and
'put that next top etc etc.
print "Sorting file."
time=time$("ms")
for r = 1 to record
'create the compare string
compa$=""
for p=1 to len(order$)
compa$=compa$+temparray$(r,val(mid$(order$,p,1)))
next p
lowest=0
for s = r+1 to record
'create the string to compare against
compb$=""
for p=1 to len(order$)
compb$=compb$+temparray$(s,val(mid$(order$,p,1)))
next p
'if it is lower then swap to remember the lowest record found
if compa$>compb$ then
compa$=compb$
lowest=s
end if
next s
'if we found a lower record put it to the current building record position
if lowest>0 then
for e = 1 to entry
swaparray$(e)=temparray$(r,e)
next e
for e = 1 to entry
temparray$(r,e)=temparray$(lowest,e)
next e
for e = 1 to entry
temparray$(lowest,e)=swaparray$(e)
next e
end if
next r
SortFile=(time$("ms")-time)/1000
'print out sorted file for info
for r = 1 to record
for e = 1 to entry
print temparray$(r,e);",";
next e
print
next r
end function
-
- Site Admin
- Posts: 117
- Joined: Wed Nov 24, 2004 2:49 am
Nice GUI, Dennis! Okay, here's my submission. No frills and no better than the others.
Code: Select all
' NL Contents sorter
' File Layout
' NL# , Title , Author , Version
' Contest Entry by Janet Terra
Nomainwin
lineCount = 0
'Count the number of items
Open "SortTest.dat" for Input as #1
While not(eof(#1))
Line Input #1,dummy$
lineCount = lineCount + 1
Wend
Close #1
'Dim nlLine$(lineCount), nlArray$(lineCount)
Dim nlLine$(lineCount)
Dim nlArray$(lineCount)
'Read the nlLine$()
Open "SortTest.dat" for input as #1
For i = 1 to lineCount
Line Input #1, nlLine$(i)
Next i
Close #1
WindowWidth = 790
WindowHeight = 580
Texteditor #main.te, 1, 1, 780, 482
Menu #main, "Sort &Options", "Sort by &Newsletter", _
[SortByNewsletter], "Sort by &Title", [SortByTitle], _
"Sort by &Author", [SortByAuthor], "Sort by &Compatibility", _
[SortByCompatibility],|, "E&xit", [endProgram]
Menu #main, "&Save", "&Save This File", [SaveThisFile]
Open "Just BASIC Sort Challenge - JLT" for Window as #main
#main, "Trapclose [endProgram]"
#main, "Font Courier_New 10 Bold"
[SortByNewsletter]
startTime = Time$("ms")
Call SortMessage "Newsletter Issue"
Call StoreArray lineCount, 1, 2, 3, 4
ShakerStringSort = ShakerStringSort(lineCount)
durationTime = Time$("ms") - startTime
Call ShowArray lineCount
Call ShowTime lineCount, durationTime
Wait
[SortByTitle]
startTime = Time$("ms")
Call SortMessage "Newsletter Title"
Call StoreArray lineCount, 2, 3, 1, 4
ShakerStringSort = ShakerStringSort(lineCount)
durationTime = Time$("ms") - startTime
Call ShowArray lineCount
Call ShowTime lineCount, durationTime
Wait
[SortByAuthor]
startTime = Time$("ms")
Call SortMessage "Newsletter Author"
Call StoreArray lineCount, 3, 2, 1, 4
ShakerStringSort = ShakerStringSort(lineCount)
durationTime = Time$("ms") - startTime
Call ShowArray lineCount
Call ShowTime lineCount, durationTime
Wait
[SortByCompatibility]
startTime = Time$("ms")
Call SortMessage "JB Compatibility"
Call StoreArray lineCount, 4, 1, 2, 3
ShakerStringSort = ShakerStringSort(lineCount)
durationTime = Time$("ms") - startTime
Call ShowArray lineCount
Call ShowTime lineCount, durationTime
Wait
[SaveThisFile]
#main.te, "!Contents text$"
Open "titleContents.dat" for Output as #1
Print #1, text$
Close #1
Wait
[endProgram]
Close #main
End
Function ShakerStringSort(nItems)
ThisItem = 1 : CompareItems = nItems
#main.te, Space$(12);
While ThisItem < CompareItems
min = ThisItem
max = ThisItem
For pass = ThisItem + 1 To CompareItems
If nlArray$(pass) < nlArray$(min) Then min = pass
If nlArray$(pass) > nlArray$(max) Then max = pass
Next pass
nlArray$(0) = nlArray$(min)
nlArray$(min) = nlArray$(ThisItem)
nlArray$(ThisItem) = nlArray$(0)
If max = ThisItem Then
nlArray$(0) = nlArray$(min)
nlArray$(min) = nlArray$(CompareItems)
nlArray$(CompareItems) = nlArray$(0)
Else
nlArray$(0) = nlArray$(max)
nlArray$(max) = nlArray$(CompareItems)
nlArray$(CompareItems) = nlArray$(0)
End If
ThisItem = ThisItem + 1
CompareItems = CompareItems - 1
If (ThisItem/20) = Int(ThisItem/20) Then
#main.te, ".";
End If
Wend
#main.te, ""
nlArray$(0) = ""
End Function
Sub StoreArray lineCount, F1, F2, F3, F4
Redim nlArray$(lineCount)
For i = 1 to lineCount
nlArray$(i) = Word$(nlLine$(i), F1, ",");"," + Word$(nlLine$(i), F2, ",");"," + _
Word$(nlLine$(i), F3, ",");"," + Word$(nlLine$(i), F4, ",")
Next i
End Sub
Sub SortMessage SortField$
Redim nlArray$(0)
#main.te, "!Cls"
For i = 1 to 10
#main.te, ""
Next i
#main.te, Space$(12);"SORTing by ";SortField$
End Sub
Sub ShowArray lineCount
#main.te, "!Cls"
#main.te, "There were ";lineCount;" values read from the file."
#main.te, ""
For i = 1 to lineCount
#main.te, nlArray$(i)
Next i
End Sub
Sub ShowTime lineCount, durationTime
#main.te, ""
#main.te, "The array of ";lineCount;" items was sorted in ";durationTime;" milliseconds."
End Sub
Joris' entry
Hello,
here is my entry. It was a rush against time as it is allready 16th of April where I am ! (ok I am 9 minutes late)
So it could have been better. I am not really happy with code, but it does the job !
Cheers
Joris
here is my entry. It was a rush against time as it is allready 16th of April where I am ! (ok I am 9 minutes late)
So it could have been better. I am not really happy with code, but it does the job !
Cheers
Joris
Code: Select all
'April 2005 JustBasic SortChallenge
'Entry by Joris Van den Bossche aka JeanRoule
[VAR]
NrOfLines = 0
fileName$ =""
SaveName$ =""
Choice = 0
[MAIN]
GOSUB [openmywindow]
WAIT
'we go eventdriven
'user can click
'==>OPEN in order to open the sortfile
'==>the numbers 1 2 3 4 in order to select on what element to sort
'==>SAVE in order to save the sorted file
END 'of MAIN
'***** BRANCHES *****
[quicksort]
startTime = time$("milliseconds") 'clock starts ticking
GOSUB [assignarray] 'please note that array assignment is
'INSIDE time measurement
dummy=QuickSort(1,NrOfLines) 'Core of the program
endTime=time$("milliseconds") 'stop the clock, print the time
print #brd.t1, endTime-startTime; " milliseconds for sorting"
WAIT
[dimensioning]
DIM ID$(NrOfLines)
DIM Title$(NrOfLines)
DIM Author$(NrOfLines)
DIM Stock$(NrOfLines)
DIM Array$(NrOfLines)
'Array$() is the array I will actually sort on.
RETURN
[readdata]
OPEN fileName$ FOR INPUT AS #fh
i = 1
WHILE eof(#fh) = 0
INPUT #fh, ID$(i), Title$(i), Author$(i), Stock$(i)
i = i+1
WEND
CLOSE #fh
RETURN
[assignarray]
'assign the elements we will sort on
SELECT CASE Choice
CASE 1
FOR x = 1 TO NrOfLines
Array$(x) = ID$(x)
NEXT x
CASE 2
FOR x = 1 TO NrOfLines
Array$(x) = Title$(x)
NEXT x
CASE 3
FOR x = 1 TO NrOfLines
Array$(x) = Author$(x)
NEXT x
CASE 4
FOR x = 1 TO NrOfLines
Array$(x) = Stock$(x)
NEXT x
CASE ELSE
END SELECT
RETURN
[output]
IF Choice = 0 THEN
NOTICE "First sort a file..."
WAIT
END IF
IF SaveFile("Save sorted file as...", "*.dat", SaveName$) THEN
OPEN SaveName$ FOR OUTPUT AS #fh
FOR i = 1 to NrOfLines
PRINT #fh, ID$(i);" ";Title$(i);" ";Author$(i);" ";Stock$(i)
NEXT i
CLOSE #fh
ELSE
WAIT
END IF
WAIT
[openmywindow]
nomainwin
WindowWidth = 240
WindowHeight = 180
UpperleftX = 50
UpperleftY = 50
button #brd, " Open ", [go], UL, 10, 60
button #brd, " Save ", [output], UL, 70 , 60
button #brd, " 1 ", [1], UL, 10, 100
button #brd, " 2 ", [2], UL, 40, 100
button #brd, " 3 ", [3], UL, 70, 100
button #brd, " 4 ", [4], UL, 100, 100
textbox #brd.t1, 10, 10, 210, 25
open "joriSort" for graphics_nsb as #brd
print #brd, "trapclose [quit]";
print #brd.t1, "Please OPEN a file"
RETURN
[go]
IF OpenFile("Open the Sort File","*.dat",fileName$) THEN
NrOfLines = NrOfLines(fileName$)
GOSUB [dimensioning]
GOSUB [readdata]
print #brd.t1, "Select on what element to sort"
WAIT
ELSE
NOTICE "No file selected, terminating"
GOSUB [quit]
END IF
RETURN
[quit]
CLOSE #brd
END
[1]
IF NrOfLines = 0 THEN
NOTICE "First open a file..."
WAIT
ELSE
PRINT #brd.t1, "Sorting on 1..."
Choice = 1:GOTO [quicksort]
END IF
[2]
IF NrOfLines = 0 THEN
NOTICE "First open a file...":WAIT
ELSE
PRINT #brd.t1, "Sorting on 2..."
Choice = 2:GOTO [quicksort]
END IF
[3]
IF NrOfLines = 0 THEN
NOTICE "First open a file...":WAIT
ELSE
PRINT #brd.t1, "Sorting on 3..."
Choice = 3:GOTO [quicksort]
END IF
[4]
IF NrOfLines = 0 THEN
NOTICE "First open a file...":WAIT
ELSE
PRINT #brd.t1, "Sorting on 4..."
Choice = 4:GOTO [quicksort]
END IF
'**** FUNCTIONS ****
FUNCTION QuickSort(Left,Right)
'Recursive Qsort. Alledgedly slower than an iterative one, but so much prettier !
dummyLeft=Left
dummyRight=Right
pivot$ = Array$(Left) 'take the first element as pivot
WHILE (dummyLeft <= dummyRight)
WHILE (Array$(dummyLeft) < pivot$ AND dummyLeft < Right)
dummyLeft = dummyLeft + 1
WEND
WHILE (pivot$ < Array$(dummyRight) AND dummyRight > Left)
dummyRight = dummyRight - 1
WEND
IF (dummyLeft <= dummyRight) THEN
S1$ = Array$(dummyLeft) 'Copying ALL the the data-elements
S2$ = ID$(dummyLeft) 'It took me 2 days to find this
S3$ = Title$(dummyLeft)
S4$ = Author$(dummyLeft) 'I roughly estimate the penalty for all this code
S5$ = Stock$(dummyLeft) 'within the Qsort to 50 milliseconds
Array$(dummyLeft) = Array$(dummyRight)
ID$(dummyLeft) = ID$(dummyRight)
Title$(dummyLeft) = Title$(dummyRight)
Author$(dummyLeft) = Author$(dummyRight)
Stock$(dummyLeft) = Stock$(dummyRight)
Array$(dummyRight) = S1$
ID$(dummyRight) = S2$
Title$(dummyRight) = S3$
Author$(dummyRight)= S4$
Stock$(dummyRight) = S5$
dummyLeft = dummyLeft + 1
dummyRight = dummyRight - 1
END IF
WEND
IF (Left < dummyRight) THEN
dummy = QuickSort(Left, dummyRight)
END IF
IF (dummyLeft < Right) THEN
dummy = QuickSort(dummyLeft, Right)
END IF
END FUNCTION
FUNCTION NrOfLines(File$)
NrOfLines = 0
OPEN File$ FOR INPUT AS #fh
WHILE eof(#fh) = 0
INPUT #fh, One$, Two$, Three$, Four$ 'Dummy Values
NrOfLines = NrOfLines +1
WEND
CLOSE #fh
END FUNCTION
FUNCTION OpenFile(Title$, joker$, byref file$)
OpenFile = 0 'BOOLEAN FALSE as we have no file yet
FILEDIALOG Title$, joker$, file$
IF file$<>"" THEN
OpenFile = 1 'BOOLEAN TRUE as we have a file
ELSE
OpenFile = 0
END IF
END FUNCTION
FUNCTION SaveFile(Title$, joker$, byref file$)
SaveFile = 0 'BOOLEAN FALSE as we have no file yet
FILEDIALOG Title$, joker$, file$
IF file$<>"" THEN
SaveFile = 1 'BOOLEAN TRUE as we have a file
ELSE
SaveFile = 0
END IF
END FUNCTION
-
- Site Admin
- Posts: 117
- Joined: Wed Nov 24, 2004 2:49 am
Revised LBNewsletters.dat File
This .dat file is an updated of the original sort.dat file used for the sorting challenge. In this file, the 4th field (JB Compatibility) has been updated for Issues 1-8 and 93 - 131. All other issues have -1 (unclassified) in the 4th field. The key is
0 - Informational only, no code
1 - Just BASIC compatible as is
2 - Just BASIC compatible with minor modifications
3 - Not Just BASIC compatible
0 - Informational only, no code
1 - Just BASIC compatible as is
2 - Just BASIC compatible with minor modifications
3 - Not Just BASIC compatible
- Attachments
-
- LBNewsletters.zip
- Newsletters 1 - 131. (Articles in Issues 9 - 92 are unclassified). 4th field key = -1: Unclassified; 0:Informational only, no code; 1: JB Compatible as is; 2: JB Compatible with minor mods; 3: Non JB compatible
- (11.36 KiB) Downloaded 445 times