REBOL [ Title: "Sort block of addresses" Purpose: {Sort a block of addresses on street name and then house number.} ] ;; [---------------------------------------------------------------------------] ;; [ This is a specialized module for a very specific purpose. ] ;; [ It takes a block of addresses expected to be in the form like this: ] ;; [ 1800 W OLD SHAKOPEE RD ] ;; [ and sorts the block first on the street name and then on the house ] ;; [ number. For addresses that do not match this form, the results will ] ;; [ not be as wanted. ] ;; [ To accomplish this sort, we will make a fixed-length sort key and attach ] ;; [ it to each address. The sort key will be 30 characters of the street ] ;; [ name plus six characters of the house number with leading zeros. ] ;; [---------------------------------------------------------------------------] SPACEFILL: func [ "Left justify a string, pad with spaces to specified length" INPUT-STRING FINAL-LENGTH ] [ head insert/dup tail copy/part trim INPUT-STRING FINAL-LENGTH #" " max 0 FINAL-LENGTH - length? INPUT-STRING ] ZEROFILL: func [ "Add zeros to the front of a string up to a given length" INPUT-STRING FINAL-LENGTH ] [ head insert/dup INPUT-STRING #"0" max 0 FINAL-LENGTH - length? INPUT-STRING ] SPLIT-ADDRESS: func [ ADDRESS /local FIRST-TOKEN ADDRESS-REMAINDER FIRST-SPACE-FOUND ADDRESS-PARTS ] [ trim ADDRESS FIRST-TOKEN: copy "" ADDRESS-REMAINDER: copy "" ADDRESS-PARTS: copy [] FIRST-SPACE-FOUND: false foreach ADDRESS-CHARACTER ADDRESS [ if equal? ADDRESS-CHARACTER #" " [ FIRST-SPACE-FOUND: true ] either FIRST-SPACE-FOUND [ append ADDRESS-REMAINDER ADDRESS-CHARACTER ] [ append FIRST-TOKEN ADDRESS-CHARACTER ] ] append ADDRESS-PARTS trim FIRST-TOKEN append ADDRESS-PARTS trim ADDRESS-REMAINDER return ADDRESS-PARTS ] SORT-ADDRESSES: func [ ADDRESSBLOCK /local PARTSBLOCK ADDRBLK HOUSE STREET SORTKEY RESULT ] [ PARTSBLOCK: copy [] foreach ADDRESS ADDRESSBLOCK [ ;; -- Dissect the address into house number and street name set [HOUSE STREET] SPLIT-ADDRESS ADDRESS ;; -- Build a fixed-length sort key out of the house and street SORTKEY: copy "" append SORTKEY rejoin [SPACEFILL STREET 30 ZEROFILL HOUSE 6] ;; print SORTKEY ;; -- Make a block out of the sort key and the original address ADDRBLK: copy [] append ADDRBLK SORTKEY append ADDRBLK ADDRESS ;; print mold ADDRBLK ;; -- Add the block we made to the cumulative block append/only PARTSBLOCK ADDRBLK ] ;; -- Sort the cumulative block on the sort key sort/compare PARTSBLOCK func [REC1 REC2] [REC1/1 < REC2/1] ;; -- Pick out only the original addresses and add them to the result RESULT: copy [] foreach ADDRBLK PARTSBLOCK [ append RESULT ADDRBLK/2 ] return RESULT ] ;;Uncomment to test. ;SORTED-ADDRESSES: SORT-ADDRESSES [ ;"203 ZENITH AVE" ;"1040 MAIN ST" ;"123 ZENITH AVE" ;"21 JUMP ST" ;"4 FOURTH ST" ;"100 FOURTH ST" ;] ;foreach ADDR SORTED-ADDRESSES [ ; print ADDR ;] ;halt