How to generate code for reverse sorting

Question

What is the easiest way to generate code for a sorting algorithm that sorts its argument in reverse order, while building on top of the existing List.sort?

I came up with two solutions that are shown below in my answer. But both of them are not really satisfactory.

Any other ideas how this could be done?

score 0 · Answer 1 · answered Oct 03 '15 at 19:53

I came up with two possible solutions. But both have (severe) drawbacks. (I would have liked to obtain the result almost automatically.)

Introduce a Haskell-style newtype. E.g., if we wanted to sort lists of nats, something like
```
datatype 'a new = New (old : 'a)

instantiation new :: (linorder) linorder
begin

definition "less_eq_new x y ⟷ old x ≥ old y"
definition "less_new x y ⟷ old x > old y"

instance by (default, case_tac [!] x) (auto simp: less_eq_new_def less_new_def)

end
```
At this point
```
value [code] "sort_key New [0::nat, 1, 0, 0, 1, 2]" 
```
yields the desired reverse sorting. While this is comparatively easy, it is not as automatic as I would like the solution to be and in addition has a small runtime overhead (since Isabelle doesn't have Haskell's newtype).

Via a locale for the dual of a linear order. First we more or less copy the existing code for insertion sort (but instead of relying on a type class, we make the parameter that represents the comparison explicit).

fun insort_by_key :: "('b ⇒ 'b ⇒ bool) ⇒ ('a ⇒ 'b) ⇒ 'a ⇒ 'a list ⇒ 'a list"
where
  "insort_by_key P f x [] = [x]"
| "insort_by_key P f x (y # ys) =
    (if P (f x) (f y) then x # y # ys else y # insort_by_key P f x ys)"

definition "revsort_key f xs = foldr (insort_by_key (op ≥) f) xs []"

at this point we have code for revsort_key.

value [code] "revsort_key id [0::nat, 1, 0, 0, 1, 2]"

but we also want all the nice results that have already been proved in the linorder locale (that derives from the linorder class). To this end, we introduce the dual of a linear order and use a "mixin" (not sure if I'm using the correct naming here) to replace all occurrences of linorder.sort_key (which does not allow for code generation) by our new "code constant" revsort_key.

interpretation dual_linorder!: linorder "op ≥ :: 'a::linorder ⇒ 'a ⇒ bool" "op >"
where
  "linorder.sort_key (op ≥ :: 'a ⇒ 'a ⇒ bool) f xs = revsort_key f xs"
proof -
  show "class.linorder (op ≥ :: 'a ⇒ 'a ⇒ bool) (op >)" by (rule dual_linorder)
  then interpret rev_order: linorder "op ≥ :: 'a ⇒ 'a ⇒ bool" "op >" .
  have "rev_order.insort_key f = insort_by_key (op ≥) f"
    by (intro ext) (induct_tac xa; simp)  
  then show "rev_order.sort_key f xs = revsort_key f xs"
    by (simp add: rev_order.sort_key_def revsort_key_def)
qed

While with this solution we do not have any runtime penalty, it is far too verbose for my taste and is not easily adaptable to changes in the standard code setup (e.g., if we wanted to use the mergesort implementation from the Archive of Formal Proofs for all of our sorting operations).

How to generate code for reverse sorting

1 Answers1