| [ QuizWit ] in KIDS 글 쓴 이(By): parsec ( 먼 소 류 ) 날 짜 (Date): 2002년 6월 4일 화요일 오후 06시 26분 27초 제 목(Title): Re: [문제] 세 양치기 > 첫번째 양치기는 가능하면 원에 가까운 모양을, 그 다음 양치기는 가능하면 > 반원에 가까운 모양을 그리는게 최적해군요. > > 그렇다면 말뚝이 무한하다면 어떤 모양으로 붙을까요? > 첫번째는 원이겠지만, 두번째는 어디 쯤 붙고, 세번째는 또 어디에 붙고... > 누가 예쁘게 CAD나 mathematica로 그려주세요. :) 두번째 양치기까지는 그럭저럭 해봤는데 세번째부터는 꽤 골치아파지네요. 다음은 매쓰매티카 입력입니다. 선으로 나눈 공식들을 차례로 매쓰매티카에 넣어보세요. (첫번째 양치기가 두른 울타리의 지름을 1로 놓고 품) (면적 비율은 1:1.38612) -----------------------8<-------------8<-------------------------- peri[a_,r_]:=2 Pi r /; (a>1 && a-1>=r) || r>=a+1; peri[a_,r_]:=0 /; a<=1 && r<=1-a; peri[a_,r_]:=Module[{x,y},sol={y -> Sqrt[2 - a^(-2) - a^2 + 2*r^2 + (2*r^2)/a^2 - r^4/a^2]/2, x -> (1 + a^2 - r^2)/(2*a)};Return[2 r ArcCos[(x-a)/r]/.sol]]/; Abs[a-1]<r && r<a+1; --------------------------------------------------------------------------- area[a_,r_]:=Pi (r^2-1) /; r>=a+1; area[a_,r_]:=Pi r^2 /; a>1 && a-1>=r ; area[a_,r_]:=0 /; a<=1 && r<=1-a; area[a_,r_]:=Module[{x,y},sol={y -> Sqrt[2 - a^(-2) - a^2 + 2*r^2 + (2*r^2)/a^2 - r^4/a^2]/2, x -> (1 + a^2 - r^2)/(2*a)}; t1=ArcCos[x]/.sol; t2=ArcCos[(x-a)/r]/.sol; Return[(t2 r^2-(x-a) y+x y-t1)/.sol]]/; Abs[a-1]<r && r<a+1; --------------------------------------------------------------------------- getr[a_]:= Module[{r,t},r=t/.FindRoot[{peri[a,t]==2 Pi},{t,0,1}];Return[r]]/;a<=1; getr[a_]:= Module[{r,t},r=t/.FindRoot[{peri[a,t]==2 Pi},{t,a,a+0.1}];Return[r]]/;a>1; --------------------------------------------------------------------------- Plot[getr[x],{x,0,3},PlotRange->{0,1.5}] --------------------------------------------------------------------------- a1=Plot3D[peri[x,y],{x,0,3},{y,0,3},PlotPoints->50,Mesh->False]; --------------------------------------------------------------------------- a2=Plot3D[2 Pi,{x,0,3},{y,0,3},PlotPoints->50,Mesh->False]; --------------------------------------------------------------------------- Show[{a1,a2}] --------------------------------------------------------------------------- Plot[area[a,getr[a]],{a,0,3},PlotRange->{0,5}] --------------------------------------------------------------------------- sx=x/.FindMinimum[-area[x,getr[x]],{x,1.5,1.8}][[2]] --------------------------------------------------------------------------- sr=getr[sx] --------------------------------------------------------------------------- area[sx,sr]/Pi --------------------------------------------------------------------------- Show[Graphics[{{RGBColor[1,.5,0],Disk[{sx,0},sr]},{RGBColor[0,0,0], Circle[{sx,0},sr]},{RGBColor[1,.9,0],Disk[{0,0},1]},{RGBColor[0,0,0], Circle[{0,0},1]}}],AspectRatio->Automatic] --------------------------------------------------------------------------- ◇ ~~~_ _ ∴ ~|~| | _/__, SEP. 11. 2001 _ ∴∴ _ ~ | | ＼ ` Armorica under a tat ,-| `,-,_| |__ | | | A ______|_|__|_|___|__|| | |__|_|_____________________________________ |