Polymorphism
From Rosetta Code
You are encouraged to solve this task according to the task description, using any language you may know.
[edit] 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");
}
}
}
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");
}
}
}
[edit] 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
P.Print;
C.Print;
end Shapes_Main;
[edit] Aikido
class Point (protected x=0.0, protected y=0.0) {
public function print {
println ("Point")
}
public function getX { return x }
public function getY { return y }
public function setX(nx) { x = nx }
public function setY(ny) { y = ny }
}
class Circle (x=0.0, y=0.0, r=0.0) extends Point (x, y) {
public function print {
println ("Circle")
}
public function getR { return r }
public function setR(nr) { r = nr }
}
var p = new Point (1, 2)
var c = new Circle (1, 2, 3)
p.print()
c.print()
[edit] BASIC
[edit] C
- See Polymorphism/C
[edit] C++
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
// 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;
}
[edit] C#
using System;
class Point
{
protected int x, y;
public Point() : this(0) {}
public Point(int x) : this(x,0) {}
public Point(int x, int y) { this.x = x; this.y = y; }
public int X { get { return x; } set { x = value; } }
public int Y { get { return y; } set { y = value; } }
public virtual 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 r) : base(p) { this.r = r; }
public Circle() : this(0) { }
public Circle(int x) : this(x,0) { }
public Circle(int x, int y) : this(x,y,0) { }
public Circle(int x, int y, int r) : base(x,y) { this.r = r; }
public int R { get { return r; } set { r = value; } }
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();
}
}
[edit] Clojure
Clojure 1.2.
(defprotocol Printable
(print-it [this] "Prints out the Printable."))
(deftype Point [x y]
Printable
(print-it [this] (println (str "Point: " x " " y))))
(defn create-point
"Redundant constructor function."
[x y] (Point. x y))
(deftype Circle [x y r]
Printable
(print-it [this] (println (str "Circle: " x " " y " " r))))
(defn create-circle
"Redundant consturctor function."
[x y r] (Circle. x y r))
[edit] 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))
[edit] D
import std.stdio: writeln;
class Point {
private int x, y;
this(int x_=0, int y_=0) { x = x_; y = y_; }
this(Point p_) { x = p_.getX(); y = p_.getY(); }
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 {
private int r;
this(int x_=0, int y_=0, int r_=0) {
super(x_, y_);
r = r_;
}
this(Point p, int r_=0) {
super(p);
r = r_;
}
this(Circle c_) {
super(c_.getX(), c_.getY());
r = c_.getR();
}
int getR() { return r; }
void setR(int r0) { this.r = r0; }
}
void main() {
auto p = new Point();
auto c = new Circle();
writeln(p);
writeln(c);
}
[edit] Delphi
type
{ TPoint }
TMyPoint = class
private
FX: Integer;
FY: Integer;
public
constructor Create; overload;
constructor Create(X0: Integer; Y0: Integer); overload;
constructor Create(MyPoint: TMyPoint); overload;
destructor Destroy; override;
procedure Print; virtual;
property X: Integer read FX write FX;
property Y: Integer read FY write FY;
end;
{ TCircle }
TCircle = class(TMyPoint)
private
FR: Integer;
public
constructor Create(X0: Integer; Y0: Integer; R0: Integer); overload;
constructor Create(MyPoint: TMyPoint; R0: Integer); overload;
constructor Create(Circle: TCircle); overload;
destructor Destroy; override;
procedure Print; override;
property R: Integer read FR write FR;
end;
implementation
uses Dialogs;
{ TCircle }
constructor TCircle.Create(X0: Integer; Y0: Integer; R0: Integer);
begin
inherited Create(X0, Y0);
FR := R0;
end;
constructor TCircle.Create(MyPoint: TMyPoint; R0: Integer);
begin
inherited Create(MyPoint);
FR := R0;
end;
constructor TCircle.Create(Circle: TCircle);
begin
Create;
if not(Circle = Self) then
begin
FX := Circle.X;
FY := Circle.Y;
FR := Circle.R;
end;
end;
destructor TCircle.Destroy;
begin
inherited Destroy;
end;
procedure TCircle.Print;
begin
ShowMessage('Circle');
end;
{ TMyPoint }
constructor TMyPoint.Create;
begin
inherited Create;
end;
constructor TMyPoint.Create(X0: Integer; Y0: Integer);
begin
Create;
FX := X0;
FY := Y0;
end;
constructor TMyPoint.Create(MyPoint: TMyPoint);
begin
Create;
if not(MyPoint = Self) then
begin
FX := MyPoint.X;
FY := MyPoint.Y;
end;
end;
destructor TMyPoint.Destroy;
begin
inherited Destroy;
end;
procedure TMyPoint.Print;
begin
ShowMessage('MyPoint');
end;
var
MyPoint: TMyPoint;
Circle: TCircle;
begin
MyPoint := TMyPoint.Create;
try
MyPoint.Print;
Circle := TCircle.Create;
try
Circle.Print;
finally
FreeAndNil(Circle);
end;
finally
FreeAndNil(MyPoint);
end;
end;
[edit] 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)
[edit] Eiffel
class
POINT
inherit
ANY
redefine
out
end
create
make, make_origin
feature -- Initialization
make (a_x, a_y: INTEGER)
-- Create with values `a_x' and `a_y'
do
set_x (a_x)
set_y (a_y)
ensure
x_set: x = a_x
y_set: y = a_y
end
make_origin
-- Create at origin
do
ensure
x_set: x = 0
y_set: y = 0
end
feature -- Access
x: INTEGER assign set_x
-- Horizontal axis coordinate
y: INTEGER assign set_y
-- Vertical axis coordinate
feature -- Element change
set_x (a_x: INTEGER)
-- Set `x' coordinate to `a_x'
do
x := a_x
ensure
x_set: x = a_x
end
set_y (a_y: INTEGER)
-- Set `y' coordinate to `a_y'
do
y := a_y
ensure
y_set: y = a_y
end
feature -- Output
out: STRING
-- Display as string
do
Result := "Point: x = " + x.out + " y = " + y.out
end
end
class
CIRCLE
inherit
POINT
rename
make as point_make
redefine
make_origin,
out
end
create
make, make_origin, make_from_point
feature -- Initialization
make (a_x, a_y, a_r: INTEGER)
-- Create with values `a_x' and `a_y' and `a_r'
require
non_negative_radius_argument: a_r >= 0
do
point_make (a_x, a_y)
set_r (a_r)
ensure
x_set: x = a_x
y_set: y = a_y
r_set: r = a_r
end
make_origin
-- Create at origin with zero radius
do
Precursor
ensure then
r_set: r = 0
end
make_from_point (a_p: POINT; a_r: INTEGER)
-- Initialize from `a_r' with radius `a_r'.
require
non_negative_radius_argument: a_r >= 0
do
set_x (a_p.x)
set_y (a_p.y)
set_r (a_r)
ensure
x_set: x = a_p.x
y_set: y = a_p.y
r_set: r = a_r
end
feature -- Access
r: INTEGER assign set_r
-- Radius
feature -- Element change
set_r (a_r: INTEGER)
-- Set radius (`r') to `a_r'
require
non_negative_radius_argument: a_r >= 0
do
r := a_r
ensure
r_set: r = a_r
end
feature -- Output
out: STRING
-- Display as string
do
Result := "Circle: x = " + x.out + " y = " + y.out + " r = " + r.out
end
invariant
non_negative_radius: r >= 0
end
class
APPLICATION
create
make
feature {NONE} -- Initialization
make
-- Run application.
local
my_point: POINT
my_circle: CIRCLE
do
create my_point.make_origin
print (my_point.out + "%N")
create {CIRCLE} my_point.make_origin
print (my_point.out + "%N")
create my_point.make (10, 15)
print (my_point.out + "%N")
create {CIRCLE} my_point.make (20, 25, 5)
print (my_point.out + "%N")
create my_circle.make (30, 35, 10)
print (my_circle.out + "%N")
create my_circle.make_from_point (my_point, 35)
print (my_circle.out + "%N")
end
end
Output:
Point: x = 0 y = 0
Circle: x = 0 y = 0 r = 0
Point: x = 10 y = 15
Circle: x = 20 y = 25 r = 5
Circle: x = 30 y = 35 r = 10
Circle: x = 20 y = 25 r = 35
Notes:
The Eiffel example varies slightly from the problem description. The polymorphic feature is out rather than print. Both out and print are inherited by every Eiffel class from class ANY. However, it is customary in Eiffel to redefine the query out to provide a string describing an instance, versus redefining print. So, this example is written to reflect the Eiffel convention.
[edit] 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 ;
[edit] Fortran
Fortran provides OO features with the type mechanism. This example works with the Intel 11.1.069 compiler.
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
[edit] F#
Polymorphism is achieved by defining an interface Printable which is implemented by Point and Circle. (In real code, you should override the ToString method which every class inherits from Object.)
Due to the use of optional parameters, we only need one constructor for every class. No accessors are necessary because we use public read-only properties. (Mutable properties are possible, too, but should be avoided in idiomatic code.)
type Printable =
abstract member Print : unit -> unit
type Point(?x, ?y) =
member t.x = defaultArg x 0.0
member t.y = defaultArg y 0.0
interface Printable with
member t.Print() = printfn "Point(x:%f, y:%f)" t.x t.y
type Circle(?center, ?radius) =
member t.center = defaultArg center (new Point())
member t.radius = defaultArg radius 1.0
interface Printable with
member t.Print() =
printfn "Circle(x:%f, y:%f, r:%f)" t.center.x t.center.y t.radius
[edit] Go
package main
import "fmt"
type point struct {
x, y float64
}
type circle struct {
x, y, r float64
}
type printer interface {
print()
}
func (p *point) print() {
fmt.Println(p.x, p.y)
}
func (c *circle) print() {
fmt.Println(c.x, c.y, c.r)
}
func main() {
var i printer // polymorphic variable
i = newPoint(3, 4) // assign one type
i.print() // call polymorphic function
i = newCircle(5, 12, 13) // assign different type to same variable
i.print() // same call accesses different method now.
}
// Above is a sort of polymorphism: both types implement the printer
// interface. The print function can be called through a variable
// of type printer, without knowing the underlying type.
// Below is other stuff the task asks for. Note that none of it is
// needed for cases as simple as this task, and it is not idomatic
// to write any of these functions in these simple cases.
// Accessors are not idiomatic in Go. Instead, simply access struct
// fields directly. To allow access from another package, you "export"
// the field by capitalizing the field name.
func (p *point) getX() float64 { return p.x }
func (p *point) getY() float64 { return p.y }
func (p *point) setX(v float64) { p.x = v }
func (p *point) setY(v float64) { p.y = v }
func (c *circle) getX() float64 { return c.x }
func (c *circle) getY() float64 { return c.y }
func (c *circle) getR() float64 { return c.r }
func (c *circle) setX(v float64) { c.x = v }
func (c *circle) setY(v float64) { c.y = v }
func (c *circle) setR(v float64) { c.r = v }
// Copy constructors, not idiomatic. Structs are assignable so
// you can simply declare and assign them as needed.
func (p *point) clone() *point { r := *p; return &r }
func (c *circle) clone() *circle { r := *c; return &r }
// Assignment methods, not idiomatic. Just use the assignment operator.
func (p *point) set(q *point) { *p = *q }
func (c *circle) set(d *circle) { *c = *d }
// Constructors are idiomatic only when construction involves something
// more than just assigning initial values. By default, structs
// are created as "zero values," that is, with all fields zero,
// empty, or nil. The struct literal synax allows for all fields to
// initialized, or for any subset of fields to be initialized by name.
// These feautures take the place of trivial default constructors.
// When additional initialization is needed, it is conventional to
// name a function New, New<Type>, or within a package, new<Type>
// as shown here.
func newPoint(x, y float64) *point {
return &point{x, y}
}
func newCircle(x, y, r float64) *circle {
return &circle{x, y, r}
}
// Destructors are never used in Go. Objects are garbage collected.
[edit] 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
[edit] Icon and Unicon
This is Unicon specific, as Unicon has classes, but Icon does not.
There is no destructor, as Unicon manages object destruction itself. The copy constructor is emulated by a method. Notice the 'initially' clauses. These act like constructors, in that they accept input parameters during instance construction. These parameters are null if not used, and so the initial field values are set to 0 if the entered value is null (tested using the '/' symbol).
class Circle (x, y, r)
# make a new copy of this instance
method copy ()
return Circle (x, y, r)
end
# print a representation of this instance
method print ()
write ("Circle (" || x || ", " || y || ", " || r || ")")
end
# called during instance construction, to pass in field values
initially (x, y, r)
self.x := if /x then 0 else x # set to 0 if argument not present
self.y := if /y then 0 else y
self.r := if /r then 0 else r
end
class Point (x, y)
# make a new copy of this instance
method copy ()
return Point (x, y)
end
# print a representation of this instance
method print ()
write ("Point (" || x || ", " || y || ")")
end
# called during instance construction, to pass in field values
initially (x, y)
self.x := if /x then 0 else x # set to 0 if argument not present
self.y := if /y then 0 else y
end
procedure main ()
p1 := Point ()
p2 := Point (1)
p3 := Point (1,2)
p4 := p3.copy ()
write ("Points:")
p1.print ()
p2.print ()
p3.print ()
p4.print ()
# demonstrate field mutator/accessor
p3.x := 3
write ("p3 value of x is: " || p3.x)
c1 := Circle ()
c2 := Circle (1)
c3 := Circle (1,2)
c4 := Circle (1,2,3)
write ("Circles:")
c1.print ()
c2.print ()
c3.print ()
c4.print ()
end
[edit] Inform 7
Accessors are not needed since property values are public. Constructors and destructors are not needed since objects are statically allocated and initialized.
Space is a room.
A point is a kind of thing.
A point has a number called X position.
A point has a number called Y position.
A circle is a kind of point.
A circle has a number called radius.
To print (P - point): say "Point: [X position of P], [Y position of P]."
To print (C - circle): say "Circle: [X position of C], [Y position of C] radius [radius of C]."
The origin is a point with X position 0 and Y position 0.
The circle of power is a circle with X position 100, Y position 25, radius 7.
When play begins:
print the origin;
print the circle of power;
end the story.
[edit] 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
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
)
[edit] 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 Point(Point p) { this(p.x, p.y); }
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 Circle(Circle c) { this(c.x, c.y, c.r); }
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();
}
}
[edit] 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);
}
[edit] Lua
Lua does not have a standard definition of objects or classes, so a basic and typical protoctype-based OOP model will be used. In Lua all objects are tables, and through the use of metatables, polymorphism can be achieved in many ways, this is only one of them.
-- Point
local Point = {x = 0, y = 0}
function Point:new(o)
o = o or {}
setmetatable(o, self)
self.__index = self
return o
end
function Point:print()
print("Point(" .. self.x .. ", " .. self.y .. ")")
end
function Point:copy()
return Point:new{x = self.x, y = self.y}
end
-- Circle
local Circle = Point:new()
Circle.r = 0
function Circle:print()
print("Circle(" .. self.x .. ", " .. self.y .. ", " .. self.r .. ")")
end
function Circle:copy()
return Circle:new{x = self.x, y = self.y, r = self.r}
end
[edit] NetRexx
Note: Based on default values in method prototypes, NetRexx will automatically generate intermediate constructors and methods, thus ensuring that none are omitted.
/* NetRexx */
options replace format comments java crossref savelog symbols binary
-- -----------------------------------------------------------------------------
class RCPolymorphism public final
method main(args = String[]) public constant
parry = [Point -
Point() -
, Point(1.0) -
, Point(1.0, 2.0) -
, Point(Point(0.3, 0.2)) -
, Circle() -
, Circle(2.0, 2.0) -
, Circle(5.0, 6.0, 7.0) -
, Circle(Point(8.0, 9.0)) -
, Circle(Point(8.0, 9.0), 4.0) -
, Circle(Circle(1.5, 1.4, 1.3)) -
]
loop pp = 0 to parry.length - 1
parry[pp].print
end pp
return
-- -----------------------------------------------------------------------------
class RCPolymorphism.Point public binary
properties private
x = double
y = double
className = Point.class.getSimpleName
method Point(x_ = double 0.0, y_ = double 0.0)
setX(x_)
setY(y_)
return
method Point(p = Point)
this(p.getX, p.getY)
return
method display public returns String
hx = '@'Rexx(Integer.toHexString(hashCode())).right(8, 0)
str = Rexx(className).left(10)':'hx': (x,y) = (' || -
Rexx(getX()).format(null, 3)',' -
Rexx(getY()).format(null, 3)')'
return str
method getX public returns double
return x
method getY public returns double
return y
method setX(x_ = double 0.0) inheritable
x = x_
return
method setY(y_ = double 0.0) inheritable
y = y_
return
method print inheritable
say display
return
-- -----------------------------------------------------------------------------
class RCPolymorphism.Circle public extends RCPolymorphism.Point binary
properties private
r = double
className = Circle.class.getSimpleName
method Circle(x_ = double 0.0, y_ = double 0.0, r_ = double 0.0)
super(x_, y_)
setR(r_)
return
method Circle(p_ = RCPolymorphism.Point, r_ = double 0.0)
this(p_.getX, p_.getY, r_)
return
method Circle(c_ = Circle)
this(c_.getX, c_.getY, c_.getR)
return
method getR public returns double
return r
method setR(r_ = double 0.0) inheritable
r = r_
return
method display public returns String
hx = '@'Rexx(Integer.toHexString(hashCode())).right(8, 0)
str = Rexx(className).left(10)':'hx': (x,y,r) = (' || -
Rexx(getX()).format(null, 3)',' -
Rexx(getY()).format(null, 3)',' -
Rexx(getR()).format(null, 3)')'
return str
- Output
Point :@0eb42cbf: (x,y) = (0.000, 0.000) Point :@17dfafd1: (x,y) = (1.000, 0.000) Point :@3343c8b3: (x,y) = (1.000, 2.000) Point :@272d7a10: (x,y) = (0.300, 0.200) Circle :@1aa8c488: (x,y,r) = (0.000, 0.000, 0.000) Circle :@3dfeca64: (x,y,r) = (2.000, 2.000, 0.000) Circle :@22998b08: (x,y,r) = (5.000, 6.000, 7.000) Circle :@0e76cbf7: (x,y,r) = (8.000, 9.000, 0.000) Circle :@1948cc8c: (x,y,r) = (8.000, 9.000, 4.000) Circle :@7a6d084b: (x,y,r) = (1.500, 1.400, 1.300)
[edit] Objeck
bundle Default {
class Point {
@x : Int;
@y : Int;
New() {
@x := 0;
@y := 0;
}
New(x : Int, y : Int) {
@x := x;
@y := y;
}
New(p : Point) {
@x := p->GetX();
@y := p->GetY();
}
method : public : GetX() ~ Int {
return @x;
}
method : public : GetY() ~ Int {
return @y;
}
method : public : SetX(x : Int) ~ Nil {
@x := x;
}
method : public : SetY(y : Int) ~ Nil {
@y := y;
}
method : public : Print() ~ Nil {
"Point"->PrintLine();
}
}
class Circle from Point {
@r : Int;
New() {
Parent();
@r := 0;
}
New(p : Point) {
Parent(p);
@r := 0;
}
New(c : Circle) {
Parent(c->GetX(), c->GetY());
@r := c->GetR();
}
method : public : GetR() ~ Int {
return @r;
}
method : public : SetR(r : Int) ~ Nil {
@r := r;
}
method : public : Print() ~ Nil {
"Circle"->PrintLine();
}
}
class Poly {
function : Main(args : String[]) ~ Nil {
p := Point->New();
c := Circle->New();
p->Print();
c->Print();
}
}
}
[edit] 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 ())
[edit] 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").
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
[edit] Pascal
See Delphi
[edit] 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()};
while (my ($k,$v) = each %self) {
print "$k: $v\n";
}
}
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
}
[edit] Perl 6
All appropriate constructors, initializers, accessors, and destructors are provided by default, but may be explicitly declared for flexibility. To create only readonly accessors for better encapsulation, leave out all the "is rw" traits. Here we demonstrate that accessors can behave like variables and may be assigned.
class Point {
has Num $.x is rw = 0;
has Num $.y is rw = 0;
method Str { $.perl }
}
class Circle {
has Point $.p is rw = Point.new;
has Num $.r is rw = 0;
method Str { $.perl }
}
my $c = Circle.new(Point.new(x => 1, y => 2), r => 3);
say $c;
$c.p.x = (-10..10).pick;
$c.p.y = (-10..10).pick;
$c.r = (0..10).pick;
say $c;
In this case we define the Str coercion method polymorphically, which is used by say or print to format the contents of the object. We could also have defined print methods directly. We could have factored this method out to a common role and composed it into each class. We could also have defined multi subs outside of the class, like this:
multi print (Point $p) { $p.perl.print }
multi print (Circle $c) { $c.perl.print }
[edit] 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.
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 . ']';
}
}
Circle class definition.
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 . ']';
}
}
Usage:
$point = new Point( 1, 5 );
$circle = new Circle( 1, 5, 6 );
$point->output();
// or
echo $point;
echo "\n";
$circle->output();
// or
echo $circle;
Will result in:
Point [x:1,y:5]
Circle [Point [x:1,y:5],radius:6]
[edit] PicoLisp
(class +Point)
# x y
(dm T (X Y)
(=: x (or X 0))
(=: y (or Y 0)) )
(dm print> ()
(prinl "Point " (: x) "," (: y)) )
(class +Circle +Point)
# r
(dm T (X Y R)
(super X Y)
(=: r (or R 0)) )
(dm print> ()
(prinl "Circle " (: x) "," (: y) "," (: r)) )
(setq
P (new '(+Point) 3 4)
C (new '(+Circle) 10 10 5) )
(print> P)
(print> C)
Output:
Point 3,4 Circle 10,10,5
[edit] 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);
[edit] PureBasic
Using the open-source precompiler SimlpeOOP.
Class MyPoint
BeginProtect
x.i
y.i
EndProtect
Public Method GetX()
MethodReturn This\X
EndMethod
Public Method GetY()
MethodReturn This\Y
EndMethod
Public Method SetX(n)
This\X=n
EndMethod
Public Method SetY(n)
This\Y=n
EndMethod
Public Method Print()
PrintN("Point")
EndMethod
Public Method Init(x=0,y=0)
This\x=x
This\y=y
EndMethod
EndClass
Class Circle Extends MyPoint
Protect Radie.i
Public Method Circel(x=0, y=0, r=0)
This\X = x
This\y = y
This\Radie=r
EndMethod
Public Method GetRadie()
MethodReturn This\Radie
EndMethod
Public Method SetRadie(n)
This\Radie = n
EndMethod
Public Method Print()
PrintN("Circle: "+ _
" X= "+Str(This\X)+ _
" Y= "+Str(This\Y)+ _
" R= "+Str(This\Radie))
EndMethod
EndClass
Testcode
*point.MyPoint = NewObject.MyPoint
*circle.Circle = NewObject.Circle
If OpenConsole()
*point\Print()
*circle\SetX(3)
*circle\Print()
CloseConsole()
EndIf
[edit] 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>
[edit] Mutability
The task calls for the creation of mutable types i.e that you are allowed to change the values of x, y, or r of a Point or Circle after they have been created. If this is not needed, then the Python namedtuple is a good way to create immutable classes with named fields such as these.
>>> from collections import namedtuple
>>> class Point(namedtuple('Point', 'x y')):
def __new__( _cls, x=0, y=0 ):
return super().__new__(_cls, x, y)
>>> class Circle(namedtuple('Circle', 'x y r')):
def __new__( _cls, x=0, y=0, r=0 ):
return super().__new__(_cls, x, y, r)
>>> Point(), Point(x=1), Point(y=2), Point(3, 4)
(Point(x=0, y=0), Point(x=1, y=0), Point(x=0, y=2), Point(x=3, y=4))
>>> Circle(), Circle(r=2), Circle(1, 2, 3)
(Circle(x=0, y=0, r=0), Circle(x=0, y=0, r=2), Circle(x=1, y=2, r=3))
>>> p = Point(1.25, 3.87)
>>> p
Point(x=1.25, y=3.87)
>>> p.x = 10.81
Traceback (most recent call last):
File "<pyshell#27>", line 1, in <module>
p.x = 10.81
AttributeError: can't set attribute
>>>
And if you don't need default arguments, this becomes:
>>> Point = namedtuple('Point', 'x y')
>>> Circle = namedtuple('Circle', 'x y r')
>>> Point(3, 4)
Point(x=3, y=4)
>>> Circle(x=1, y=2, r=3)
Circle(x=1, y=2, r=3)
>>>
[edit] 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).
setClass("point",
representation(
x="numeric",
y="numeric"),
prototype(
x=0,
y=0))
# Instantiate class with some arguments
p1 <- new("point", x=3)
# Access some values
p1@x # 3
# Define a print method
setMethod("print", signature("point"),
function(x, ...)
{
cat("This is a point, with location, (", x@x, ",", x@y, ").\n")
})
print(p1)
# Define a circle class
setClass("circle",
representation(
centre="point",
r="numeric"),
prototype(
centre=new("point"),
r=1))
circS4 <- new("circle", r=5.5)
# Access some values
circS4@r # 5.5
circS4@centre@x # 0
# 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)
[edit] 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.
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
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
[edit] SIMPOL
In SIMPOL any type can be declared to be tagged with a name. That name can then be used to define a variable that can hold a reference to any type tagged with the same name. Multiple constructors are not needed, since all the parameters can be provided in the same constructor call. Types embedded in other types resolve according to the rules in SIMPOL such that if a property name is used that is not present in the actual type definition, then a depth first search starting at the beginning of the type definition will resolve a matching property or method name of an embedded type. This resolution is not performed on properties defined as reference are not used in the extended dot operator resolution mechanism unless they are also assigned the resolve keyword. The embed keyword in the type definition states that the type itself can be embedded in another type (any type can be placed as a reference in another type).
type mypoint(mypoint) embed export
embed
integer x
integer y
reference
function copy
function print
end type
function mypoint.new(mypoint me, integer x=0, integer y=0)
me.x = x
me.y = y
end function me
function mypoint.copy(mypoint me)
mypoint p
p =@ mypoint.new(me.x, me.y)
end function p
function mypoint.print(mypoint me)
end function "mypoint"
type circle(mypoint) embed export
reference
mypoint midpoint resolve
embed
integer radius
reference
function copy
function print
end type
function circle.new(circle me, integer x=0, integer y=0, integer radius=0, mypoint midpoint)
if midpoint =@= .nul
me.midpoint =@ mypoint.new(x, y)
else
me.x = midpoint.x
me.y = midpoint.y
end if
me.radius = radius
end function me
function circle.copy(circle me)
circle c
c =@ circle.new(radius=me.radius, midpoint=me.midpoint)
end function c
function circle.print(circle me)
end function "circle"
function main()
type(mypoint) p, c
string result
p =@ mypoint.new()
c =@ circle.new()
result = p.print() + "{d}{a}" + c.print() + "{d}{a}"
end function result
SIMPOL does not currently have access to stdin, stdout, and stderr, so to return a value from the program to a console, it must be as part of the return value.
[edit] 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'!
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'!
Transcript show: center; space; show: radius ! !
TODO: more idiomatic mechanism for presenting objects as strings. TODO: fill in more methods
[edit] Tcl
orSince 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.
package require TclOO
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
}
}
# 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
}
Categories:
- Programming Tasks
- Basic language learning
- Object oriented
- ActionScript
- Ada
- Aikido
- BASIC
- C
- C++
- C sharp
- Clojure
- Common Lisp
- D
- Delphi
- E
- Eiffel
- Factor
- Fortran
- F Sharp
- Go
- Haskell
- Unicon
- Inform 7
- J
- Java
- JavaScript
- Lua
- NetRexx
- Objeck
- OCaml
- Oz
- Pascal
- Perl
- Perl 6
- PHP
- PicoLisp
- Pop11
- PureBasic
- Python
- R
- Ruby
- SIMPOL
- Smalltalk
- Tcl
- TclOO
- ALGOL 68/Omit
- GUISS/Omit
- Mathematica/Omit
- ML/I/Omit
- PARI/GP/Omit
- TI-83 BASIC/Omit
- TI-89 BASIC/Omit
