てなぐさみのメモ: SCIP in C++11 ― 2.5.2節

型の塔と問題2.81～問題2.86

演算テーブルがしっかり作ってあるので、

put-coercionやget-coercionの追加は簡単。

ただし、型を下げるdropに属する手続きを演算テーブルに入れてしまうと、

apply-genericとの整合性がなくなるので、これらはテーブルに入れない。

問題2.81はそりゃ無限ループにハマるわ。

apply-genericはさしあたり1引数と2引数のものだけあればいいので、

2引数版について型変換前に、2つの引数が同じ型なら型変換部分に入らないようにするだけ。

問題2.82については、apply-genericが任意個の引数を取る実装について、

C++では少なくとも自分には今のところ作り方がわからないのでパス。

今までの実装ではそもそも整数と実数の区別がない。

この辺も一応実装。てか単に型タグを変えて、

整数同士の割り算の場合、割り切れるかどうかをみて、

割り切れなかったら有理数を返すようにしただけ。

それよりも、raiseを単に型タグごとの振り分けでやっていると、

apply-genericが扱う2引数手続きのどっちをraiseすべきなのかが不明になる。

それをいちいちサーチするのはたぶん一般性・拡張性を損なうので、型IDを定義して、

型の塔のどちらが上位でどちらが下位なのかを判断出来るようにするべきだな。

この問題のような一次元的な型の塔なら単に数を対応させれば済むが、

もっと複雑な階層構造は、本文にもあるようにややこしいだろうなあ。

なお問題2.86の一般的状況では、問題2.84のapply-genericをそのまま使うと、

有理数を複素数にraiseするときに、有理数が一度realになってしまう。

なのでraiseは直接の変換法が定義されていないときに行うに留めることにする。

問題2.86は複素数の表現と演算のパッケージの全面改装が必要だな。

有理数パッケージも、後々有理関数が出るからそれへの拡張も意識すると、

単に数値の組じゃなくて、整数型の組にするべきだなたぶん。

大改修になるかと思いきや、演算テーブルがしっかりしているのでそうでもなかった。

改めてデータ主導プログラミングの威力を思い知る。

ただ感じたのは、最初「データがどう表現されているか」を考えながら改修していたら、

どれがタグ付けされていてどれがされていないのかが混乱して、コードのバランスが一時崩れた。

そこで考え方を変えて、「データはどうあるべきか」から見直していったら、すっと通れた。

もしかしてこれが一つのポイント？

あと名前の衝突が多くなってきたので、汎用手続きはnamespaceで囲う。

てか、もともとクラスの使用意義が薄い（というか危ない使用法になってる）ので、

始めから全部クラスでなくnamespaceにしておけばよかったか。

また、型が入り乱れてきたので、Number, Rational, Complexの各型を、

Listにtypedefしてきたのをやめて、すべてListにする。

----

//---------abstraction barrier---------

typedef string TagType;

const List raise(const List&);

const List attachTag(const TagType typeTag,const List& contents)

{

return(cons(makeLeaf(typeTag),contents));}

const TagType typeTag(const List& datum)

{

//if(isInt(datum)){return(TagType("number"));}

if(isPair(datum)){return(value<TagType>(car(datum)));}

cerr<<"Bad tagged datum -- TYPE-TAG"<<listString(datum)<<endl;

exit(1);

return("");

}

const int typeID(const TagType& tag){

if(tag=="number"){return(0);}

if(tag=="rational"){return(1);}

if(tag=="real"){return(2);}

return(3); //Complex

}

const List contents(const List& datum)

{

if(typeTag(datum)=="number"||typeTag(datum)=="real")

{return(cadr(datum));}

if(isPair(datum)){return(cdr(datum));}

cerr<<"Bad tagged datum -- CONTENTS"<<listString(datum)<<endl;

exit(1);

return(makeList());

}

//apply-generic for 1 arg

const List applyGeneric

(const string operation, const List& arg1)

{

const TagType typeTag1(typeTag(arg1));

const List procedureLeaf

(get(makeList(operation,makeList(typeTag1))));

if(isFunction(procedureLeaf)){

const auto procedure(executable<List,List>(procedureLeaf));

return(procedure(contents(arg1)));

}

cerr<<"No method for these types --- APPLY-Generic"

<<listString(makeList(operation,arg1))<<endl;

return(makeList());

}

