diff --git a/src/grade.c b/src/grade.c new file mode 100644 index 00000000..819c398f --- /dev/null +++ b/src/grade.c @@ -0,0 +1,125 @@ +#define GRADE_CAT(N) CAT(GRADE_N,N) + +#define SORT_CMP(W, X) GRADE_NEG compare((W).k, (X).k) +#define SORT_NAME GRADE_CAT(BP) +#define SORT_TYPE BI32p +#include "sortTemplate.c" + +#define SORT_CMP(W, X) (GRADE_NEG ((W).k - (i64)(X).k)) +#define SORT_NAME GRADE_CAT(IP) +#define SORT_TYPE I32I32p +#include "sortTemplate.c" + +B GRADE_CAT(c1)(B t, B x) { + if (isAtm(x) || rnk(x)==0) thrM(GRADE_CHR": Argument cannot be a unit"); + if (rnk(x)>1) x = toCells(x); + usz ia = a(x)->ia; + if (ia>I32_MAX) thrM(GRADE_CHR": Argument too large"); + if (ia==0) { dec(x); return inc(bi_emptyIVec); } + + i32* rp; B r = m_i32arrv(&rp, ia); + if (TI(x).elType==el_i32) { + i32* xp = i32any_ptr(x); + i32 min=I32_MAX, max=I32_MIN; + for (usz i = 0; i < ia; i++) { + i32 c = xp[i]; + if (cmax) max=c; + } + i64 range = max - (i64)min + 1; + if (range/2 < ia) { + TALLOC(usz, tmp, range+1); + for (i64 i = 0; i < range+1; i++) tmp[i] = 0; +#if GRADE_UP + for (usz i = 0; i < ia; i++) (tmp-min+1)[xp[i]]++; + for (i64 i = 1; i < range; i++) tmp[i]+= tmp[i-1]; + for (usz i = 0; i < ia; i++) rp[(tmp-min)[xp[i]]++] = i; +#else + for (usz i = 0; i < ia; i++) (tmp-min)[xp[i]]++; + for (i64 i = range-2; i >= 0; i--) tmp[i]+= tmp[i+1]; + for (usz i = 0; i < ia; i++) rp[(tmp-min+1)[xp[i]]++] = i; +#endif + TFREE(tmp); dec(x); + return r; + } + + TALLOC(I32I32p, tmp, ia); + for (usz i = 0; i < ia; i++) { + tmp[i].v = i; + tmp[i].k = xp[i]; + } + CAT(GRADE_CAT(IP),tim_sort)(tmp, ia); + for (usz i = 0; i < ia; i++) rp[i] = tmp[i].v; + TFREE(tmp); dec(x); + return r; + } + + TALLOC(BI32p, tmp, ia); + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) { + tmp[i].v = i; + tmp[i].k = xgetU(x,i); + } + CAT(GRADE_CAT(BP),tim_sort)(tmp, ia); + for (usz i = 0; i < ia; i++) rp[i] = tmp[i].v; + TFREE(tmp); dec(x); + return r; +} +B GRADE_CAT(c2)(B t, B w, B x) { + if (isAtm(w) || rnk(w)==0) thrM(GRADE_CHR": 𝕨 must have rank≥1"); + if (isAtm(x)) x = m_atomUnit(x); + ur wr = rnk(w); + ur xr = rnk(x); + + if (wr > 1) { + if (wr > xr+1) thrM(GRADE_CHR": =𝕨 cannot be greater than =𝕩"); + i32 nxr = xr-wr+1; + x = toKCells(x, nxr); xr = nxr; + w = toCells(w); xr = 1; + } + + u8 we = TI(w).elType; usz wia = a(w)->ia; + u8 xe = TI(x).elType; usz xia = a(x)->ia; + + if (wia>I32_MAX-10) thrM(GRADE_CHR": 𝕨 too big"); + i32* rp; B r = m_i32arrc(&rp, x); + + if (we==el_i32 & xe==el_i32) { + i32* wi = i32any_ptr(w); + i32* xi = i32any_ptr(x); + if (CHECK_VALID) for (usz i = 0; i < (i64)wia-1; i++) if (GRADE_NEG(wi[i]-wi[i+1]) GRADE_UD(>,<) 0) thrM(GRADE_CHR": 𝕨 must be sorted"GRADE_UD(," in descending order")); + + for (usz i = 0; i < xia; i++) { + i32 c = xi[i]; + usz s = 0, e = wia+1; + while (e-s > 1) { + usz m = (s+(i64)e)/2; + if (c GRADE_UD(<,>) wi[m-1]) e = m; + else s = m; + } + rp[i] = s; + } + } else { + BS2B wgetU = TI(w).getU; + BS2B xgetU = TI(x).getU; + if (CHECK_VALID) for (usz i = 0; i < wia-1; i++) if (compare(wgetU(w,i), wgetU(w,i+1)) GRADE_UD(>,<) 0) thrM(GRADE_CHR": 𝕨 must be sorted"GRADE_UD(," in descending order")); + + for (usz i = 0; i < xia; i++) { + B c = xgetU(x,i); + usz s = 0, e = wia+1; + while (e-s > 1) { + usz m = (s+e) / 2; + if (compare(c, wgetU(w,m-1)) GRADE_UD(<,>) 0) e = m; + else s = m; + } + rp[i] = s; + } + } + dec(w);dec(x); + return r; +} +#undef GRADE_N +#undef GRADE_CHR +#undef GRADE_NEG +#undef GRADE_UP +#undef GRADE_UD diff --git a/src/h.h b/src/h.h index e7897758..afb951e1 100644 --- a/src/h.h +++ b/src/h.h @@ -128,7 +128,7 @@ char* format_type(u8 u) { /*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(indexOf,"⊐") F(memberOf,"∊") F(find,"⍷") \ /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(couple,"≍") F(shiftb,"»") F(shifta,"«") F(take,"↑") F(drop,"↓") F(group,"⊔") F(reverse,"⌽") \ /*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \ - /*sort.c*/ F(gradeUp,"⍋") \ + /*sort.c*/ F(gradeUp,"⍋") F(gradeDown,"⍒") \ /*sysfn.c*/ F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(repr,"•Repr") F(fill,"•FillFn") \ /*sysfn.c*/ F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(bqn,"•BQN") F(cmp,"•Cmp") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") F(hash,"•Hash") \ diff --git a/src/load.c b/src/load.c index 4126ed03..fbfe2810 100644 --- a/src/load.c +++ b/src/load.c @@ -62,19 +62,19 @@ static inline void load_init() { comp_currArgs = bi_N; gc_addFn(load_gcFn); B fruntime[] = { - /* +-×÷⋆√⌊⌈|¬ */ bi_add , bi_sub , bi_mul , bi_div , bi_pow , bi_N , bi_floor, bi_ceil , bi_stile , bi_not, - /* ∧∨<>≠=≤≥≡≢ */ bi_and , bi_or , bi_lt , bi_gt , bi_ne , bi_eq , bi_le , bi_ge , bi_feq , bi_fne, - /* ⊣⊢⥊∾≍↑↓↕«» */ bi_ltack , bi_rtack , bi_shape, bi_join , bi_couple, bi_take , bi_drop , bi_ud , bi_shifta, bi_shiftb, - /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_reverse, bi_N , bi_slash, bi_gradeUp, bi_N , bi_select, bi_pick , bi_indexOf, bi_N , bi_memberOf, - /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_find , bi_group , bi_asrt , bi_const , bi_swap , bi_cell , bi_each , bi_tbl , bi_N , bi_fold, - /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_atop , bi_over , bi_before, bi_after , bi_under, bi_val , bi_cond , bi_N, + /* +-×÷⋆√⌊⌈|¬ */ bi_add , bi_sub , bi_mul , bi_div , bi_pow , bi_N , bi_floor, bi_ceil , bi_stile , bi_not, + /* ∧∨<>≠=≤≥≡≢ */ bi_and , bi_or , bi_lt , bi_gt , bi_ne , bi_eq , bi_le , bi_ge , bi_feq , bi_fne, + /* ⊣⊢⥊∾≍↑↓↕«» */ bi_ltack , bi_rtack , bi_shape, bi_join , bi_couple , bi_take , bi_drop , bi_ud , bi_shifta, bi_shiftb, + /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_reverse, bi_N , bi_slash, bi_gradeUp, bi_gradeDown, bi_select, bi_pick , bi_indexOf, bi_N , bi_memberOf, + /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_find , bi_group , bi_asrt , bi_const , bi_swap , bi_cell , bi_each , bi_tbl , bi_N , bi_fold, + /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_atop , bi_over , bi_before , bi_after , bi_under, bi_val , bi_cond , bi_N, /* ⚇⍟⎊ */ bi_N , bi_repeat, bi_catch }; bool rtComplete[] = { /* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,0,1,1,1,1, /* ∧∨<>≠=≤≥≡≢ */ 1,1,1,1,1,1,1,1,1,1, /* ⊣⊢⥊∾≍↑↓↕«» */ 1,1,0,1,1,1,1,1,1,1, - /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 1,0,1,1,0,1,1,1,0,1, + /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 1,0,1,1,1,1,1,1,0,1, /* ⍷⊔!˙˜˘¨⌜⁼´ */ 1,1,1,1,1,1,1,1,0,1, /* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,1,1,1,1,1,1,0,0, /* ⚇⍟⎊ */ 0,1,1 diff --git a/src/sort.c b/src/sort.c index c57dc64c..0c0f4151 100644 --- a/src/sort.c +++ b/src/sort.c @@ -1,108 +1,35 @@ -#include "sort.h" +#include "h.h" + + +#define CAT0(A,B) A##_##B +#define CAT(A,B) CAT0(A,B) +typedef struct BI32p { B k; i32 v; } BI32p; +typedef struct I32I32p { i32 k; i32 v; } I32I32p; + +#define GRADE_N gradeUp +#define GRADE_CHR "⍋" +#define GRADE_NEG +#define GRADE_UP 1 +#define GRADE_UD(U,D) U +#include "grade.c" +#define GRADE_N gradeDown +#define GRADE_CHR "⍒" +#define GRADE_NEG - +#define GRADE_UP 0 +#define GRADE_UD(U,D) D +#include "grade.c" + +#define SORT_CMP(W, X) compare(W, X) +#define SORT_NAME b +#define SORT_TYPE B +#include "sortTemplate.c" + +#define SORT_CMP(W, X) ((W) - (i64)(X)) +#define SORT_NAME i +#define SORT_TYPE i32 +#include "sortTemplate.c" + -B gradeUp_c1(B t, B x) { - if (isAtm(x) || rnk(x)==0) thrM("⍋: Argument cannot be a unit"); - if (rnk(x)>1) x = toCells(x); - usz ia = a(x)->ia; - if (ia>I32_MAX) thrM("⍋: Argument too large"); - if (ia==0) return inc(bi_emptyIVec); - - i32* rp; B r = m_i32arrv(&rp, ia); - if (TI(x).elType==el_i32) { - i32* xp = i32any_ptr(x); - i32 min=I32_MAX, max=I32_MIN; - for (usz i = 0; i < ia; i++) { - i32 c = xp[i]; - if (cmax) max=c; - } - i64 range = max - (i64)min + 1; - if (range/2 < ia) { - TALLOC(usz, tmp, range+1); - for (i64 i = 0; i < range; i++) tmp[i] = 0; - for (usz i = 0; i < ia; i++) (tmp-min+1)[xp[i]]++; - for (i64 i = 1; i < range; i++) tmp[i]+= tmp[i-1]; - for (usz i = 0; i < ia; i++) rp[(tmp-min)[xp[i]]++] = i; - - TFREE(tmp); dec(x); - return r; - } - - TALLOC(I32I32p, tmp, ia); - for (usz i = 0; i < ia; i++) { - tmp[i].v = i; - tmp[i].k = xp[i]; - } - ip_tim_sort(tmp, ia); - for (usz i = 0; i < ia; i++) rp[i] = tmp[i].v; - TFREE(tmp); dec(x); - return r; - } - - TALLOC(BI32p, tmp, ia); - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) { - tmp[i].v = i; - tmp[i].k = xgetU(x,i); - } - bp_tim_sort(tmp, ia); - for (usz i = 0; i < ia; i++) rp[i] = tmp[i].v; - TFREE(tmp); dec(x); - return r; -} -B gradeUp_c2(B t, B w, B x) { - if (isAtm(w) || rnk(w)==0) thrM("⍋: 𝕨 must have rank≥1"); - if (isAtm(x)) x = m_atomUnit(x); - ur wr = rnk(w); - ur xr = rnk(x); - - if (wr > 1) { - if (wr > xr+1) thrM("⍋: =𝕨 cannot be greater than =𝕩"); - i32 nxr = xr-wr+1; - x = toKCells(x, nxr); xr = nxr; - w = toCells(w); xr = 1; - } - - u8 we = TI(w).elType; usz wia = a(w)->ia; - u8 xe = TI(x).elType; usz xia = a(x)->ia; - - if (wia>I32_MAX-10) thrM("⍋: 𝕨 too big"); - i32* rp; B r = m_i32arrc(&rp, x); - - if (we==el_i32 & xe==el_i32) { - i32* wi = i32any_ptr(w); - i32* xi = i32any_ptr(x); - if (CHECK_VALID) for (usz i = 0; i < (i64)wia-1; i++) if (wi[i] > wi[i+1]) thrM("⍋: 𝕨 must be sorted"); - - for (usz i = 0; i < xia; i++) { - i32 c = xi[i]; - usz s = 0, e = wia+1; - while (e-s > 1) { - usz m = (s+(i64)e)/2; - if (c < wi[m-1]) e = m; - else s = m; - } - rp[i] = s; - } - } else { - BS2B wgetU = TI(w).getU; - BS2B xgetU = TI(x).getU; - if (CHECK_VALID) for (usz i = 0; i < wia-1; i++) if (compare(wgetU(w,i), wgetU(w,i+1)) > 0) thrM("⍋: 𝕨 must be sorted"); - - for (usz i = 0; i < xia; i++) { - B c = xgetU(x,i); - usz s = 0, e = wia+1; - while (e-s > 1) { - usz m = (s+e) / 2; - if (compare(c, wgetU(w,m-1)) < 0) e = m; - else s = m; - } - rp[i] = s; - } - } - dec(w);dec(x); - return r; -} int sort_icmp(const void* w, const void* x) { return *(int*)w - *(int*)x; } int sort_bcmp(const void* w, const void* x) { return compare(*(B*)w, *(B*)x); } @@ -128,7 +55,7 @@ B and_c1(B t, B x) { return withFill(r.b,xf); } -#define F(A,M,D) A(gradeUp) +#define F(A,M,D) A(gradeUp) A(gradeDown) BI_FNS0(F); static inline void sort_init() { BI_FNS1(F) } #undef F diff --git a/src/sort.h b/src/sort.h deleted file mode 100644 index f64e6cd4..00000000 --- a/src/sort.h +++ /dev/null @@ -1,24 +0,0 @@ -#pragma once -#include "h.h" - -#define SORT_CMP(W, X) compare(W, X) -#define SORT_NAME b -#define SORT_TYPE B -#include "sortTemplate.c" - -#define SORT_CMP(W, X) ((W) - (i64)(X)) -#define SORT_NAME i -#define SORT_TYPE i32 -#include "sortTemplate.c" - -typedef struct BI32p { B k; i32 v; } BI32p; -#define SORT_CMP(W, X) compare((W).k, (X).k) -#define SORT_NAME bp -#define SORT_TYPE BI32p -#include "sortTemplate.c" - -typedef struct I32I32p { i32 k; i32 v; } I32I32p; -#define SORT_CMP(W, X) ((W).k - (i64)(X).k) -#define SORT_NAME ip -#define SORT_TYPE I32I32p -#include "sortTemplate.c"