Polymorphism

From Rosetta Code
Revision as of 13:41, 10 March 2010 by rosettacode>Abu (Wrong alphabetic position)
Task
Polymorphism
You are encouraged to solve this task according to the task description, using any language you may know.

Create two classes Point(x,y) and Circle(x,y,r) with a polymorphic function print, accessors for (x,y,r), copy constructor, assignment and destructor and every possible default constructors

ActionScript

<lang actionscript>package {

   public class Point
   {
       protected var _x:Number;
       protected var _y:Number;
       
       public function Point(x:Number = 0, y:Number = 0)
       {
           _x = x;
           _y = y;
       }
       
       public function getX():Number
       {
           return _x;
       }
       
       public function setX(x:Number):void
       {
           _x = x;
       }
       
       public function getY():Number
       {
           return _y;
       }
       
       public function setY(y:Number):void
       {
           _x = y;
       }
       
       public function print():void
       {
           trace("Point");
       }
   }

}</lang> <lang actionscript>package {

   public class Circle extends Point
   {
       private var r:Number;
       
       public function Circle(x:Number=0, y:Number=0, r:Number=0)
       {
           super(x, y);
           this.r = r;
       }
       
       public function getR():Number
       {
           return r;
       }
       
       public function setR(r:Number):void
       {
           this.r = r;
       }
       
       public override function print():void
       {
           trace("Circle");
       }
   }

}</lang>

Ada

This example is constructed using a parent package and a child package. The parent package defines the Point type. The child package defines the Circle type. <lang ada>package Shapes is

  type Point is tagged private;
  procedure Print(Item : in Point);
  function Setx(Item : in Point; Val : Integer) return Point;
  function Sety(Item : in Point; Val : Integer) return Point;
  function Getx(Item : in Point) return Integer;
  function Gety(Item : in Point) return Integer;
  function Create return Point;
  function Create(X : Integer) return Point;
  function Create(X, Y : Integer) return Point;
 

private

  type Point is tagged record
     X : Integer := 0;
     Y : Integer := 0;
  end record;

end Shapes;</lang> <lang ada>with Ada.Text_Io; use Ada.Text_Io;

package body Shapes is

  -----------
  -- Print --
  -----------
  procedure Print (Item : in Point) is
  begin
     Put_line("Point");
  end Print;
  ----------
  -- Setx --
  ----------
  function Setx (Item : in Point; Val : Integer) return Point is
  begin
     return (Val, Item.Y);
  end Setx;
  ----------
  -- Sety --
  ----------
  function Sety (Item : in Point; Val : Integer) return Point is
  begin
     return (Item.X, Val);
  end Sety;
  ----------
  -- Getx --
  ----------
  function Getx (Item : in Point) return Integer is
  begin
     return Item.X;
  end Getx;
  ----------
  -- Gety --
  ----------
  function Gety (Item : in Point) return Integer is
  begin
     return Item.Y;
  end Gety;
  ------------
  -- Create --
  ------------
  function Create return Point is
  begin
     return (0, 0);
  end Create;
  ------------
  -- Create --
  ------------
  function Create (X : Integer) return Point is
  begin
     return (X, 0);
  end Create;
  ------------
  -- Create --
  ------------
  function Create (X, Y : Integer) return Point is
  begin
     return (X, Y);
  end Create;

end Shapes;</lang> The following is the child package defining the Circle type. <lang ada>package Shapes.Circles is

  type Circle is new Point with private;
  procedure Print(Item : Circle);
  function Setx(Item : Circle; Val : Integer) return Circle;
  function Sety(Item : Circle; Val : Integer) return Circle;
  function Setr(Item : Circle; Val : Integer) return Circle;
  function Getr(Item : Circle) return Integer;
  function Create(P : Point) return Circle;
  function Create(P : Point; R : Integer) return Circle;
  function Create(X : Integer) return Circle;
  function Create(X : Integer; Y : Integer) return Circle;
  function Create(X : Integer; Y : Integer; R : Integer) return Circle;
  function Create return Circle;

private

  type Circle is new Point with record
     R : Integer := 0;
  end record;

end Shapes.Circles;</lang> <lang ada>with Ada.Text_Io; use Ada.Text_IO;