//apply-generic for 2 args

const List applyGeneric

(const string operation, const List& arg1,const List& arg2)

{

const TagType typeTag1(typeTag(arg1));

const TagType typeTag2(typeTag(arg2));

const List procedureLeaf

(get(makeList(operation,makeList(typeTag1,typeTag2))));

if(isFunction(procedureLeaf)){

const auto procedure(executable<List,List,List>(procedureLeaf));

return(procedure(contents(arg1),contents(arg2)));

}else if(typeTag1!=typeTag2){

const auto type1ToType2(getCoercion(typeTag1,typeTag2));

const auto type2ToType1(getCoercion(typeTag2,typeTag1));

if(isFunction(type1ToType2)){

return(applyGeneric

(operation,

executable<List,List>(type1ToType2)(arg1),arg2));

}else if(isFunction(type2ToType1)){

return(applyGeneric

(operation,arg1,

executable<List,List>(type2ToType1)(arg2)));

}else if(typeID(typeTag1)<typeID(typeTag2)){

return(applyGeneric(operation,raise(arg1),arg2));

}else if(typeID(typeTag1)>typeID(typeTag2)){

return(applyGeneric(operation,arg1,raise(arg2)));

}

cerr<<"No method for these types --- APPLY-Generic"

<<listString(makeList(operation,typeTag1,typeTag2))<<endl;

return(makeList());

}

/*const List makeArgList(void)

{return(cons());}

template<typename ... ListArgs>

const List makeArgList

(const List& arg1, const ListArgs...args)

{

return(cons(arg1,makeArgList(args...)));

}

template<typename ListType1, typename ... ListArgs>

const List apply(const List& procedureLeaf, const List& argList)

{

const function<List(void)> voidProc=[](void){return(makeList());};

function<List(ListType1,ListArgs...)> procRecursive;

procRecursive=[&voidProc,&procRecursive,argList](const List& args){

if(isNull(args))return(voidProc());

};

return(procRecurSive(argList));

}

template<typename ... ListArgs>

const List applyGeneric

(const string operation, const List& arg1, const ListArgs...args)

{

const TagType typeTag1(typeTag(arg1));

const List procedureLeaf(get(makeList(operation,typeTag1)));

if(isFunction(procedureLeaf)){

const List contentsList

(mapping(function<List(List)>(contents),

makeArgList(arg1,args...)));

//return(apply(procedureLeaf,contentsList));

}

cerr<<"No method for these types --- APPLY-Generic"

<<listString(makeList(operation,arg1))<<"..."<<endl;

return(makeList());

}*/

//---------abstraction barrier---------

const List drop(const List&);

namespace Generic{

template<typename NumType>

const List makeNumber(const NumType& x)

{return(executable<List,List>

(get(makeList("make","number")))(makeLeaf(x)));

}

template<typename NumType>

const List makeReal(const NumType& x)

{return(executable<List,List>

(get(makeList("make","real")))(makeLeaf(x)));

}

const List makeRational(const List& x, const List& y)

{

if(typeTag(x)!="number" || typeTag(y)!="number"){

cerr<<"A rational number can be made of only integers (numerator="

<<listString(x)<<", denominator="

<<listString(y)<<")."<<endl;

exit(1);

}

return(executable<List,List,List>

(get(makeList("make","rational")))(x,y));

}

template<typename XType>

const List makeRational(const XType& x, const List& y)

{return(makeRational(makeNumber(x),y));}

template<typename YType>

const List makeRational(const List& x, const YType& y)

{return(makeRational(x,makeNumber(y)));}

template<typename XType, typename YType>

const List makeRational(const XType& x, const YType& y)

{return(makeRational(makeNumber(x),makeNumber(y)));}

const List numerator(const List& x)

{

return(executable<List,List>

(get(makeList("numerator",makeList("rational"))))

(contents(x)));

}

const List denominator(const List& x)

{

return(executable<List,List>

(get(makeList("denominator",makeList("rational"))))

(contents(x)));

}

const List realPart(const List& z)

{return(applyGeneric("real-part",z));}

const List imagPart(const List& z)

{return(applyGeneric("imag-part",z));}

const List magnitude(const List& z)

{return(applyGeneric("magnitude",z));}

const List angle(const List& z)

{return(applyGeneric("angle",z));}

template<typename ReType,typename ImType>

const List makeFromRealImag(const ReType& x,const ImType& y)

{

return(executable<List,List,List>

(get(makeList("make-from-real-imag","rectangular")))

(makeLeaf(x),makeLeaf(y)));

}

template<typename MagType,typename AngType>

const List makeFromMagAng(const MagType& r,const AngType& a)

{

return(executable<List,List,List>

(get(makeList("make-from-mag-ang","polar")))

(makeLeaf(r),makeLeaf(a)));

}

const List makeComplexFromRealImag(const List& x,const List& y)

{

if(typeTag(x)=="complex" || typeTag(y)=="complex"){

cerr<<"A complex number can be made of only real numbers (real part="

<<listString(x)<<", imaginary part="

<<listString(y)<<")."<<endl;

exit(1);

}

return(executable<List,List,List>

(get(makeList("make-from-real-imag","complex")))

(x,y));

}

template<typename ReType>

const List makeComplexFromRealImag(const ReType& x, const List& y)

{return(makeComplexFromRealImag(drop(makeReal(x)),y));}

template<typename ImType>

const List makeComplexFromRealImag(const List& x, const ImType& y)

{return(makeComplexFromRealImag(x,drop(makeReal(y))));}

template<typename XType, typename YType>

const List makeComplexFromRealImag(const XType& x, const YType& y)

{return(makeComplexFromRealImag(drop(makeReal(x)),drop(makeReal(y))));}

template<typename XType, typename YType>

const List makeComplexFromMagAng(const XType& x, const YType& y)

{

return(executable<List,List,List>

(get(makeList("make-from-mag-ang","complex")))

(makeLeaf(x),makeLeaf(y)));

}

const List add(const List& x,const List& y)

{

return(applyGeneric("add",x,y));

}

const List sub(const List& x,const List& y)

{

return(applyGeneric("sub",x,y));

}

const List mul(const List& x,const List& y)

{

return(applyGeneric("mul",x,y));

}

const List div(const List& x,const List& y)

{

if(typeTag(x)=="number" && typeTag(y)=="number"

&& contents(x)%contents(y)!=makeLeaf(0)){

return(makeRational(x,y));

}

return(applyGeneric("div",x,y));

}

const bool isEqu(const List& x,const List& y)

{return(makeLeaf(0)!=applyGeneric("equ?",x,y));}

const bool isZero(const List& x)

{return(makeLeaf(0)!=applyGeneric("=zero?",x));}

const List gcd(const List& x,const List& y)

{return(applyGeneric("gcd",x,y));}

const List square(const List& x){return(mul(x,x));}

const List squareRoot(const List& x)

{return(applyGeneric("squareRoot",x));}

const List arcTangent2(const List& y,const List& x)

{return(applyGeneric("arcTangent2",y,x));}

const List sine(const List& x)

{return(applyGeneric("sine",x));}

const List cosine(const List& x)

{return(applyGeneric("cosine",x));}

}

//---------abstraction barrier---------

template<typename XType, typename YType>

const List makeRational(const XType&, const YType&);

class NumberArithmetic{

public:

NumberArithmetic(const string tagIn="number"):tagString(tagIn){

put(makeList("gcd",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->gcd(x,y)));})));

