/* ----------------------------------------------------------------------------- Copyright 2021,2023 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. ----------------------------------------------------------------------------- */ // Author: Kevin P. Barry [ta0kira@gmail.com] define Sorting { sort (seq) { \ sortWith<#x, #x>(seq) } sortWith (seq) { \ seq `sortWith2` AsLessThan2<#x, #xx>.new() } sortWith2 (seq, compare) { \ HeapSort<#x>.inPlace(seq, compare) } reverse (seq) { scoped { Int i <- seq.size()/2-1 } in while (i >= 0) { $ReadOnly[i]$ Int j <- seq.size()-i-1 #x temp <- seq.readAt(i) \ seq.writeAt(i, seq.readAt(j)) \ seq.writeAt(j, temp) } update { i <- i-1 } } sortList (head) { return sortListWith<#n, #x, #x>(head) } sortListWith (head) { return head `sortListWith2` AsLessThan2<#x, #xx>.new() } sortListWith2 (head, compare) { return MergeSort<#n, #x>.sort(head, compare) } reverseList (head) (head2) { if (!present(head)) { return empty } head2 <- head $Hidden[head]$ scoped { optional #n prev <- empty } in while (true) { optional #n next <- require(head2).next() \ require(head2).setNext(prev) prev <- head2 if (present(next)) { head2 <- next } else { break } } } } // Putting the params at the top level allows helpers to be called without // needing to pass the params every time. concrete HeapSort<#x> { @type inPlace ([ReadAt<#x> & WriteAt<#x>], LessThan2<#x>) -> () } define HeapSort { $ReadOnlyExcept[]$ @value [ReadAt<#x> & WriteAt<#x>] seq @value LessThan2<#x> compare inPlace (seq, compare) { \ (delegate -> #self).execute() } @value execute () -> () execute () { $NoTrace$ // Convert the container to a heap. scoped { Int i <- seq.size()/2-1 } in while (i >= 0) { $ReadOnly[i]$ \ sift(i, seq.size()) } update { i <- i-1 } // Traverse the heap and populate the container in place. scoped { Int i <- seq.size()-1 } in while (i >= 0) { $ReadOnly[i]$ \ swap(0, i) \ sift(0, i) } update { i <- i-1 } } @value sift (Int, Int) -> () sift (start, size) { $NoTrace$ scoped { Int last <- start Int indexLargest <- last $Hidden[start]$ } in while (2*last+1 < size) { $ReadOnly[last]$ Int left <- 2*last+1 Int right <- 2*last+2 $ReadOnly[left, right]$ if (seq.readAt(indexLargest) `compare.lessThan2` seq.readAt(left)) { indexLargest <- left } if (right < size && seq.readAt(indexLargest) `compare.lessThan2` seq.readAt(right)) { indexLargest <- right } if (indexLargest == last) { break } } update { \ swap(last, indexLargest) last <- indexLargest } } @value swap (Int, Int) -> () swap (i, j) { $NoTrace$ if (i != j) { #x temp <- seq.readAt(i) \ seq.writeAt(i, seq.readAt(j)) \ seq.writeAt(j, temp) } } } // Putting the params at the top level allows helpers to be called without // needing to pass the params every time. concrete MergeSort<#n, #x> { #n requires ListNode<#n, #x> @type sort (optional #n, LessThan2<#x>) -> (optional #n) } define MergeSort { @value LessThan2<#x> compare sort (head, compare) { return #self{ compare }.iterated(head) } @value iterated (optional #n) -> (optional #n) iterated (head) (head2) { head2 <- head $Hidden[head]$ scoped { Int chunk <- 1 Bool dirty <- true } in while (dirty) { $ReadOnly[chunk]$ scoped { optional #n tail <- empty optional #n next <- head2 head2 <- empty dirty <- false } in while (present(next)) { optional #n left <- next optional #n right <- left `splitAt` chunk next <- right `splitAt` chunk $Hidden[next]$ $ReadOnly[left, right]$ dirty <- dirty || present(right) optional #n newHead, optional #n newTail <- left `merge` right if (!present(head2)) { head2 <- newHead } else { \ require(tail).setNext(newHead) } tail <- newTail } } update { chunk <- 2*chunk } } @value splitAt (optional #n, Int) -> (optional #n) splitAt (head, n) { optional #n head2 <- head $Hidden[head]$ scoped { Int i <- n } in while (present(head2)) { if (i == 1) { return require(head2).setNext(empty) } else { head2 <- require(head2).next() } } update { i <- i-1 } return empty } @value merge (optional #n, optional #n) -> (optional #n, optional #n) merge (left, right) (head, tail) { head <- empty tail <- empty optional #n left2 <- left optional #n right2 <- right $Hidden[left, right]$ while (present(left2) && present(right2)) { #n append <- defer if (require(left2).get() `compare.lessThan2` require(right2).get()) { left2 <- (append <- require(left2)).next() } else { right2 <- (append <- require(right2)).next() } if (!present(head)) { head <- append } else { \ require(tail).setNext(append) } tail <- append } if (present(left2)) { if (!present(head)) { head <- require(left2) } else { \ require(tail).setNext(require(left2)) } } if (present(right2)) { if (!present(head)) { head <- require(right2) } else { \ require(tail).setNext(require(right2)) } } while (present(tail)) { optional #n next <- require(tail).next() if (present(next)) { tail <- next } else { break } } } }