my
$debug
= 0;
$PDL::debug
=
$debug
;
my
$pa
= sequence(3,4);
my
$pb
= yvals(zeroes(4,3)) + sequence(4);
my
$pc
=
$pa
->transpose->slice(
':,-1:0'
);
thread_define
'tline(a(n);b(n))'
, over {
$_
[0] .=
$_
[1];
};
broadcast_define
'tassgn(a(n,m);[o] b())'
, over {
$_
[1] .=
$_
[0]->sum;
};
broadcast_define
'ttext(a(n=3)), NOtherPars => 1'
, over {
${
$_
[1]} .=
sprintf
(
"%.3f %.3f %.3f,\n"
,
$_
[0]->list);
};
broadcast_define
'tprint(a(n);b(n)), NOtherPars => 1'
, over {
${
$_
[2]} .=
"$_[1]"
;
};
PDL::Core::set_debugging(1)
if
$debug
;
tline(
$pc
,
$pb
);
is_pdl
$pc
,
$pb
;
$pc
= ones(5);
throws_ok {
tline(
$pa
,
$pc
);
}
qr/conflicting/
;
$pa
= ones(2,3,4)
*sequence
(4)->slice(
'*,*,:'
);
tassgn(
$pa
,(
$pb
=null));
is_pdl
$pb
, 6
*sequence
(4);
$pa
= sequence(4,4);
throws_ok {
ttext(
$pa
, \
my
$text
);
}
qr/conflicting/
;
note
"testing tprint\n"
;
$pa
= sequence(3);
$pb
= pdl [1];
my
$text
=
""
;
tprint(
$pa
,
$pb
, \
$text
);
is
$text
,
'[1 1 1]'
;
thread_define
'_apply_slice_ND(data(n);sl(2,m);[o]output(m)),NOtherPars=>2'
, over {
my
(
$data
,
$sl
,
$output
,
$func
,
$args
) =
@_
;
_apply_slice_1D(
$sl
, ones(
$data
->type),
my
$output1D
= null,
$data
,
$func
,
$args
);
$output
.=
$output1D
;
};
thread_define
'_apply_slice_1D(slices(n);dummy();[o]output()),NOtherPars=>3'
, over {
my
(
$slices
,
$dummy
,
$output1D
,
$data
,
$func
,
$args
) =
@_
;
my
$data_sliced
= slice(
$data
,
$slices
->unpdl);
$output1D
.= PDL::Core::topdl(
$data_sliced
->
$func
(
@$args
));
};
my
$x
= sequence(5,3,2);
my
$slices
= indx([0,2], [1,3], [2,4]);
my
$y
= null;
lives_ok { _apply_slice_ND(
$x
,
$slices
,
$y
,
'sum'
, []) };
done_testing;