if(this->getTag()=="number"){

put(makeList("add",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->add(x,y)));})));

put(makeList("sub",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->sub(x,y)));})));

put(makeList("mul",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->mul(x,y)));})));

put(makeList("div",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->div(x,y)));})));

}else{

put(makeList("add",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->add(x,y))));})));

put(makeList("sub",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->sub(x,y))));})));

put(makeList("mul",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->mul(x,y))));})));

put(makeList("div",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->div(x,y))));})));

}

put(makeList("equ?",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->isEqu(x,y));})));

put(makeList("=zero?",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->isZero(x));})));

put(makeList("squareRoot",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(drop(this->squareRoot(x)));})));

put(makeList("sine",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(drop(this->sine(x)));})));

put(makeList("cosine",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(drop(this->cosine(x)));})));

put(makeList("arcTangent2",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& y, const List& x)

{return(drop(this->arcTangent2(y,x)));})));

put(makeList("make",this->getTag()),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->tag(x));})));

}

virtual ~NumberArithmetic(void){};

const List gcd(const List& a, const List& b)const{

if(makeLeaf(0)==b){return(a);}

return(gcd(b,a%b));

}

virtual const List add

(const List& x, const List& y)const

{return(x+y);}

virtual const List sub

(const List& x, const List& y)const

