view release on metacpan or  search on metacpan

lib/Array/AsObject.pm  view on Meta::CPAN

sub intersection {
   my($obj1,$obj2,$unique) = @_;

   my $class = ref($obj1);
   my $ret   = new $class;

   if (ref($obj2) ne $class) {
      $$ret{"err"} = "Obj2 not of the right class";
      return $ret;
   }

   # $tmp is identical to $obj2
   # foreach element in $obj1
   #    if it's in $tmp
   #       add it to $ret
   #       remove it from $tmp

   my $tmp   = new $class;
   $tmp->list(@{ $$obj2{"set"} });
   my $all   = ($unique ? 1 : 0);

   my @list  = @{ $$obj1{"set"} };
   foreach my $ele (@list) {
      if ($tmp->exists($ele)) {
         $ret->push($ele);
         $tmp->delete($all,0,$ele);
      }
   }

   return $ret;
}

sub is_equal {
   my($obj1,$obj2,$unique) = @_;

   my $class = ref($obj1);

   if (ref($obj2) ne $class) {
      return undef;
   }

   my @list1  = @{ $$obj1{"set"} };
   my @list2  = @{ $$obj2{"set"} };

   if ($unique) {
      foreach my $ele (@list1) {
         return 0  if (! $obj2->exists($ele));
      }
      foreach my $ele (@list2) {
         return 0  if (! $obj1->exists($ele));
      }
      return 1;
   }

   foreach my $ele (@list1,@list2) {
      return 0  if ($obj1->count($ele) != $obj2->count($ele));
   }
   return 1;
}

sub not_equal {
   return 1 - is_equal(@_);
}

sub is_subset {
   my($obj1,$obj2,$unique) = @_;

   my $class = ref($obj1);

   if (ref($obj2) ne $class) {
      return undef;
   }

   my @list  = @{ $$obj2{"set"} };

   if ($unique) {
      foreach my $ele (@list) {
         return 0  if (! $obj1->exists($ele));
      }
      return 1;
   }

   foreach my $ele (@list) {
      return 0  if ($obj2->count($ele) > $obj1->count($ele));
   }
   return 1;
}

sub not_subset {
   return 1 - is_subset(@_);
}

sub symmetric_difference {
   my($obj1,$obj2,$unique) = @_;

   my $class = ref($obj1);
   my $ret   = new $class;

   if (ref($obj2) ne $class) {
      $$ret{"err"} = "Obj2 not of the right class";
      return $ret;
   }

   my $tmp1  = new $class;
   my @list1 = @{ $$obj1{"set"} };
   $tmp1->list(@list1);

   my $tmp2  = new $class;
   my @list2 = @{ $$obj2{"set"} };
   $tmp2->list(@list2);

   my $all   = ($unique ? 1 : 0);

   foreach my $ele (@list1,@list2) {
      if ($tmp1->exists($ele)  &&  $tmp2->exists($ele)) {
         $tmp1->delete($all,0,$ele);
         $tmp2->delete($all,0,$ele);
      } elsif ($tmp1->exists($ele)) {
         $ret->push($ele);
         $tmp1->delete(0,0,$ele);
      } elsif ($tmp2->exists($ele)) {
         $ret->push($ele);
         $tmp2->delete(0,0,$ele);
      }
   }

   return $ret;
}

sub union {
   my($obj1,$obj2,$unique) = @_;

   my $class = ref($obj1);
   my $ret   = new $class;

   if (ref($obj2) ne $class) {
      $$ret{"err"} = "Obj2 not of the right class";
      return $ret;
   }

   my @list1 = @{ $$obj1{"set"} };
   my @list2 = @{ $$obj2{"set"} };

   $ret->list(@list1,@list2);
   if ($unique) {
      $ret->unique();
   }

   return $ret;