遺伝学・遺伝統計学関連の姉妹ブログ『ryamadaの遺伝学・遺伝統計学メモ』
京都大学大学院医学研究科ゲノム医学センター統計遺伝学分野のWiki
講義・スライド
医学生物学と数学とプログラミングの三重学習を狙う学習ツール
駆け足で読む○○シリーズ
ぱらぱらめくるシリーズ
カシオの計算機
オンライン整数列大辞典

円に関する反転２

トポロジー R 教科書 Three-Dimensional Geometry and Topology 双曲幾何学
  • 円は、原則として円に移される
  • 例外は、原点を通過する円で、それは直線に移される
  • 直線は、原点を通過する円に移される
# hyperbolic disk 

t<-seq(from=0,to=1,length=100)*2*pi
xc<-cos(t)
yc<-sin(t)

#plot(xc,yc,type="l")


# straigt lines orthogonally crossing a point on the circle in hyperbolic geometic space 

#r<-seq(from=0,to=3,by=0.1)
r<-tan(seq(from=0,to=pi,length=10)/2)
Xcs<-Ycs<-matrix(0,length(r),length(t))
for(i in 1:length(r)){
	Xcs[i,]<-1+r[i]*cos(t)
	Ycs[i,]<-r[i]*sin(t)+r[i]
}
Xcs<-rbind(Xcs,Xcs)
Ycs<-rbind(Ycs,-Ycs)
xlim<-c(-1.5,3)
#xlim<-range(Xcs)
ylim<-xlim

plot(xc,yc,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="")
for(i in 1:length(Xcs[,1])){
	par(new=TRUE)
	plot(Xcs[i,],Ycs[i,],xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="")
	
}
abline(h=0)

Npt<-5

ts<-runif(Npt)*pi/2
rs<-runif(Npt)*0.8+0.1

xs<-rs*cos(ts)
ys<-rs*sin(ts)
xs2<-1/rs*cos(ts)
ys2<-1/rs*sin(ts)

xlim<-ylim<-range(c(xs2,ys2,xc,yc))
plot(xc,yc,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="")

par(new=TRUE)

plot(rs*cos(ts),rs*sin(ts),,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=2)

par(new=TRUE)
plot(1/rs*cos(ts),1/rs*sin(ts),,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=3)

points(0,0,pch=19)

# Cの中心を含まない円は円に移される
Npt<-100

ts<-seq(from=0,to=1,length=Npt)*2*pi
centerX<-runif(1)
centerY<-runif(1)
rs<-runif(1)
#rs<-sqrt(centerX^2+centerY^2)
xs<-rs*cos(ts)+centerX
ys<-rs*sin(ts)+centerY

Rs<-sqrt(xs^2+ys^2)
Ts<-acos(xs/Rs)
Ts[which(ys<0)]<--Ts[which(ys<0)]


xs2<-1/Rs*cos(Ts)
ys2<-1/Rs*sin(Ts)

tmplim<-range(c(xs2,ys2,xc,yc))
xlim<-ylim<-c(max(tmplim[1],-10),min(tmplim[2],10))
plot(xc,yc,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="")

par(new=TRUE)

plot(xs,ys,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=2)

par(new=TRUE)
plot(xs2,ys2,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=3)

points(0,0,pch=19)

# Cの中心を含む円は直線に移される
Npt<-100

ts<-seq(from=0,to=1,length=Npt)*2*pi
centerX<-runif(1)
centerY<-runif(1)
#rs<-runif(1)
rs<-sqrt(centerX^2+centerY^2)
xs<-rs*cos(ts)+centerX
ys<-rs*sin(ts)+centerY

Rs<-sqrt(xs^2+ys^2)
Ts<-acos(xs/Rs)
Ts[which(ys<0)]<--Ts[which(ys<0)]


xs2<-1/Rs*cos(Ts)
ys2<-1/Rs*sin(Ts)

tmplim<-range(c(xs2,ys2,xc,yc))
xlim<-ylim<-c(max(tmplim[1],-10),min(tmplim[2],10))
plot(xc,yc,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="")

par(new=TRUE)

plot(xs,ys,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=2)

par(new=TRUE)
plot(xs2,ys2,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=3)

points(0,0,pch=19)

# 直線は円に移される
Npt<-1000

ts<-seq(from=-10,to=10,length=Npt)
a<-runif(1)
b<-runif(1)
xs<-ts
ys<-a*ts+b

Rs<-sqrt(xs^2+ys^2)
Ts<-acos(xs/Rs)
Ts[which(ys<0)]<--Ts[which(ys<0)]


xs2<-1/Rs*cos(Ts)
ys2<-1/Rs*sin(Ts)

tmplim<-range(c(xs2,ys2,xc,yc))
xlim<-ylim<-c(max(tmplim[1],-10),min(tmplim[2],10))
plot(xc,yc,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="")

par(new=TRUE)

plot(xs,ys,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=2)

par(new=TRUE)
plot(xs2,ys2,xlim=xlim,ylim=ylim,type="l",main="",xlab="",ylab="",col=3)

points(0,0,pch=19)