view release on metacpan or  search on metacpan

t/lib/TF_Utils.pm  view on Meta::CPAN

}

sub Placeholder {
	my ($graph, $status, $name, $dtype) = @_;
	$name ||= 'feed';
	$dtype ||= INT32;
	my $desc = AI::TensorFlow::Libtensorflow::OperationDescription->New($graph, 'Placeholder', $name);
	$desc->SetAttrType('dtype', $dtype);
	my $op = $desc->FinishOperation($status);
	AssertStatusOK($status);
	$op;
}

sub Const {
	my ($graph, $status, $name, $t) = @_;
	my $desc = AI::TensorFlow::Libtensorflow::OperationDescription->New($graph, 'Const', $name);
	$desc->SetAttrTensor('value', $t, $status);
	$desc->SetAttrType('dtype', $t->Type);
	my $op = $desc->FinishOperation($status);
	AssertStatusOK($status);
	$op;
}

my %dtype_to_pack = (
	FLOAT  => 'f',
	DOUBLE => 'd',
	INT32  => 'l',
	INT8   => 'c',
	BOOL   => 'c',
);

use FFI::Platypus::Buffer qw(scalar_to_pointer);
use FFI::Platypus::Memory qw(memcpy);

sub ScalarConst {
	my ($graph, $status, $name, $dtype, $value) = @_;
	$name ||= 'scalar';
	my $t = AI::TensorFlow::Libtensorflow::Tensor->Allocate($dtype, []);
	die "Pack format for $dtype is unknown" unless exists $dtype_to_pack{$dtype};
	my $data = pack $dtype_to_pack{$dtype} . '*', $value;
	memcpy scalar_to_pointer(${ $t->Data }),
		 scalar_to_pointer($data),
		 $t->ByteSize;
	return Const($graph, $status, $name, $t);
}


use AI::TensorFlow::Libtensorflow::Lib::Types qw(TFOutput TFOutputFromTuple);
use Types::Standard qw(HashRef);

my $TFOutput = TFOutput->plus_constructors(
		HashRef, 'New'
	)->plus_coercions(TFOutputFromTuple);
sub Add {
	my ($l, $r, $graph, $s, $name, $check) = @_;
	$name ||= 'add';
	$check = 1 if not defined $check;
	my $desc = AI::TensorFlow::Libtensorflow::OperationDescription->New(
		$graph, "AddN", $name);
	$desc->AddInputList([
		$TFOutput->map( [ $l => 0 ], [ $r => 0 ] )
	]);
	my $op = $desc->FinishOperation($s);
	AssertStatusOK($s) if $check;
	$op;
}

sub AddNoCheck {
	my ($l, $r, $graph, $s, $name) = @_;
	return Add( $l, $r, $graph, $s, $name, 0);
}

sub Neg {
	my ($n, $graph, $s, $name) = @_;
	$name ||= 'neg';
	my $desc = AI::TensorFlow::Libtensorflow::OperationDescription->New(
		$graph, "Neg", $name);
	my $neg_input = $TFOutput->coerce([$n => 0]);
	$desc->AddInput($neg_input);
	my $op = $desc->FinishOperation($s);
	AssertStatusOK($s);
	$op;
}

sub AnyTensor {
	my ($dtype, $v) = @_;
	die "Pack format for $dtype is unknown" unless exists $dtype_to_pack{$dtype};
	if( ! ref $v ) {
		my $t = AI::TensorFlow::Libtensorflow::Tensor->Allocate( $dtype, [] );
		memcpy scalar_to_pointer( ${ $t->Data } ),
			scalar_to_pointer(pack($dtype_to_pack{$dtype}, $v)), $dtype->Size;
		return $t;
	} elsif( ref $v eq 'ARRAY' ) {
		my $n = @$v;
		my $t = AI::TensorFlow::Libtensorflow::Tensor->Allocate( $dtype, [$n] );
		memcpy scalar_to_pointer( ${ $t->Data } ),
			scalar_to_pointer(pack("$dtype_to_pack{$dtype}*", @$v)), $n * $dtype->Size;
		return $t;
	}
}

sub Int8Tensor {
	return AnyTensor(INT8, @_);
}

sub Int32Tensor {
	return AnyTensor(INT32, @_);
}

sub AssertStatusOK {
	my ($status) = @_;
	die "Status not OK: @{[ $status->GetCode ]} : @{[ $status->Message ]}"
		unless $status->GetCode == AI::TensorFlow::Libtensorflow::Status::OK;
}

sub AssertStatusNotOK {
	my ($status) = @_;
	die "Status expected not OK" if $status->GetCode == AI::TensorFlow::Libtensorflow::Status::OK;
	return "Status: @{[ $status->GetCode ]}:  @{[ $status->Message ]}";
}

t/lib/TF_Utils.pm  view on Meta::CPAN

	TF_Utils::AssertStatusOK($s);

	$ctx->note('Create a session for this graph.');
	my $csession = TF_Utils::CSession->new( graph => $graph, status => $s, use_XLA => $use_XLA );
	TF_Utils::AssertStatusOK($s);

	if( $device ) {
		$ctx->note("Setting op Min on device $device");
	}
	my $min = TF_Utils::MinWithDevice( $feed, $one, $graph, $device, $s );
	TF_Utils::AssertStatusOK($s);

	$ctx->note('Run the graph.');
	$csession->SetInputs( [ $feed, TF_Utils::Int32Tensor([3, 2, 5]) ]);
	$csession->SetOutputs($min);
	$csession->Run($s);
	TF_Utils::AssertStatusOK($s);
	is($csession->output_tensor(0), object {
		call Type => INT32;
		call NumDims => 0; # scalar
		call ByteSize => INT32->Size;
		call sub {
			[ unpack "l*", ${ shift->Data } ];
		} => [ 2 ];
	}, 'Min( Feed() = [3, 2, 5] )');

	$ctx->release;
}

sub GPUDeviceName {
	my ($session) = @_;

	my $s = AI::TensorFlow::Libtensorflow::Status->New;
	my $graph;
	if( ! $session ) {
		my $opts = AI::TensorFlow::Libtensorflow::SessionOptions->New;
		$graph = AI::TensorFlow::Libtensorflow::Graph->New;
		$session ||= AI::TensorFlow::Libtensorflow::Session->New($graph, $opts, $s);
	}

	my $device_list = $session->ListDevices($s);
	my $device_idx = first { my $type = $device_list->Type( $_, $s ) eq 'GPU' } 0..$device_list->Count - 1;

	return "" unless $device_idx;

	return $device_list->Name( $device_idx, $s );
}

sub DumpDevices {
	my ($session) = @_;

	my $s = AI::TensorFlow::Libtensorflow::Status->New;
	my $graph;
	if( ! $session ) {
		my $opts = AI::TensorFlow::Libtensorflow::SessionOptions->New;
		$graph = AI::TensorFlow::Libtensorflow::Graph->New;
		$session ||= AI::TensorFlow::Libtensorflow::Session->New($graph, $opts, $s);
	}

	my $device_list = $session->ListDevices($s);
	my @devices = map {
		my $idx = $_;
		my %h = map { ( $_ => $device_list->$_( $idx, $s ) ) } qw(Name Type MemoryBytes Incarnation);
		\%h;
	} 0..$device_list->Count - 1;
	use Data::Dumper; print Dumper(\@devices);
}

1;