package body Shapes.Circles is

  -----------
  -- Print --
  -----------
  procedure Print (Item : Circle) is
  begin
     Put_line("Circle");
  end Print;
  ----------
  -- Setx --
  ----------
  function Setx (Item : Circle; Val : Integer) return Circle is
  begin
     return (Val, Item.Y, Item.R);
  end Setx;
  ----------
  -- Sety --
  ----------
  function Sety (Item : Circle; Val : Integer) return Circle is
     Temp : Circle := Item;
  begin
     Temp.Y := Val;
     return Temp;
  end Sety;
  ----------
  -- Setr --
  ----------
  function Setr (Item : Circle; Val : Integer) return Circle is
  begin
     return (Item.X, Item.Y, Val);
  end Setr;
  ----------
  -- Getr --
  ----------
  function Getr (Item : Circle) return Integer is
  begin
     return Item.R;
  end Getr;
  ------------
  -- Create --
  ------------
  function Create (P : Point) return Circle is
  begin
     return (P.X, P.Y, 0);
  end Create;
  ------------
  -- Create --
  ------------
  function Create (P : Point; R : Integer) return Circle is
  begin
     return (P.X, P.Y, R);
  end Create;
  ------------
  -- Create --
  ------------
  function Create (X : Integer) return Circle is
  begin
     return (X, 0, 0);
  end Create;
  ------------
  -- Create --
  ------------
  function Create (X : Integer; Y : Integer) return Circle is
  begin
     return (X, Y, 0);
  end Create;
  ------------
  -- Create --
  ------------
  function Create (X : Integer; Y : Integer; R : Integer) return Circle is
  begin
     return (X, Y, R);
  end Create;
  ------------
  -- Create --
  ------------
  function Create return Circle is
  begin
     return (0, 0, 0);
  end Create;

end Shapes.Circles;</lang> The following procedure is an entry point for a program, serving the same purpose as the main function in C. <lang ada>with Shapes.Circles; use Shapes.Circles; use Shapes;

procedure Shapes_Main is

  P : Point;
  C : Circle;

begin

  P.Print;
  C.Print;

end Shapes_Main;</lang>

BASIC

C

C++

<lang cpp>class Point {

 protected:
   int x, y;
 public:
   Point(int x0 = 0, int y0 = 0) : x(x0), y(y0) {}
   Point(const Point& p) : x(p.x), y(p.y) {}
   virtual ~Point() {}
   const Point& operator=(const Point& p)
   {
     if(this != &p)
     {
       x = p.x;
       y = p.y;
     }
     return *this;
   }
   int getX() { return x; }
   int getY() { return y; }
   int setX(int x0) { x = x0; }
   int setY(int y0) { y = y0; }
   virtual void print() { printf("Point\n"); }

};

class Circle : public Point {

 private:
   int r;
 public:
   Circle(Point p, int r0 = 0) : Point(p), r(r0) {}
   Circle(int x0 = 0, int y0 = 0, int r0 = 0) : Point(x0, y0), r(r0) {}
   virtual ~Circle() {}
   const Circle& operator=(const Circle& c)
   {
     if(this != &c)
     {
       x = c.x;
       y = c.y;
       r = c.r;
     }
     return *this;
   }
   int getR() { return r; }
   int setR(int r0) { r = r0; }
   virtual void print() { printf("Circle\n"); }

};

int main() {

 Point* p = new Point();
 Point* c = new Circle();
 p->print();
 c->print();     
 return 0;

}</lang>

Pattern: Curiously Recurring Template Pattern

<lang cpp>// CRTP: Curiously Recurring Template Pattern template <typename Derived> class PointShape { protected:

 int x, y;

public:

 PointShape(int x0, int y0) : x(x0), y(y0) { }
 ~PointShape() { }
 int getX() { return x; }
 int getY() { return y; }
 int setX(int x0) { x = x0; }
 int setY(int y0) { y = y0; }
 // compile-time virtual function
 void print() { reinterpret_cast<const Derived*>(this)->printType(); }

};

class Point : public PointShape<Point> { public:

 Point(int x0 = 0, int y0 = 0) : PointShape(x0, y0) { }
 Point(const Point& p) : PointShape(p.x, p.y) { }
 ~Point() {}
 const Point& operator=(const Point& p)
 {
   if(this != &p)
   {
     x = p.x;
     y = p.y;
   }
   return *this;
 }
 void printType() { printf("Point\n"); }

};

class Circle : public PointShape<Circle> { private:

 int r;

public:

 Circle(int x0 = 0, int y0 = 0, int r0 = 0) : PointShape(x0, y0), r(r0) { }
 Circle(Point p, int r0 = 0) : PointShape(p.x, p.y), r(r0) { }
 ~Circle() {}
 const Circle& operator=(const Circle& c)
 {
   if(this != &c)
   {
     x = c.x;
     y = c.y;
     r = c.r;
   }
   return *this;
 }
 int getR() { return r; }
 int setR(int r0) { r = r0; }
 void printType() { printf("Circle\n"); }

};

int main() {

 Point* p = new Point();
 Point* c = new Circle();
 p->print();
 c->print();
 return 0;

}</lang>

