R版KETpicとユークリッド原論

2010年12月27日 (月)

「与えられた円の中心を見つけること」第3巻命題1  

ユークリッド原 論(試案)のHP(下記)の図を参考に、R版KETpicを活用してみました。
文章はHPを利用させていただきました。
http://mis.edu.yamaguchi-u.ac.jp/kyoukan/watanabe/elements/hyoushi/

1)与えられた円をABCとせよ。
ABC<- Circledata(c(5,5),2)


2)円ABCの中心を見つけることが要求されている。

3)円周上を通る任意の点から線分ABをひき、点Dでそれを2等分しなさい。
Line<- Listplot(c(0,4),c(8,4))

Tmp<- Intersectcrvs(Line,ABC)
A<- Tmp[[1]]
B<- Tmp[[2]]
AB<- Listplot(A,B)
D<- (A+B)/2

4)DからABに対して直角にDCをひきなさい。それをEまで延長し、FでCEを2等分しなさい。

C<- SuisenPtocrv(D,A,B,ABC)
DC<- Lineplot(D,C)
E<- Intersectcrvs(DC ,ABC)[[2]]
EC<- Listplot(E,C)
F<- (C+E)/2#与えられた円の中心に一致

■ソースコード例(ketpicadd101223.RDataを再ダウンロードしてください
setwd("C:/rwork")
load("ketpic101207.RData")
load("tgpack101207.RData")
load("ketpicadd101223.RData")

Setwindow(c(0,10),c(0,10))
WindispT()
ABC<- Circledata(c(5,5),2)#与えた円の中心c(5,5)
Line<- Listplot(c(0,4),c(8,4))
Tmp<- Intersectcrvs(Line,ABC)
A<- Tmp[[1]]
B<- Tmp[[2]]
AB<- Listplot(A,B)
D<- (A+B)/2
C<- SuisenPtocrv(D,A,B,ABC)[[1]]
DC<- Lineplot(D,C)
E<- Intersectcrvs(DC,ABC)[[2]]
EC<- Listplot(E,C)
F<- (C+E)/2#与えられた円の中心に一致
cat("与えられた円の中心の座標は(",F[1],",",F[2],")となります","\n",sep="")
WindispT()
WindispT(ABC,AB,EC,F)
Puttext(A,"A",pos=2,color="blue")
Puttext(B,"B",pos=4,color="blue")
Puttext(C,"C",pos=3,color="blue")
Puttext(D+c(0.2,0.1),"D",pos=1,color="blue")
Puttext(E,"E",pos=1,color="blue")
Puttext(F,"F",pos=4,color="blue")
Fxy<- as.character(paste("(",F[1],",",F[2],")",sep=""))
Puttext(F+c(0.1,0),Fxy,pos=4,color="blue")

■作図結果

Euclid_3_1_2


無料ブログはココログ
2017年8月
    1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31