Polymorphism
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
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
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.
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;
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;
The following is the child package defining the Circle type.
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;
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;
The following procedure is an entry point for a program, serving the same purpose as the main function in C.
with Shapes.Circles; use Shapes.Circles; use Shapes; procedure Shapes_Main is P : Point; C : Circle; begin Print(P); Print(C); end Shapes_Main;
BASIC
C
- See Polymorphism (C)
C++
Compiler: GCC, Visual C++, BCC, 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
Compiler: GCC, Visual C++, BCC, 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))
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
Polymorhism 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(); } }
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);
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.
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