C#

<lang csharp>using System; class Point {

 protected int x, y;
 public Point() { this(0); }
 public Point(int x0) : this(x0,0) { }
 public Point(int x0, int y0) { x = x0; y = y0; }
 public int getX() { return x; }
 public int getY() { return y; }
 public int setX(int x0) { x = x0; }
 public int setY(int y0) { y = y0; }
 public void print() { System.Console.WriteLine("Point"); }

}

public class Circle : Point {

 private int r;
 public Circle(Point p) : this(p,0) { }
 public Circle(Point p, int r0) : base(p) { r = r0; }
 public Circle() : this(0) { }
 public Circle(int x0) : this(x0,0) { }
 public Circle(int x0, int y0) : this(x0,y0,0) { }
 public Circle(int x0, int y0, int r0) : base(x0,y0) { r = r0; }
 public int getR() { return r; }
 public int setR(int r0) { r = r0; }
 public override void print() { System.Console.WriteLine("Circle"); }

 public static void main(String args[])
 {
   Point p = new Point();
   Point c = new Circle();
   p.print();
   c.print();
 }

}</lang>

Common Lisp

<lang lisp>(defclass point ()

 ((x :initarg :x :initform 0 :accessor x)
  (y :initarg :y :initform 0 :accessor y)))

(defclass circle (point)

 ((radius :initarg :radius :initform 0 :accessor radius)))

