note description: "[ Quicksort according to Lamport/Meyer. The Lampsort algorithm is a simple loop; it does not use recursion, but relies on an interesting data structure, a set of intervals. It is hardly more difficult to understand, and hardly shorter, than the traditional recursive version. the recursive version, and its parallelized variants, are only examples of possible implementations ]" author: "JSO" date: "$Date$" revision: "$Revision$" class LAMPSORT [G -> COMPARABLE] create make feature {NONE} -- Initialization default_create -- Process instances of classes with no creation clause. -- (Default: do nothing.) -- (from ANY) do end feature -- Access generating_type: TYPE [detachable LAMPSORT [G]] -- Type of current object -- (type of which it is a direct instance) -- (from ANY) external "built_in" ensure -- from ANY generating_type_not_void: Result /= Void end generator: STRING_8 -- Name of current object's generating class -- (base class of the type of which it is a direct instance) -- (from ANY) external "built_in" ensure -- from ANY generator_not_void: Result /= Void generator_not_empty: not Result.is_empty end feature -- Comparison frozen deep_equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void -- or attached to isomorphic object structures? -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.is_deep_equal (b) end ensure -- from ANY instance_free: class shallow_implies_deep: standard_equal (a, b) implies Result both_or_none_void: (a = Void) implies (Result = (b = Void)) same_type: (Result and (a /= Void)) implies (b /= Void and then a.same_type (b)) symmetric: Result implies deep_equal (b, a) end frozen equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void or attached -- to objects considered equal? -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.is_equal (b) end ensure -- from ANY instance_free: class definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.is_equal (b)) end frozen is_deep_equal (other: LAMPSORT [G]): BOOLEAN -- Are Current and other attached to isomorphic object structures? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY shallow_implies_deep: standard_is_equal (other) implies Result same_type: Result implies same_type (other) symmetric: Result implies other.is_deep_equal (Current) end is_equal (other: LAMPSORT [G]): BOOLEAN -- Is other attached to an object considered -- equal to current object? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY symmetric: Result implies other ~ Current consistent: standard_is_equal (other) implies Result end frozen standard_equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void or attached to -- field-by-field identical objects of the same type? -- Always uses default object comparison criterion. -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.standard_is_equal (b) end ensure -- from ANY instance_free: class definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.standard_is_equal (b)) end frozen standard_is_equal (other: LAMPSORT [G]): BOOLEAN -- Is other attached to an object of the same type -- as current object, and field-by-field identical to it? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY same_type: Result implies same_type (other) symmetric: Result implies other.standard_is_equal (Current) end feature -- Status report conforms_to (other: ANY): BOOLEAN -- Does type of current object conform to type -- of other (as per Eiffel: The Language, chapter 13)? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" end same_type (other: ANY): BOOLEAN -- Is type of current object identical to type of other? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY definition: Result = (conforms_to (other) and other.conforms_to (Current)) end feature -- Duplication frozen clone (other: detachable ANY): like other obsolete "Use `twin' instead. [2017-05-31]" -- Void if other is void; otherwise new object -- equal to other -- -- For non-void other, clone calls copy; -- to change copying/cloning semantics, redefine copy. -- (from ANY) do if other /= Void then Result := other.twin end ensure -- from ANY instance_free: class equal: Result ~ other end copy (other: LAMPSORT [G]) -- Update current object using fields of object attached -- to other, so as to yield equal objects. -- (from ANY) require -- from ANY other_not_void: other /= Void type_identity: same_type (other) external "built_in" ensure -- from ANY is_equal: Current ~ other end frozen deep_clone (other: detachable ANY): like other obsolete "Use `deep_twin' instead. [2017-05-31]" -- Void if other is void: otherwise, new object structure -- recursively duplicated from the one attached to other -- (from ANY) do if other /= Void then Result := other.deep_twin end ensure -- from ANY instance_free: class deep_equal: deep_equal (other, Result) end frozen deep_copy (other: LAMPSORT [G]) -- Effect equivalent to that of: -- copy (other . deep_twin) -- (from ANY) require -- from ANY other_not_void: other /= Void do copy (other.deep_twin) ensure -- from ANY deep_equal: deep_equal (Current, other) end frozen deep_twin: LAMPSORT [G] -- New object structure recursively duplicated from Current. -- (from ANY) external "built_in" ensure -- from ANY deep_twin_not_void: Result /= Void deep_equal: deep_equal (Current, Result) end frozen standard_clone (other: detachable ANY): like other obsolete "Use `standard_twin' instead. [2017-05-31]" -- Void if other is void; otherwise new object -- field-by-field identical to other. -- Always uses default copying semantics. -- (from ANY) do if other /= Void then Result := other.standard_twin end ensure -- from ANY instance_free: class equal: standard_equal (Result, other) end frozen standard_copy (other: LAMPSORT [G]) -- Copy every field of other onto corresponding field -- of current object. -- (from ANY) require -- from ANY other_not_void: other /= Void type_identity: same_type (other) external "built_in" ensure -- from ANY is_standard_equal: standard_is_equal (other) end frozen standard_twin: LAMPSORT [G] -- New object field-by-field identical to other. -- Always uses default copying semantics. -- (from ANY) external "built_in" ensure -- from ANY standard_twin_not_void: Result /= Void equal: standard_equal (Result, Current) end frozen twin: LAMPSORT [G] -- New object equal to Current -- twin calls copy; to change copying/twinning semantics, redefine copy. -- (from ANY) external "built_in" ensure -- from ANY twin_not_void: Result /= Void is_equal: Result ~ Current end feature -- Basic operations frozen as_attached: attached LAMPSORT [G] obsolete "Remove calls to this feature. [2017-05-31]" -- Attached version of Current. -- (Can be used during transitional period to convert -- non-void-safe classes to void-safe ones.) -- (from ANY) do Result := Current end frozen default: detachable LAMPSORT [G] -- Default value of object's type -- (from ANY) do end frozen default_pointer: POINTER -- Default value of type POINTER -- (Avoid the need to write p.default for -- some p of type POINTER.) -- (from ANY) do ensure -- from ANY instance_free: class end default_rescue -- Process exception for routines with no Rescue clause. -- (Default: do nothing.) -- (from ANY) do end frozen do_nothing -- Execute a null action. -- (from ANY) do ensure -- from ANY instance_free: class end feature a: ARRAY [G] lampsort (i, j: INTEGER_32) require a.lower <= i i <= j j <= a.upper local l_intvl: INTEGER_INTERVAL intervals: SET [INTEGER_INTERVAL] do from create l_intvl.make (a.lower, a.upper) create intervals.make_empty intervals.extend (l_intvl) invariant True until intervals.is_empty loop intervals.choose_item picked := intervals.item intervals.remove_item if picked.count > 1 then partition (picked.lower, picked.upper) intervals.extend (picked.lower |..| pivot1) intervals.extend (pivot2 |..| picked.upper) end end end make (l_a: like a) do a := l_a create picked.make (0, -1) ensure a = l_a end partition (i, j: INTEGER_32) require a.lower <= i i <= j j <= a.upper local m, n, k: INTEGER_32 x: G do from x := a [i] n := j + 1 m := i k := m invariant i <= m and m <= k and k <= n and n <= j + 1 across i |..| (m - 1) as it all a [it.item] < x end across m |..| (k - 1) as kt all a [kt.item] = x end across n |..| j as jt all x < a [jt.item] end variant n - k until k = n loop if a [k] = x then k := k + 1 elseif a [k] < x then swap (m, k) m := m + 1 k := k + 1 else check x < a [k] end swap (k, n - 1) n := n - 1 end end pivot1 := m - 1 pivot2 := n ensure i - 1 <= pivot1 and pivot1 <= j i <= pivot2 and pivot2 <= j + 1 permutation (a, a.deep_twin) across i |..| pivot1 as it all across (pivot1 + 1) |..| j as jt all a [it.item] <= a [jt.item] end end across i |..| (pivot2 - 1) as it all across pivot2 |..| j as jt all a [it.item] <= a [jt.item] end end end picked: INTEGER_INTERVAL pivot1: INTEGER_32 pivot2: INTEGER_32 sort -- Lampsort version of quicksort for array a do lampsort (a.lower, a.upper) ensure across a.lower |..| (a.upper - 1) as k all a [k.item] <= a [k.item + 1] end permutation (old a.deep_twin, a) end sort2 -- recursive quicksort do sort_recursive (a.lower, a.upper) ensure across a.lower |..| (a.upper - 1) as k all a [k.item] <= a [k.item + 1] end permutation (old a.deep_twin, a) end sort_recursive (i, j: INTEGER_32) require a.lower <= i i <= j + 1 j <= a.upper do if i < j then partition (i, j) sort_recursive (i, pivot1) sort_recursive (pivot2, j) end end swap (m, n: INTEGER_32) require a.lower <= m m <= n n <= a.upper local temp: G do temp := a [m] a [m] := a [n] a [n] := temp ensure a [m] ~ old a [n] and a [n] ~ old a [m] end feature -- Output Io: STD_FILES -- Handle to standard file setup -- (from ANY) once create Result Result.set_output_default ensure -- from ANY instance_free: class io_not_void: Result /= Void end out: STRING_8 -- New string containing terse printable representation -- of current object -- (from ANY) do Result := tagged_out ensure -- from ANY out_not_void: Result /= Void end print (o: detachable ANY) -- Write terse external representation of o -- on standard output. -- (from ANY) do if o /= Void then Io.put_string (o.out) end ensure -- from ANY instance_free: class end frozen tagged_out: STRING_8 -- New string containing terse printable representation -- of current object -- (from ANY) external "built_in" ensure -- from ANY tagged_out_not_void: Result /= Void end feature -- Platform Operating_environment: OPERATING_ENVIRONMENT -- Objects available from the operating system -- (from ANY) once create Result ensure -- from ANY instance_free: class operating_environment_not_void: Result /= Void end feature {NONE} -- Retrieval frozen internal_correct_mismatch -- Called from runtime to perform a proper dynamic dispatch on correct_mismatch -- from MISMATCH_CORRECTOR. -- (from ANY) local l_msg: STRING_8 l_exc: EXCEPTIONS do if attached {MISMATCH_CORRECTOR} Current as l_corrector then l_corrector.correct_mismatch else create l_msg.make_from_string ("Mismatch: ") create l_exc l_msg.append (generating_type.name) l_exc.raise_retrieval_exception (l_msg) end end feature -- array queries permutation (a1, a2: like a): BOOLEAN do if a1.count = a2.count then Result := across a1 as it all a1.occurrences (it.item) = a2.occurrences (it.item) end else Result := False end ensure Result implies a1.count = a2.count and then across a1 as it all a1.occurrences (it.item) = a2.occurrences (it.item) end not Result implies a1.count /= a2.count or else (across a1 as it some a1.occurrences (it.item) /= a2.occurrences (it.item) end) end invariant -- from ANY reflexive_equality: standard_is_equal (Current) reflexive_conformance: conforms_to (Current) end -- class LAMPSORT
Generated by ISE EiffelStudio