{return(x-y);}

virtual const List mul

(const List& x, const List& y)const

{return(x*y);}

virtual const List div

(const List& x, const List& y)const

{return(x/y);}

const List isEqu(const List& x, const List& y)const

{return(makeLeaf(x==y));}

const List isZero(const List& x)const

{return(makeLeaf(isEqNumber(x,0)));}

virtual const List squareRoot(const List& x)const

{return(drop(Generic::makeReal(sqrt(value<double>(x)))));}

virtual const List sine(const List& x)const

{return(drop(Generic::makeReal(std::sin(value<double>(x)))));}

virtual const List cosine(const List& x)const

{return(drop(Generic::makeReal(std::cos(value<double>(x)))));}

virtual const List arcTangent2(const List& y,const List& x)const

{return(drop(Generic::makeReal

(std::atan2(value<double>(y),value<double>(x)))));}

const TagType getTag(void)const{return(this->tagString);}

virtual const List tag(const List& x)const

{return(attachTag(this->getTag(),x));}

private:

const TagType tagString;

};

NumberArithmetic* _numberPackage(nullptr);

NumberArithmetic* _realPackage(nullptr);

void installNumberPackage(void){

_numberPackage=new NumberArithmetic();

}

void installRealPackage(void){

_realPackage=new NumberArithmetic("real");

}

void uninstallNumberPackage(void){

if(nullptr!=_numberPackage) delete _numberPackage;

}

void uninstallRealPackage(void){

if(nullptr!=_realPackage) delete _realPackage;

}

//---------abstraction barrier---------

class RationalArithmetic{

public:

RationalArithmetic(void):tagString("rational"){

put(makeList("numerator",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->numer(x));})));

put(makeList("denominator",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->denom(x));})));

put(makeList("add",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->add(x,y))));})));

put(makeList("sub",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->sub(x,y))));})));

put(makeList("mul",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->mul(x,y))));})));

put(makeList("div",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->div(x,y))));})));

put(makeList("equ?",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->isEqu(x,y));})));

put(makeList("=zero?",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->isZero(x));})));

put(makeList("squareRoot",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(drop(this->squareRoot(x)));})));

put(makeList("sine",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(drop(this->sine(x)));})));

put(makeList("cosine",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(drop(this->cosine(x)));})));

put(makeList("arcTangent2",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& y, const List& x)

{return(drop(this->arcTangent2(y,x)));})));

put(makeList("make",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->makeRational(x,y)));})));

}

virtual ~RationalArithmetic(void){};

const List makeRational

(const List& numerator,const List& denominator)const

{

const List g(Generic::gcd(numerator,denominator));

if(contents(denominator)<makeLeaf(0)){

return(makeList

(Generic::div

(Generic::mul(Generic::makeNumber(-1),

numerator),

g),

Generic::div(

Generic::mul

(Generic::makeNumber(-1),

denominator),

g)));

}

return(makeList(Generic::div(numerator,g),

Generic::div(denominator,g)));

}

const List numer(const List& x)const{return(car(x));}

const List denom(const List& x)const{return(cadr(x));}

virtual const List add

(const List& x, const List& y)const

{

return(this->makeRational

(Generic::add

(Generic::mul(this->numer(x),this->denom(y)),

Generic::mul(this->numer(y),this->denom(x))),

Generic::mul(this->denom(x),this->denom(y))));

}

virtual const List sub

(const List& x, const List& y)const

