Algorithm-BreakOverlappingRectangles
view release on metacpan or search on metacpan
BreakOverlappingRectangles.xs view on Meta::CPAN
#define X0 0
#define Y0 1
#define X1 2
#define Y1 3
#define IDOFFSET (sizeof(NV) * 4)
#define BRUTEFORCECUTOFF 40
#if 1
#define DP(f)
#define DUMP(msg, av, start)
#define my_assert(a) assert(a)
#else
#define my_assert(a) if(!(a)) _failed_assertion(aTHX_ #a, __LINE__, __FILE__)
#define DP(f) f
#define DUMP(msg, av, start) _dump(aTHX_ (msg), (av), (start))
static void
_dump(pTHX_ char *msg, AV *rects, I32 start) {
I32 end = av_len(rects) + 1;
SV **svs = AvARRAY(rects);
I32 i;
fprintf (stderr, "%s = start: %d, end: %d", msg, start, end);
for (i = start; i < end; i++) {
SV *sv = svs[i];
if (SvOK(sv)) {
STRLEN len, j;
NV* nv = (NV*)SvPV(svs[i], len);
IV* iv = (IV*)(SvPV_nolen(svs[i]) + IDOFFSET);
len = (len - IDOFFSET) / sizeof(IV);
fprintf (stderr, " [%.0f %.0f %.0f %.0f |", nv[0], nv[1], nv[2], nv[3]);
for (j = 0; j < len; j++)
fprintf(stderr, " %d", iv[j]);
fprintf(stderr, "]");
BreakOverlappingRectangles.xs view on Meta::CPAN
DP(printf("cmp(%f, %f) => %d\n", fa, fb, (fa < fb) ? -1 : ((fa > fb) ? 1 : 0)));
return (fa < fb) ? -1 : ((fa > fb) ? 1 : 0);
}
void
sort_inplace(pTHX_ double **v, int size) {
sortsv((SV**)v, size, (SVCOMPARE_t)&double_cmp);
}
static NV
find_best_cut(pTHX_ AV *rects, I32 start, I32 end, int dir, NV *bestv) {
NV **v0, **v1, **vc0, **vc1;
NV v, med, best;
int op, cl;
int i;
SV **svs;
I32 size = end - start;
my_assert(bestv);
DUMP("fbc in", rects, start);
DP(fprintf(stderr, "end: %d\n", end));
Newx(v0, size + 1, NV *);
Newx(v1, size + 1, NV *);
v0[size] = v1[size] = NULL;
vc0 = v0; vc1 = v1;
svs = AvARRAY(rects) + start;
size = end - start;
for (i = 0; i < size; i++) {
NV *nv = (NV*)SvPV_nolen(svs[i]);
if (dir == 'x') {
v0[i] = nv + X0;
v1[i] = nv + X1;
}
else {
v0[i] = nv + Y0;
v1[i] = nv + Y1;
BreakOverlappingRectangles.xs view on Meta::CPAN
}
}
Safefree(vc0);
Safefree(vc1);
return best;
}
static void
_break(pTHX_ AV *rects, I32 start, AV *parts);
static void
_brute_force_merge(pTHX_ AV *rects, I32 start, AV *parts) {
I32 i, len;
for (i = start; i <= av_len(rects); i++) {
SV *svr = (AvARRAY(rects))[i];
I32 j;
for (j=0; j <= av_len(parts);) {
NV *r = (NV*) SvPV_nolen(svr);
SV *svp = (AvARRAY(parts))[j];
NV *p = (NV*) SvPV_nolen(svp);
if ((r[X1] > p[X0]) &&
(r[X0] < p[X1]) &&
(r[Y1] > p[Y0]) &&
BreakOverlappingRectangles.xs view on Meta::CPAN
}
j++;
}
}
/*
for (i = av_len(parts); i >= 0; i--)
av_push(rects, av_pop(parts));
*/
if ((len = av_len(parts)) >= 0) {
SV **svrs, **svps;
I32 start = av_len(rects) + 1;
av_extend(rects, start + len);
svrs = AvARRAY(rects) + start;
svps = AvARRAY(parts);
AvFILLp(parts) = -1;
AvFILLp(rects) = start + len;
do {
svrs[len] = svps[len];
svps[len] = &PL_sv_undef;
} while (--len >= 0);
}
}
static void
_brute_force_break(pTHX_ AV *rects, I32 start, AV *parts) {
I32 i, j, end1;
DUMP("bfb in", rects, start);
end1 = av_len(rects);
if (end1 < start + 1)
return;
if (end1 - start > 2 * BRUTEFORCECUTOFF ) {
SV **svs;
I32 end;
I32 middle = (start + end1 + 1) / 2;
_break(aTHX_ rects, middle, parts);
svs = AvARRAY(rects);
end = av_len(rects) + 1;
i = start;
j = end;
while (i < middle && j > middle) {
j--;
SV *tmp = svs[i];
svs[i] = svs[j];
svs[j] = tmp;
i++;
}
middle = start + end - middle;
_break(aTHX_ rects, middle, parts);
end = av_len(rects);
if ((end - start) > (end1 - start) * 1.2)
return _break(aTHX_ rects, start, parts);
while (end-- >= middle)
av_push(parts, av_pop(rects));
return _brute_force_merge(aTHX_ rects, start, parts);
}
while (--end1 >= start) {
SV *last, *next;
SV **svs;
DP(fprintf(stderr, "bfb: start: %d, end1: %d, end: %d\n", start, end1, av_len(rects) + 1));
svs = AvARRAY(rects);
last = svs[AvFILLp(rects)];
svs[AvFILLp(rects)--] = &PL_sv_undef;
next = svs[end1];
svs[end1] = last;
av_push(parts, next);
_brute_force_merge(aTHX_ rects, end1, parts);
}
return;
}
static void
_break(pTHX_ AV *rects, I32 start, AV *parts) {
NV bestx, bestxx, besty, bestyy, div;
int off;
I32 i, j, middle, end;
SV **svs;
DUMP("break", rects, start);
while (1) {
end = av_len(rects) + 1;
if ((end - start) <= BRUTEFORCECUTOFF)
return _brute_force_break(aTHX_ rects, start, parts);
bestx = find_best_cut(aTHX_ rects, start, end, 'x', &bestxx);
besty = ((bestx == 0) ? 1 : find_best_cut(aTHX_ rects, start, end, 'y', &bestyy));
if (bestx < besty) {
off = X0;
div = bestxx;
DP(fprintf(stderr, "cutting at x=%.0f, best=%.2f\n", bestxx, bestx));
}
else {
off = Y0;
div = bestyy;
DP(fprintf(stderr, "cutting at y=%.0f, best=%.2f\n", bestyy, besty));
}
svs = AvARRAY(rects);
i = start;
middle = end;
while (i < middle) {
SV *sv = svs[i];
NV n0 = ((NV*)SvPV_nolen(sv))[off];
if (n0 < div) {
middle--;
svs[i] = svs[middle];
svs[middle] = sv;
}
else
i++;
}
DUMP("b0", rects, start);
if (middle == start || middle == end)
return _brute_force_break(aTHX_ rects, start, parts);
_break(aTHX_ rects, middle, parts);
DUMP("b1", rects, start);
svs = AvARRAY(rects);
end = av_len(rects) + 1;
i = start;
j = end;
while (i < middle && j > middle) {
j--;
SV *tmp = svs[i];
svs[i] = svs[j];
svs[j] = tmp;
i++;
}
DUMP("b2", rects, start);
end += start - middle;
off += 2;
i = start;
middle = end;
DP(fprintf(stderr, "i: %d, middle: %d\n", i, middle));
while (i < middle) {
SV *sv = svs[i];
NV n0 = ((NV*)SvPV_nolen(sv))[off];
if (n0 > div) {
middle--;
svs[i] = svs[middle];
svs[middle] = sv;
}
else
i++;
}
DUMP("b3", rects, start);
if (middle == start)
return _brute_force_break(aTHX_ rects, start, parts);
start = middle;
}
/* _break(aTHX_ rects, middle); */
}
MODULE = Algorithm::BreakOverlappingRectangles PACKAGE = Algorithm::BreakOverlappingRectangles
PROTOTYPES: DISABLE
void
_break_rectangles(rects)
AV *rects;
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
bytes_to_uni|||n
bytes_to_utf8||5.006001|
call_argv|5.006000||p
call_atexit||5.006000|
call_list||5.004000|
dXSTARG|5.006000||p
deb_curcv|||
deb_nocontext|||vn
deb_stack_all|||
deb_stack_n|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|
deprecate_old|||
deprecate|||
despatch_signals||5.007001|
destroy_matcher|||
die_nocontext|||vn
die_where|||
is_utf8_upper||5.006000|
is_utf8_xdigit||5.006000|
isa_lookup|||
items|||n
ix|||n
jmaybe|||
join_exact|||
keyword|||
leave_scope|||
lex_end|||
lex_start|||
linklist|||
listkids|||
list|||
load_module_nocontext|||vn
load_module||5.006000|v
localize|||
looks_like_bool|||
looks_like_number|||
lop|||
mPUSHi|5.009002||p
pTHX_|5.006000||p
pTHX|5.006000||p
packWARN|5.007003||p
pack_cat||5.007003|
pack_rec|||
package|||
packlist||5.008001|
pad_add_anon|||
pad_add_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_peg|||n
pad_push|||
push_scope|||
put_byte|||
pv_display||5.006000|
pv_escape||5.009004|
pv_pretty||5.009004|
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_croak2|||
re_dup|||
re_intuit_start||5.006000|
re_intuit_string||5.006000|
readpipe_override|||
realloc||5.007002|n
reentrant_free|||
reentrant_init|||
reentrant_retry|||vn
reentrant_size|||
ref_array_or_hash|||
refcounted_he_chain_2hv|||
refcounted_he_fetch|||
skipspace2|||
skipspace|||
sortcv_stacked|||
sortcv_xsub|||
sortcv|||
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stashpv_hvname_match||5.009005|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strip_return|||
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2nv|||
sv_2pv_flags||5.007002|
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
print "$hints{$f}" if exists $hints{$f};
$info++;
}
return rv;
}
#endif
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
start_subparse(),
#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv(name,0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
#endif
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
#ifdef PERL_IMPLICIT_CONTEXT
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
#ifndef sv_catpvf_mg
#endif
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
#ifdef PERL_IMPLICIT_CONTEXT
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
#ifndef sv_setpvf_mg
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
void
DPPP_(my_warner)(U32 err, const char *pat, ...)
{
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
#define warner Perl_warner
/* Perl_warner_nocontext depends on warner */
#define Perl_warner_nocontext Perl_warner
#endif
/*
* The grok_* routines have been modified to use warn() instead of
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
for (; len-- && *s; s++) {
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#define Perl_my_snprintf DPPP_(my_my_snprintf)
#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
int
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
if (retval >= (int)len)
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}
( run in 0.374 second using v1.01-cache-2.11-cpan-0d8aa00de5b )