(defgeneric shallow-copy (object)) (defmethod shallow-copy ((p point))

 (make-instance 'point :x (x p) :y (y p)))

(defmethod shallow-copy ((c circle))

 (make-instance 'circle :x (x c) :y (y c) :radius (radius c)))

(defgeneric print-shape (shape)) (defmethod print-shape ((p point))

 (print 'point))

(defmethod print-shape ((c circle))

 (print 'circle))

(let ((p (make-instance 'point :x 10))

     (c (make-instance 'circle :radius 5)))
 (print-shape p)
 (print-shape c))</lang>

D

<lang d>import std.stdio;

class Point {

   int x, y;
   this(int x0=0, int y0=0) { x = x0; y = y0; }
   int getX() { return x; }
   void setX(int x) { this.x = x; }
   int getY() { return y; }
   void setY(int y) { this.y = y; }

}

class Circle : Point {

   int r;
   this(int x0=0, int y0=0, int r0=0) { super(x0,y0); r=r0; }
   this(Point p, int r0=0) { super(p.getX,p.getY); r = r0; }
   int getR() { return r; }
   void setR(int r) { this.r = r; }

}

void main() {

   auto p = new Point();
   auto c = new Circle();
   writefln(p);
   writefln(c);

}</lang>

E

<lang e>def makePoint(x, y) {

 def point implements pbc {
   to __printOn(out) { out.print(`<point $x,$y>`) }
   to __optUncall() { return [makePoint, "run", [x, y]] }
   to x() { return x }
   to y() { return y }
   to withX(new) { return makePoint(new, y) }
   to withY(new) { return makePoint(x, new) }
 }
 return point

}

def makeCircle(x, y, r) {

 def circle extends makePoint(x, y) implements pbc {
   to __printOn(out) { out.print(`<circle $x,$y r $r>`) }
   to __optUncall() { return [makeCircle, "run", [x, y, r]] }
   to r() { return r }
   to withX(new) { return makeCircle(new, y, r) }
   to withY(new) { return makeCircle(x, new, r) }
   to withR(new) { return makeCircle(x, y, new) }
 }
 return circle

}</lang>

(It is unidiomatic to have mutation operations on an object of this sort in E, so this example has variation operations instead. __optUncall is used for serialization, and is the closest analogue to a copy constructor. E does not have destructors, but only post-mortem finalizers (which are registered after the object is created). The "extends" is only implementation inheritance; it is not necessary to enable polymorphism.)

<lang e>def p := makePoint(0.5, 0.5) def c := makeCircle(1, 1, 2) println(p) println(c)</lang>

Factor

<lang factor>QUALIFIED: io  ! there already is print in io

GENERIC: print ( shape -- )

TUPLE: point x y ; C: <point> point  ! shorthand constructor definition

M: point print drop "Point" io:print ;

TUPLE: circle radius x y ; C: <circle> circle

M: circle print drop "Circle" io:print ;</lang>

Fortran

Fortran provides OO features with the type mechanism. This example works with the Intel 11.1.069 compiler. <lang fortran> module geom

 type point
    real(8), private  :: x = 0
    real(8), private  :: y = 0
  contains                    
    procedure, public :: get_x
    procedure, public :: get_y
    procedure, public :: set_x
    procedure, public :: set_y
    procedure, public :: print => print_point
 end type point                              
 type, extends(point) :: circle
    real(8), private  :: r = 0 
  contains                     
    procedure, public :: get_r 
    procedure, public :: set_r 
    procedure, public :: print => print_circle
 end type circle                              

contains

 real(8) function get_x(this)
   class(point), intent(in) :: this
   get_x = this%x                  
 end function get_x                
 real(8) function get_y(this)
   class(point), intent(in) :: this
   get_y = this%y                  
 end function get_y                
 subroutine set_x(this, val)
   class(point), intent(inout) :: this
   real(8), intent(in)         :: val 
   this%x = val                       
 end subroutine set_x                 
 subroutine set_y(this, val)
   class(point), intent(inout) :: this
   real(8), intent(in)         :: val 
   this%y = val                       
 end subroutine set_y                 
 subroutine print_point(this)
   class(point), intent(in) :: this
   write(*,'(2(a,f0.4),a)') 'Point(',this%x,', ',this%y,')'
 end subroutine print_point
 real(8) function get_r(this)
   class(circle), intent(in) :: this
   get_r = this%r
 end function get_r
 subroutine set_r(this, val)
   class(circle), intent(inout) :: this
   real(8), intent(in)          :: val
   this%r = val
 end subroutine set_r
 subroutine print_circle(this)
   class(circle), intent(in) :: this
   write(*,'(3(a,f0.4),a)') 'Circle(',this%x,', ',this%y,'; ',this%r,')'
 end subroutine print_circle

end module geom

program inh

 use geom
 type(point)  :: p
 type(circle) :: c
 p = point(2.0d0, 3.0d0)
 call p%print
 c = circle(3.0d0, 4.0d0, 5.0d0)
 call c%print

end program inh

</lang>

Haskell

Polymorphism is achieved through the type class Show

<lang haskell>data Point = Point Integer Integer instance Show Point where

   show (Point x y) = "Point at "++(show x)++","++(show y)
   

-- Constructor that sets y to 0 ponXAxis = flip Point 0

-- Constructor that sets x to 0 ponYAxis = Point 0

-- Constructor that sets x and y to 0 porigin = Point 0 0

data Circle = Circle Integer Integer Integer instance Show Circle where

   show (Circle x y r) = "Circle at "++(show x)++","++(show y)++" with radius "++(show r)
   

-- Constructor that sets y to 0 conXAxis = flip Circle 0

-- Constructor that sets x to 0 conYAxis = Circle 0

-- Constructor that sets x and y to 0 catOrigin = Circle 0 0

--Constructor that sets y and r to 0 c0OnXAxis = flip (flip Circle 0) 0

--Constructor that sets x and r to 0 c0OnYAxis = flip (Circle 0) 0</lang>

J

<lang J>coclass 'Point' create=: monad define

 'X Y'=:2{.y

) getX=: monad def 'X' getY=: monad def 'Y' setX=: monad def 'X=:y' setY=: monad def 'Y=:y' print=: monad define

 smoutput 'Point ',":X,Y

) destroy=: codestroy</lang>

<lang J>coclass 'Circle' coinsert 'Point' create=: monad define

 'X Y R'=: 3{.y

) getR=: monad def 'R' setR=: monad def 'R=:y' print=: monad define

 smoutput 'Circle ',":X,Y,R

)</lang>

Java

<lang java>class Point {

  protected int x, y;
  public Point() { this(0); }
  public Point(int x0) { this(x0,0); }
  public Point(int x0, int y0) { x = x0; y = y0; }
  public int getX() { return x; }
  public int getY() { return y; }
  public int setX(int x0) { x = x0; }
  public int setY(int y0) { y = y0; }
  public void print() { System.out.println("Point"); }

}

public class Circle extends Point {

  private int r;
  public Circle(Point p) { this(p,0); }
  public Circle(Point p, int r0) { super(p); r = r0; }
  public Circle() { this(0); }
  public Circle(int x0) { this(x0,0); }
  public Circle(int x0, int y0) { this(x0,y0,0); }
  public Circle(int x0, int y0, int r0) { super(x0,y0); r = r0; }
  public int getR() { return r; }
  public int setR(int r0) { r = r0; }
  public void print() { System.out.println("Circle"); }

  public static void main(String args[]) {
     Point p = new Point();
     Point c = new Circle();
     p.print();
     c.print();     
  }

}</lang>

JavaScript

<lang javascript>/* create new Point in one of these ways:

*    var p = new Point(x,y);
*    var p = new Point(a_point);
* default value for x,y is 0
*/

function Point() {

   var arg1 = arguments[0];
   var arg2 = arguments[1];
   if (arg1 instanceof Point) {
       this.x = arg1.x;
       this.y = arg1.y;
   }
   else { 
       this.x = arg1 == null ? 0 : arg1;
       this.y = arg2 == null ? 0 : arg1;
   } 
   this.set_x = function(_x) {this.x = _x;}
   this.set_y = function(_y) {this.y = _y;}

}

Point.prototype.print = function() {

   var out = "Point(" + this.x + "," + this.y + ")";
   print(out);

}

/* create new Circle in one of these ways:

*    var c = new Circle(x,y,r);
*    var c = new Circle(a_circle);
*    var c = new Circle(a_point,r);
* default value for x,y,r is 0
*/

function Circle() {

   var arg1 = arguments[0];
   var arg2 = arguments[1];
   var arg3 = arguments[2];
   if (arg1 instanceof Circle) {
       this.x = arg1.x;
       this.y = arg1.y;
       this.r = arg1.r;
   }
   else if (arg1 instanceof Point) {
       this.x = arg1.x;
       this.y = arg1.y;
       this.r = arg2 == null ? 0 : arg2;
   }
   else { 
       this.x = arg1 == null ? 0 : arg1;
       this.y = arg2 == null ? 0 : arg2;
       this.r = arg3 == null ? 0 : arg3;
   } 
   this.set_x = function(_x) {this.x = _x;}
   this.set_y = function(_y) {this.y = _y;}
   this.set_r = function(_r) {this.r = _r;}

}

Circle.prototype.print = function() {

   var out = "Circle(" + this.x + "," + this.y + "," + this.r + ")";
   print(out);

}</lang>

OCaml

<lang ocaml>class point ?(x=0.0) ?(y=0.0) () = (* extra () used to erase the optional parameters *) object (self)

 val mutable x = x
 val mutable y = y 
 method x = x
 method y = y
 method set_x x' = x <- x'
 method set_y y' = y <- y'
 method print = Printf.sprintf "Point (%f, %f)" x y
 method copy = {< >}

end

class circle ?(r=1.0) ?(x=0.0) ?(y=0.0) () = object (self)

 inherit point ~x:x ~y:y ()
 val mutable r = r
 method r = r
 method set_r r' = r <- r'
 method print = Printf.sprintf "Circle (%f, %f, %f)" r x y

end

let print x = print_endline x#print

let () =

 let p = new point () in
 let c = new circle () in
   print c;
   print p;
   c#set_x 10.0;
   print c;
   print (new point ~y:2.1 ())</lang>

Oz

No inheritance necessary for polymorphism, so we don't use it here (a circle is certainly not a point). Default constructors are implemented by named default arguments. No accessors because we use immutable public attributes ("features").

<lang oz>class Point

  feat
     x
     y
     
  meth init(x:X<=0.0 y:Y<=0.0)
     self.x = X
     self.y = Y
  end
  meth print
     {System.showInfo
      "Point("#
      "x:"#self.x#
      ", y:"#self.y#
      ")"}
  end

end

class Circle

  feat
     center
     r
     
  meth init(center:C<={New Point init} r:R<=1.0)
     self.center = C
     self.r = R
  end
  meth print
     {System.showInfo
      "Circle("#
      "x:"#self.center.x#
      ", y:"#self.center.y#
      ", r:"#self.r#
      ")"}
  end

end</lang>

Perl

What polymorphic function means in the context of Perl is as clear as mud. subs already can take anything as parameter by default. Destructors are automatic, so I dropped them. <lang perl>{

    package Point;
    use Class::Spiffy -base;
    use Clone qw(clone);

    sub _print {
        my %self = %{shift()};
        print map {"$_: $self{$_}\n"} keys %self;
    };

    sub members {
        no strict;
        grep {
            1 == length and defined *$_{CODE}
        } keys %{*{__PACKAGE__."\::"}};
    };

    sub new {
        my $class = shift;
        my %param = @_;
        $param{$_} = 0 for grep {!defined $param{$_}} members;
        bless \%param, $class;
    };

    sub copy_constructor {
        clone shift;
    };

    sub copy_assignment {
        my $self = shift;
        my $from = shift;
        $self->$_($from->$_) for $from->members;
    };

    field 'x';
    field 'y';

};

{

    package Circle;
    use base qw(Point);
    field 'r';

};

{

    package main;
    $_->_print, print "\n" for (
       Point->new,
       Point->new(x => 2),
       Point->new(y => 3),
       Point->new(x => 8, y => -5),
    );
    my $p1 = Point->new(x => 8, y => -5);

    my $p2 = $p1->copy_constructor;
    print "we are really different objects, not just references ".
          "to the same instance\n" unless \$p1 eq \$p2;

    # accessors autogenerated
    $p1->x(1);
    $p1->y(2);
    print $p1->x, "\n";
    print $p1->y, "\n";

    $p2->copy_assignment($p1);
    print $p2->x, "\n";
    print $p2->y, "\n";
    print "we now have the same values, but we are still ".
          "different objects\n" unless \$p1 eq \$p2;

    $_->_print, print "\n" for (
       Circle->new,
       Circle->new(x => 1),
       Circle->new(y => 2),
       Circle->new(r => 3),
       Circle->new(x => 4, y => 5),
       Circle->new(x => 6, r => 7),
       Circle->new(y => 8, r => 9),
       Circle->new(x => 1, y => 2, r => 3),
    );

    my $c = Circle->new(r => 4);
    print $c->r, "\n"; # accessor autogenerated

};</lang>

PHP

'print' is a reserved keyword in PHP so the method to print is called 'output'. Alternatively the Point and Circle objects can be converted to a string representation by simply printing / echo'ing the object because the objects implement the magic '__toString' method.


Point class definition.

<lang PHP> class Point {

 protected $_x;
 protected $_y;
 
 public function __construct()
 {
   switch( func_num_args() )
   {
     case 1:
       $point = func_get_arg( 0 );
       $this->setFromPoint( $point );
       break;
     case 2:
       $x = func_get_arg( 0 );
       $y = func_get_arg( 1 );
       $this->setX( $x );
       $this->setY( $y );
       break;
     default:
       throw new InvalidArgumentException( 'expecting one (Point) argument or two (numeric x and y) arguments' );
   }
 }
 
 public function setFromPoint( Point $point )
 {
   $this->setX( $point->getX() );
   $this->setY( $point->getY() );
 }
 
 public function getX()
 {
   return $this->_x;
 }
 
 public function setX( $x )
 {
   if( !is_numeric( $x ) )
   {
     throw new InvalidArgumentException( 'expecting numeric value' );
   }
   
   $this->_x = (float) $x;
 }
 
 public function getY()
 {
   return $this->_y;
 }
 
 public function setY( $y )
 {
   if( !is_numeric( $y ) )
   {
     throw new InvalidArgumentException( 'expecting numeric value' );
   }
   
   $this->_y = (float) $y;
 }
 
 public function output()
 {
   echo $this->__toString();
 }
 
 public function __toString()
 {
   return 'Point [x:' . $this->_x . ',y:' . $this->_y . ']';
 }

} </lang>

Circle class definition.

<lang PHP> class Circle extends Point {

 private $_radius;
 
 public function __construct()
 {
   switch( func_num_args() )
   {
     case 1:
       $circle = func_get_arg( 0 );
       $this->setFromCircle( $circle );
       break;
     case 2:
       $point = func_get_arg( 0 );
       $radius = func_get_arg( 1 );
       $this->setFromPoint( $point );
       $this->setRadius( $radius );
       break;
     case 3:
       $x = func_get_arg( 0 );
       $y = func_get_arg( 1 );
       $radius = func_get_arg( 2 );
       $this->setX( $x );
       $this->setY( $y );
       $this->setRadius( $radius );
       break;
     default:
       throw new InvalidArgumentException( 'expecting one (Circle) argument or two (Point and numeric radius) or three (numeric x, y and radius) arguments' );
   }
 }
 
 public function setFromCircle( Circle $circle )
 {
   $this->setX( $circle->getX() );
   $this->setY( $circle->getY() );
   $this->setRadius( $circle->getRadius() );
 }
 
 public function getPoint()
 {
   return new Point( $this->getX(), $this->getY() );
 }
 
 public function getRadius()
 {
   return $this->_radius;
 }
 
 public function setRadius( $radius )
 {
   if( !is_numeric( $radius ) )
   {
     throw new InvalidArgumentException( 'expecting numeric value' );
   }
   
   $this->_radius = (float) $radius;
 }
 
 public function __toString()
 {
   return 'Circle [' . $this->getPoint() . ',radius:' . $this->_radius . ']';
 }

} </lang>

Usage:

<lang PHP> $point = new Point( 1, 5 ); $circle = new Circle( 1, 5, 6 );

$point->output(); // or echo $point;

echo "\n";

$circle->output(); // or echo $circle; </lang>

Will result in:

Point [x:1,y:5]
Circle [Point [x:1,y:5],radius:6]

PicoLisp

<lang PicoLisp>(class +Point)

  1. x y

(dm T (X Y)

  (=: x (or X 0))
  (=: y (or Y 0)) )

(dm print> ()

  (prinl "Point " (: x) "," (: y)) )

(class +Circle +Point)

  1. r

(dm T (X Y R)

  (super X Y)
  (=: r (or R 0)) )

(dm print> ()

  (prinl "Circle " (: x) "," (: y) "," (: r)) )</lang>

<lang PicoLisp>(setq

  P (new '(+Point) 3 4)
  C (new '(+Circle) 10 10 5) )

(print> P) (print> C)</lang> Output:

Point 3,4
Circle 10,10,5

Pop11

When class is defined in Pop11 it automatically defines default constructors, slot accessors and copy operations. So it is enough to define classes and the print method.

<lang pop11>uses objectclass; define :class Point;

   slot x = 0;
   slot y = 0;

enddefine;

define :class Circle;

   slot x = 0;
   slot y = 0;
   slot r = 1;

enddefine;

define :method print(p : Point);

   printf('Point(' >< x(p) >< ', ' >< y(p) >< ')\n');

enddefine;

define :method print(p : Circle);

   printf('Circle(' >< x(p) >< ', ' >< y(p) >< ', ' >< r(p) >< ')\n');

enddefine;</lang>

To test we can use the following code:

<lang pop11>;;; Initialize variables using default constructors lvars instance1 = newPoint(); lvars instance2 = newCircle();

Use print method

print(instance1); print(instance2);</lang>

Python

Multiple constructors are not needed because Python supports default values for arguments. Accessors are not needed because Python attributes are public. It is possible to add managed attributes later without changing the interface and existing client code. For the print function, use the standard __repr__ methods, used when printing an object. Destructors are not needed of course.

<lang python>class Point(object):

   def __init__(self, x=0.0, y=0.0):
       self.x = x
       self.y = y
   def __repr__(self):
       return '<Point 0x%x x: %f y: %f>' % (id(self), self.x, self.y)

class Circle(object):

   def __init__(self, center=None, radius=1.0):
       self.center = center or Point()
       self.radius = radius
   def __repr__(self):
       return '<Circle 0x%x x: %f y: %f radius: %f>' % (
           id(self), self.center.x, self.center.y, self.radius)</lang>

Usage example:

>>> from polymorphism import Point, Circle
>>> p1 = Point()
>>> Point()
<Point 0x5b1b0 x: 0.000000 y: 0.000000>
>>> Point(3, 4)
<Point 0x5b0f0 x: 3.000000 y: 4.000000>
>>> Point(y=4)
<Point 0x5b0b0 x: 0.000000 y: 4.000000>
>>> Point(x=3)
<Point 0x5b1b0 x: 3.000000 y: 0.000000>
>>> Circle()
<Circle 0x5b330 x: 0.000000 y: 0.000000 radius: 1.000000>
>>> Circle(Point(3,4))
<Circle 0x5b3b0 x: 3.000000 y: 4.000000 radius: 1.000000>
>>> Circle(Point(3,4), 7)
<Circle 0x5b3d0 x: 3.000000 y: 4.000000 radius: 7.000000>
>>> Circle(radius=10)
<Circle 0x5b0f0 x: 0.000000 y: 0.000000 radius: 10.000000>
>>> Circle(center=Point(127,0))
<Circle 0x5b0b0 x: 127.000000 y: 0.000000 radius: 1.000000>
>>> p = Point(1.25, 3.87)
>>> p
<Point 0x5b3d0 x: 1.250000 y: 3.870000>
>>> p.x = 10.81
>>> p
<Point 0x5b3d0 x: 10.810000 y: 3.870000>
>>> c = Circle(p, 21.4)
>>> c
<Circle 0x5b0b0 x: 10.810000 y: 3.870000 radius: 21.400000>
>>> c.center.x = 1.0
>>> c
<Circle 0x5b0b0 x: 1.000000 y: 3.870000 radius: 21.400000>

R

Only the S4 class system is considered here. Copy constructors are not needed, since objects are copied by value. Neither are destructors needed (just use the rm function). <lang R>setClass("point",

  representation(
     x="numeric",
     y="numeric"),
  prototype(
     x=0,
     y=0))
     
  1. Instantiate class with some arguments

p1 <- new("point", x=3)

  1. Access some values

p1@x # 3

  1. Define a print method

setMethod("print", signature("point"),

  function(x, ...)
  {
     cat("This is a point, with location, (", x@x, ",", x@y, ").\n") 
  })

print(p1)

  1. Define a circle class

setClass("circle",

  representation(
     centre="point",
     r="numeric"),
  prototype(
     centre=new("point"),
     r=1))

circS4 <- new("circle", r=5.5)

  1. Access some values

circS4@r # 5.5 circS4@centre@x # 0

  1. Define a print method

setMethod("print", signature("circle"),

  function(x, ...)
  {
     cat("This is a circle, with radius", x@r, "and centre (", x@centre@x, ",", x@centre@y, ").\n")
  })

print(circS4)</lang>

Ruby

We use attr_accessor to provide all the accessor and assignment operations. Default arguments eliminate the need for multiple constructors. The built-in puts uses the object's to_s method. Due to duck typing, the two classes do not need to inherit from each other. The Kernel#dup method can be used as a copy constructor.

<lang ruby>class Point

   attr_accessor :x,:y
   def initialize(x=0,y=0)
       self.x=x
       self.y=y
   end
   def to_s
       "Point at #{x},#{y}"
   end

end

class Circle

   attr_accessor :x,:y,:r
   def initialize(x=0,y=0,r=0)
       self.x=x
       self.y=y
       self.r=r
   end
   def to_s
       "Circle at #{x},#{y} with radius #{r}"
   end

end</lang> Example:

# create a point
p = Point.new(1, 2)
puts p  # => Point at 1,2
puts p.x  # => 1
# create a circle
c = Circle.new(4,5,6)
# copy it
d = c.dup
d.r = 7.5
puts c  # => Circle at 4,5 with radius 6
puts d  # => Circle at 4,5 with radius 7.5

Smalltalk

Like Python and Ruby, these objects do not need to be related in order to have polymorphic methods. <lang smalltalk>!Object subclass: #Point

 instanceVariableNames: 'x y'
 classVariableNames: 
 poolDictionaries: 
 category: 'polymorphism' !

!Point class methodsFor: 'instance creation'! new

 ^self newBasic x := 0; y := 0 ! !

!Point class methodsFor: 'instance creation'! x: x y: y

 ^self newBasic x := x; y := y ! !

!Point methodsFor: 'member access'! x

 ^x ! !

!Point methodsFor: 'member access'! y

 ^y ! !

!Point methodsFor: 'member access'! x: x

 ^self x := x ! !

!Point methodsFor: 'member access'! y: y

 ^self y := y ! !

!Point methodsFor: 'member access'! x: x y: y

 ^self x := x; y := y ! !

!Point methodsFor: 'polymorphism test'! print

 Transcript show: x; space; show: y ! !

!Object subclass: #Circle

 instanceVariableNames: 'center r'
 classVariableNames: 
 poolDictionaries: 
 category: 'polymorphism' !

!Circle class methodsFor: 'instance creation'! new

 ^self newBasic center := Point new; r := 0 ! !

!Circle class methodsFor: 'instance creation'! radius: radius

 ^self newBasic center := Point new; r := radius ! !

!Circle class methodsFor: 'instance creation'! at: point radius: r

 ^self newBasic center := point; r := r ! !

!Circle methodsFor: 'member access'! center

 ^center ! !

!Circle methodsFor: 'member access'! x: x y: y

 ^self center x: x y: y ! !

!Circle methodsFor: 'member access'! radius

 ^r ! !

!Circle methodsFor: 'member access'! radius: radius

 ^self r := radius ! !

!Circle methodsFor: 'polymorphism test'! print

 Transcript show: center; space; show: radius ! !</lang>

TODO: more idiomatic mechanism for presenting objects as strings. TODO: fill in more methods

Tcl

Works with: Tcl version 8.6

Since Tcl's objects have their methods invoked by sending a (potentially-interceptable) message to them, allowing them to even respond to method calls that are not explicitly declared on them, there is no need for the objects to be formally related. We only do so here for convenience. In addition, Tcl's arguments to commands, procedures and methods are all fully polymorphic by default. <lang tcl>oo::class create Point {

   variable X Y
   constructor {x y} {
       set X $x
       set Y $y
   }
   method x args {
       set X {*}$args
   }
   method y args {
       set Y {*}$args
   }
   method print {} {
       puts "Point($X,$Y)"
   }
   method copy {} {
       set copy [oo::copy [self]]
       $copy x $X
       $copy y $Y
       return $copy
   }

} oo::class create Circle {

   superclass Point
   variable R
   constructor {x y radius} {
       next $x $y
       set R $radius
   }
   method radius args {
       set R {*}$args
   }
   method print {} {
       puts "Circle([my x],[my y],$R)"
   }
   method copy {} {
       set copy [next]
       $copy radius $R
       return $copy
   }

}

  1. No destructors: unneeded by these classes

set p [Point new 1.0 2.0] set c [Circle new 3.0 4.0 5.0] set cCopy [$c copy] puts "$p is at ([$p x],[$p y])" $c radius 1.5 set objects [list $p $c $cCopy] foreach o $objects {

   $o print

}</lang>