September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -0,0 +1,67 @@
|
|||
use framework "Foundation"
|
||||
|
||||
-- SORTING COMPOSITE STRUCTURES (BY PRIMARY AND N-ARY KEYS)
|
||||
|
||||
-- List of {strKey, blnAscending} pairs -> list of records -> sorted list of records
|
||||
-- sortByComparing :: [(String, Bool)] -> [Records] -> [Records]
|
||||
on sortByComparing(keyDirections, xs)
|
||||
set ca to current application
|
||||
|
||||
script recDict
|
||||
on |λ|(x)
|
||||
ca's NSDictionary's dictionaryWithDictionary:x
|
||||
end |λ|
|
||||
end script
|
||||
set dcts to map(recDict, xs)
|
||||
|
||||
script asDescriptor
|
||||
on |λ|(kd)
|
||||
set {k, d} to kd
|
||||
ca's NSSortDescriptor's sortDescriptorWithKey:k ascending:d selector:dcts
|
||||
end |λ|
|
||||
end script
|
||||
|
||||
((ca's NSArray's arrayWithArray:dcts)'s ¬
|
||||
sortedArrayUsingDescriptors:map(asDescriptor, keyDirections)) as list
|
||||
end sortByComparing
|
||||
|
||||
|
||||
-- GENERIC FUNCTIONS ---------------------------------------------------------
|
||||
|
||||
-- map :: (a -> b) -> [a] -> [b]
|
||||
on map(f, xs)
|
||||
tell mReturn(f)
|
||||
set lng to length of xs
|
||||
set lst to {}
|
||||
repeat with i from 1 to lng
|
||||
set end of lst to |λ|(item i of xs, i, xs)
|
||||
end repeat
|
||||
return lst
|
||||
end tell
|
||||
end map
|
||||
|
||||
-- Lift 2nd class handler function into 1st class script wrapper
|
||||
-- mReturn :: Handler -> Script
|
||||
on mReturn(f)
|
||||
if class of f is script then
|
||||
f
|
||||
else
|
||||
script
|
||||
property |λ| : f
|
||||
end script
|
||||
end if
|
||||
end mReturn
|
||||
|
||||
-- TEST ----------------------------------------------------------------------
|
||||
set xs to [¬
|
||||
{city:"Shanghai ", pop:24.2}, ¬
|
||||
{city:"Karachi ", pop:23.5}, ¬
|
||||
{city:"Beijing ", pop:21.5}, ¬
|
||||
{city:"Sao Paulo ", pop:24.2}, ¬
|
||||
{city:"Dhaka ", pop:17.0}, ¬
|
||||
{city:"Delhi ", pop:16.8}, ¬
|
||||
{city:"Lagos ", pop:16.1}]
|
||||
|
||||
-- Boolean true for ascending order, false for descending:
|
||||
|
||||
sortByComparing([{"pop", false}, {"city", true}], xs)
|
||||
|
|
@ -1,21 +1,20 @@
|
|||
#import system.
|
||||
#import system'routines.
|
||||
#import extensions.
|
||||
import system'routines.
|
||||
import extensions.
|
||||
|
||||
#symbol program =
|
||||
program =
|
||||
[
|
||||
#var elements := (
|
||||
KeyValue new &key:"Krypton" &object:83.798r,
|
||||
KeyValue new &key:"Beryllium" &object:9.012182r,
|
||||
KeyValue new &key:"Silicon" &object:28.0855r,
|
||||
KeyValue new &key:"Cobalt" &object:58.933195r,
|
||||
KeyValue new &key:"Selenium" &object:78.96r,
|
||||
KeyValue new &key:"Germanium" &object:72.64r).
|
||||
var elements := (
|
||||
KeyValue new key:"Krypton" value:83.798r,
|
||||
KeyValue new key:"Beryllium" value:9.012182r,
|
||||
KeyValue new key:"Silicon" value:28.0855r,
|
||||
KeyValue new key:"Cobalt" value:58.933195r,
|
||||
KeyValue new key:"Selenium" value:78.96r,
|
||||
KeyValue new key:"Germanium" value:72.64r).
|
||||
|
||||
#var sorted := elements sort:(:former:later) [ former key < later key ].
|
||||
var sorted := elements sort(:former:later)( former key < later key ).
|
||||
|
||||
sorted run &each:element
|
||||
sorted forEach(:element)
|
||||
[
|
||||
console writeLine:(element key):" - ":element.
|
||||
console printLine(element key," - ",element).
|
||||
].
|
||||
].
|
||||
|
|
|
|||
|
|
@ -0,0 +1,53 @@
|
|||
' FB 1.05.0 Win64
|
||||
|
||||
Type Pair
|
||||
As String name, value
|
||||
Declare Constructor(name_ As String, value_ As String)
|
||||
Declare Operator Cast() As String
|
||||
End Type
|
||||
|
||||
Constructor Pair(name_ As String, value_ As String)
|
||||
name = name_
|
||||
value = value_
|
||||
End Constructor
|
||||
|
||||
Operator Pair.Cast() As String
|
||||
Return "[" + name + ", " + value + "]"
|
||||
End Operator
|
||||
|
||||
' selection sort, quick enough for sorting small number of pairs
|
||||
Sub sortPairsByName(p() As Pair)
|
||||
Dim As Integer i, j, m
|
||||
For i = LBound(p) To UBound(p) - 1
|
||||
m = i
|
||||
For j = i + 1 To UBound(p)
|
||||
If p(j).name < p(m).name Then m = j
|
||||
Next j
|
||||
If m <> i Then Swap p(i), p(m)
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
Dim As Pair pairs(1 To 4) = _
|
||||
{ _
|
||||
Pair("grass", "green"), _
|
||||
Pair("snow", "white" ), _
|
||||
Pair("sky", "blue"), _
|
||||
Pair("cherry", "red") _
|
||||
}
|
||||
|
||||
Print "Before sorting :"
|
||||
For i As Integer = 1 To 4
|
||||
Print Tab(3); pairs(i)
|
||||
Next
|
||||
|
||||
sortPairsByName pairs()
|
||||
|
||||
Print
|
||||
Print "After sorting by name :"
|
||||
For i As Integer = 1 To 4
|
||||
Print Tab(3); pairs(i)
|
||||
Next
|
||||
|
||||
Print
|
||||
Print "Press any key to quit"
|
||||
Sleep
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
import Data.List
|
||||
import Data.Function (on)
|
||||
|
||||
data Person =
|
||||
P String
|
||||
Int
|
||||
deriving (Eq)
|
||||
|
||||
instance Show Person where
|
||||
show (P name val) = "Person " ++ name ++ " with value " ++ show val
|
||||
|
||||
instance Ord Person where
|
||||
compare (P a _) (P b _) = compare a b
|
||||
|
||||
pVal :: Person -> Int
|
||||
pVal (P _ x) = x
|
||||
|
||||
people :: [Person]
|
||||
people = [P "Joe" 12, P "Bob" 8, P "Alice" 9, P "Harry" 2]
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
mapM_ print $ sort people
|
||||
putStrLn []
|
||||
mapM_ print $ sortBy (on compare pVal) people
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
import Data.Ord (comparing)
|
||||
import Data.List (sortBy)
|
||||
|
||||
xs :: [(String, String, Int)]
|
||||
xs =
|
||||
zip3
|
||||
(words "Richard John Marvin Alan Maurice James")
|
||||
(words "Hamming McCarthy Minskey Perlis Wilkes Wilkinson")
|
||||
[1915, 1927, 1926, 1922, 1913, 1919]
|
||||
|
||||
main :: IO ()
|
||||
main = mapM_ print $ sortBy (comparing (\(_, _, y) -> y)) xs
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
import List
|
||||
|
||||
data Person = P String Int deriving Eq
|
||||
instance Show Person where
|
||||
show (P name val) = "Person "++name++" with value "++(show val)
|
||||
instance Ord Person where
|
||||
compare (P n1 _) (P n2 _) = compare n1 n2
|
||||
|
||||
people = [(P "Joe" 12), (P "Bob" 8), (P "Alice" 9), (P "Harry" 2)]
|
||||
sortedPeople = sort people
|
||||
sortedPeopleByVal = sortBy (\(P _ v1) (P _ v2)->compare v1 v2) people
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
(() => {
|
||||
'use strict';
|
||||
|
||||
// GENERIC FUNCTIONS FOR COMPARISONS
|
||||
|
||||
// compare :: a -> a -> Ordering
|
||||
const compare = (a, b) => a < b ? -1 : (a > b ? 1 : 0);
|
||||
|
||||
// on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
|
||||
const on = (f, g) => (a, b) => f(g(a), g(b));
|
||||
|
||||
// flip :: (a -> b -> c) -> b -> a -> c
|
||||
const flip = f => (a, b) => f.apply(null, [b, a]);
|
||||
|
||||
// arrayCopy :: [a] -> [a]
|
||||
const arrayCopy = (xs) => xs.slice(0);
|
||||
|
||||
// show :: a -> String
|
||||
const show = x => JSON.stringify(x, null, 2);
|
||||
|
||||
|
||||
// TEST
|
||||
const xs = [{
|
||||
name: 'Shanghai',
|
||||
pop: 24.2
|
||||
}, {
|
||||
name: 'Karachi',
|
||||
pop: 23.5
|
||||
}, {
|
||||
name: 'Beijing',
|
||||
pop: 21.5
|
||||
}, {
|
||||
name: 'Sao Paulo',
|
||||
pop: 24.2
|
||||
}, {
|
||||
name: 'Dhaka',
|
||||
pop: 17.0
|
||||
}, {
|
||||
name: 'Delhi',
|
||||
pop: 16.8
|
||||
}, {
|
||||
name: 'Lagos',
|
||||
pop: 16.1
|
||||
}]
|
||||
|
||||
// population :: Dictionary -> Num
|
||||
const population = x => x.pop;
|
||||
|
||||
// name :: Dictionary -> String
|
||||
const name = x => x.name;
|
||||
|
||||
return show({
|
||||
byPopulation: arrayCopy(xs)
|
||||
.sort(on(compare, population)),
|
||||
byDescendingPopulation: arrayCopy(xs)
|
||||
.sort(on(flip(compare), population)),
|
||||
byName: arrayCopy(xs)
|
||||
.sort(on(compare, name)),
|
||||
byDescendingName: arrayCopy(xs)
|
||||
.sort(on(flip(compare), name))
|
||||
});
|
||||
})();
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
// version 1.1
|
||||
|
||||
data class Employee(val name: String, var category: String) : Comparable<Employee> {
|
||||
override fun compareTo(other: Employee) = this.name.compareTo(other.name)
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val employees = arrayOf(
|
||||
Employee("David", "Manager"),
|
||||
Employee("Alice", "Sales"),
|
||||
Employee("Joanna", "Director"),
|
||||
Employee("Henry", "Admin"),
|
||||
Employee("Tim", "Sales"),
|
||||
Employee("Juan", "Admin")
|
||||
)
|
||||
employees.sort()
|
||||
for ((name, category) in employees) println("${name.padEnd(6)} : $category")
|
||||
}
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
a = .array~new
|
||||
|
||||
a~append(.pair~new("06-07", "Ducks"))
|
||||
a~append(.pair~new("00-01", "Avalanche"))
|
||||
a~append(.pair~new("02-03", "Devils"))
|
||||
a~append(.pair~new("01-02", "Red Wings"))
|
||||
a~append(.pair~new("03-04", "Lightning"))
|
||||
a~append(.pair~new("04-05", "lockout"))
|
||||
a~append(.pair~new("05-06", "Hurricanes"))
|
||||
a~append(.pair~new("99-00", "Devils"))
|
||||
a~append(.pair~new("07-08", "Red Wings"))
|
||||
a~append(.pair~new("08-09", "Penguins"))
|
||||
|
||||
b = a~copy -- make a copy before sorting
|
||||
b~sort
|
||||
say "Sorted using direct comparison"
|
||||
do pair over b
|
||||
say pair
|
||||
end
|
||||
|
||||
c = a~copy
|
||||
-- this uses a custom comparator instead
|
||||
c~sortWith(.paircomparator~new)
|
||||
say
|
||||
say "Sorted using a comparator (inverted)"
|
||||
do pair over c
|
||||
say pair
|
||||
end
|
||||
|
||||
-- a name/value mapping class that directly support the sort comparisons
|
||||
::class pair inherit comparable
|
||||
::method init
|
||||
expose name value
|
||||
use strict arg name, value
|
||||
|
||||
::attribute name
|
||||
::attribute value
|
||||
|
||||
::method string
|
||||
expose name value
|
||||
return name "=" value
|
||||
|
||||
-- the compareto method is a requirement brought in
|
||||
-- by the
|
||||
::method compareto
|
||||
expose name
|
||||
use strict arg other
|
||||
return name~compareto(other~name)
|
||||
|
||||
-- a comparator that shows an alternate way of sorting
|
||||
::class pairComparator subclass comparator
|
||||
::method compare
|
||||
use strict arg left, right
|
||||
-- perform the comparison on the names
|
||||
return -left~name~compareTo(right~name)
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
BEGIN
|
||||
|
||||
CLASS COMPARABLE;;
|
||||
|
||||
COMPARABLE CLASS PAIR(N,V); TEXT N,V;;
|
||||
|
||||
CLASS COMPARATOR;
|
||||
VIRTUAL:
|
||||
PROCEDURE COMPARE IS
|
||||
INTEGER PROCEDURE COMPARE(A, B); REF(COMPARABLE) A, B;;
|
||||
BEGIN
|
||||
END**OF**COMPARATOR;
|
||||
|
||||
COMPARATOR CLASS PAIRBYNAME;
|
||||
BEGIN
|
||||
INTEGER PROCEDURE COMPARE(A, B); REF(COMPARABLE) A, B;
|
||||
BEGIN
|
||||
COMPARE := IF A QUA PAIR.N < B QUA PAIR.N THEN -1 ELSE
|
||||
IF A QUA PAIR.N > B QUA PAIR.N THEN +1 ELSE 0;
|
||||
END;
|
||||
END**OF**PAIRBYNAME;
|
||||
|
||||
PROCEDURE BUBBLESORT(A, C); NAME A; REF(COMPARABLE) ARRAY A; REF(COMPARATOR) C;
|
||||
BEGIN
|
||||
INTEGER LOW, HIGH, I;
|
||||
BOOLEAN SWAPPED;
|
||||
|
||||
PROCEDURE SWAP(I, J); INTEGER I, J;
|
||||
BEGIN
|
||||
REF(COMPARABLE) TEMP;
|
||||
TEMP :- A(I); A(I) :- A(J); A(J) :- TEMP;
|
||||
END**OF**SWAP;
|
||||
|
||||
LOW := LOWERBOUND(A, 1);
|
||||
HIGH := UPPERBOUND(A, 1);
|
||||
SWAPPED := TRUE;
|
||||
WHILE SWAPPED DO
|
||||
BEGIN
|
||||
SWAPPED := FALSE;
|
||||
FOR I := LOW + 1 STEP 1 UNTIL HIGH DO
|
||||
BEGIN
|
||||
COMMENT IF THIS PAIR IS OUT OF ORDER ;
|
||||
IF C.COMPARE(A(I - 1), A(I)) > 0 THEN
|
||||
BEGIN
|
||||
COMMENT SWAP THEM AND REMEMBER SOMETHING CHANGED ;
|
||||
SWAP(I - 1, I);
|
||||
SWAPPED := TRUE;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END**OF**BUBBLESORT;
|
||||
|
||||
COMMENT ** MAIN PROGRAM **;
|
||||
REF(PAIR) ARRAY A(1:5);
|
||||
INTEGER I;
|
||||
|
||||
A(1) :- NEW PAIR( "JOE", "5531" );
|
||||
A(2) :- NEW PAIR( "ADAM", "2341" );
|
||||
A(3) :- NEW PAIR( "BERNIE", "122" );
|
||||
A(4) :- NEW PAIR( "WALTER", "1234" );
|
||||
A(5) :- NEW PAIR( "DAVID", "19" );
|
||||
|
||||
BUBBLESORT(A, NEW PAIRBYNAME);
|
||||
|
||||
FOR I:= 1 STEP 1 UNTIL 5 DO
|
||||
BEGIN OUTTEXT(A(I).N); OUTCHAR(' '); OUTTEXT(A(I).V); OUTIMAGE; END;
|
||||
OUTIMAGE;
|
||||
|
||||
END.
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
class P{var name,value;
|
||||
fcn init(nm,val){name,value=vm.arglist}
|
||||
fcn __opLT(p){name<p.name} // implementation of P1 < P2
|
||||
}
|
||||
// create list of pairs:
|
||||
p:=List(P("sam","a"),P("fred","b"),P("chris","c"));
|
||||
p.sort();
|
||||
p.apply("name"); //-->L("chris","fred","sam")
|
||||
Loading…
Add table
Add a link
Reference in a new issue