Initial data commit

Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-1.applescript

@@ -0,0 +1,197 @@
+use AppleScript version "2.4"
+use framework "Foundation"
+use scripting additions
+
+
+-- disjointSort :: [Int] -> [Int] -> [Int]
+on disjointSort(ixs, xs)
+    set ks to sort(ixs)
+    script nth -- 1-based index
+        on |λ|(k)
+            item (succ(k)) of xs
+        end |λ|
+    end script
+    set dct to mapFromList(zip(ks, sort(map(nth, ks))))
+
+    script build
+        on |λ|(x, i)
+            set mb to lookupDict(pred(i) as string, dct)
+            if Nothing of mb then
+                x
+            else
+                |Just| of mb
+            end if
+        end |λ|
+    end script
+    map(build, xs)
+end disjointSort
+
+
+on run
+    disjointSort({6, 1, 7}, {7, 6, 5, 4, 3, 2, 1, 0})
+end run
+
+
+
+-- GENERIC FUNCTIONS ----------------------------------------------------
+
+-- Just :: a -> Maybe a
+on Just(x)
+    {type:"Maybe", Nothing:false, Just:x}
+end Just
+
+-- Nothing :: Maybe a
+on Nothing()
+    {type:"Maybe", Nothing:true}
+end Nothing
+
+-- length :: [a] -> Int
+on |length|(xs)
+    set c to class of xs
+    if list is c or string is c then
+        length of xs
+    else
+        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
+    end if
+end |length|
+
+-- lookupDict :: a -> Dict -> Maybe b
+on lookupDict(k, dct)
+    set ca to current application
+    set v to (ca's NSDictionary's dictionaryWithDictionary:dct)'s objectForKey:k
+    if v ≠ missing value then
+        Just(item 1 of ((ca's NSArray's arrayWithObject:v) as list))
+    else
+        Nothing()
+    end if
+end lookupDict
+
+-- 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
+
+-- mapFromList :: [(k, v)] -> Dict
+on mapFromList(kvs)
+    set tpl to unzip(kvs)
+    script
+        on |λ|(x)
+            x as string
+        end |λ|
+    end script
+    (current application's NSDictionary's ¬
+        dictionaryWithObjects:(|2| of tpl) ¬
+            forKeys:map(result, |1| of tpl)) as record
+end mapFromList
+
+-- min :: Ord a => a -> a -> a
+on min(x, y)
+    if y < x then
+        y
+    else
+        x
+    end if
+end min
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: First-class m => (a -> b) -> m (a -> b)
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
+
+-- pred :: Enum a => a -> a
+on pred(x)
+    x - 1
+end pred
+
+-- sort :: Ord a => [a] -> [a]
+on sort(xs)
+    ((current application's NSArray's arrayWithArray:xs)'s ¬
+        sortedArrayUsingSelector:"compare:") as list
+end sort
+
+-- succ :: Enum a => a -> a
+on succ(x)
+    1 + x
+end succ
+
+-- take :: Int -> [a] -> [a]
+-- take :: Int -> String -> String
+on take(n, xs)
+    set c to class of xs
+    if list is c then
+        if 0 < n then
+            items 1 thru min(n, length of xs) of xs
+        else
+            {}
+        end if
+    else if string is c then
+        if 0 < n then
+            text 1 thru min(n, length of xs) of xs
+        else
+            ""
+        end if
+    else if script is c then
+        set ys to {}
+        repeat with i from 1 to n
+            set v to xs's |λ|()
+            if missing value is v then
+                return ys
+            else
+                set end of ys to v
+            end if
+        end repeat
+        return ys
+    else
+        missing value
+    end if
+end take
+
+-- Tuple (,) :: a -> b -> (a, b)
+on Tuple(a, b)
+    {type:"Tuple", |1|:a, |2|:b, length:2}
+end Tuple
+
+-- unzip :: [(a,b)] -> ([a],[b])
+on unzip(xys)
+    set xs to {}
+    set ys to {}
+    repeat with xy in xys
+        set end of xs to |1| of xy
+        set end of ys to |2| of xy
+    end repeat
+    return Tuple(xs, ys)
+end unzip
+
+-- zip :: [a] -> [b] -> [(a, b)]
+on zip(xs, ys)
+    zipWith(Tuple, xs, ys)
+end zip
+
+-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+on zipWith(f, xs, ys)
+    set lng to min(|length|(xs), |length|(ys))
+    if 1 > lng then return {}
+    set xs_ to take(lng, xs) -- Allow for non-finite
+    set ys_ to take(lng, ys) -- generators like cycle etc
+    set lst to {}
+    tell mReturn(f)
+        repeat with i from 1 to lng
+            set end of lst to |λ|(item i of xs_, item i of ys_)
+        end repeat
+        return lst
+    end tell
+end zipWith

Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-2.applescript

@@ -0,0 +1 @@
+{7, 0, 5, 4, 3, 2, 1, 6}

Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-3.applescript

@@ -0,0 +1,27 @@
+use AppleScript version "2.3.1" -- Mac OS 10.9 (Mavericks) or later.
+use sorter : script "Insertion sort" -- https://www.rosettacode.org/wiki/Sorting_algorithms/Insertion_sort#AppleScript.
+
+on sortValuesAtIndices(values, indices)
+    set indexedValues to {}
+    repeat with thisIndex in indices
+        set end of indexedValues to item thisIndex of values
+    end repeat
+
+    set indexCount to (count indices)
+
+    tell sorter to sort(indexedValues, 1, indexCount)
+    tell sorter to sort(indices, 1, indexCount)
+
+    repeat with i from 1 to indexCount
+        set thisIndex to item i of indices
+        set item thisIndex of values to item i of indexedValues
+    end repeat
+
+    return
+end sortValuesAtIndices
+
+-- Test code:
+set values to {7, 6, 5, 4, 3, 2, 1, 0}
+set indices to {7, 2, 8} -- AppleScript indices are one-based.
+sortValuesAtIndices(values, indices)
+return values

Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-4.applescript

@@ -0,0 +1 @@
+{7, 0, 5, 4, 3, 2, 1, 6}