Polymorphism

From Rosetta Code
Revision as of 15:08, 19 December 2008 by rosettacode>Mwn3d (→‎{{header|C sharp|C#}}: I think it was supposed to look like this)
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

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. <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;

</ada> <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;

</ada> The following is the child package defining the Circle type. <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;

</ada> <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;

</ada> The following procedure is an entry point for a program, serving the same purpose as the main function in C. <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;

</ada>

BASIC

C

C++

Works with: g++
Works with: Visual C++
Works with: BCC
Works with: Watcom
 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;
 }

Pattern: Curiously Recurring Template Pattern

Works with: g++
Works with: Visual C++
Works with: BCC
Works with: Watcom
 // 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;
 }

C#

 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();
   }
 }

Common 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))

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);
}

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
}

(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.)

def p := makePoint(0.5, 0.5)
def c := makeCircle(1, 1, 2)
println(p)
println(c)

Haskell

Polymorphism is achieved through the type class Show

   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

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();     
  }
}

OCaml

<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 ())</ocaml>

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.

{
    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
};

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.

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;

To test we can use the following code:

;;; Initialize variables using default constructors
lvars instance1 = newPoint();
lvars instance2 = newCircle();
;;; Use print method
print(instance1);
print(instance2);

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.

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)

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>

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.

   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

Smalltalk

Like Python and Ruby, these objects do not need to be related in order to have polymorphic methods.

!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 ! !

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