{

return(this->makeRational

(Generic::sub

(Generic::mul(this->numer(x),this->denom(y)),

Generic::mul(this->numer(y),this->denom(x))),

Generic::mul(this->denom(x),this->denom(y))));

}

virtual const List mul

(const List& x, const List& y)const

{

return(this->makeRational

(Generic::mul(this->numer(x),this->numer(y)),

Generic::mul(this->denom(x),this->denom(y))));

}

virtual const List div

(const List& x, const List& y)const

{

return(this->makeRational

(Generic::mul(this->numer(x),this->denom(y)),

Generic::mul(this->denom(x),this->numer(y))));

}

virtual const List isEqu

(const List& x, const List& y)const

{

return(makeLeaf(this->numer(x)==this->numer(y)

&& this->denom(x)==this->denom(y)));

}

virtual const List isZero

(const List& x)const

{return(makeLeaf(isEqNumber(contents(this->numer(x)),0)));}

virtual const List squareRoot(const List& x)const

{

const List numeratorSqrt(Generic::squareRoot(this->numer(x)));

const List denominatorSqrt(Generic::squareRoot(this->denom(x)));

if(typeTag(numeratorSqrt)=="number"

&& typeTag(denominatorSqrt)=="number"){

return(this->tag(this->makeRational

(numeratorSqrt,denominatorSqrt)));

}

return(Generic::div(numeratorSqrt,denominatorSqrt));

}

virtual const List sine(const List& x)const

{

return(Generic::makeReal

(std::sin

(value<double>

(contents

(Generic::div

(Generic::makeReal(contents(this->numer(x))),

Generic::makeReal(contents(this->denom(x)))))))));

}

virtual const List cosine(const List& x)const

{

return(Generic::makeReal

(std::cos

(value<double>

(contents

(Generic::div

(Generic::makeReal(contents(this->numer(x))),

Generic::makeReal(contents(this->denom(x)))))))));

}

virtual const List arcTangent2(const List& y,const List& x)const

{

const List division(this->div(y,x));

return(Generic::makeReal

(std::atan2(value<double>(contents(this->numer(division))),

value<double>(contents(this->denom(division))))));

}

const TagType getTag(void)const{return(this->tagString);}

virtual const List tag(const List& x)const

{return(attachTag(this->getTag(),x));}

private:

const TagType tagString;

};

RationalArithmetic* _rationalPackage(nullptr);

void installRationalPackage(void){

_rationalPackage=new RationalArithmetic();

}

void uninstallRationalPackage(void){

if(nullptr!=_rationalPackage) delete _rationalPackage;

}

//---------abstraction barrier---------

const bool isRectangular(const List z)

{return(isEq(typeTag(z),makeLeaf("rectangular")));}

const bool isPolar(const List z)

{return(isEq(typeTag(z),makeLeaf("polar")));}

class ComplexProcedure{

public:

ComplexProcedure(void)=delete;

ComplexProcedure(const TagType tagIn):tagString(tagIn){}

virtual ~ComplexProcedure(void){};

virtual const List realPart(const List&)const=0;

virtual const List imagPart(const List&)const=0;

virtual const List makeFromRealImag

(const List&, const List&)const=0;

virtual const List magnitude(const List&)const=0;

virtual const List angle(const List&)const=0;

virtual const List makeFromMagAng

(const List&, const List&)const=0;

const TagType getTag(void)const{return(this->tagString);}

virtual const List tag(const List& z)const

{return(attachTag(this->getTag(),z));}

private:

const TagType tagString;

};

template <typename FieldType>

class ComplexRectangular :public ComplexProcedure{

public:

ComplexRectangular(void):ComplexProcedure("rectangular"){

put(makeList("real-part",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->realPart(z));})));

put(makeList("imag-part",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->imagPart(z));})));

put(makeList("magnitude",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->magnitude(z));})));

put(makeList("angle",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->angle(z));})));

put(makeList("make-from-real-imag",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List x, const List y)

{return(this->tag

(this->makeFromRealImag(x,y)));})));

put(makeList("make-from-mag-ang",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List r, const List a)

{return(this->tag

(this->makeFromMagAng(r,a)));})));

}

const List realPart(const List& z)const override

{return(car(z));}

const List imagPart(const List& z)const override

