1000 ! 一筆書き
1010 ! 最初に頂点の数を入力（2以上25以下）
1020 ! 次に，辺を端点の数字をコンマで区切って入力
1030 ! たとえば，頂点2と頂点3を結ぶ辺は，2,3 と入力
1040 ! ひとつの辺を入力するごとにEnterキーを押す
1050 ! 頂点1を含む辺を必ず含める
1060 ! 同じ点を端点とする辺（たとえば,3,3）は不可
1070 ! 同じ2点を複数回指定しても2点を結ぶ辺は1本
1080 ! 最後に　0,0　を入力
1090 ! 奇点が4個以上ある場合や非連結の場合は，辺を追加入力することができる
1100 DECLARE EXTERNAL SUB  GRAPH.Input_Vertices ,GRAPH.Draw_Start
1110 DECLARE EXTERNAL SUB  GRAPH.Build_Circuit, GRAPH.Build_Trail
1120 DECLARE EXTERNAL FUNCTION  GRAPH.Ix_OddPoint
1130 !
1140 SET WINDOW -1.2,1.2,-1.2,1.2
1150 CALL Input_Vertices 
1160 !
1170 LET a=Ix_OddPoint(1)
1180 IF a=0 THEN           ! 偶点のみ
1190    CALL Draw_Start(1)
1200    CALL Build_Circuit(1)
1210 ELSE                  ! 奇点あり 
1220    CALL Draw_Start(a)
1230    LET b=Ix_OddPoint(a+1)
1240    CALL Build_Trail(a,b)
1250 END IF 
1260 END
1270 !  
2000 EXTERNAL PICTURE ArrowHead
2010 PLOT AREA : 0,0; -0.1,0.02; -0.1,-0.02
2020 END PICTURE
2030 ! 
3000 MODULE GRAPH         
3010 SHARE NUMERIC m(25,25)    ! 隣接行列 
3020 SHARE NUMERIC N_Max       ! 頂点個数
3030 PUBLIC SUB  Input_Vertices
3040 PUBLIC SUB  Draw_Start,Build_Circuit, Build_Trail
3050 PUBLIC FUNCTION  Ix_OddPoint
3060 SHARE SUB Add, Del
3070 SHARE SUB Draw_Name, Draw_Path
3080 SHARE FUNCTION Test_Connected, N_OddPoints
3090 SHARE FUNCTION degree, Ix_Any_Vertex
3100 !
3110 EXTERNAL SUB Input_Vertices
3120    DO
3130       INPUT PROMPT "頂点の数(2以上25以下)": N_Max 
3140    LOOP UNTIL N_Max>=2 AND N_Max<=25 
3150    MAT m=ZER(N_Max,N_Max)
3160    !
3170    !
3180    SET TEXT JUSTIFY "CENTER","HALF"
3190    FOR i=1 TO N_MAX
3200       CALL Draw_Name(i)
3210    NEXT i
3220    ! 
3230    SET LINE COLOR 7 
3240    DO
3250       INPUT a,b
3260       IF a>0 AND b>0 THEN
3270          IF a<>b THEN
3280             CALL Add(a,b)
3290             CALL Draw_Path(a,b)
3300          ELSE
3310             PAUSE "異なる2点を結ぶ辺のみ入力できます"
3320          END IF
3330       ELSE
3340          LET N_Odd=N_OddPoints
3350          IF N_Odd>2 THEN 
3360             PAUSE "奇点が" & STR$(N_Odd) &"個ある"
3370          ELSEIF Test_Connected=1 THEN
3380             PAUSE "非連結"
3390          ELSE 
3400             EXIT DO
3410          END IF
3420       END IF
3430    LOOP
3440    SET LINE COLOR 1
3450 END SUB
3460 !
3470 EXTERNAL SUB Add(a,b)
3480    LET m(a,b)=1
3490    LET m(b,a)=1
3500 END SUB
3510 ! 
3520 EXTERNAL SUB Del(a,b)
3530    LET m(a,b)=0
3540    LET m(b,a)=0
3541    PRINT a;b;"除去"
3542    MAT PRINT m;
3550 END SUB
3560 ! 
3570 EXTERNAL FUNCTION Test_Connected
3580    ! 点1の連結成分が全体と一致すれば0,そうでないなら1
3590    DIM p(25,25),q(25,25)
3600    MAT p=ZER(N_Max,N_Max)
3610    MAT q=IDN(N_Max)
3620    FOR i=1 TO N_Max
3630       MAT q=q*m
3640       MAT p=p+q
3650    NEXT i
3660    LET t=0
3670    FOR i=2 TO N_Max
3680       IF p(1,i)=0 THEN 
3690          LET t=1
3700       END IF
3710    NEXT i
3720    LET  Test_Connected=t 
3730 END FUNCTION
3740 ! 
3750 EXTERNAL SUB Build_Trail(a,b)
3760    ! a,bが奇点であるとき，aからbに至る小道を作図
3770    IF m(a,b)=1 THEN
3780       CALL del(a,b)
3790       CALL Build_Circuit(a)
3800       CALL Draw_Arrow(a,b)
3810       CALL Build_Circuit(b)
3820    ELSE
3830       LET c=Ix_Any_Vertex(b)
3840       CALL del(b,c)
3850       CALL Build_Trail(a,c)
3860       CALL Draw_Arrow(c,b)
3870       CALL Build_Circuit(b)
3880    END IF
3890 END SUB
3900 ! 
3910 EXTERNAL SUB build_circuit(a)
3920    ! mは奇点を持たないものとする
3930    ! aから始まりaで終わる回路を描く
3940    LET b=Ix_Any_Vertex(a)
3950    IF b>0 THEN
3960       CALL Draw_Arrow(a,b)
3970       CALL Del(a,b)
3980       CALL Build_Trail(b,a)
3990    END IF
4000 END SUB
4010 ! 
4020 EXTERNAL FUNCTION Ix_Any_Vertex(a)
4030    ! aと辺を共有する頂点のうち最小番号のもの
4040    ! 存在しなければ0
4050    LET t=0
4060    FOR i=1 TO N_Max
4070       IF m(a,i)=1 THEN 
4080          LET t=i
4090          EXIT FOR
4100       END IF
4110    NEXT i
4120    LET Ix_Any_Vertex=t
4130 END FUNCTION
4140 ! 
4150 EXTERNAL FUNCTION degree(n)
4160    LET t=0
4170    FOR i=1 TO N_Max
4180       IF m(n,i)=1 THEN LET t=t+1
4190    NEXT i
4200    LET degree=t
4210 END FUNCTION 
4220 ! 
4230 EXTERNAL FUNCTION N_OddPoints
4240    LET t=0
4250    FOR i=1 TO N_Max
4260       IF MOD(degree(i),2)=1 THEN LET t=t+1
4270    NEXT i
4280    LET N_OddPoints=t
4290 END FUNCTION
4300 ! 
4310 EXTERNAL FUNCTION Ix_OddPoint(k)
4320    FOR i=k TO N_Max
4330       IF MOD(degree(i),2)=1 THEN
4340          LET Ix_OddPoint=i
4350          EXIT FUNCTION
4360       END IF
4370    NEXT i
4380    LET Ix_OddPoint=0
4390 END FUNCTION
4400 ! 
4410 EXTERNAL SUB Draw_Start(a)
4420    OPTION ANGLE DEGREES
4430    LET t=a*360/N_Max
4440    LET x2=COS(t)
4450    LET y2=SIN(t)
4460    SET AREA COLOR 4
4470    DRAW arrowhead WITH ROTATE(ANGLE(-x2,-y2))*SHIFT(x2,y2)
4480    SET AREA COLOR 1
4490 END SUB
4500 ! 
4510 EXTERNAL SUB Draw_Name(a)
4520    OPTION ANGLE DEGREES
4530    LET t=a*360/N_Max
4540    LET x2=1.12*COS(t)
4550    LET y2=1.12*SIN(t)
4560    PLOT TEXT ,AT x2,y2: STR$(a)
4570 END SUB
4590 ! 
4600 EXTERNAL SUB Draw_Path(a1,a2)
4610    OPTION ANGLE DEGREES
4620    LET t1=a1*360/N_Max
4630    LET t2=a2*360/N_Max
4640    PLOT LINES: COS(t1),SIN(t1) ; COS(t2),SIN(t2)
4650 END SUB
4660 ! 
4670 EXTERNAL SUB Draw_Arrow(a1,a2)
4680    OPTION ANGLE DEGREES
4690    PRINT a1;"->";a2
4700    LET t1=a1*360/N_Max
4710    LET t2=a2*360/N_Max
4720    LET x1=COS(t1)
4730    LET y1=SIN(t1)
4740    LET x2=COS(t2)
4750    LET y2=SIN(t2)
4760    PLOT LINES: x1,y1 ; x2,y2
4770    DRAW arrowhead WITH ROTATE(ANGLE(x2-x1,y2-y1))*SHIFT(x2,y2)
4780 END SUB
4790 ! 
4800 END MODULE 
   
