diff options
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 25 | ||||
| -rw-r--r-- | lib.h | 3 | ||||
| -rw-r--r-- | tests/012/sort.tl | 5 | ||||
| -rw-r--r-- | txr.1 | 44 |
5 files changed, 75 insertions, 4 deletions
@@ -7424,6 +7424,8 @@ void eval_init(void) reg_fun(intern(lit("unique"), user_package), func_n2ov(unique, 1)); reg_fun(intern(lit("uniq"), user_package), func_n1(uniq)); reg_fun(intern(lit("grade"), user_package), func_n3o(grade, 1)); + reg_fun(intern(lit("hist-sort"), user_package), func_n1v(hist_sort)); + reg_fun(intern(lit("nrot"), user_package), func_n2o(nrot, 1)); reg_fun(intern(lit("rot"), user_package), func_n2o(rot, 1)); @@ -133,7 +133,7 @@ val nil_string; val identity_f, identity_star_f; val equal_f, eql_f, eq_f, car_f, cdr_f, null_f; -val list_f, less_f, greater_f; +val list_f, less_f, greater_f, gt_f; val prog_string; @@ -175,6 +175,8 @@ const seq_kind_t seq_kind_tab[MAXTYPE+1] = { SEQ_NOTSEQ, /* DARG */ }; +static val hist_succ_f; + val identity(val obj) { return obj; @@ -11565,6 +11567,20 @@ val grade(val seq, val lessfun, val keyfun_in) return nil; } +static val hist_succ(val left, val right) +{ + (void) right; + return succ(left); +} + +val hist_sort(val seq, varg hashv_args) +{ + val hash = group_reduce(hashv(hashv_args), + identity_f, hist_succ_f, + seq, zero, nil); + return nsort(hash_alist(hash), gt_f, cdr_f); +} + val nrot(val seq, val n_in) { val len = length(seq); @@ -13957,8 +13973,8 @@ static void obj_init(void) &user_package, &public_package, &equal_f, &eq_f, &eql_f, &car_f, &cdr_f, &null_f, &list_f, - &identity_f, &identity_star_f, &less_f, &greater_f, - &prog_string, &cobj_hash, &lazy_streams_binding, + &identity_f, &identity_star_f, &less_f, &greater_f, >_f, + &prog_string, &cobj_hash, &lazy_streams_binding, &hist_succ_f, convert(val *, 0)); nil_string = lit("nil"); @@ -14126,9 +14142,12 @@ static void obj_init(void) list_f = func_n0v(listv); less_f = func_n2(less); greater_f = func_n2(greater); + gt_f = func_n2(gt); prog_string = string(progname); cobj_hash = make_hash(hash_weak_none, nil); + + hist_succ_f = func_n2(hist_succ); } static val simple_qref_args_p(val args, val pos) @@ -705,7 +705,7 @@ extern val null_string; extern val identity_f, identity_star_f; extern val equal_f, eql_f, eq_f, car_f, cdr_f, null_f; -extern val list_f, less_f, greater_f; +extern val list_f, less_f, greater_f, gt_f; extern val prog_string; @@ -1340,6 +1340,7 @@ val sort_group(val seq, val keyfun, val lessfun); val unique(val seq, val keyfun, varg hashv_args); val uniq(val seq); val grade(val seq, val lessfun, val keyfun_in); +val hist_sort(val seq, varg hashv_args); val nrot(val seq, val n_in); val rot(val seq, val n_in); val find(val list, val key, val testfun, val keyfun); diff --git a/tests/012/sort.tl b/tests/012/sort.tl index 03c122d3..92811715 100644 --- a/tests/012/sort.tl +++ b/tests/012/sort.tl @@ -88,3 +88,8 @@ (((a 1) (a 2) (a 3) (a 4)) ((b 1) (b 2)) ((c 2) (c 1)))) + +(mtest + (hist-sort nil) nil + (hist-sort '(3 4 5)) ((3 . 1) (4 . 1) (5 . 1)) + (hist-sort '("a" "b" "c" "a" "b" "a" "b" "a")) (("a" . 4) ("b" . 3) ("c" . 1))) @@ -56576,6 +56576,50 @@ Separate the integers 1\(en10 into even and odd, and sum these groups: -> #H(() (t 30) (nil 25)) .brev +.coNP Function @ hist-sort +.synb +.mets (hist-sort < sequence << option *) +.syne +.desc +The +.code hist-sort +function produces a histogram in the form of an association list, +which is sorted in descending order of frequency. The keys in the +association list are elements of +.meta sequence +and the values are the frequency values: positive integers +indicating how many times the keys occur in +.metn sequence . + +Note: for a description of association lists, see the +.code assoc +function, and the section Association Lists in which its description is +contained. + +The +.code hist-sort +function works by internally constructing a hash table, which is not +returned. Elements of +.meta sequence +serve as keys in that hash. The trailing arguments +.mono +.meti << option * +.onom +if any, consist of the same keywords that are understood by the +.code hash +function, and determine the properties of that hash. + +.TP* Examples + +.verb +(hist-sort nil) -> nil + +(hist-sort '(3 4 5)) -> ((3 . 1) (4 . 1) (5 . 1)) + +(hist-sort '("a" "b" "c" "a" "b" "a" "b" "a")) +-> (("a" . 4) ("b" . 3) ("c" . 1)) +.brev + .coNP Functions @ make-similar-hash and @ copy-hash .synb .mets (make-similar-hash << hash ) |