{return(cadr(z));}

const List makeFromRealImag

(const List& x, const List& y)const override

{return(makeList(x,y));}

const List magnitude(const List& z)const override

{

return(Generic::squareRoot

(Generic::add

(Generic::square(this->realPart(z)),

Generic::square(this->imagPart(z)))));

}

const List angle(const List& z)const override

{

return(Generic::arcTangent2

(this->imagPart(z),this->realPart(z)));

}

const List makeFromMagAng

(const List& r, const List& a)const override

{

return(this->makeFromRealImag

(Generic::mul(r,Generic::cosine(a)),

Generic::mul(r,Generic::sine(a))));

}

};

template <typename FieldType>

class ComplexPolar:public ComplexProcedure{

public:

ComplexPolar(void):ComplexProcedure("polar"){

put(makeList("real-part",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->realPart(z));})));

put(makeList("imag-part",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->imagPart(z));})));

put(makeList("magnitude",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->magnitude(z));})));

put(makeList("angle",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& z)

{return(this->angle(z));})));

put(makeList("make-from-real-imag",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List x, const List y)

{return(this->tag

(this->makeFromRealImag(x,y)));})));

put(makeList("make-from-mag-ang",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List r, const List a)

{return(this->tag

(this->makeFromMagAng(r,a)));})));

}

const List realPart(const List& z)const override{

return(Generic::mul(this->magnitude(z),

Generic::cosine(this->angle(z))));

}

const List imagPart(const List& z)const override{

return(Generic::mul(this->magnitude(z),

Generic::sine(this->angle(z))));

}

const List makeFromRealImag

(const List& x, const List& y)const override

{

return(this->makeFromMagAng

(Generic::squareRoot

(Generic::add(Generic::square(x),Generic::square(y))),

Generic::arcTangent2(y,x)));

}

const List magnitude(const List& z)const override

{return(car(z));}

const List angle(const List& z)const

{return(cadr(z));}

const List makeFromMagAng

(const List& r, const List& a)const override

{return(makeList(r,a));}

};

//---------abstraction barrier---------

typedef double Field;

ComplexProcedure* _complexPackage1(nullptr);

ComplexProcedure* _complexPackage2(nullptr);

const void installRectangularComplexPackage(void){

_complexPackage1=new ComplexRectangular<Field>();

}

const void installPolarComplexPackage(void){

_complexPackage2=new ComplexPolar<Field>();

}

const void uninstallComplexPackages(void){

if(nullptr!=_complexPackage1) delete _complexPackage1;

if(nullptr!=_complexPackage2) delete _complexPackage2;

}

//---------abstraction barrier---------

class ComplexArithmetic{

public:

ComplexArithmetic(void):

tagString("complex"),

_complexProcedure1(new ComplexRectangular<Field>()),

_complexProcedure2(new ComplexPolar<Field>())

{

put(makeList("add",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->addComplex(x,y))));})));

put(makeList("sub",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->subComplex(x,y))));})));

put(makeList("mul",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->mulComplex(x,y))));})));

put(makeList("div",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(drop(this->tag(this->divComplex(x,y))));})));

put(makeList("real-part",makeList(this->getTag())),

makeLeaf(function<List(List)>(Generic::realPart)));

put(makeList("imag-part",makeList(this->getTag())),

makeLeaf(function<List(List)>(Generic::imagPart)));

put(makeList("magnituide",makeList(this->getTag())),

makeLeaf(function<List(List)>(Generic::magnitude)));

put(makeList("angle",makeList(this->getTag())),

makeLeaf(function<List(List)>(Generic::angle)));

put(makeList("equ?",makeList(this->getTag(),this->getTag())),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->isEquComplex(x,y));})));

put(makeList("=zero?",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->isZeroComplex(x));})));

put(makeList("squareRoot",makeList(this->getTag())),

makeLeaf(function<List(List)>

([this](const List& x)

{return(this->squareRootComplex(x));})));

put(makeList("make-from-real-imag",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->makeFromRealImag(x,y)));})));

put(makeList("make-from-mag-ang",this->getTag()),

makeLeaf(function<List(List,List)>

([this](const List& x,const List& y)

{return(this->tag(this->makeFromMagAng(x,y)));})));

}

virtual ~ComplexArithmetic(void){

delete _complexProcedure1;

delete _complexProcedure2;

};

const List makeFromRealImag

(const List& x,const List& y)const

{

return(executable<List,List,List>

(get(makeList("make-from-real-imag","rectangular")))

(x,y));

}

const List makeFromMagAng

(const List& r,const List& a)const

{

return(executable<List,List,List>

(get(makeList("make-from-mag-ang","polar")))

(r,a));

}

virtual const List addComplex

(const List& x, const List& y)const

{

return(this->makeFromRealImag

(Generic::add(Generic::realPart(x),

Generic::realPart(y)),

Generic::add(Generic::imagPart(x),

Generic::imagPart(y))));

}

virtual const List subComplex

(const List& x, const List& y)const

{

return(this->makeFromRealImag

(Generic::sub(Generic::realPart(x),

Generic::realPart(y)),

Generic::sub(Generic::imagPart(x),

Generic::imagPart(y))));

}

virtual const List mulComplex

(const List& x, const List& y)const

{

return(this->makeFromMagAng

(Generic::mul(Generic::magnitude(x),

Generic::magnitude(y)),

Generic::add(Generic::angle(x),

Generic::angle(y))));

}

virtual const List divComplex

(const List& x, const List& y)const

{

return(this->makeFromMagAng

(Generic::div(Generic::magnitude(x),

Generic::magnitude(y)),

Generic::sub(Generic::angle(x),

Generic::angle(y))));

}

virtual const List isEquComplex

(const List& x, const List& y)const

{return(makeLeaf(Generic::realPart(x)==Generic::realPart(y)

&& Generic::imagPart(x)==Generic::imagPart(y)));}

virtual const List isZeroComplex(const List& x)const

{return(makeLeaf(isEqNumber(Generic::realPart(x),

Generic::makeNumber(0))

&& isEqNumber(Generic::imagPart(x),0)));}

virtual const List squareRootComplex(const List& x)const

{return(Generic::makeComplexFromMagAng

(Generic::squareRoot(Generic::magnitude(x)),

Generic::div(Generic::angle(x),

Generic::makeNumber(2))));}

const TagType getTag(void)const{return(this->tagString);}

virtual const List tag(const List& x)const

{return(attachTag(this->getTag(),x));}

private:

const TagType tagString;

const ComplexProcedure* _complexProcedure1;

const ComplexProcedure* _complexProcedure2;

};

ComplexArithmetic* _complexPackage(nullptr);

void installComplexPackage(void){

_complexPackage=new ComplexArithmetic();

}

void uninstallComplexPackage(void){

if(nullptr!=_complexPackage) delete _complexPackage;

}

//---------abstraction barrier---------

// raise coercion

const List number2Complex(const List& n)

{

return(Generic::makeComplexFromRealImag

(n,Generic::makeNumber(0)));

}

const List number2Rational(const List& n)

{

return(Generic::makeRational(n,Generic::makeNumber(1)));

}

const List number2Real(const List& n)

{

return(Generic::makeReal(contents(n)));

}

const List rational2Real(const List& r)

{

return(Generic::div(number2Real(Generic::numerator(r)),

number2Real(Generic::denominator(r))));

}

const List rational2Complex(const List& r)

{

return(Generic::makeComplexFromRealImag

(r,Generic::makeNumber(0)));

}

const List real2Complex(const List& re)

{

return(Generic::makeComplexFromRealImag

(re,Generic::makeNumber(0)));

}

//drop coercion

const List rational2Number(const List& r)

{

return(Generic::numerator(r));

}

const List real2Number(const List& n)

{

return(Generic::makeNumber

(static_cast<int>(value<double>(contents(n)))));

}

const List complex2Real(const List& c)

{

return(Generic::realPart(c));

}

const List raise(const List& x){

if(typeTag(x)=="number"){return(number2Rational(x));}

if(typeTag(x)=="rational"){return(rational2Real(x));}

if(typeTag(x)=="real"){return(real2Complex(x));}

return(x); //Complex

}

const List drop(const List& x){

if(typeTag(x)=="complex"

&& Generic::isZero(Generic::imagPart(x))){

return(drop(Generic::realPart(x)));

}

if(typeTag(x)=="real"

&& isInteger(contents(x))){

return(real2Number(x));

}

if(typeTag(x)=="rational"

&& Generic::isEqu(Generic::denominator(x),Generic::makeNumber(1))){

return(rational2Number(x));

}

return(x);

}

void installCoercion(void)

{

//raise

putCoercion("number","rational",

makeLeaf(function<List(List)>(number2Rational)));

putCoercion("number","real",

makeLeaf(function<List(List)>(number2Real)));

putCoercion("number","complex",

makeLeaf(function<List(List)>(number2Complex)));

putCoercion("rational","real",

makeLeaf(function<List(List)>(rational2Real)));

putCoercion("rational","complex",

makeLeaf(function<List(List)>(rational2Complex)));

putCoercion("real","complex",

makeLeaf(function<List(List)>(real2Complex)));

}

//---------abstraction barrier---------

int main(int argc, char** argv)

{

installNumberPackage();

installRationalPackage();

installRealPackage();

installComplexPackage();

installCoercion();

using namespace Generic;

const List n1(makeNumber(3));

const List n2(makeNumber(2));

const List r1(div(n1,n2));

const List re1(makeReal(4));

cout<<"r1 = "<<listString(r1)<<endl;

cout<<"n1 = "<<listString(n1)<<endl;

cout<<"(add n1 r1) = "<<listString(add(n1,r1))<<endl;

cout<<"(sub n1 r1) = "<<listString(sub(n1,r1))<<endl;

cout<<"(mul n1 r1) = "<<listString(mul(n1,r1))<<endl;

cout<<"(div n1 r1) = "<<listString(div(n1,r1))<<endl;

cout<<"re1 = "<<listString(re1)<<endl;

cout<<"(add r1 re1) = "<<listString(add(r1,re1))<<endl;

cout<<"(sub r1 re1) = "<<listString(sub(r1,re1))<<endl;

cout<<"(mul r1 re1) = "<<listString(mul(r1,re1))<<endl;

cout<<"(div r1 re1) = "<<listString(div(r1,re1))<<endl;

cout<<endl;

const List c1(makeComplexFromRealImag(1,2));

cout<<"c1 = "<<listString(c1)<<endl;

cout<<"(add c1 n1) = "<<listString(add(c1,n1))<<endl;

cout<<"(sub c1 n1) = "<<listString(sub(c1,n1))<<endl;

cout<<"(mul c1 n1) = "<<listString(mul(c1,n1))

<<"(exact: (3sqrt(5) atan(2)))"<<endl;

cout<<"(div c1 n1) = "<<listString(div(c1,n1))

<<"(exact: (sqrt(5)/3 atan(2)))"<<endl;

uninstallNumberPackage();

uninstallRationalPackage();

uninstallRealPackage();

uninstallComplexPackage();

return(0);

}

----

出力

----

r1 = ('rational ('number 3) ('number 2))

n1 = ('number 3)

(add n1 r1) = ('rational ('number 9) ('number 2))

(sub n1 r1) = ('rational ('number 3) ('number 2))

(mul n1 r1) = ('rational ('number 9) ('number 2))

(div n1 r1) = ('number 2)

re1 = ('real 4)

(add r1 re1) = ('real 5.5)

(sub r1 re1) = ('real -2.5)

(mul r1 re1) = ('number 6)

(div r1 re1) = ('real 0.375)

c1 = ('complex 'rectangular ('number 1) ('number 2))

(add c1 n1) = ('complex 'rectangular ('number 4) ('number 2))

(sub c1 n1) = ('complex 'rectangular ('number -2) ('number 2))

(mul c1 n1) = ('complex 'polar ('real 6.708203932499369) ('real 1.10714871779409))(exact: (3sqrt(5) atan(2)))

(div c1 n1) = ('complex 'polar ('real 0.7453559924999299) ('real 1.10714871779409))(exact: (sqrt(5)/3 atan(2)))

てなぐさみのメモ

目次

2012-09-11

SCIP in C++11 ― 2.5.2節

0 件のコメント :

コメントを投稿