summaryrefslogtreecommitdiff
path: root/texmf-dist/scripts
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2018-04-09 13:55:45 +0900
committerNorbert Preining <norbert@preining.info>2018-04-09 13:55:45 +0900
commit3a815dbc6fc9d8c06ff04967c5585a81b30c3559 (patch)
treea32b85fefbb454f076527fe73f7a151a1b8cabce /texmf-dist/scripts
parent4de9ce5199bd578a50302b75436cf03e99c49f32 (diff)
update ketpic
Diffstat (limited to 'texmf-dist/scripts')
-rw-r--r--texmf-dist/scripts/ketcindy/LICENSE.txt14
-rw-r--r--texmf-dist/scripts/ketcindy/dirhead.txt7
-rw-r--r--texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jarbin156234 -> 156844 bytes
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt22
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs1110
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt18
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs481
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt17
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs10059
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt7
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt5
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs16
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt21
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs919
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r (renamed from texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r)4273
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r (renamed from texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r)0
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r14614
-rw-r--r--texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r580
-rw-r--r--texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h788
-rw-r--r--texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h97
-rw-r--r--texmf-dist/scripts/ketcindy/ketlibC/surflib.h600
-rw-r--r--texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h37
-rw-r--r--texmf-dist/scripts/ketcindy/ketoutset.txt12
-rwxr-xr-x[-rw-r--r--]texmf-dist/scripts/ketcindy/setketcindy.txt5
-rw-r--r--texmf-dist/scripts/ketcindy/template1basic.cdybin4197 -> 4302 bytes
-rwxr-xr-x[-rw-r--r--]texmf-dist/scripts/ketcindy/template2advanced.cdybin4846 -> 5778 bytes
26 files changed, 26461 insertions, 7241 deletions
diff --git a/texmf-dist/scripts/ketcindy/LICENSE.txt b/texmf-dist/scripts/ketcindy/LICENSE.txt
new file mode 100644
index 00000000..505587ff
--- /dev/null
+++ b/texmf-dist/scripts/ketcindy/LICENSE.txt
@@ -0,0 +1,14 @@
+// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
+//
+//This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation; either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see <http://www.gnu.org/licenses/>
diff --git a/texmf-dist/scripts/ketcindy/dirhead.txt b/texmf-dist/scripts/ketcindy/dirhead.txt
new file mode 100644
index 00000000..e87a8005
--- /dev/null
+++ b/texmf-dist/scripts/ketcindy/dirhead.txt
@@ -0,0 +1,7 @@
+Dirhead=Dircdy;
+Dirwork=gethome()+pathsep()+"ketcindy";
+Dircdy=Dirwork;
+setdirectory(Dirhead);
+import("setketcindy.txt");
+import("ketoutset.txt");
+setdirectory(Dirwork);
diff --git a/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar b/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar
index ad013a20..044a36a7 100644
--- a/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar
+++ b/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar
Binary files differ
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt
index 5afce0d3..55b2fc71 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt
@@ -1,3 +1,25 @@
+// 2018.03.27
+// Start3d changed (for C)
+// 2018.02.27
+// Sfbdpara,... changed ("Res=" made from fname)
+// 2018.02.26
+// Sfcutparadata (renamed from Sfcutdata) changed
+// 2018.02.24
+// Sfcutdata added
+// 2018.02.23
+// Crvonsfparadata added
+// Wireparadata added
+// Skeletonparadata rechanged to old version
+// 2018.02.22
+// Intersectcrvsf added (changed to R)
+// Sdbdpradata,Crvsfparadata,Intersectcrvsf changed (title printing)
+// 2018.02.20
+// Addpoints added
+// PthiddenQ,Meetpoints debugged
+// 2018.02.18
+// Sfbdparadata debuggded (OTHERPARTITION )
+// 2018.02.11
+// Sfbdparadata added
// 2018.01.04
// Skeletonparadata(Skeletondatacindy) majorly changed
// 2017.10.23
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs
index 1b6f69e1..ce7a65f1 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs
@@ -14,7 +14,7 @@
// along with this program. If not, see <http://www.gnu.org/licenses/>
//
-println("ketcindylib3d(2018.01.05) loaded");
+println("ketcindylib3d(20180327) loaded");
//help:start();
@@ -79,12 +79,15 @@ Ketinit3d(subflg,position):=(
ErrFlg=0;
);
-Start3d():=Start3d([]); //16.11.12
-Start3d(ptexception):=( //16.11.12
+Start3d():=Start3d([]);
+Start3d(ptexception):=(
//help:Start3d();
//help:Start3d(execptionptlist);
regional(xmn,xMx,ymn,yMx,pt,pt3,pt2,
xPos,yTh,yPh,Eps,tmp,tmp1,tmp2,tmp3,tmp4);
+ ConstantListC=[[50,50],[5000,1500,500,200],[0.00001,0.01,0.1]];
+ FuncListC=[];
+ CommandListC=[];
GCLIST=[];
GLIST=[];
FUNLIST=[];
@@ -97,7 +100,7 @@ Start3d(ptexception):=( //16.11.12
ErrFlag=0;
OBJCMD=[]; // 16.11.29from
OCNAME=Fhead;
- OCOPTION=["m","v"];// 16.11.29upto
+ OCOPTION=["m","v"];// 16.11.29until
ArrowlineNumber=1; // 16.01.31
ArrowheadNumber=1;
BezierNumber=1; //16.01.31
@@ -124,7 +127,7 @@ Start3d(ptexception):=( //16.11.12
+format((FI.x-xPos)*40,5)+")";
GLIST=append(GLIST,tmp);
THETA=(TH.x-xPos)*20*pi/180;
- PHI=(FI.x-xPos)*40*pi/180; // 16.06.20upto
+ PHI=(FI.x-xPos)*40*pi/180; // 16.06.20until
if(isselected(TH) % isselected(FI), // 17.05.18from
if(length(Ch)>0,
ChNum=Ch_(length(Ch));
@@ -133,7 +136,7 @@ Start3d(ptexception):=( //16.11.12
ChNum=1;
);
Ch=[0];
- );// 17.05.18upto
+ );// 17.05.18until
if(length(VLIST)==0, // 16.06.20
tmp=remove(allpoints(),[NE,SW,TH,FI,O,X,Y,Z]);//17.06.02
tmp4=remove(tmp,ptexception);
@@ -145,7 +148,7 @@ Start3d(ptexception):=( //16.11.12
pt3=Xyzcoord(pt.x,pt.y,tmp);
Defvar(tmp1+"3d",pt3);
pt2=Parapt(pt3); // 16.05.28from
- Defvar(tmp1+"2d",pt2); // 16.05.28upto
+ Defvar(tmp1+"2d",pt2); // 16.05.28until
);
);
,
@@ -199,7 +202,7 @@ Start3d(ptexception):=( //16.11.12
shadowc=[0,0,0,0.5]; mboxc="yellow"; //17.03.02 regional debugged
SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
letterc,mboxc,mboxc,mboxc,62,2,letterc];
- ThinDense=0.1; //17.07.01upto
+ ThinDense=0.1; //17.07.01until
Ptseg3data(ptexception); //16.08.23
);
@@ -231,7 +234,7 @@ Setangle(theta,phi):=( //16.12.24
pt3=Xyzcoord(pt.x,pt.y,tmp);
Defvar(tmp1+"3d",pt3);
pt2=Parapt(pt3); // 16.05.28from
- Defvar(tmp1+"2d",pt2); // 16.05.28upto
+ Defvar(tmp1+"2d",pt2); // 16.05.28until
);
);
,
@@ -554,7 +557,7 @@ Spaceline(Arg1,Arg2):=(
name="-"+replace(tmp,",","");
Spaceline(name,Arg1,Arg2);
);
-); // 16.02.22 upto
+); // 16.02.22 until
Spaceline(nm,ptlistorg,optionorg):=(
//help:Spaceline("1",[[2,5,1],[4,2,3]]);
//help:Spaceline([A,B]);
@@ -609,7 +612,7 @@ Spaceline(nm,ptlistorg,optionorg):=(
);
);
tmp=substring(tmp,0,length(tmp)-1)+"]";
- tmp=name3+"=Spaceline("+tmp+")"; //17.07.13upto
+ tmp=name3+"=Spaceline("+tmp+")"; //17.07.13until
// tmp=name3+"=Spaceline("+textformat(ptlist,5)+")"; //17.05.24
GLIST=append(GLIST,tmp);
tmp=name2+"=Projpara("+name3+")";
@@ -962,7 +965,7 @@ Xyzax3data(nm,Xrange,Yrange,Zrange,options):=(
);
);
);
- ); // 16.08.14upto
+ ); // 16.08.14until
tmp1=indexof(Xrange,"=");
tmp=parse(substring(Xrange,tmp1,length(Xrange)));
Px=[tmp_1,0,0]; Qx=[tmp_2,0,0];
@@ -1008,7 +1011,7 @@ Xyzax3data(nm,Xrange,Yrange,Zrange,options):=(
if(length(Origin)>0,
Letter([Parapt([0,0,0]),Origin,"O"]);
);
- ); // 16.08.14upto
+ ); // 16.08.14until
if(SUBSCR==1, // 15.02.11
Subgraph(name3,opcindy);
);
@@ -1722,11 +1725,11 @@ Putpoint3d(Arg1,Arg2,Arg3):=(
ptslist=Arg1;
fixstr=Arg2;
);
- if(islist(fixstr),fixstr=fixstr_1);// 16.03.02 upto
+ if(islist(fixstr),fixstr=fixstr_1);// 16.03.02 until
nn=length(ptslist)/2;
forall(1..nn,kk, // 16.08.19from
tmp1=ptslist_(2*kk-1);
- pt3=ptslist_(2*kk); // 16.08.19upto
+ pt3=ptslist_(2*kk); // 16.08.19until
VLIST=select(VLIST,#_1!=tmp1+"3d");
tmp2=parse(tmp1);
if(ispoint(tmp2), // 16.05.26from
@@ -1740,7 +1743,7 @@ Putpoint3d(Arg1,Arg2,Arg3):=(
Defvar(tmp1+"3d",tmp);
,
Defvar(tmp1+"3d",pt3);
- ); // 16.05.26upto
+ ); // 16.05.26until
Defvar(tmp1+"fix",0);
pt=Parapt(pt3);
Putpoint(tmp1,pt,parse(tmp1+".xy"));
@@ -1898,7 +1901,7 @@ Putaxes3d(size):=(
Putpoint3d(["Y",[0,sL_2,0]],"fix");
Putpoint3d(["Z",[0,0,sL_3]],"fix");
// Fixpoint3d(["O",[0,0,0]]);
-// Fixpoint3d(["X",[sL_1,0,0],"Y",[0,sL_2,0],"Z",[0,0,sL_3]]);//17.06.02fupto
+// Fixpoint3d(["X",[sL_1,0,0],"Y",[0,sL_2,0],"Z",[0,0,sL_3]]);//17.06.02funtil
);
IntersectsgpL(name,sgstr,pLstr):=
@@ -2103,7 +2106,7 @@ Putbezier3data(name,pt3Lorg,options):=( // 17.10.08 greatly changed
,
tmp1=name+numstr+"p";
tmp2=(pt3L_(nn-1)+pt3L_nn)/2;
- VLIST=select(VLIST,#_1!=tmp1+"3d"); // 16.08.19upto
+ VLIST=select(VLIST,#_1!=tmp1+"3d"); // 16.08.19until
Putpoint3d([tmp1,tmp2]);
ctrpts=append(ctrpts,tmp1);
);
@@ -2329,7 +2332,7 @@ Concatobj(objL,options):=(
);
);
vL=concat(vL,vadd);
- fL=concat(fL,fnew); // 16.02.11 upto
+ fL=concat(fL,fnew); // 16.02.11 until
);
tmp2=apply(1..length(fL),1);
if(rmf=="y",
@@ -2397,7 +2400,7 @@ VertexEdgeFace(nm,vfnLorg,optionorg):=(
);
if(length(vfnL)==1,
vfnL=[vfnL_1,[1..length(vfnL_1)]];
- ); // 16.06.19upto
+ ); // 16.06.19until
tmp=Divoptions(options);
Noflg=tmp_2;
eqL=tmp_5;
@@ -2439,7 +2442,7 @@ VertexEdgeFace(nm,vfnLorg,optionorg):=(
Putpoint3d(["v"+text(#),vtx],"fix");
);
);
- vL=append(vL,vname); // 16.02.10 upto
+ vL=append(vL,vname); // 16.02.10 until
);
eL=[];
forall(vfnL_2,face,
@@ -2590,7 +2593,7 @@ Phparadata(nm,nmvf,vfL,options):=(
tmp2=tmp2+text(#)+",";
);
tmp2=substring(tmp2,0,length(tmp2)-1)+")";
- ); // 2015.05.27 upto
+ ); // 2015.05.27 until
tmp=name3+"=Phparadata("+tmp1+","+tmp2+opstr+")";
GLIST=append(GLIST,tmp);
tmp=name2+"=Projpara("+name3+")";
@@ -2844,7 +2847,7 @@ Nohiddenbyfaces(nm,segstr,facestr,optionorg,optionsh):=(
);
);
segL=tmp2;
- Changestyle3d(segL,["nodisp"]); // 16.02.29 upto
+ Changestyle3d(segL,["nodisp"]); // 16.02.29 until
if(islist(segL),
if(isstring(segL_1),
segL=apply(segL,parse(#));
@@ -2857,14 +2860,14 @@ Nohiddenbyfaces(nm,segstr,facestr,optionorg,optionsh):=(
faceL=parse(facestr);
tmp=replace(facestr,"phf","phv"); // 16.02.10 from
tmp=parse(tmp);
- vtxL=apply(tmp,replace(#,"3d","")); // 16.02.10 upto
+ vtxL=apply(tmp,replace(#,"3d","")); // 16.02.10 until
flg=1;
,
faceL=parse(facestr);
);
);
if(flg==0,
- if(length(faceL)==2, // 16.08.19upto
+ if(length(faceL)==2, // 16.08.19until
vtxL=facestr_1;
faceL=facestr_2;
,
@@ -3220,22 +3223,23 @@ Sfbdparadata(nm,fd,options):=
Sfbdparadata(nm,fd,options,["nodisp"]);
Sfbdparadata(nm,fdorg,optionorg,optionsh):=(
//help:Sfbdparadata("1",Fd);
-//help:Sfbdparadata(options2=["Wait=30",limit1([0.05,1], limit2(0.2)]);
+//help:Sfbdparadata(options2=["Wait=60",division(c(50,50)),Eps1(c(0.01,1)), Eps2(0.05)]);
regional(fd,options,name2,name3,name2h,name3h,waiting,
- eqL,reL,strL,fname,outreg,tmp,tmp1,tmp2,flg,wflg);
+ eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg);
name2="sfbd2d"+nm;
name3="sfbd3d"+nm;
name2h="sfbdh2d"+nm;
name3h="sfbdh3d"+nm;
fname=Fhead+"sfbd"+nm+".txt";
- fd=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ tmp=text(tmp);
+ fd=RSform(tmp,2);
options=optionorg;
tmp=Divoptions(options);
eqL=tmp_5;
reL=tmp_6;
strL=tmp_7;
- waiting=30;
- outreg=0; // 16.08.20
+ waiting=120;
forall(eqL,
tmp=indexof(#,"=");
tmp1=Toupper(substring(#,0,1));
@@ -3244,11 +3248,6 @@ Sfbdparadata(nm,fdorg,optionorg,optionsh):=(
waiting=parse(tmp2);
options=remove(options,[#]);
);
-// if(tmp1=="O", // 16.08.20
-// tmp=Toupper(substring(tmp2,0,1));
-// if(tmp=="T" % tmp=="Y", outreg=1,outreg=0);
-// options=remove(options,[#]);
-// );
);
options=remove(options,reL);
wflg=0;
@@ -3263,55 +3262,38 @@ Sfbdparadata(nm,fdorg,optionorg,optionsh):=(
options=remove(options,[#]);
);
);
- cmdL=MkprecommandS(5); // 16.02.01
- tmp=[
- Dq+fname+Dq,
- Dq+name3+Dq,name3,
- Dq+name2+Dq,name2,
- Dq+name3h+Dq,name3h,
- Dq+name2h+Dq,name2h,
- Dq+"HIDDENDATA"+Dq,"HIDDENDATA", // 16.08.20from
- Dq+"PARTITIONPT"+Dq,"PARTITIONPT",
- Dq+"OTHERPARTITION"+Dq,"OTHERPARTITION" // 16.08.20upto
- ];
- fd=apply(fd,replace(#,"_1","(1)")); // 16.05.25from
- fd=apply(fd,replace(#,"_2","(2)"));
- fd=apply(fd,replace(#,"_3","(3)")); // 16.05.25upto
- cmdL=concat(cmdL,[
- name3+"=Sfbdparadata",concat([fd,"Error"],reL),
+ tmp=["fd"+nm];
+ if(length(reL)>0,
+ reL=textformat(reL,4);
+ reL=substring(reL,1,length(reL)-1);
+ reL=Rsform(reL);
+ tmp=append(tmp,reL);
+ );
+ tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2];
+ tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]);
+// tmp1=concat(tmp1,[Dqq("CUSPPT"),"CUSPPT"]);
+// tmp1=concat(tmp1,[Dqq("OTHERPARTITION"),"OTHERPARTITION"]);
+ tmp2=replace(fname,".txt",".dat"); //18.02.18
+ cmdL=[
+ "print",[Dqq("fd"+nm)], //18.02.22
+ "fd"+nm+"="+fd,[],
+ name3+"=Sfbdparadata",tmp,
name2+"=Projpara",[name3],
- name3h+"=BorderHiddenData()",[],
+ name3h+"=HIDDENDATA",[],
name2h+"=Projpara",[name3h],
- "function Ot=Hiddend(),global HIDDENDATA,Ot=HIDDENDATA,endfunction)"
- ,[], // 16.08.20from
- "function Ot=Otherp(),global OTHERPARTITION,Ot=OTHERPARTITION,endfunction)"
- ,[],
- "HIDDENDATA=Hiddend()",[],
- "PARTITIONPT=PartitionPt()",[],
- "OTHERPARTITION=Otherp()",[],
- "for J=1:length(OTHERPARTITION)",[],
- " Tmp1=OTHERPARTITION(J)",[],
- " Tmp2=[]",[],
- " for K=1:length(Tmp1)",[],
- " Tmp2=[Tmp2;Tmp1(K),1000]",[],
- " end",[],
- " OTHERPARTITION(J)=Tmp2",[],
- "end",[],
- "WriteOutData",tmp
- ]);
- options=append(options,"Wait="+text(waiting));
- if(wflg==1,options=concat(options,["m"])); // 16.08.20
- if(wflg==-1,options=concat(options,["r"]));
+ "WriteOutData",tmp1,
+ "save",["CUSPPT","OTHERPARTITION","file='"+tmp2+"'"]
+ ];
+ tmp=replace(fname,".txt","end.txt");
+ options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]);
+ if(wflg==1,options=append(options,"m"));
+ if(wflg==-1,options=append(options,"r"));
if(ErrFlag==0,
- CalcbyS("sfbd"+nm,cmdL,options);
+ CalcbyR("sfbd"+nm,cmdL,options);
);
if(ErrFlag==1,
err("Sfbdparadata not completed");
,
- if(outreg==1,
- OutFileList=remove(OutFileList,[fname]);
- OutFileList=append(OutFileList,fname);
- );
ReadOutData(fname);
if(islist(parse(name2)),
Extractdata(name2,options);
@@ -3323,32 +3305,48 @@ Sfbdparadata(nm,fdorg,optionorg,optionsh):=(
);
);
-Wireparadata(nm,out,wr1,wr2,fd):=
- Wireparadata(nm,out,fd,wr1,wr2,[],["nodisp"]);
-Wireparadata(nm,out,fd,wr1,wr2,options):=
- Wireparadata(nm,out,fd,wr1,wr2,options,["nodisp"]);
-Wireparadata(nm,outstr,fdorg,wr1,wr2,optionorg,optionsh):=(
+Addpoints():=(//18.02.20
+ if(isstring(ADDPOINT),
+ ADDPOINT;
+ ,
+ "list()";
+ );
+);
+Addpoints(ptlist):=(
+//help:Addpoints(list of 3d points);
+ if(length(ptlist)==0,
+ ADDPOINT="list()";
+ ,
+ ADDPOINT=Rsform(textformat(ptlist,6),2);
+ );
+ ADDPOINT;
+);
+
+Wireparadata(nm,sf,wr1,wr2,fd):=
+ Wireparadata(nm,sf,fd,wr1,wr2,[],["nodisp"]);
+Wireparadata(nm,sf,fd,wr1,wr2,options):=
+ Wireparadata(nm,sf,fd,wr1,wr2,options,["nodisp"]);
+Wireparadata(nm,sfstr,fdorg,wr1,wr2,optionorg,optionsh):=(
//help:Wireparadata("1","sfbd3d1",fd,5,5);
-//help:Wireparadata(options2=["Wait=40"]);
- regional(out,fd,options,name2,name3,name2h,name3h,outreg,
- eqL,reL,strL,fname,outfname,waiting,tmp,tmp1,tmp2,flg,wflg);
+//help:Wireparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]);
+ regional(fd,options,name2,name3,name2h,name3h,outreg,
+ eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,flg,wflg);
name2="wire2d"+nm;
name3="wiref3d"+nm;
name2h="wireh2d"+nm;
name3h="wireh3d"+nm;
fname=Fhead+"wire"+nm+".txt";
- tmp=replace(outstr,"3d","");
- outfname=Fhead+tmp+".txt"; // 16.08.20
- out=parse(outstr);
- if(!islist(out), ErrFlag=1);
- fd=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ rfname=Fhead+sfstr+".txt";
+ rfname=replace(rfname,"3d","");
+ tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ tmp=text(tmp);
+ fd=RSform(tmp,2);
options=optionorg;
tmp=Divoptions(options);
eqL=tmp_5;
reL=tmp_6;
strL=tmp_7;
- waiting=40;
- outreg=0;
+ waiting=600;
forall(eqL,
tmp=indexof(#,"=");
tmp1=Toupper(substring(#,0,1));
@@ -3357,11 +3355,6 @@ Wireparadata(nm,outstr,fdorg,wr1,wr2,optionorg,optionsh):=(
waiting=parse(tmp2);
options=remove(options,[#]);
);
-// if(tmp1=="O", // 16.08.20from
-// tmp=Toupper(substring(tmp2,0,1));
-// if(tmp=="T" % tmp=="Y", outreg=1,outreg=0);
-// options=remove(options,[#]);
-// );// 16.08.20upto
);
options=remove(options,reL);
wflg=0;
@@ -3376,117 +3369,82 @@ Wireparadata(nm,outstr,fdorg,wr1,wr2,optionorg,optionsh):=(
options=remove(options,[#]);
);
);
- flg=0;
- tmp1=floor(5*1000/WaitUnit);
- repeat(tmp1,
- if(flg==0,
- tmp=load(Fhead+replace(outstr,"3d","")+".txt");
- if(length(tmp)>=4,
- tmp2=substring(tmp,length(tmp)-4,length(tmp));
- if(tmp2=="////",
- flg=1;
- );
- ,
- wait(WaitUnit);
- );
- );
- );
- if(flg==0,
- Err(outstr+" file not copleted");
- ErrFlag=1;
- );
- if(ErrFlag==0,
-// Writeoutdata(outfname,["Out",out]);
- );
- cmdL=MkprecommandS(5); // 16.02.01
- tmp=[
- Dq+fname+Dq,
- Dq+name3+Dq,name3,
- Dq+name2+Dq,name2,
- Dq+name3h+Dq,name3h,
- Dq+name2h+Dq,name2h
- ];
- fd=apply(fd,if(isstring(#),replace(#,"_1","(1)"),#)); // 16.05.25 08.17from
- fd=apply(fd,if(isstring(#),replace(#,"_2","(2)"),#));
- fd=apply(fd,if(isstring(#),replace(#,"_3","(3)"),#)); // 16.05.25 08.17upto
- cmdL=concat(cmdL,[
- "disp('Running Wireparadata')",[],
- "tmp=ReadOutData",[Dq+outfname+Dq],
- "execstr(tmp)",[],
- "function SetHidd(Dt),global HIDDENDATA,HIDDENDATA=Dt,endfunction)",
- [], // 16.08.20from
- "function SetPart(Dt),global PARTITIONPT,PARTITIONPT=Dt,endfunction)",
- [],
- "function SetOther(Dt),global OTHERPARTITION,OTHERPARTITION=Dt,endfunction)",
- [],
- "if type(HIDDENDATA)~=15,HIDDENDATA=list(HIDDENDATA),end",[],
- "if type(PARTITIONPT)~=15,PARTITIONPT=list(PARTITIONPT),end",[],
- "if type(OTHERPARTITION)~=15,OTHERPARTITION=list(OTHERPARTITION),end",[],
- "for J=1:length(OTHERPARTITION)",[],
- " Tmp=OTHERPARTITION(J)",[],
- " OTHERPARTITION(J)=Tmp(:,1)",[],
- "end",[],
- "SetHidd(HIDDENDATA)",[],
- "SetPart(PARTITIONPT)",[],
- "SetOther(OTHERPARTITION)",[],
- "if type("+outstr+")~=15,"+outstr+"=list("+outstr+"),end",[], // 16.08.20upto
- name3+"=Wireparadata",concat([outstr,fd,wr1,wr2,"Error"],reL),
+ tmp1=textformat(wr1,6);
+ tmp1=Rsform(tmp1,1);
+ tmp2=textformat(wr2,6);
+ tmp2=Rsform(tmp2,1);
+ tmp=[sfstr,"fd"+nm,tmp1,tmp2];
+ reL=RSform(text(reL),2);
+ reL=substring(reL,5,length(reL)-1);
+ if(length(reL)>0,
+ reL=textformat(reL,4);
+ reL=substring(reL,1,length(reL)-1);
+ reL=Rsform(reL);
+ tmp=append(tmp,reL);
+ );
+ tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2];
+ tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]);
+ tmp2=replace(rfname,".txt",".dat");
+ cmdL=[
+ "print",[Dqq("wire"+nm)], //18.02.22
+ "fd"+nm+"="+fd,[],
+ "ReadOutData",[Dqq(rfname)],
+ "load",[Dqq(tmp2)],
+ "Addpoints",[Addpoints()],
+ name3+"=Wireparadata",tmp,
name2+"=Projpara",[name3],
- name3h+"=WireHiddenData()",[],
+ name3h+"=WIREHIDDENDATA",[],
name2h+"=Projpara",[name3h],
- "WriteOutData",tmp
- ]);
- options=append(options,"Wait="+text(waiting));
+ "WriteOutData",tmp1
+ ];
+ tmp=replace(fname,".txt","end.txt");
+ options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]);
if(wflg==1,options=concat(options,["m"]));
if(wflg==-1,options=concat(options,["r"]));
if(ErrFlag==0,
- CalcbyS("wire"+nm,cmdL,options);
+ CalcbyR("wire"+nm,cmdL,options);
);
if(ErrFlag==1,
err("Wireparadata not completed");
,
- if(outreg==1,
-// OutFileList=remove(OutFileList,[fname]);
-// OutFileList=append(OutFileList,fname);
- );
ReadOutData(fname);
- if(!islist(parse(name2)), ErrFlag=1);
- if(ErrFlag==0,
+ if(islist(parse(name2)),
Extractdata(name2,options);
if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]);
Extractdata(name2h,tmp);
+ ,
+ ErrFlag=1;
);
);
);
-Crvsfparadata(nm,gd,out,fd):=
- Crvsfparadata(nm,gd,out,fd,[],["nodisp"]);
-Crvsfparadata(nm,gd,out,fd,options):=
- Crvsfparadata(nm,gd,out,fd,options,["nodisp"]);
-Crvsfparadata(nm,gdstr,outstr,fdorg,optionorg,optionsh):=(
+Crvsfparadata(nm,crv,sf,fd):=
+ Crvsfparadata(nm,crv,sf,fd,[],["nodisp"]);
+Crvsfparadata(nm,crv,sf,fd,options):=
+ Crvsfparadata(nm,crv,sf,fd,options,["nodisp"]);
+Crvsfparadata(nm,crvstr,sfstr,fdorg,optionorg,optionsh):=(
//help:Crvsfparadata("1","ax3d","sfbd3d1",fd);
-//help:Crvsfparadata(options2=["Wait=20"]);
- regional(gd,out,fd,options,name2,name3,name2h,name3h,outreg,
- eqL,reL,strL,fname,gdfname,outfname,waiting,tmp,tmp1,tmp2,flg,wflg);
+//help:Crvsfparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]);
+ regional(gd,out,fd,options,name2,name3,name2h,name3h,
+ eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg);
+ tmp=replace(crvstr,"3d","2d");
+ Changestyle(tmp,["nodisp"]);
name2="crvsf2d"+nm;
name3="crvsf3d"+nm;
name2h="crvsfh2d"+nm;
name3h="crvsfh3d"+nm;
fname=Fhead+"crvsf"+nm+".txt";
- gdfname=Fhead+"crv"+nm+".txt";
- tmp=replace(outstr,"3d","");
- outfname=Fhead+tmp+".txt"; // 16.08.20
- gd=parse(gdstr);
- out=parse(outstr);
- if(!islist(out), ErrFlag=1);
- fd=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ rfname=Fhead+sfstr+".txt";
+ rfname=replace(rfname,"3d","");
+ tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ tmp=text(tmp);
+ fd=RSform(tmp,2);
options=optionorg;
tmp=Divoptions(options);
eqL=tmp_5;
reL=tmp_6;
strL=tmp_7;
- waiting=20;
- outreg=1;
+ waiting=120;
forall(eqL,
tmp=indexof(#,"=");
tmp1=Toupper(substring(#,0,1));
@@ -3495,11 +3453,6 @@ Crvsfparadata(nm,gdstr,outstr,fdorg,optionorg,optionsh):=(
waiting=parse(tmp2);
options=remove(options,[#]);
);
-// if(tmp1=="O",
-// tmp=Toupper(substring(tmp2,0,1));
-// if(tmp=="T" % tmp=="Y", outreg=1,outreg=0);
-// options=remove(options,[#]);
-// );
);
options=remove(options,reL);
wflg=0;
@@ -3514,111 +3467,188 @@ Crvsfparadata(nm,gdstr,outstr,fdorg,optionorg,optionsh):=(
options=remove(options,[#]);
);
);
- flg=0;
- tmp1=floor(5*1000/WaitUnit);
- repeat(tmp1,
- if(flg==0,
- tmp=load(Fhead+replace(outstr,"3d","")+".txt");
- if(length(tmp)>=4,
- tmp2=substring(tmp,length(tmp)-4,length(tmp));
- if(tmp2=="////",
- flg=1;
- );
- ,
- wait(WaitUnit);
- );
- );
- );
- if(flg==0,
- Err(outstr+" file not copleted");
- ErrFlag=1;
- );
- if(wflg==0,
- tmp=load(fname);
- if(length(tmp)==0,wflg=1);
- );
- if(ErrFlag==0,
-// Writeoutdata(outfname,["Gc",gd,"Out",out]);
-// wait(WaitUnit);
- );
- cmdL=MkprecommandS(5); // 16.02.01
- tmp=[
- Dq+fname+Dq,
- Dq+name3+Dq,name3,
- Dq+name2+Dq,name2,
- Dq+name3h+Dq,name3h,
- Dq+name2h+Dq,name2h
+ reL=RSform(text(reL),2);
+ reL=substring(reL,5,length(reL)-1);
+ tmp=[crvstr,sfstr,"fd"+nm];
+ if(length(reL)>0,
+ reL=textformat(reL,4);
+ reL=substring(reL,1,length(reL)-1);
+ reL=Rsform(reL);
+ tmp=append(tmp,reL);
+ );
+ tmp1=[DqDq(fname),DqDq(name3),name3,DqDq(name2),name2];
+ tmp1=concat(tmp1,[DqDq(name3h),name3h,DqDq(name2h),name2h]);
+ tmp2=replace(rfname,".txt",".dat");
+ cmdL=[
+ "print",[Dqq("crv"+nm)], //18.02.22
+ "fd"+nm+"="+fd,[],
+ "ReadOutData",[Dqq(rfname)],
+ "load",[Dqq(tmp2)],
+ "Addpoints",[Addpoints()]
];
- fd=apply(fd,if(isstring(#),replace(#,"_1","(1)"),#)); // 16.05.25 08.17from
- fd=apply(fd,if(isstring(#),replace(#,"_2","(2)"),#));
- fd=apply(fd,if(isstring(#),replace(#,"_3","(3)"),#)); // 16.05.25 08.17upto
+ tmp3=select(GLIST,indexof(#,crvstr+"=")>0); //18.02.22from
+ if(length(tmp3)==0,
+ tmp3=Fhead+crvstr+".txt";
+ tmp3=replace(tmp3,"3d","");
+ cmdL=concat(cmdL,[
+ "ReadOutData",[Dqq(tmp3)]
+ ]);
+ ); //18.02.22until
cmdL=concat(cmdL,[
- "disp('Running Crvsfparadata')",[],
- "tmp=ReadOutData",[Dq+outfname+Dq],
- "execstr(tmp)",[],
- "function SetHidd(Dt),global HIDDENDATA,HIDDENDATA=Dt,endfunction)",
- [], // 16.08.20from
- "function SetPart(Dt),global PARTITIONPT,PARTITIONPT=Dt,endfunction)",
- [],
- "function SetOther(Dt),global OTHERPARTITION,OTHERPARTITION=Dt,endfunction)",
- [],
- "if type(HIDDENDATA)~=15,HIDDENDATA=list(HIDDENDATA),end",[],
- "if type(PARTITIONPT)~=15,PARTITIONPT=list(PARTITIONPT),end",[],
- "if type(OTHERPARTITION)~=15,OTHERPARTITION=list(OTHERPARTITION),end",[],
- "for J=1:length(OTHERPARTITION)",[],
- " Tmp=OTHERPARTITION(J)",[],
- " OTHERPARTITION(J)=Tmp(:,1)",[],
- "end",[],
- "SetHidd(HIDDENDATA)",[],
- "SetPart(PARTITIONPT)",[],
- "SetOther(OTHERPARTITION)",[],
- "if type("+outstr+")~=15,"+outstr+"=list("+outstr+"),end",[], // 16.08.20upto
- name3+"=Crvsfparadata",concat([gdstr,outstr,fd,"Error"],reL),
+ name3+"=Crvsfparadata",tmp,
name2+"=Projpara",[name3],
- name3h+"=CrvsfHiddenData()",[],
+ name3h+"=CRVSFHIDDENDATA",[],
name2h+"=Projpara",[name3h],
- "WriteOutData",tmp
+ "WriteOutData",tmp1
]);
- options=append(options,"Wait="+text(waiting));
- if(wflg==1,options=concat(options,["m"]));
- if(wflg==-1,options=concat(options,["r"]));
+ tmp=replace(fname,".txt","end.txt");
+ options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]);
+ if(wflg==1,options=append(options,"m"));
+ if(wflg==-1,options=append(options,"r"));
if(ErrFlag==0,
- CalcbyS("crvsf"+nm,cmdL,options);
+ CalcbyR("crvsf"+nm,cmdL,options);
);
if(ErrFlag==1,
err("Crvsfparadata not completed");
,
- if(outreg==1,
- OutFileList=remove(OutFileList,[fname]);
- OutFileList=append(OutFileList,fname);
+ ReadOutData(fname);
+ if(islist(parse(name2)),
+ Extractdata(name2,options);
+ if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]);
+ Extractdata(name2h,tmp);
+ ,
+ ErrFlag=1;
);
+ );
+);
+
+Crvonsfparadata(nm,crv2d,sf,fd):=
+ Crvsonfparadata(nm,crv2d,sf,fd,[],["nodisp"]);
+Crvonsfparadata(nm,crv2d,sf,fd,options):=
+ Crvonsfparadata(nm,crv2d,sf,fd,options,["nodisp"]);
+Crvonsfparadata(nm,crv2dstr,sfstr,fdorg,optionorg,optionsh):=(
+//help:Crvonsfparadata("1",["[1,t]","t=[0,2*pi]","Num=50"],"sfbd3d1",fd);
+//help:Crvonsfparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]);
+ regional(gd,out,fd,options,name2,name3,name2h,name3h,
+ eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg);
+ name2="crvonsf2d"+nm;
+ name3="crvonsf3d"+nm;
+ name2h="crvonsfh2d"+nm;
+ name3h="crvonsfh3d"+nm;
+ fname=Fhead+"crvonsf"+nm+".txt";
+ rfname=Fhead+sfstr+".txt";
+ rfname=replace(rfname,"3d","");
+ tmp=apply(fdorg,if(isstring(#),Dqq(#),#));
+ tmp=text(tmp);
+ fd=RSform(tmp,2);
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ reL=tmp_6;
+ strL=tmp_7;
+ waiting=120;
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,1));
+ tmp2=substring(#,tmp,length(#));
+ if(tmp1=="W",
+ waiting=parse(tmp2);
+ options=remove(options,[#]);
+ );
+ );
+ options=remove(options,reL);
+ wflg=0;
+ forall(strL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="M",
+ wflg=1;
+ options=remove(options,[#]);
+ );
+ if(tmp=="R",
+ wflg=-1;
+ options=remove(options,[#]);
+ );
+ );
+ if(isstring(crv2dstr),
+ crv=Rsform(crv2dstr);
+ ,
+ crv=apply(crv2dstr,Dqq(#));
+ crv=Rsform(text(crv));
+ crv="Paramplot"+substring(crv,1,length(crv));
+ );
+ reL=RSform(text(reL),2);
+ reL=substring(reL,5,length(reL)-1);
+ tmp=["crv",sfstr,"fd"+nm];
+ if(length(reL)>0,
+ reL=textformat(reL,4);
+ reL=substring(reL,1,length(reL)-1);
+ reL=Rsform(reL);
+ tmp=append(tmp,reL);
+ );
+ tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2];
+ tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]);
+ tmp2=replace(rfname,".txt",".dat");
+ cmdL=[
+ "print",[Dqq("crvonsf"+nm)], //18.02.22
+ "fd"+nm+"="+fd,[],
+ "ReadOutData",[Dqq(rfname)],
+ "load",[Dqq(tmp2)],
+ "Addpoints",[Addpoints()],
+ "crv="+crv,[],
+ name3+"=Crvonsfparadata",tmp,
+ name2+"=Projpara",[name3],
+ name3h+"=HIDDENDATA",[],
+ name2h+"=Projpara",[name3h],
+ "WriteOutData",tmp1
+ ];
+ tmp=replace(fname,".txt","end.txt");
+ options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]);
+ if(wflg==1,options=append(options,"m"));
+ if(wflg==-1,options=append(options,"r"));
+ if(ErrFlag==0,
+ CalcbyR("crvonsf"+nm,cmdL,options);
+ );
+ if(ErrFlag==1,
+ err("Crvonsfparadata not completed");
+ ,
ReadOutData(fname);
- tmp=replace(gdstr,"3d","2d");
- Changestyle([tmp],["nodisp"]);
- Extractdata(name2,options);
- if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]);
- Extractdata(name2h,tmp);
- );
-);
-
-Intersectcrvsf(nm,gd,fd):=
- Intersectcrvsf(nm,gd,fd,[]);
-Intersectcrvsf(nm,gdstr,fdorg,optionorg):=(
-//help:Intersectcrvsf("1",ax3d_1,fd);
-//help:Intersectcrvsf(options=["Wait=10",50,0.05]);
- regional(name,gd,fd,options,reL,fname,gdfname,
- waiting,tmp,tmp1,tmp2,flg,wflg,pts);
- name="intpts"+nm;
+ if(islist(parse(name2)),
+ Extractdata(name2,options);
+ if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]);
+ Extractdata(name2h,tmp);
+ ,
+ ErrFlag=1;
+ );
+ );
+);
+
+Intersectcrvsf(nm,crv,fd):=Intersectcrvsf(nm,crv,fd,"",[]);
+Intersectcrvsf(nm,crv,fd,Arg):=(
+ if(isstring(Arg),
+ Intersectcrvsf(nm,crv,fd,Arg,[]);
+ ,
+ Intersectcrvsf(nm,crv,fd,"",Arg);
+ );
+);
+Intersectcrvsf(nm,crvstr,fdorg,bdyeq,optionorg):=(
+//help:Intersectcrvsf("1",curve,fd);
+//help:Intersectcrvsf("1",curve,fd,curveequation);
+//help:Intersectcrvsf(options=[Np([50,50]),Eps(0.01)]);
+ regional(name,crv,fd,options,reL,fname,crvfname,argR,
+ waiting,tmp,tmp1,tmp2,flg,wflg,pts); name="crvsf"+nm;
+ name="crvsf"+nm;
fname=Fhead+name+".txt";
- gdfname=Fhead+"crv"+nm+".txt";
- gd=parse(gdstr);
- fd=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ crvfname=Fhead+"crv"+nm+".txt";
+// crv=parse(crvstr);
+// crv=textformat(crv,6);
+// crv=Rsform(crv,2);
+ fd=apply(fdorg,if(isstring(#),Dqq(#),#));
options=optionorg;
tmp=Divoptions(options);
eqL=tmp_5;
reL=tmp_6;
strL=tmp_7;
- waiting=10;
+ waiting=120;
forall(eqL,
tmp=indexof(#,"=");
tmp1=Toupper(substring(#,0,1));
@@ -3641,68 +3671,149 @@ Intersectcrvsf(nm,gdstr,fdorg,optionorg):=(
options=remove(options,[#]);
);
);
- if(wflg>-1,
- Writeoutdata(gdfname,["Gd",gd]);
-// wait(WaitUnit);
+ tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ tmp=text(tmp);
+ fd=RSform(tmp,2);
+ tmp=textformat(reL,4);
+ tmp=substring(tmp,1,length(tmp)-1);
+ tmp=Rsform(tmp);
+ if(length(bdyeq)>0,
+ argR=","+Dqq(bdyeq);
+ ,
+ argR="";
+ );
+ if(length(tmp)>0,
+ argR=argR+","+tmp;
);
- fd=apply(fd,replace(#,"_1","(1)")); // 16.05.25from
- fd=apply(fd,replace(#,"_2","(2)"));
- fd=apply(fd,replace(#,"_3","(3)")); // 16.05.25upto
+ tmp1=[Dqq(fname),Dqq(name),"tmp"];
cmdL=[
- "disp('Finding Intersectcrvsf')",[],
- "Setangle",[THETA,PHI]*180/pi,
- "tmp=ReadOutData",[Dq+gdfname+Dq],
- "execstr(tmp)",[],
- "Intpts=Intersectcrvsf",concat(["Gd",fd,"Error"],reL),
- "tmp1='['",[],
- "for J=1:length(Intpts)",[],
- " tmp2=Intpts(J)",[],
- " for K=1:length(tmp2)",[],
- " if K==1",[],
- " tmp1=tmp1+'['",[],
- " end",[],
- " tmp1=tmp1+string(tmp2(K))",[],
- " if K<length(tmp2)",[],
- " tmp1=tmp1+','",[],
- " else",[],
- " tmp1=tmp1+']'",[],
- " end",[],
- " end",[],
- " if J<length(Intpts)",[],
- " tmp1=tmp1+','",[],
- " else",[],
- " tmp1=tmp1+']||||'",[], //16.08.09
- " end",[],
- "end",[],
- "fid=mopen('"+fname+"','w')",[],
- " mputl(tmp1,fid)",[],
- "mclose(fid)",[]
+ "print",[Dqq("crvsf"+nm)], //18.02.22
+ "crv="+crvstr,[],
+ "fd="+fd,[],
+ "tmp1=Intersectcrvsf(crv,fd"+argR+")",[],
+ "tmp=c()",[],
+ "for(j in Looprange(1,length(tmp1))){",[],
+ " tmp=Appendrow(tmp,tmp1[[j]])",[],
+ "}",[],
+ "WriteOutData",tmp1,
+ "tmp",[]
];
- options=append(options,"Wait="+text(waiting));
- if(wflg==1,options=concat(options,["m"]));
- if(wflg==-1,options=concat(options,["r"]));
+ tmp=replace(fname,".txt","end.txt");
+ options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]);
+ if(wflg==1,options=append(options,"m"));
+ if(wflg==-1,options=append(options,"r"));
+ if(ErrFlag==1,
+ err("Crvsfparadata not completed");
+ ,
+ CalcbyR("ans",cmdL,options);
+ ReadOutData(fname);
+ );
+ println("generate "+name);
+ parse(name);
+);
+
+Sfcutparadata(nm,eqstr,sf,fd):=
+ Sfcutparadata(nm,eqstr,sf,fd,[]);
+Sfcutparadata(nm,eqstr,sf,fd,options):=
+ Sfcutparadata(nm,eqstr,sf,fd,options,["nodisp"]);
+Sfcutparadata(nm,eqstr,sf,fdorg,optionorg,optionsh):=(
+//help:Sfcutparadata("1","x+y+z=1","sfbd3d1",fd,"x+y+z=1");
+//help:Sfcutparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]);
+ regional(gd,out,fd,options,name2,name3,name2h,name3h,
+ eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg);
+ tmp=replace(sfcut,"3d","2d");
+ Changestyle(tmp,["nodisp"]);
+ name2="sfcut2d"+nm;
+ name3="sfcut3d"+nm;
+ name2h="sfcuth2d"+nm;
+ name3h="sfcuth3d"+nm;
+ fname=Fhead+"sfcut"+nm+".txt";
+ rfname=Fhead+sf+".txt";
+ rfname=replace(rfname,"3d","");
+ tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#));
+ tmp=text(tmp);
+ fd=RSform(tmp,2);
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ reL=tmp_6;
+ strL=tmp_7;
+ waiting=120;
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,1));
+ tmp2=substring(#,tmp,length(#));
+ if(tmp1=="W",
+ waiting=parse(tmp2);
+ options=remove(options,[#]);
+ );
+ );
+ options=remove(options,reL);
+ wflg=0;
+ forall(strL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="M",
+ wflg=1;
+ options=remove(options,[#]);
+ );
+ if(tmp=="R",
+ wflg=-1;
+ options=remove(options,[#]);
+ );
+ );
+ reL=RSform(text(reL),2);
+ reL=substring(reL,5,length(reL)-1);
+ tmp=[Dqq(eqstr),sf,"fd"+nm];
+ if(length(reL)>0,
+ reL=textformat(reL,4);
+ reL=substring(reL,1,length(reL)-1);
+ reL=Rsform(reL);
+ tmp=append(tmp,reL);
+ );
+ tmp1=[DqDq(fname),DqDq(name3),name3,DqDq(name2),name2];
+ tmp1=concat(tmp1,[DqDq(name3h),name3h,DqDq(name2h),name2h]);
+ tmp2=replace(rfname,".txt",".dat");
+ cmdL=[
+ "print",[Dqq("sfcut"+nm)], //18.02.22
+ "fd"+nm+"="+fd,[],
+ "ReadOutData",[Dqq(rfname)],
+ "load",[Dqq(tmp2)],
+ name3+"=Sfcutparadata",tmp,
+ name2+"=Projpara",[name3],
+ name3h+"=CRVONSFHIDDENDATA",[],
+ name2h+"=Projpara",[name3h],
+ "WriteOutData",tmp1
+ ];
+ tmp=replace(fname,".txt","end.txt");
+ options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]);
+ if(wflg==1,options=append(options,"m"));
+ if(wflg==-1,options=append(options,"r"));
if(ErrFlag==0,
- CalcbyS(name,cmdL,options); // 16.08.14
+ CalcbyR("sfcut"+nm,cmdL,options);
);
if(ErrFlag==1,
- err("Intersectcrvsf not completed");
+ err("Sfcutparadata not completed");
,
- println(name+" obtained"); //16.08.14from
- pts=load(fname);
- pts=replace(pts,"||||","");
- tmp=name+"="+pts;
- parse(tmp);
- parse(pts); //16.08.14upto
+ ReadOutData(fname);
+ if(islist(parse(name2)),
+ Extractdata(name2,options);
+ if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]);
+ Extractdata(name2h,tmp);
+ ,
+ ErrFlag=1;
+ );
);
);
-////////////// new skeleton 2018.01.04from ////////////////
-
Skeletonparadata(nm):=Skeletondatacindy(nm,[]);
Skeletonparadata(nm,options):=Skeletondatacindy(nm,options);
Skeletonparadata(nm,pltdata1,pltdata2):=Skeletondatacindy(nm,pltdata1,pltdata2);
Skeletonparadata(nm,pltdata1org,pltdata2org,options):=
Skeletondatacindy(nm,pltdata1org,pltdata2org,options);
+
+
+////////////// new skeleton 2018.01.04 not completed and slow////////////////
+
Skeletondatacindy(nm):=Skeletondatacindy(nm,[]);
Skeletondatacindy(nm,options):=(
regional(tmp);
@@ -3791,10 +3902,9 @@ Makeskeletondata(ObjL,PltL,R0):=(
remov=[];
obj2=Projcurve(obj);
forall(1..(length(PltL)),nn,
-
plt=PltL_nn;
tmp=Projcurve(plt);
- koc=Intersectcurves(obj2,tmp);
+ koc=IntersectcurvesPp(obj2,tmp);
forall(1..(length(koc)),kk,
ptk=koc_kk;
tmp=PointonCurve(ptk_2,obj);
@@ -3894,7 +4004,363 @@ Makeskeletondata(ObjL,PltL,R0):=(
Allres;
);
-////////////// new skeleton 2018.01.04upto ////////////////
+////////////// current skeleton 2018.01.04 ////////////////
+
+Skeletondatacindy(nm):=Skeletondatacindy(nm,[]);
+Skeletondatacindy(nm,options):=(
+ regional(tmp);
+ tmp=Datalist3d();
+ Skeletondatacindy(nm,tmp,tmp,options);
+);
+Skeletondatacindy(nm,pltdata1,pltdata2):=
+ Skeletondatacindy(nm,pltdata1,pltdata2,[]);
+Skeletondatacindy(nm,pltdata1org,pltdata2org,options):=(
+//help:Skeletondatacindy("1");
+//help:Skeletondatacindy("1",[pdata1,pdata2],[pdata3]);
+//help:Skeletondatacindy(options2=[1(width)]);
+ regional(Eps,Eps2,name2,name3,Ltype,Noflg,reL,opcindy,
+ Out,ObjL,Plt3L,Rr,pltdata1,pltdata2,Plt2L,ObjL,ii,Data,
+ Obj3,jj,Gd,PtD,size,tmp,tmp1,tmp2);
+ name2="sk2d"+nm;
+ name3="sk3d"+nm;
+ pltdata1=[];// 16.01.31
+ forall(pltdata1org,tmp1,
+ tmp=parse(tmp1);
+ pltdata1=append(pltdata1,tmp);
+ );
+ pltdata2=[];// 16.01.31
+ forall(pltdata2org,tmp1,
+ tmp=parse(tmp1);
+ pltdata2=append(pltdata2,tmp);
+ );
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ reL=tmp_6; //16.02.28
+ opcindy=tmp_9;
+ Rr=0.075*1000/2.54/MilliIn;
+ size=1;
+ Eps2=0.05;
+ if(length(reL)>0, //16.02.28
+ size=reL_1;
+ Rr=size*Rr;
+ if(length(reL)>1,Eps2=reL_2);
+ );
+ Eps=10^(-4);
+ ObjL=Flattenlist(pltdata1);
+ Plt3L=Flattenlist(pltdata2);
+ tmp=apply(Plt3L,ProjcoordCurve(#));
+ Plt2L=Flattenlist(tmp);
+/////////// tmp=apply(pltdata1,replace(#,"3d","2d"));
+ Out=[];
+ forall(1..(length(ObjL)),ii,
+ Obj3=ObjL_ii;
+ tmp=ProjcoordCurve(Obj3);
+ Data=Makeskeletondata([tmp],Plt2L,Rr,Eps2);
+ forall(1..(length(Data)),jj,
+ Gd=Data_jj;
+ if((length(Gd)>1)
+ & (norm(Ptcrv(1,Gd)-Ptcrv(2,Gd))>Eps),
+ PtD=[];
+ forall(1..(length(Gd)),
+ tmp=Gd_#;
+ tmp1=Invparapt(tmp,Obj3);
+ PtD=append(PtD,tmp1);
+ );
+ Out=append(Out,PtD);
+ );
+ );
+ );
+ Out=select(Out,length(Projcurve(#))>0); // 16.12.19
+ tmp1=apply(Out,textformat(#,5));
+ tmp=name3+"="+tmp1;
+ parse(tmp);
+ tmp=name2+"=Projcurve("+tmp1+");";
+ parse(tmp);
+ Changestyle3d(pltdata1org,["nodisp"]);
+ if(Noflg<3,
+ println("generate skeleton :"+name3);
+ tmp1=text(pltdata1org);
+ tmp1="list("+substring(tmp1,1,length(tmp1)-1)+")";
+ tmp2=text(pltdata2org);
+ tmp2="list("+substring(tmp2,1,length(tmp2)-1)+")";
+ tmp=name3+"=Skeletonpara3data("+tmp1+","+tmp2+",";
+ tmp=tmp+text(size)+")";
+ GLIST=append(GLIST,tmp);
+ tmp=name2+"=Projpara("+name3+")";
+ GLIST=append(GLIST,tmp);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name2);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name2,Ltype,opcindy]);
+ if(SUBSCR==1,
+ Subgraph(name3,opcindy);
+ );
+ );
+ Out;
+);
+
+Makeskeletondata(Obj2L,Plt2L,R0,Eps2):=(
+ regional(Allres,Eps,Dmat,Dind,ii,Dt,nn1,nn2,Nind,Nobj,
+ Plt2,PhL,ClipL,ns,pt1,pt2,pt,pta,ptb,za,zb,z1,z2,t1,t2,te,
+ koc,KukanL,nn,tt,Rr,Flg,ii,jj,ptq,hh,Ku,Res,contflg,breakflg);
+ Eps=10.0^(-4);
+ Dmat=[];
+ Dind=[];
+ forall(1..(length(Plt2L)),ii,
+ Dt=Plt2L_ii;
+ nn1=length(Dmat)+1;
+ Dmat=concat(Dmat,Dt);
+ nn2=length(Dmat);
+ Dind=append(Dind,[nn1,nn2]);
+ );
+ Nind=length(Dind);
+ Allres=[];
+ forall(1..(length(Obj2L)),Nobj,
+ Plt2=Obj2L_Nobj;
+ PhL=Columnlist(Plt2,1..2);
+ ClipL=[];
+ forall(1..(length(PhL)-1),ns,
+ pt1=PhL_(ns..(ns+1));
+ forall(1..(length(Dind)),ii,
+ tmp=Dind_ii;
+ tmp=Dmat_(Dind_ii_1..Dind_ii_2);
+ pt2=Columnlist(tmp,1..2);
+ koc=IntersectcrvsPp(pt1,pt2,[Eps]);
+ if(length(koc)>0,
+ breakflg=0;
+ forall(1..(length(koc)),jj,
+ contflg=0;
+ if(breakflg==0,
+ pt=Op(1,Op(jj,koc));
+ tmp=Op(2,Op(jj,koc));
+ if((tmp<1+Eps) & (ns==1),
+ contflg=1;
+ );
+ if(contflg==0,
+ if((tmp>length(pt1)-Eps)
+ & (ns==length(PhL)-1),
+ contflg=1;
+ );
+ );
+ if(contflg==0,
+ nn1=ns;
+ nn2=Op(3,Op(jj,koc));
+ tmp=Plt2_nn1;
+ pta=tmp_(1..2);
+ za=tmp_3;
+ tmp=Plt2_(nn1+1);
+ ptb=tmp_(1..2);
+ zb=tmp_3;
+ if(norm(pta-ptb)<Eps,
+ contflg=1;
+ );
+ );
+ if(contflg==0,
+ t1=norm(pta-pt)/norm(pta-ptb);
+ z1=(1-t1)*za+t1*zb;
+ tmp=Dmat_(Dind_ii_1..Dind_ii_2);
+ tmp1=tmp_nn2;
+ pta=tmp1_(1..2);
+ za=tmp1_3;
+ tmp2=tmp_(nn2+1);
+ ptb=tmp2_(1..2);
+ zb=tmp2_3;
+ if(norm(pta-ptb)<Eps,
+ contflg=1;
+ );
+ );
+ if(contflg==0,
+ t2=norm(pta-pt)/norm(pta-ptb);
+ z2=(1-t2)*za+t2*zb;
+ if(z1<z2-Eps2,
+ if(length(ClipL)==0,
+ tmp=1;
+ ,
+ tmp1=column(ClipL,1);
+ tmp1=apply(tmp1,#-pt_1);
+ tmp2=column(ClipL,2);
+ tmp2=apply(tmp2,#-pt_2);
+ tmp3=apply(tmp1,#^2)+apply(tmp2,#^2);
+ tmp=min(tmp3);
+ );
+ if(tmp>Eps^2,
+ tmp1=pt1_2-pt1_1;
+ tmp2=ptb-pta;
+ tmp3=Dotprod(tmp1,tmp2);
+ tmp3=tmp3/norm(tmp1)/norm(tmp2);
+ tmp=1-0.5*tmp3^2;
+ tmp1=concat(pt,[nn1,t1,R0/tmp]);
+ ClipL=append(ClipL,tmp1);
+ );
+ );
+ );
+ );
+ );
+ );
+ );
+ );
+ te=length(Plt2);
+ KukanL=[[1.0,te]];
+ pt1=PhL;
+ if(length(ClipL)>0,
+ forall(1..(length(ClipL)),ii,
+ tmp=ClipL_ii;
+ pt=tmp_(1..2);
+ nn=tmp_3;
+ tt=nn+tmp_4;
+ Rr=tmp_5;
+ Flg=0;
+ breakflg=0;
+ forall(reverse(1..nn),jj,
+ contflg=0;
+ if(breakflg==0,
+ ptq=PointonCurve(jj,pt1);
+ if(norm(pt-ptq)<Rr,
+ contflg=1;
+ );
+ if(contflg==0,
+ Flg=jj;
+ breakflg=1;
+ contflg=1;
+ );
+ );
+ );
+ if(Flg==0,
+ t1=1;
+ ,
+ t1=Flg; t2=tt;
+ hh=t2-t1;
+ forall(1..10,
+ hh=hh*0.5;
+ ptq=PointonCurve(t1+hh,pt1);
+ if(norm(pt-ptq)<Rr,
+ t2=t2-hh;
+ ,
+ t1=t1+hh;
+ );
+ );
+ );
+ Ku=[t1];
+ Flg=0;
+ breakflg=0;
+ forall((nn+1)..te,jj,
+ contflg=0;
+ if(breakflg==0,
+ ptq=PointonCurve(jj,pt1);
+ if(norm(pt-ptq)<Rr,
+ contflg=1;
+ );
+ if(contflg==0,
+ Flg=jj;
+ breakflg=1;
+ contflg=1;
+ );
+ );
+ );
+ if(Flg==0,
+ t2=te;
+ ,
+ t1=tt; t2=Flg;
+ hh=t2-t1;
+ forall(1..10,
+ hh=hh*0.5;
+ ptq=PointonCurve(t1+hh,pt1);
+ if(norm(pt-ptq)<Rr,
+ t1=t1+hh;
+ ,
+ t2=t2-hh;
+ );
+ );
+ );
+ Ku=append(Ku,t2);
+ KukanL=Kukannozoku(Ku,KukanL);
+ );
+ );
+ Res=[];
+ forall(1..(length(KukanL)),ii,
+ tmp=KukanL_ii;
+ t1=tmp_1; nn1=floor(t1);
+ t2=tmp_2; nn2=floor(t2);
+ PtL=[];
+ if(t1-nn1<1-Eps,
+ tmp=PointonCurve(t1,pt1);
+ PtL=[tmp];
+ );
+ forall((nn1+1)..nn2,jj,
+ tmp=PointonCurve(jj,pt1);
+ PtL=append(PtL,tmp);
+ );
+ if(t2-nn2>Eps,
+ tmp=PointonCurve(t2,pt1);
+ PtL=append(PtL,tmp);
+ );
+ tmp=Listplot("",PtL,["nodata"]);
+ Res=append(Res,tmp);
+ );
+ Allres=concat(Allres,Res);
+ );
+ Allres;
+);
+
+Kukannozoku(Jokyo,KukanL):=(
+ regional(Res,Eps,nn,ii,t1,t2,Ku,Flg,contflg,tmp,tmp1);
+ Eps=10^(-6);
+ nn=length(KukanL);
+ t1=Jokyo_1; t2=Jokyo_2;
+ tmp=KukanL_1;
+ t1=max(t1,tmp_1);
+ tmp=KukanL_nn;
+ t2=min(t2,tmp_2);
+ Res=[];
+ Flg=0;
+ contflg=0;
+ forall(1..nn,ii,
+ if(contflg==0,
+ Ku=KukanL_ii;
+ if(Flg==0,
+ if(Ku_2<t1,
+ Res=append(Res,Ku);
+ ,
+ Flg=1;
+ if(Ku_1<t1-Eps,
+ tmp=[Ku_1,t1];
+ Res=append(Res,tmp);
+ );
+ if(Ku_2>t2+Eps,
+ tmp=[t2,Ku_2];
+ Res=append(Res,tmp);
+ );
+ );
+ ,
+ if(Flg==1,
+ if(Ku_2<t2,
+ contflg=1;
+ ,
+ if(contflg==0,
+ Flg=2;
+ if(Ku_1<t2-Eps,
+ Ku=[t2,Ku_2];
+ );
+ Res=append(Res,Ku);
+ );
+ );
+ ,
+ if(contflg==0,
+ Res=append(Res,Ku);
+ );
+ );
+ );
+ );
+ );
+ Res;
+);
+
+////////////////// end of current skeleton//////////////
ProjcoordCurve(Curve):=(
regional(SP,CP,ST,CT,Out,jj,pt,x,y,z,xz,yz,zz);
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt
index b573897b..167b36e1 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt
@@ -1,3 +1,21 @@
+//20180405
+// Ketinit changed (order of changesettiing, Dircdy)
+//20180402
+// Implicitplot, Connectseg added
+//20180329
+// Ketinit changed (changing of Dircdy)
+// Changesetting added
+// Derivative changed ( Numerical method supportted )
+//20180328
+// Cindyname (=Cdyname ) added
+// Cindyfile,Cindypath deleted
+//20180317
+// IntersectcurvesPp changed
+// Collectsameseg added, Collectnear commented out
+// 2018.02.11
+// Dqq added ( = DqDq)
+// 2018.02.06
+// Intersectpartseg debugged
// 2018.02.02
// Enclosing2 changed (for distanted curves, startpt option removed )
// 2018.02.01
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs
index e70be8b1..b7ba683a 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs
@@ -14,9 +14,9 @@
// along with this program. If not, see <http://www.gnu.org/licenses/>
//
-println("KETCindy V.3.1.5(2018.02.02");
+println("KETCindy V.3.2.0(20180405");
println(ketjavaversion());//17.06.05
-println("ketcindylibbasic1(2018.02.02) loaded");
+println("ketcindylibbasic1(20180402) loaded");
//help:start();
@@ -50,7 +50,7 @@ Ketinit(sy,rangex,rangey):=(
MARKLEN=0.05;
MARKLENInit=MARKLEN:
MARKLENNow= MARKLEN;
- GENTEN=[0,0];//18.01.15upto
+ GENTEN=[0,0];//18.01.15until
KETPICLAYER=20;
MilliIn=1/2.54*1000;
PenThick=round(MilliIn*0.02);
@@ -89,16 +89,32 @@ Ketinit(sy,rangex,rangey):=(
Fhead=replace(Fhead,".cdy","");
Slidename=Fhead; //17.10.24
);//17.11.12
- if(isstring(Dircdy) & iswindows(), //17.12.01
+ Dircdy=replace(Dircdy,"%E3%80%80"," ");//180405
+ tmp1=Indexall(Dircdy,"%"); //180329from
+ if(length(tmp1)>0,
+ tmp1=append(tmp1,length(Dircdy));
+ tmp2=substring(Dircdy,0,tmp1_1-1);
+ forall(1..(length(tmp1)-1),
+ tmp=substring(Dircdy,tmp1_#,tmp1_#+2);
+ tmp2=tmp2+unicode(tmp);
+ tmp2=tmp2+substring(Dircdy,tmp1_#+2,tmp1_(#+1)-1);
+ );
+ Dircdy=tmp2;
+ ); //180329to
+ if(iswindows(), //17.12.01
Dircdy=replace(Dircdy,"/",pathsep());
if(substring(Dircdy,0,1)==pathsep(),
Dircdy=substring(Dircdy,1,length(Dircdy));
);
+ Changesetting([gethome(), gethome()+"\Desktop","C:"]); //180405
+ ,
+ Changesetting([gethome(),gethome(),gethome()+"/Desktop"]);
);
+ Changework(Dircdy+pathsep()+"fig"); //180329to
Fnametex=Fhead+".tex";
FnameR=Fhead+".r";
FnamebodyR=Fhead+"body.r";
- Fnameout=Fhead+".txt"; // 17.10.13upto
+ Fnameout=Fhead+".txt"; // 17.10.13until
if(!isstring(Mackc),// 16.06.07
Mackc="sh";
);
@@ -107,7 +123,7 @@ Ketinit(sy,rangex,rangey):=(
,
Shellparent="/kc.sh";
if(!isexists(Dirwork,""),
- println(Dirwork+" not exist");
+ println(Dirwork+" not exists");
,
if(!iskcexists(Dirwork),
setdirectory(Dirwork);
@@ -142,9 +158,32 @@ Ketinit(sy,rangex,rangey):=(
);
if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0,
LibnameS=replace(LibnameS,"ketpic","ketpic2e");
- );//17.12.03upto
+ );//17.12.03until
);
+Changesetting(dirL):=( //180329
+ regional(fname,tmp1,flg);
+ fname="changesetting.txt";
+ tmp1=apply(dirL,#+pathsep()+"ketcindy");
+ tmp1=prepend(Dircdy,tmp1);
+ flg=0;
+ forall(tmp1,
+ if(flg==0,
+ if(isexists(#,fname),
+ setdirectory(#);
+ import(fname);
+ println(fname+" imported from "+#);
+ flg=1;
+ );
+ );
+ );
+ if(flg==0,
+ println(fname+" not exists in "+text(tmp1));
+ println(" Put "+fname+" in one of folders above");
+ );
+);
+
+Cindyname():=Getcdyname();
Cdyname():=Getcdyname();
Getcdyname():=( //17.12.27
//help:Cdyname();
@@ -206,62 +245,12 @@ Setparent(file):=( // 17.11.27
Texparent=file;
);
-Setcindyname():=Setcindyname("");//16.12.25
-Setcindyname(file):=(
-//help:Setcindyname("Fhead");
-//help:Setcindyname(<only when on the terminal "ketcindy/cindy.sh "+file>);
- regional(tmp,tmp1,tmp2);
- setdirectory(Dirhead);
- CindyPathName="";
- CindyFileName="";
- CindyPathName=load("cindypath.txt");
- tmp2=load("cindyfile.txt");
- tmp2=replace(tmp2,".cdy","");
- if(length(tmp2)>0,
- CindyFileName=tmp2;
- if(length(file)>0,
- tmp=file+"="+DqDq(tmp2);
- parse(tmp);
- println(file+" set to "+DqDq(tmp2));
- );
- ,
- println("set "+file+" manually");
- );
- setdirectory(Dirwork);
- CindyFileName;
-);
-
-Cindypath():=( // 16.12.26
-//help:Cindypath();
- regional(out);
- CindyPathName="";
- setdirectory(Dirhead);
- CindyPathName=load("cindypath.txt");
- setdirectory(Dirwork);
- if(length(CindyPathName)==0,
- out=Dirwork;
- ,
- out=CindyPathName;
- );
- println(" path name="+out);
- out;
+Dqq(str):=DqDq(str); //18.02.11
+DqDq(str):=(
+//help(Dqq("ab"); => Dq+"ab"+Dq)
+ unicode("0022")+str+unicode("0022");
);
-Cindyfile():=( // 16.12.26
-//help:Cindyfile();
- regional(out);
- CindyFileName="";
- setdirectory(Dirhead);
- out=load("cindyfile.txt");
- out=replace(out,".cdy","");
- setdirectory(Dirwork);
- CindyFileName=out;
- println(" file name="+out);
- out;
-);
-
-DqDq(str):=unicode("0022")+str+unicode("0022");
-
Tab2list(dtstr):=Tab2list(dtstr,[]);
Tab2list(dtstrorg,options):=(
//help:Tab2list(datastr);
@@ -282,7 +271,7 @@ Tab2list(dtstrorg,options):=(
if(tmp1=="B",
tmp1="0123456789+-."; // 16.09.28from
tmp=substring(tmp2,0,1);
- if(indexof(tmp1,tmp)>0,rep=parse(tmp2),rep=tmp2); // 16.09.28upto
+ if(indexof(tmp1,tmp)>0,rep=parse(tmp2),rep=tmp2); // 16.09.28until
);
if(tmp1=="S", // 16.12.04
if(tmp2!="tab",sep=tmp2);
@@ -293,13 +282,13 @@ Tab2list(dtstrorg,options):=(
first=crm;
if(indexof(dtstr,crm+lfm)>0,
first=first+lfm;
- ); // 16.09.05upto
+ ); // 16.09.05until
);
dtstr=dtstrorg;// 16.09.19from
tmp=substring(dtstr,length( dtstr)-1,length(dtstr));
if(tmp!=lfm,
dtstr=dtstr+first;
- );// 16.09.19upto
+ );// 16.09.19until
tmp1=Indexall(dtstr,first);
tmp1=prepend(0,tmp1);
tmp1=append(tmp1,length(dtstr));
@@ -455,7 +444,7 @@ Bracket(str,br):=(
ph=substring(br,0,1);
pt=substring(br,1,2);
noL=Indexall(str,ph);
- ncL=Indexall(str,pt); // 16.05.22upto
+ ncL=Indexall(str,pt); // 16.05.22until
nall=sort(concat(noL,ncL));
level=0;
out=[];
@@ -570,13 +559,6 @@ Pardiagram(str,options):=(
out;
);
-Changelib(path):=(
- Dirlib=path;
- setdirectory(Dirlib);
- import("ketcindyset.txt");
- setdirectory(Dirwork); // 16.04.23
-);
-
Changework(dirorg):=( //16.10.21
//help:Changework(directory);
regional(dir,subdir,tmp);
@@ -586,14 +568,14 @@ Changework(dirorg):=( //16.10.21
tmp=length(dir);
if(substring(dir,tmp-1,tmp)==pathsep(),
dir=substring(dir,0,tmp-1);
- );//17.11.20upto
+ );//17.11.20until
tmp=Indexall(dir,pathsep()); //17.11.24from
subdir="";
if(length(tmp)>0,
tmp=tmp_(length(tmp));
subdir=substring(dir,tmp,length(dir));
dir=substring(dir,0,tmp-1);
- ); //17.11.24upto
+ ); //17.11.24until
if(dir=="" % !isexists(dir,""),
println("Directory "+dir+" not exist, so set to "+Dirwork);
ErrFlag=-1;
@@ -603,7 +585,7 @@ Changework(dirorg):=( //16.10.21
Dirwork=dir+pathsep()+subdir;
,
Dirwork=dir;
- ); //17.11.24upto
+ ); //17.11.24until
setdirectory(Dirwork);
if(!iswindows(), //17.04.11
if(!iskcexists(Dirwork),
@@ -818,7 +800,7 @@ Textformat(value,dig):=(
if(length(tmp1)>1, //18.01.29from
tmp1=substring(tmp1,0,length(tmp1)-1);
);
- tmp1=tmp1+"]"; //18.01.29upto
+ tmp1=tmp1+"]"; //18.01.29until
,
if(ispoint(value) % isstring(value),
// vv=Lcrd(value);
@@ -924,7 +906,7 @@ MeasureDepth(list):=(
Flg=1;
,
tmp1=select(1..(length(list)),length(list_#)>0);//17.05.21from
- tmp=list_(tmp1_1);//17.05.21upto
+ tmp=list_(tmp1_1);//17.05.21until
);
repeat(4,
if(Flg==0,
@@ -1109,7 +1091,7 @@ Invert(nm,Fig,options):=(
name="-inv"+nm;
tmp=Invert(Fig);
Listplot(name,tmp,options);
-);// upto 16.01.27
+);// until 16.01.27
Paramoncrv(pP,Gdata):=(
regional(Tmp,PtL);
@@ -1412,7 +1394,7 @@ IntersectcrvsPp(Gr1,Gr2,options):=(
Out_#_1=(Out_#_1+Tmp2_1)/2;//17.04.14
);
);
- ); // 15.04.06 upto
+ ); // 15.04.06 until
Out;
);
@@ -1468,6 +1450,7 @@ Intersectseg(seg1org,seg2org,Eps1):=(
out=[-1];
,
tmp=Intersectline(p1,q1-p1,p2,q2-p2);
+println([1475,textformat(tmp,6)]);
if(islist(tmp_1),
pt=tmp_1; t=tmp_2; s=tmp_3;
if((t*(t-1)<Eps)&(s*(s-1)<Eps),
@@ -1475,7 +1458,7 @@ Intersectseg(seg1org,seg2org,Eps1):=(
,
t=min([max([t,0]),1]);
s=min([max([s,0]),1]);
- tmp3=[|p1-p2|,|p1-q2|,|p2-p1|,|p2-q1|]; //18.01.30from
+ tmp3=[|p1-p2|,|p1-q2|,|q1-p2|,|q1-q2|]; //18.01.30from
tmp1=[Op(2,q2-p2),-Op(1,q2-p2)];
tmp=Intersectline(p1,tmp1,p2,q2-p2);
if(islist(tmp_1),
@@ -1502,7 +1485,7 @@ Intersectseg(seg1org,seg2org,Eps1):=(
tmp3=append(tmp3,|tmp_1-q2|);
);
);
- out=[min(tmp3),pt,t,s]; //18.01.30upto
+ out=[min(tmp3),pt,t,s]; //18.01.30until
);
,
dist=tmp_1;
@@ -1645,7 +1628,7 @@ Intersectpartseg(crv1org,crv2org,ii,jj,Eps1,Eps2,Dist):=(
seg1=[os1_kk,os1_(kk+1)];
seg2=[os2_ll,os2_(ll+1)];
tmp=Intersectseg(seg1,seg2,Eps1);
- if(tmp_1<Eps1,
+ if((tmp_1<Eps1)&(length(tmp)>1), //18.02.06
if(tmp_1<dst+Eps,
dst=tmp_1;
tmp2=select(tmp2,#_1<dst);
@@ -1676,6 +1659,8 @@ Intersectpartseg(crv1org,crv2org,ii,jj,Eps1,Eps2,Dist):=(
out;
);
+if(1==0,
+
Collectnear(ptdL,Eps2):=(
regional(Eps,gL,rL,numL,ii,jj,flg,tmp,tmp1);
Eps=10^(-4);
@@ -1704,6 +1689,52 @@ Collectnear(ptdL,Eps2):=(
[gL,rL];
);
+);
+
+Collectsameseg(ptdL):=(
+ regional(Eps,gL,rL,numL,ii,jj,flg,tmp,tmp1,tmp2,tmp1md,
+ dst,kk,s1,e1,s2,e2);
+ Eps00=10^(-8);
+ if(length(ptdL)==0,
+ gL=[];rL=[];
+ ,
+ tmp1md=[ptdL_1];
+ rL=ptdL_(2..(length(ptdL)));
+ tmp1=tmp1md_1;
+ kk=floor(tmp1_2);
+ if(tmp1_2<kk+Eps00,
+ s1=kk-1-Eps00; e1=s1+2+2*Eps00;
+ ,
+ s1=kk-Eps00; e1=s1+1+2*Eps00;
+ );
+ kk=floor(tmp1_3);
+ if(tmp1_3<kk+Eps00,
+ s2=kk-1-Eps00; e2=s2+2+2*Eps00;
+ ,
+ s2=kk-Eps00; e2=s2+1+2*Eps00;
+ );
+ numL=[];
+ forall(1..(length(rL)),ii,
+ tmp=rL_ii;
+ tmp1=tmp_2;tmp2=tmp_3;
+ if((tmp1>s1)&(tmp1<e1)&(tmp2>s2)&(tmp2<e2),
+ tmp1md=append(tmp1md,tmp);
+ numL=append(numL,ii);
+ );
+ );
+ gL=[];
+ tmp=apply(tmp1md,#_4);
+ dst=min(tmp);
+ forall(tmp1md,
+ if(#_4<dst+Eps00,
+ gL=append(gL,#);
+ );
+ );
+ rL=remove(rL,rL_(numL));
+ );
+ [gL,rL];
+);
+
IntersectcurvesPp(crv1org,crv2org):=IntersectcurvesPp(crv1org,crv2org,[]);
IntersectcurvesPp(crv1org,crv2org,options):=(
//help:IntersectcurvesPp(crv1,crv2);
@@ -1741,7 +1772,7 @@ IntersectcurvesPp(crv1org,crv2org,options):=(
if(|tmp-#|>Eps,
crv2=append(crv2,#);
);
- );//18.01.05upto
+ );//18.01.05until
if(crv1==crv2,
self=1;
,
@@ -1778,7 +1809,7 @@ IntersectcurvesPp(crv1org,crv2org,options):=(
flg=0;
forall(1..(length(tmp2)),
if(flg==0,
- tmp=Collectnear(tmp1,Eps2);
+ tmp=Collectsameseg(tmp1);
out=append(out,tmp_1);
if(length(tmp_2)==0,
flg=1;
@@ -1796,7 +1827,7 @@ IntersectcurvesPp(crv1org,crv2org,options):=(
dst=min(tmp);
tmp1=select(tmp1,#_4<dst+Eps);
tmp=apply(tmp1,#_1);
- tmp=sum(tmp)/length(tmp1);
+ tmp=sum(tmp)/length(tmp);
tmp2=[tmp];
tmp=Nearestpt(tmp2_1,crv1org);
tmp2=append(tmp2,tmp_2);
@@ -1885,7 +1916,7 @@ Nearestpt(point,PL2):=(
if(Sm<Ans_5, // 16.05.03from
Ans=[pA,Nn,Pm,Lm,Sm];
);
- ); // 16.05.03upto
+ ); // 16.05.03until
);
if(Flg==0,
Ans=Ans_(3..5);
@@ -1893,14 +1924,38 @@ Nearestpt(point,PL2):=(
Ans;
);
-Derivative(fun,var,value):=(
+Derivative(fun,var,value):=Derivative(fun,var,value,[]);
+Derivative(fun,var,value,options):=(
//help:Derivative("x^3","x",2);
- regional(str,tmp);
- str="d(";
- str=str+replace(fun,var,"#")+",";
- str=str+value+")";
- tmp=Pcrd([1,parse(str)]); // 14.11.08
- tmp_2;
+ regional(eqL,method,eps,str,x1,x2,y1,y2,tmp,tmp1,tmp2);
+ method="N";
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ forall(eqL,
+ tmp=substring(#,"=");
+ tmp1=Toupper(substring(#,0,1));
+ tmp2=substring(#,tmp,tmp+1);
+ if(tmp1=="M",
+ method=Toupper(tmp2);
+ );
+ );
+ if(method=="D",
+ str="d(";
+ str=str+replace(fun,var,"#")+",";
+ str=str+value+")";
+ tmp=Pcrd([1,parse(str)]); // 14.11.08
+ tmp_2;
+ );
+ if(method=="N",
+ eps=10^(-6);
+ x1=max(XMIN,value-eps);
+ x2=min(XMAX,value+eps);
+ tmp=Assign(fun,[var,format(x1,6)]);
+ y1=parse(tmp);
+ tmp=Assign(fun,[var,format(x2,6)]);
+ y2=parse(tmp);
+ (y2-y1)/(x2-x1);
+ );
);
Integrate(pltdata,range):=Integrate(pltdata,range,[]);
@@ -3006,7 +3061,7 @@ AddGraph(nm,pltdata,options):=(
);
GLIST=append(GLIST,tmp1);
);
- ); // 16.04.04 upto
+ ); // 16.04.04 until
if(Noflg<2,
if(isstring(Ltype),
Ltype=GetLinestyle(text(Noflg)+Ltype,name);
@@ -3259,7 +3314,7 @@ Pointdata(nm,listorg,options):=(
);
tmp2=tmp2+tmp+",";
);
- tmp2=substring(tmp2,0,length(tmp2)-1)+")"; //17.10.10upto
+ tmp2=substring(tmp2,0,length(tmp2)-1)+")"; //17.10.10until
);
GLIST=append(GLIST,name+"=Pointdata("+tmp2+")");
);
@@ -3273,7 +3328,7 @@ Pointdata(nm,listorg,options):=(
thick=PenThick/PenThickInit; // 16.04.09 from
if(length(size)>0,tmp1=parse(size),tmp1=1);
tmp1=max(tmp1,1)/8;
- Setpen(tmp1); // 16.04.09 upto
+ Setpen(tmp1); // 16.04.09 until
Com2nd("Drwpt(list("+name+")"+opstr+")");
Setpen(thick); // 16.04.09
if(length(size)>0,
@@ -3294,7 +3349,7 @@ Listplot(nm,list,options):=(
name=substring(nm,1,length(nm));
,
name="sg"+nm;
- ); // upto
+ ); // until
tmp=Divoptions(options);
Ltype=tmp_1;
Noflg=tmp_2;
@@ -3344,7 +3399,7 @@ Listplot(Arg1,Arg2):=(
name="";
forall(list, // 16.10.07from
name=name+#.name;
- );// 16.10.07upto
+ );// 16.10.07until
Listplot(name,list,options);
);
);
@@ -3407,7 +3462,7 @@ Lineplot(Arg1,Arg2):=(
name="";
forall(list, // 16.10.07from
name=name+#.name;
- );// 16.10.07upto
+ );// 16.10.07until
Lineplot(name,list,options);
);
);
@@ -3718,6 +3773,195 @@ Paramplot(name1,funstr,variable,options):=(
);
);
+Connectseg(Pdata):=(
+ regional(Eps,PlotL,vL,ctr,qd,ah,ao,flg,jj,
+ pp,qq,tmp,tmp1,tmp2);
+ Eps=10^(-4);
+ PlotL=[Pdata_1];
+ vL=2..(length(Pdata));
+ ctr=0;
+ while((length(vL)>0)&(ctr<1000),
+ ctr=ctr+1;
+ qd=PlotL_(length(PlotL));
+ ah=qd_1; ao=qd_(length(qd));
+ flg=0;
+ forall(1..(length(vL)),jj,
+ if(flg==0,
+ tmp1=Pdata_(vL_jj);
+ pp=tmp1_1; qq=tmp1_(length(tmp1));
+ if(Norm(pp-ao)<Eps,
+ tmp=tmp1_(2..(length(tmp1)));
+ if(length(tmp)>0,
+ qd=concat(qd,tmp);
+ );
+ PlotL_(length(PlotL))=qd;
+ vL=remove(vL,[vL_jj]);
+ flg=1;
+ );
+ );
+ if(flg==0,
+ if(Norm(qq-ao)<Eps,
+ tmp=tmp1_(1..(length(tmp1)-1));
+ tmp=reverse(tmp);
+ qd=concat(qd,tmp);
+ PlotL_(length(PlotL))=qd;
+ vL=remove(vL,[vL_jj]);
+ flg=1;
+ );
+ );
+ if(flg==0,
+ if(Norm(pp-ah)<Eps,
+ tmp=tmp1_(2..(length(tmp1)));
+ qd=concat(tmp,qd);
+ PlotL_(length(PlotL))=qd;
+ vL=remove(vL,[vL_jj]);
+ flg=1;
+ );
+ );
+ if(flg==0,
+ if(Norm(qq-ah)<Eps,
+ tmp=tmp1_(1..(length(tmp1)-1));
+ tmp=reverse(tmp);
+ qd=concat(tmp,qd);
+ PlotL_(length(PlotL))=qd;
+ vL=remove(vL,[vL_jj]);
+ flg=1;
+ );
+ );
+ );
+ if(flg==0,
+ PlotL=concat(PlotL,Pdata_(vL_1));
+ vL=remove(vL,[vL_1]);
+ );
+ );
+ PlotL;
+);
+
+Implicitplot(name1,func,xrng,yrng):=Implicitplot(name1,func,xrng,yrng,[]);
+Implicitplot(name1,func,xrng,yrng,options):=(
+//help:Implicitplot("1","x^2+x*y+y^2=1","x=[-3,3]","y=[-3,3]");
+//help:Implicitplot(options=["Num=[50,50]"]);
+ regional(name,Fn,varx,vary,rngx,rngy,Mdv,Ndv,tmp,tmp1,tmp2,
+ Eps,Ltype,Noflg,eqL,opsr,opcindy,dx,dy,out,jj,ii,kk,
+ yval1,yval2,xval1,xval2,eval11,eva12,eval21,eval22,pL,vL,qL);
+ name="imp"+name1;
+ Eps=10^(-4);
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ eqL=tmp_5;
+ opstr=tmp_(length(tmp)-1);
+ opcindy=tmp_(length(tmp));
+ Mdv=50;Ndv=50;
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,tmp-1));
+ tmp2=substring(#,tmp,length(#));
+ opstr=opstr+",'"+#+"'";
+ if(substring(#,0,1)=="N",
+ Mdv=parse(tmp2);
+ if(!islist(Mdv),
+ Ndv=Mdv;
+ ,
+ Ndv=Mdv_2;
+ Mdv=Mdv_1;
+ );
+ );
+ );
+ tmp=indexof(func,"=");
+ if(tmp==0,
+ Fn=func;
+ ,
+ tmp1=substring(func,0,tmp-1);
+ tmp2=substring(func,tmp,length(func));
+ Fn=tmp1+"-("+tmp2+")";
+ );
+ tmp=indexof(xrng,"=");
+ varx=substring(xrng,0,tmp-1);
+ rngx=parse(substring(xrng,tmp,length(xrng)));
+ tmp=indexof(yrng,"=");
+ vary=substring(yrng,0,tmp-1);
+ rngy=parse(substring(yrng,tmp,length(yrng)));
+ tmp="Impfun("+varx+","+vary+"):="+Fn;
+ parse(tmp);
+ dx=(rngx_2-rngx_1)/Mdv;
+ dy=(rngy_2-rngy_1)/Ndv;
+ out=[];
+ forall(1..Ndv,jj,
+ yval1=rngy_1+(jj-1)*dy;
+ yval2=rngy_1+jj*dy;
+ xval1=rngx_1;
+ eval11=Impfun(xval1,yval1);
+ eval12=Impfun(xval1,yval2);
+ forall(1..Mdv,ii,
+ xval2=rngx_1+ii*dx;
+ eval21=Impfun(xval2,yval1);
+ eval22=Impfun(xval2,yval2);
+ pL=[[xval1,yval1]];vL=[eval11];
+ pL=append(pL,[xval2,yval1]);vL=append(vL,eval21);
+ pL=append(pL,[xval2,yval2]);vL=append(vL,eval22);
+ pL=append(pL,[xval1,yval2]);vL=append(vL,eval12);
+ pL=append(pL,[xval1,yval1]);vL=append(vL,eval11);
+ qL=[];
+ forall(1..4,kk,
+ if(abs(vL_kk)<=Eps,
+ qL=append(qL,pL_kk);
+ ,
+ if(vL_kk>Eps,
+ if(vL_(kk+1)< -Eps,
+ tmp=1/(vL_kk-vL_(kk+1))*
+ (-vL_(kk+1)*pL_kk+vL_kk*pL_(kk+1));
+ qL=append(qL,tmp);
+ );
+ ,
+ if(vL_(kk+1)>Eps,
+ tmp=1/(-vL_kk+vL_(kk+1))*
+ (vL_(kk+1)*pL_kk-vL_kk*pL_(kk+1));
+ qL=append(qL,tmp);
+ );
+ );
+ );
+ );
+ xval1=xval2;
+ eval11=eval21;
+ eval12=eval22;
+ if(length(qL)==2,
+ out=append(out,qL);
+ );
+ );
+ );
+ if(length(out)>0,
+ out=Connectseg(out);
+ );
+ if(length(out)==1,
+ out=out_1;
+ );
+ if(Noflg<3,
+ println("generate Implicitplotdata "+name);
+ if(MeasureDepth(out)==1,
+ tmp1=apply(out,Pcrd(#));
+ ,
+ tmp1=[];
+ forall(out,tmp2,
+ tmp1=append(tmp1,apply(tmp2,Pcrd(#)));
+ );
+ );
+ tmp=name+"="+textformat(tmp1,5);
+ parse(tmp);
+ tmp=name+"=Implicitplot('"+func+"','"+xrng+"','"+yrng+"'"+opstr+")";
+ GLIST=append(GLIST,tmp);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ out;
+);
+
Circledata(cenrad):=Circledata(cenrad,[]);
Circledata(para1,para2):=(
//help:Circledata([A,B],["Rng=[0,pi/2]"]);
@@ -3733,7 +3977,7 @@ Circledata(para1,para2):=(
name="";// 16.10.07from
forall(cenrad,
name=name+#.name;
- );// 16.10.07upto
+ );// 16.10.07until
);
Circledata(name,cenrad,options);
);
@@ -3832,7 +4076,7 @@ Framedata(list):=(
,
Framedata(list,[]);
);
-);//16.10.29upto
+);//16.10.29until
Framedata(Arg1,Arg2):=(
regional(name,list,options,str);
if(isstring(Arg1),
@@ -3845,7 +4089,7 @@ Framedata(Arg1,Arg2):=(
name="";// 16.10.07from
forall(list,
name=name+#.name;
- );// 16.10.07upto
+ );// 16.10.07until
Framedata(name,list,options);
);
);
@@ -4405,7 +4649,7 @@ Arrowhead(point,Houkou,options):=(
);
tmp=PenThick/PenThickInit;
opstr=opstr+","+text(tmp);
- ); // 16.04.09 upto
+ ); // 16.04.09 until
Com2nd("Arrowhead("+ptstr+","+hostr+opstr+")");
);
);
@@ -4437,6 +4681,7 @@ Arrowdata(Arg1,Arg2):=(
);
Arrowdata(Arg1,Arg2,options):=(
//help:Arrowdata([A,B],[2,10]);
+//help:Arrowdata("1",[p1,p2]);
regional(Retflg,nm,ptlist,name,opstr,opcindy,realL,strL,size,
flg,Ltype,Noflg,lineflg,tmp,tmp1,tmp2,pA,pB,segpos);
Retflg=0;
@@ -4482,7 +4727,7 @@ Arrowdata(Arg1,Arg2,options):=(
tmp=tmp2-0.2*size/2*(tmp2-tmp1)/|tmp2-tmp1|; // 15.06.11
,
tmp=tmp2;
- ); // 16.04.09 upto
+ ); // 16.04.09 until
tmp=[LLcrd(tmp1),LLcrd(tmp)];//16.10.20
GLIST=append(GLIST,name+"=Listplot("+textformat(tmp,5)+")");
);
@@ -4558,7 +4803,7 @@ Anglemark(Arg1,Arg2):=( // 2015.04.28 from
nm=substring(tmp,1,length(tmp)-1);
Anglemark(nm,plist,options);
);
-); // upto
+); // until
Anglemark(nm,plist,options):=(
//help:Anglemark([A,B,C],["E=\theta",2]);
//help:Anglemark("1",[A,B,C],["E=1.2,\theta",2]);
@@ -4611,7 +4856,7 @@ Anglemark(nm,plist,options):=(
tmp1=Ctr+Brat*ra*[cos(Th),sin(Th)];
tmp="Defvar("+Dq+Bpos+"=";
tmp=tmp+textformat(tmp1,5)+Dq+");";
- parse(tmp);//16.10.31upto(moved)
+ parse(tmp);//16.10.31until(moved)
if(length(Bname)>0,
parse(Bname);
);
@@ -4652,7 +4897,7 @@ Paramark(Arg1,Arg2):=( // 17.03.27 from
nm=substring(tmp,1,length(tmp)-1);
Paramark(nm,plist,options);
);
-);// upto
+);// until
Paramark(nm,plist,options):=(
//help:Paramark([A,B,C],["E=\theta"]);
//help:Paramark("1",[p1,p2,p3],["E=\theta"]);
@@ -4745,7 +4990,7 @@ Bowdata(plist,options):=(
nm=plist;
tmp=options;
Bowdata(nm,tmp,[]);
- ); // 16.12.04upto
+ ); // 16.12.04until
);
Bowdata(nm,plist,options):=(
//help:Bowdata([C,A],[2,1.2,"Expr=10","da"]);
@@ -4770,7 +5015,7 @@ Bowdata(nm,plist,options):=(
Tmov=0;//16.11.01from
Nmov=0;
Bmov="";
- rev=0;//16.11.01upto
+ rev=0;//16.11.01until
if(length(realL)>0,
Hgt=realL_1*Hgt; // 15.04.12
if(length(realL)>1,Cut=realL_2);
@@ -4801,7 +5046,7 @@ Bowdata(nm,plist,options):=(
BOWMIDDLE=[pC_1+ra*cos(Th),pC_2+ra*sin(Th)];
Bpos="md"+name; // 16.10.31from(moved)
tmp="Defvar("+Dq+Bpos+"="+textformat(BOWMIDDLE,5)+Dq+");";
- parse(tmp);// 16.10.31upto(moved)
+ parse(tmp);// 16.10.31until(moved)
if(length(Bname)>0, //16.11.01from
tmp=indexof(Bops,",");
if(tmp>0,
@@ -4843,7 +5088,7 @@ Bowdata(nm,plist,options):=(
);
Bname=Bname+Dq+Bops+Dq+")";
parse(Bname);
- );//16.11.01upto
+ );//16.11.01until
if(Cut==0,
Th1=Ydata_3;
Th2=Ydata_4;
@@ -5234,7 +5479,7 @@ EnclosingS(nm,plist,options):=(
tmp1=tmp1+#+",";
);
tmp=tmp+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")";
- GLIST=append(GLIST,tmp);//16.11.07upto
+ GLIST=append(GLIST,tmp);//16.11.07until
// GLIST=append(GLIST,"Tmp=[]"); // 16.11.05from
// nn=floor(length(AnsL)/20);
// forall(1..nn,ii,
@@ -5249,7 +5494,7 @@ EnclosingS(nm,plist,options):=(
// tmp="Tmp=[Tmp,"+textformat(tmp,5)+"]";
// GLIST=append(GLIST,tmp);
// );
-// GLIST=append(GLIST,name+"=Listplot(Tmp)"); // 16.11.05upto
+// GLIST=append(GLIST,name+"=Listplot(Tmp)"); // 16.11.05until
);
if(Noflg<2,
if(isstring(Ltype),
@@ -5320,7 +5565,7 @@ Enclosing2(nm,plistorg,options):=(
tmp=Listplot(name,[tmp1,tmp2],["nodisp"]);
plist=append(plist,"sg"+name);
Start=tmp2;
- tst=1; //18.02.02upto
+ tst=1; //18.02.02until
,
if(length(KL)==1,
tst=KL_1_2;
@@ -5359,7 +5604,7 @@ Enclosing2(nm,plistorg,options):=(
parse(tmp);
plist_nxtno=Gdata;
t2=Length(tmp1);
- ss=1; //18.02.02upto
+ ss=1; //18.02.02until
,
t2=KL_1_2;
ss=KL_1_3;
@@ -5397,7 +5642,7 @@ Enclosing2(nm,plistorg,options):=(
tmp1=tmp1+#+",";
);
tmp=tmp+substring(tmp1,0,length(tmp1)-1)+"))";//18.02.02
- GLIST=append(GLIST,tmp);//16.11.07upto
+ GLIST=append(GLIST,tmp);//16.11.07until
);
if(Noflg<2,
if(isstring(Ltype),
@@ -5647,7 +5892,7 @@ Shade(plist,options):=(
forall(plist,
if(flg==0,
if(isstring(#),tmp=parse(#),tmp=#); // from 16.01.24
- if(!islist(tmp),flg=1); upto
+ if(!islist(tmp),flg=1); until
);
);
if(flg==1,
@@ -5669,7 +5914,7 @@ Shade(plist,options):=(
);
,
tmp1=tmp1+"Listplot("+textformat(#,5)+"),";
- ); // upto 16.01.24
+ ); // until 16.01.24
);
Str=Str+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")";
Com2nd(Str);
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt
index 428c5b30..3bdf66fc 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt
@@ -1,3 +1,20 @@
+//20180405
+// Makebat debugged
+//20180404
+// Tlistplot changed ("Msg");
+// WritetoRS debugged ( openfie(..,Cdy= ))
+//20180403
+// WritetoRS, Makebat changed (for Zenkaku)
+// Convsjiswin removed
+// Mkslidesummary debugged
+//20180401
+// Convsjiswin added
+// Makebat changed (for convsjis )
+//20180330
+// Presentation changed (for wallpaper )
+// Settitle changed (Title option )
+//20180303
+// Letter debugged (for ` )
//2017.12.24
// IftoR, FortoR,Deffun rewritten
//2017.12.23
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs
index 5c8381af..1b9311bd 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs
@@ -1,5011 +1,5048 @@
-// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
-//
-//This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation; either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see <http://www.gnu.org/licenses/>
-//
-
-println("ketcindybasic2(2017.12.24) loaded");
-
-//help:start();
-
-Dispchoice():=(
- if(islist(Ch),
- if(!isreal(ChNum),ChNum=1);
- drawtext(mouse().xy,"Ch="+text(Ch)+" N="+text(ChNum),size->24,color->[0,0,1]);
- );
-);
-
-Datetime():=(
-//help:Datetime();
- regional(names,dt,tmp);
- tmp=getdatetime();
- dt=tokenize(tmp," ");
- dt=apply(dt,if(!isstring(#),text(#),#));
- names=["Jan","Feb","Mar","Apr","May","Jun",
- "Jul","Aug","Sep","Oct","Nov","Dec"];
- tmp=select(1..12,names_#==dt_2);
- tmp=text(tmp_1);
- tmp=[dt_6+"/"+tmp+"/"+dt_3,dt_4];
-);
-
-Rotatepoint(point,Theta,ctr):=(
-//help:Rotatepoint(A,2*pi/3,B);
- regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- tmp=Lcrd(ctr);
- Cx=tmp_1; Cy=tmp_2;
- X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta);
- Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta);
- [X2,Y2];
-);
-
-Translatepoint(point,mov):=(
-//help:Translatepoint(A,[2,3]);
- regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- tmp=Lcrd(mov);
- Cx=tmp_1; Cy=tmp_2;
- X2=X1+Cx;
- Y2=Y1+Cy;
- [X2,Y2];
-);
-
-Scalepoint(point,ratio,center):=(
-//help:Scalepoint(A,[3,2],[0,0]);
- regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- tmp=Lcrd(center);
- Cx=tmp_1; Cy=tmp_2;
- X2=Cx+ratio_1*(X1-Cx);
- Y2=Cy+ratio_2*(Y1-Cy);
- [X2,Y2];
-);
-
-Reflectpoint(point,symL):=(
-//help:Reflectpoint(A,B);
-//help:Reflectpoint(A,[[2,3]]);
-//help:Reflectpoint(A,[C,E]);
- regional(X1,X2,Y1,Y2,Us,Vs,Pt1,Pt2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- Pt1=Lcrd(symL_1);
- if(length(symL)==1,
- Pt2=Pt1;
- ,
- Pt2=Lcrd(symL_2);
- );
- Us=Pt2_1-Pt1_1;
- Vs=Pt2_2-Pt1_2;
- if(Pt1==Pt2,
- X2=2*Pt1_1-X1;
- Y2=2*Pt1_2-Y1;
- ,
- X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1
- -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1
- +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- );
- [X2,Y2];
-);
-
-Rotatedata(nm,plist,Theta):=Rotatedata(nm,plist,Theta,[]);
-Rotatedata(nm,plist,angle,options):=(
-//help:Rotatedata("1","crAB",pi/3,[[1,5],"dr,2"]);
- regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdLL,PdL,
- opcindy,Nj,Njj,Kj,Mj,X1,Y1,X2,Y2,Ltype,Noflg,name);
- name="rt"+nm;
- Pt=[0,0];
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- tmp1=tmp_6;
- if(length(tmp1)>0,Pt=Lcrd(tmp1_1));
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- if(isstring(angle),Theta=parse(angle),Theta=angle);
- Cx=Pt_1; Cy=Pt_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==0,Kj=[Kj]); //17.11.24
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X1=tmp_1;
- Y1=tmp_2;
- X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta);
- Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta);
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Rotatedata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1);// 17.12.23(2lines)
- tmp=name+"=Rotatedata("+tmp1+","
- +textformat(angle,5)+","+RSform(textformat(Pt,5))+")"; //17.12.23
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Translatedata(nm,plist,mov):=Translatedata(nm,plist,mov,[]);
-Translatedata(nm,plist,mov,options):=(
-//help:Translatedata("1",["gr1"],[1,2]);
- regional(tmp,tmp1,tmp2,pdata,Cx,Cy,PdL,Nj,Njj,Kj,
- opcindy,X2,Y2,Ltype,Noflg,name);
- name="tr"+nm;
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- tmp=Lcrd(mov);
- Cx=tmp_1; Cy=tmp_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X2=tmp_1+Cx;
- Y2=tmp_2+Cy;
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Translatedata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1);// 17.12.23
- tmp=name+"=Translatedata("+tmp1+","+RSform(textformat(mov,5))+")";
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Scaledata(nm,plist,ratioV):=(
- regional(tmp);
- tmp=Lcrd(ratioV);
- Scaledata(nm,plist,tmp_1,tmp_2,[]);
-);
-Scaledata(nm,plist,Arg1,Arg2):=(
-//help:Scaledata("1","crAB",3,2,[[0,0]]);
- regional(tmp,options);
- if(islist(Arg2),
- tmp=Lcrd(Arg1);
- options=Arg2;
- Scaledata(nm,plist,tmp_1,tmp_2,options);
- ,
- Scaledata(nm,plist,Arg1,Arg2,[]);
- );
-);
-Scaledata(nm,plist,rx,ry,options):=(
- regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdL,
- opcindy,Nj,Njj,Kj,X2,Y2,Ltype,Noflg,name);
- name="sc"+nm;
- Pt=[0,0];
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- tmp1=tmp_6;
- if(length(tmp1)>0,
- Pt=Lcrd(tmp1_1);
- );
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- Cx=Pt_1; Cy=Pt_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X2=Cx+rx*(tmp_1-Cx);
- Y2=Cy+ry*(tmp_2-Cy);
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Scaledata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1); // 17.12.23
- tmp=name+"=Scaledata("+tmp1+","
- +textformat(rx,5)+","+textformat(ry,5)+","+RSform(textformat(Pt,5))+")";
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Reflectdata(nm,plist,symL):=Reflectdata(nm,plist,symL,[]);
-Reflectdata(nm,plist,symL,options):=(
-//help:Reflectdata("1","crAB",[C]);
- regional(tmp,tmp1,tmp2,pdata,Us,Vs,Pt1,Pt2,Cx,Cy,PdL,
- opcindy,Nj,Njj,Kj,X1,Y1,X2,Y2,Ltype,Noflg,name);
- name="re"+nm;
- Pt=[0,0];
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- Pt1=Lcrd(symL_1);
- if(length(symL)==1,
- Pt2=Pt1;
- ,
- Pt2=Lcrd(symL_2);
- );
- Us=Pt2_1-Pt1_1;
- Vs=Pt2_2-Pt1_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X1=tmp_1;
- Y1=tmp_2;
- if(Pt1==Pt2,
- X2=2*Pt1_1-X1;
- Y2=2*Pt1_2-Y1;
- ,
- X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1
- -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1
- +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- );
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Reflectdata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1);// 17.12.23
- tmp=name+"=Reflectdata("+tmp1+","+RSform(textformat(symL,5))+")";//17.12.23
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Mksegments():=Mksegments([]);
-Mksegments(options):=(
-//help:Mksegments();
- regional(segstr,p,q,r,tmp1,tmp2,tmp3);
- forall(allsegments(),seg,
- str=text(inspect(seg,"definition"));
- tmp1=indexof(str,"(");
- tmp2=indexof(str,";");
- tmp3=indexof(str,")");
- p=substring(str,tmp1,tmp2-1);
- q=substring(str,tmp2,tmp3-1);
- Listplot([parse(p),parse(q)]);
- );
-);
-
-Mkcircles():=Mkcircles([]);
-Mkcircles(options):=(
-//help:Mkcircles():
- regional(seg,cir,str,p,q,r,tmp1,tmp2,tmp3,tmp4);
- forall(allcircles(),cir,
- str=text(inspect(cir,"definition"));
- tmp1=indexof(str,"(");
- tmp2=indexof(str,";");
- tmp3=indexof(str,")");
- tmp4=indexof(str,";",tmp2+1);
- if(tmp4==0,
- p=substring(str,tmp1,tmp2-1);
- q=substring(str,tmp2,tmp3-1);
- Circledata([parse(p),parse(q)]);
- ,
- p=substring(str,tmp1,tmp2-1);
- q=substring(str,tmp2,tmp4-1);
- r=substring(str,tmp4,tmp3-1);
- Circledata([parse(p),parse(q),parse(r)]);
- );
- );
-);
-
-MakeRarg(arglist):=(
- regional(str,tmpstr);
- str="";
- forall(arglist,
- if(isstring(#),
- tmpstr=Dq+RSslash(#)+Dq;
- ,
- tmpstr=textformat(#,6);
- );
- str=str+tmpstr+",";
- );
- str=substring(str,0,length(str)-1);
- str;
-);
-
-Setax(arglist):=(
-//help:Setax(["l","x","e","y","n","O","sw"]);
-//help:Setax([7,"nw"]);
- regional(tmp);
- tmp=MakeRarg(arglist);
- Com1st("Setax("+tmp+")");
-);
-
-Htickmark(arglist):=(
-//help:Htickmark([1,"1",2,"sw","2"]);
- regional(tmp);
- tmp="";
- tmp=MakeRarg(arglist);
- Com2nd("Htickmark("+tmp+")");
-);
-
-Vtickmark(arglist):=(
-//help:Vtickmark([1,"1",2,"sw","2"]);
- regional(tmp);
- tmp=MakeRarg(arglist);
- Com2nd("Vtickmark("+tmp+")");
-);
-
-Vtick(py):=Vtick(py,MARKLEN,[]);
-Vtick(py,len):=Vtick(py,len,[]);
-Vtick(py,len,options):=(
-//help:Vtick(1,0.1,options);
- regional(tmp,tmp1,tmp2);
- tmp="v"+text(round(py*100));
- tmp=replace(tmp,"-","m");
- tmp1=[0-len/2,py];
- tmp2=[0+len/2,py];
- Listplot(tmp,[tmp1,tmp2],options);
-);
-
-Htick(px):=Htick(px,MARKLEN,[]);
-Htick(px,len):=Htick(px,len,[]);
-Htick(px,lenorg,options):=(
-//help:Htick(-1,0.1,options);
- regional(len,tmp,tmp1,tmp2);
- tmp=LLcrd([0,lenorg]);
- len=tmp_2;
- tmp="h"+text(round(px*100));
- tmp=replace(tmp,"-","m");
- tmp1=[px,0-len/2];
- tmp2=[px,0+len/2];
- Listplot(tmp,[tmp1,tmp2],options);
-);
-
-Drwxy():=(
-//help:Drwxy();
- Com2nd("Drwxy()");
- Addax(0); // 16.01.21
-);
-
-Drwpt(pstr):=Drawpoint(pstr);
-Drwpt(ptlist,nn):=( // 16.03.05 from
-//help:Drwpt(A);
-//help:Drwpt("[1,1],0");
-//help:Drwpt(A,0);
-//help:Drwpt([1,2],0);
- Drawpoint(ptlist,nn);
-);
-Drawpoint(pstr):=(
- if(isstring(pstr),
- println("Drwpt : "+pstr);
- Com2nd("Drwpt("+pstr+")");
- ,
- Drawpoint(pstr,1);
- );
-);
-Drawpoint(ptlistorg,nn):=(
- regional(ptlist,thick,tmp,tmp1);
- println("Drwpt : "+text(ptlistorg));
- if(islist(ptlistorg),
- if(MeasureDepth(ptlistorg)==1,
- ptlist=ptlistorg
- ,
- ptlist=[ptlistorg]
- );
- ,
- ptlist=[ptlistorg]
- );
- thick=PenThick/PenThickInit;// 16.04.09 from
- tmp1=max(TenSize/TenSizeInit,1)/8;
- Setpen(tmp1); // 16.04.09 upto
- forall(ptlist,
- tmp=textformat(#,5)+","+text(nn);
- Com2nd("Drwpt("+tmp+")"); // 16.04.09
- );
- Setpen(thick); // 16.04.09
-);// 16.03.05 upto
-
-Addax(param):=(
-//help:Addax(0);
- ADDAXES=textformat(param,5);
-);
-
-Expr(Pt,Dr,St):=Expr([Pt,Dr,St]);
-Expr(list):=Expr(list,[]);
-Expr(listorg,options):=( //16.10.09
-//help:Expr([A,"e","f(x)=x^2"]);
- regional(list,str,tmp,tmp1,tmp2);
- list=listorg;
- forall(1..round(length(list)/3),
- str=list_(3*#);
- if(!isstring(str),str=format(str,5));
- str="$"+str+"$";
- list_(3*#)=str;
- );
- Letter(list,options);
-);
-
-Letter(Pt,Dr,St):=Letter([Pt,Dr,St]);
-Letter(list):=Letter(list,[]);
-Letter(list,options):=(
-//help:Letter([C,"c","Graph of f(x)"]);
- regional(Nj,Pos,Dir,Str,Off,Dmv,Xmv,Ymv,Noflg,opcindy,
- opL,aln,sz,clr,bld,ita,tmp,tmp1,tmp2);
- tmp=Divoptions(options);
- Noflg=tmp_2;
- opL=select(options,indexof(#,"->")>0); //16.10.09from
- tmp=select(opL,indexof(#,"color"));
- size=12;
- clr=[0,0,0];
- bld=false;
- ita=false;
- aln="left";
- forall(opL,
- tmp=indexof(#,"->");
- tmp1=removespace(substring(#,0,tmp-1));
- tmp2=substring(#,tmp+1,length(#));
- if(tmp1=="size",sz=parse(tmp2));
- if(tmp1=="color",clr=parse(tmp2));
- if(tmp1=="bold",bld=parse(tmp2));
- if(tmp1=="ita",ita=parse(tmp2));
- );//16.10.09upto
- Off=-4;
- Dmv=8;
- Nj=1;
- while(Nj+2<=length(list),
-// Pos=textformat(list_Nj,5);
- Pos=list_Nj;
- Dir=list_(Nj+1);
- tmp=indexof(Dir,"s")+indexof(Dir,"n");//16.10.19from
- if(tmp>0,
- tmp=indexof(Dir,"w")+indexof(Dir,"e");
- if(tmp==0,
- Dir="c"+Dir;//16.10.08
- );
- );//16.10.19upto
- Str=list_(Nj+2);
- if(!isstring(Str),Str=format(Str,5)); // 16.09.30,10.09
- tmp=replace(Str,".xy","");
- tmp=replace(tmp,".x","(1)");
- Str=replace(tmp,".y","(2)");
- Str=RSslash(Str); // 17.09.24
- if(indexof(Str,"`")>0,
-// tmp=Dq+",Assign('"+Str+"','`',Prime()))";
- tmp=Dq+",Assign('"+Str+"'))"; // 15.02.22
- ,
- tmp=Dq+","+Dq+Str+Dq+")";
- );
- if(Noflg==0,
- Com2nd("Letter("+Lcrd(Pos)+","+Dq+Dir+tmp);//16.10.10
- );
- if(Noflg<2,
- Xmv=0;//16.10.13
- Ymv=-4;
- if(indexof(Dir,"n")>0,
- Ymv=Dmv/2;
- );
- if(indexof(Dir,"s")>0,
- Ymv=-Dmv*3/2;//16.10.13
- );
- if(indexof(Dir,"e")>0,
- Xmv=Dmv/2;
- Off=0;
- aln="left";
- );
- if(indexof(Dir,"w")>0,
- Xmv=-Dmv/2;
- Off=0; // 16.09.30from
- aln="right";
- );
- if(indexof(Dir,"c")>0,
- Xmv=0;//16.10.13
- Off=0;
- if(Ymv==0,Ymv=-4);//16.10.08
- aln="mid"; // 16.09.30upto
- );
- Str=list_(Nj+2); //17.10.17
- drawtext(Pcrd(Pos),Str,offset->[Off+Xmv,Off+Ymv],
- size->sz,color->clr,align->aln,bold->bld,italics->ita);//16.10.09
- );
- Nj=Nj+3;
- );
-);
-
-Letterrot(pt,dir,str):=Letterrot(pt,dir,0,0,str);
-Letterrot(pt,dir,movstr,str):=(
-//help:Letterrot(C,B-A,"AB"):
-//help:Letterrot(C,B-A,0,5,"AB"):
-//help:Letterrot(C,B-A,"t0n5","AB"):
- regional(tmov,nmov,tmp,tmp1,tmp2);
- tmp1=indexof(movstr,"t");
- tmp2=indexof(movstr,"n");
- if(tmp1>0,
- if(tmp2>0,tmp=tmp2-1,tmp=length(movstr));
- tmov=parse(substring(movstr,tmp1,tmp));
- ,
- tmov=0;
- );
- if(tmp2>0,
- nmov=parse(substring(movstr,tmp2,length(movstr)));
- ,
- nmov=0;
- );
- Letterrot(pt,dir,tmov,nmov,str);
-);
-Letterrot(pt,dir,tmov,nmov,str):=(
- regional(tmp);
- Letter([pt,"c",str],["notex"]);
- tmp=replace(str,"\","\\"); //17.10.18
- Com2nd("Letterrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')");
-);
-
-Exprrot(pt,dir,str):=Exprrot(pt,dir,0,0,str);
-Exprrot(pt,dir,movstr,str):=(
-//help:Exprrot(C,B-A,"d"):
-//help:Exprrot(C,B-A,0,5,"d"):
-//help:Exprrot(C,B-A,"t0n5","d"):
- regional(tmov,nmov,tmp,tmp1,tmp2);
- tmp1=indexof(movstr,"t");
- tmp2=indexof(movstr,"n");
- if(tmp1>0,
- if(tmp2>0,tmp=tmp2-1,tmp=length(movstr));
- tmov=parse(substring(movstr,tmp1,tmp));
- ,
- tmov=0;
- );
- if(tmp2>0,
- nmov=parse(substring(movstr,tmp2,length(movstr)));
- ,
- nmov=0;
- );
- Exprrot(pt,dir,tmov,nmov,str);
-);
-Exprrot(pt,dir,tmov,nmov,str):=(
- regional(tmp);
- Expr([pt,"c",str],["notex"]);
- tmp=replace(str,"\","\\"); //17.10.18
- Com2nd("Exprrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')");
-);
-
-Putslider(ptstr,p1,p2):=Slider(ptstr,p1,p2);
-Slider(ptstr,p1,p2):=( //17.04.11
-//help:Slider("A-C-B",[-3,0],[3,0]);
- regional(pA,pB,pC,seg,sname,Alpha,tmp,tmp1);
- tmp=indexall(ptstr,"-");
- pA=substring(ptstr,0,tmp_1-1);
- pC=substring(ptstr,tmp_1,tmp_2-1);
- pB=substring(ptstr,tmp_2,length(ptstr));
- seg=pA+pB;
- Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ";
- sname="";
- forall(1..(length(seg)),
- tmp=substring(seg,#-1,#);
- tmp1=indexof(Alpha,tmp);
- if(tmp1>0,
- sname=sname+unicode(text(tmp1+96),base->10);
- ,
- sname=sname+tmp;
- );
- );
- Putpoint(pA,p1);
- Putpoint(pB,p2);
- Listplot([parse(pA),parse(pB)],["notex","color->[0,0.4,0.4]","size->2"]);
-// create([sname],"Segment",[parse(pA),parse(pB)]);
-// tmp2=Listplot("",[p1,p2],["nodata"]);
- Putonseg(pC,parse("sg"+pA+pB));
-// create([pC],"PointOn",[parse(sname),0.5]);
-);
-
-Putpoint(name,Pt):=Putpoint(name,Pt,Pt);
-Putpoint(name,Ptinit,Pt):=(
-//help:Putpoint("A",[1,2],[1,A.y]);
- regional(ptstr);
- ptstr=apply(allpoints(),#.name);//16.10.06
- if(!contains(ptstr,name),
- createpoint(name,Pcrd([Ptinit_1,Ptinit_2]));
- ,
- ptstr=name+".xy="+textformat(Pcrd(Pt),5);
- parse(ptstr);
- );
-);
-
-Bezierpt(t,ptlist,ctrlist):=(
- regional(flg3,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9);
- p0=ptlist_1;
- p3=ptlist_2;
- p1=ctrlist_1;
- if(length(ctrlist)==1,
- p2=p3;
- flg3=0;
- ,
- p2=ctrlist_2;
- flg3=1;
- );
- if(length(p0)<3, // 15.02.08
- p0=Lcrd(p0);
- p3=Lcrd(p3);
- p1=Lcrd(p1);
- p2=Lcrd(p2);
- );
- p4=(1-t)*p0+t*p1;
- p5=(1-t)*p1+t*p2;
- p6=(1-t)*p2+t*p3;
- p7=(1-t)*p4+t*p5;
- p8=(1-t)*p5+t*p6;
- p9=(1-t)*p7+t*p8;
- if(flg3==0,p7,p9);
-);
-
-Bezier(ptctrlist):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,[]);
-Bezier(ptctrlist,options):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,options);
-Bezier(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]);
-Bezier(nm,ptlist,ctrlist,options):=BezierCurve(nm,ptlist,ctrlist,options);
-BezierCurve(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]);
-BezierCurve(nm,ptlistorg,ctrlistorg,options):=(
-//help:Bezier("1",[A,D],[B,C]);
-//help:Bezier(options=["Num=10"]);
- regional(name,Ltype,Noflg,opstr,opcindy,Num,
- ptlist,ctrlist,tmp,tmp1,tmp2,ii,st,out,list);
- name="bz"+nm;
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opstr=tmp_(length(tmp)-1);
- opcindy=tmp_(length(tmp));
- Num=10;
- tmp1=tmp_5;
- forall(tmp1, // 14.12.31
- if(substring(#,0,1)=="N",
- tmp2=indexof(#,"=");
- Num=parse(substring(#,tmp2,length(#)));
- opstr=opstr+","+Dq+#+Dq;
- );
- );
- ptlist=apply(ptlistorg,Lcrd(#)); // 16.08.16
- ctrlist=[]; // 14.12.31
- if(length(ctrlistorg)==length(ptlist)-1,
- forall(ctrlistorg,tmp1,
- if(MeasureDepth(tmp1)==0,tmp=[tmp1],tmp=tmp1);
- tmp=apply(tmp,Lcrd(#)); // 16.08.16
- ctrlist=append(ctrlist,tmp);
- );
- ,
- forall(1..(length(ptlist)-1),ii,
- tmp=ctrlistorg_((2*ii-1)..(2*ii));
- tmp=apply(tmp,Lcrd(#)); // 16.08.16
- ctrlist=append(ctrlist,tmp);
- );
- );
- if(!islist(Num),
- Num=apply(ctrlist,Num);
- );
- list=[];
- forall(1..(length(ptlist)-1),ii,
- tmp1=ptlist_(ii..(ii+1));
- tmp2=ctrlist_ii;
- if(ii==1,st=0,st=1);
- forall(st..Num_ii,
- tmp=Bezierpt(#/Num_ii,tmp1,tmp2);
- list=append(list,tmp);
- );
- );
- if(Noflg<3,
- println("generate Bezier "+name);
- out=apply(list,Pcrd(#));
- tmp=name+"="+textformat(out,5);
- parse(tmp);
- tmp1=textformat(ptlist,5);
- tmp1=RSform(tmp1,2); //17.12.23
- tmp2=textformat(ctrlist,5);
- tmp2=RSform(tmp2,3); //17.12.23
- GLIST=append(GLIST,name+"=Bezier("+tmp1+","+tmp2+opstr+")");
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- list;
-);
-
-Readcsvsla(fname):=Readplotdigdata(fname,[]);
-Readcsvsla(fname,options):=Readplotdigdata(fname,options);
-Readplotdigdata(fname):=Readplotdigdata(fname,[]);
-Readplotdigdata(fname,options):=(
- regional(fsc,mv,cmdall,dataL,nd,npt,ptdata,ii,tmp,tmp1,tmp2,tmp3);
- tmp=Divoptions(options);
- tmp1=tmp_6;
- sc=1;//10;
- mv=[0,0];//[5,5];
- forall(tmp1,
- if(!islist(#),sc=#,mv=#);
- );
- if(indexof(fname,".")>0,
- tmp=load(fname);
- ,
- tmp=load(fname+".txt");
- );
- cmdall=tokenize(tmp,"//");
- dataL=[];
- forall(2..length(cmdall),ii,
- tmp1=parse("["+cmdall_ii+"]");
- dataL=append(dataL,tmp1);
- );
- if(length(dataL_(length(dataL)))<2,
- dataL=dataL_(1..(length(dataL)-1));
- );
- nd=length(dataL_1)/2;
- npt=length(dataL);
- ptdata=[];
- forall(1..nd,ii,
- tmp3=[];
- forall(1..npt,
- tmp1=dataL_#_(2*ii-1);
- tmp2=dataL_#_(2*ii);
- if(isreal(tmp1),
- tmp3=append(tmp3,[tmp1,tmp2]);
- );
- );
- ptdata=append(ptdata,tmp3);
- );
- tmp1=[];
- forall(ptdata,
- tmp=#/sc;
- tmp=Translatedata("1",[tmp],-mv,["nodata"]);
- tmp1=append(tmp1,tmp);
- );
- ptdata=tmp1;
- ptdata;
-);
-
-Putbezierdata(name,ptL):=Putbezierdata(name,ptL,[]);
-Putbezierdata(name,ptL,options):=(
- regional(psize,Deg,tmp,tmp1,tmp2,p1,p2,pts,ctrs);
- tmp=Divoptions(options);
- psize=3;
- Deg=3;
- tmp1=tmp_5;
- forall(tmp1,
- if(substring(#,0,1)=="D",
- tmp=indexof(#,"=");
- Deg=parse(substring(#,tmp,length(#)));
- );
- if(substring(#,0,1)=="S",
- tmp=indexof(#,"=");
- psize=parse(substring(#,tmp,length(#)));
- );
- );
- pts=[];
- ctrs=[];
- forall(1..length(ptL),
- p2=ptL_#; // 16.08.16
- if(ispoint(p2),
- tmp1=text(p2);
- ,
- tmp1=name+text(#);
- Putpoint(tmp1,p2,Lcrd(parse(tmp1))); // 16.08.16
- );
- inspect(parse(tmp1),"ptsize",psize);
- pts=append(pts,parse(tmp1));
- inspect(parse(tmp1),"color",4);
- if(#>1,
- p1=Lcrd(ptL_(#-1)); // 16.08.16
- p2=Lcrd(ptL_#); // 16.08.16
- if(Deg==3,
- tmp=(2*p1+p2)/3;
- tmp1=name+"p"+text(#-1);
- Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16
- inspect(parse(tmp1),"labeled",false); //15.01.22
- Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22
- inspect(parse(tmp1),"ptsize",psize);
- inspect(parse(tmp1),"color",3);
- tmp=(p1+2*p2)/3;
- tmp2=name+"q"+text(#-1);
- Putpoint(tmp2,tmp,Lcrd(parse(tmp2))); // 16.08.16
- inspect(parse(tmp2),"labeled",false); //15.01.22
- Letter([parse(tmp2),"ne",tmp2],["notex"]); //15.01.22
- inspect(parse(tmp2),"ptsize",psize);
- inspect(parse(tmp2),"color",3);
- ctrs=append(ctrs,[parse(tmp1),parse(tmp2)]);
- ,
- tmp=(p1+p2)/2;
- tmp1=name+"p"+text(#-1);
- Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16
- inspect(parse(tmp1),"labeled",false); //15.01.22
- Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22
- inspect(parse(tmp1),"ptsize",psize);
- inspect(parse(tmp1),"color",3);
- ctrs=append(ctrs,[parse(tmp1)]);
- );
- );
- );
- [pts,ctrs,name];
-);
-
-Bezierstart(n):=( // 2016.02.26
- BezierNumber=n;
-);
-
-Mkbezierptcrv(ptdata):=Mkbezierptcrv(ptdata,[]);
-Mkbezierptcrv(ptdata,options):=(
- //help:Mkbezierptcrv([A,B,C,D]);
- //help:Mkbezierptcrv([[A,B],[C,D]]);
- //help:Mkbezierptcrv(options=["Num=10"]);
- // global BezierNumber
- regional(ptlist,Out,tmp,tmp1,tmp2);
- if(isstring(ptdata),
- ptlist=Readcsvsla(ptdata,options);
- ,
- ptlist=ptdata;
- );
- if(MeasureDepth(ptlist)==1,ptlist=[ptlist]);
- Out=[];
- forall(1..length(ptlist),
- tmp=floor((BezierNumber-1)/26);// 15.02.23
- if(tmp==0,tmp="",tmp=text(tmp));
- tmp2=mod(BezierNumber,26);
- if(tmp2==0,tmp2=26);
- tmp1=unicode(text(96+tmp2),base->10)+tmp;// 15.03.11
- tmp2=Putbezierdata(tmp1,ptlist_#,options);
- Bezier(tmp2,options);
- BezierNumber=BezierNumber+1;
- Out=append(Out,tmp2_(1..2));
- );
- Out;
-);
-
-Mkbeziercrv(nm,ptctrL):=Mkbeziercrv(nm,ptctrL,[]);
-Mkbeziercrv(nm,ptctrL,options):=(
- //help:Mkbeziercrv("1",[[A,B,C,D],[[P,Q],[R,S],T]]);
- regional(ptctrLL,name,ptlist,ctrlist,tmp,tmp1,tmp2);
- if(MeasureDepth(ptctrL)==2,ptctrLL=[ptctrL],ptctrLL=ptctrL);
- forall(1..length(ptctrLL),
- name=nm+text(#);
- ptlist=ptctrLL_#_1;
- ctrlist=ptctrLL_#_2;
- Bezier(nm,ptlist,ctrlist,options); // 17.01.06
- );
-);
-
-Writebezier():=Writebezier(Fhead,"all");
-Writebezier(head):=Writebezier(head,"all");
-Writebezier(head,seL):=(
-//help:Writebezier(file);
-//help:Writebezier(file,"acd");
- regional(bz,dt,name,tmp,tmp1,tmp2);
- bz=select(GLIST,indexof(#,"=Bezier")>0);
- tmp1=[]; // 16.04.22from
- if(seL!="all",
- forall(1..length(seL),
- tmp=substring(seL,#-1,#);
- tmp=select(bz,indexof(#,"bz"+tmp)>0);
- tmp1=concat(tmp1,tmp);
- );
- bz=tmp1;// 16.04.22upto
- );
- dt=[head+"n",[[length(bz),0]]];
- forall(1..length(bz),
- tmp=indexof(bz_#,"=");
- name=substring(bz_#,0,tmp-1);
- tmp=indexof(bz_#,","+Dq);
- if(tmp>0,
- tmp1=substring(bz_#,0,tmp-1)+")";
- ,
- tmp1=bz_#;
- );
- tmp1=replace(tmp1,"Bezier(","[");
- tmp1=replace(tmp1,"list(","[");
- tmp1=replace(tmp1,")","]");
- tmp1=replace(tmp1,",",".xy,");
- tmp1=replace(tmp1,"]",".xy]");
- tmp1=replace(tmp1,".xy,[",",[");
- tmp1=replace(tmp1,"].xy","]");
- tmp1=replace(tmp1,name,head+text(#));
- parse(tmp1);
- tmp=parse(head+text(#)+"_1");
- dt=concat(dt,[head+text(#)+"k",tmp]);
- tmp=parse(head+text(#)+"_2");
- dt=concat(dt,[head+text(#)+"c",tmp]);
- );
- WriteOutData(head+".txt",dt);
- dt;
-);
-
-Readbezier(file):=Readbezier(file,[]);
-Readbezier(file,optionorg):=(
-//help:Readbezier("xsr");
-//help:Readbezier(options=["Num=10","nogeo"]);
- regional(nn,options,stL,geo,nc,alpha,out,tmp,tmp1,tmp2,tmp3);
- options=optionorg;
- tmp=Divoptions(options);
- stL=tmp_7;
- geo=0;
- forall(stL,
- tmp=Toupper(substring(#,0,1));
- if(tmp=="G",geo=1);
- options=remove(options,[#]);
- );
- ReadOutData(file);
- tmp=file+"n_1_1";
- nn=parse(tmp);
- out=[];
- forall(1..nn,nc,
- tmp=file+text(nc);
- tmp1=parse(tmp+"k");
- tmp2=parse(tmp+"c");
- if(MeasureDepth(tmp2)==1,tmp2=[tmp2]); // 16.04.22from
- if(geo==1,
- alpha="abcdefghijklmnopqrstuvwxyz";
- forall(1..length(tmp1),
- tmp="k"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#);
- Putpoint(tmp,tmp1_#,parse(tmp+".xy"));
- inspect(parse(tmp),"labeled",false);
- inspect(parse(tmp),"ptsize",3);
- tmp1_#=parse(tmp+".xy");
- );
- forall(1..length(tmp2),
- tmp="c"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#)+"1";
- Putpoint(tmp,tmp2_#_1,parse(tmp+".xy"));
- inspect(parse(tmp),"labeled",false);
- inspect(parse(tmp),"color",4);
- inspect(parse(tmp),"ptsize",3);
- tmp2_#_1=parse(tmp+".xy");
- tmp="c"+BezierNumber+"no"+text(nc)+substring(alpha,#-1,#)+"2";
- Putpoint(tmp,tmp2_#_2,parse(tmp+".xy"));
- inspect(parse(tmp),"labeled",false);
- inspect(parse(tmp),"color",4);
- inspect(parse(tmp),"ptsize",3);
- tmp2_#_2=parse(tmp+".xy");
- );
- BezierNumber=BezierNumber+1;
- );
- Bezier(file+text(nc),tmp1,tmp2,options);// 16.04.22upto
- out=append(out,"bz"+tmp);
- );
- out;
-);
-
-Ospline(nm,ptlist):=Ospline(nm,ptlist,[]);
-Ospline(nm,ptlist,options):=(
-//help:Ospline("1",ptlist,[options]);
- regional(tmp,tmp1,tmp2,list,ptL,ctrL,name,closed,flg,
- p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32);
- name="o"+nm;
- if(isstring(ptlist),list=parse(ptlist),list=ptlist);
- if(|list_1-list_(length(list))|<10^(-6),closed=1,closed=0);
-// list=apply(list,LLcrd(#));
- ctrL=[];
- forall(1..(length(list)-1),
- flg=0;
- p1=Lcrd(list_#); // 16.08.16
- p2=Lcrd(list_(#+1)); // 16.08.16
- if(#==1 % #==length(list)-1,
- flg=1;
- if(closed==0,
- pQ=(p1+2*p2)/3; // 15.09.21 // 16.08.16
- pR=(2*p1+p2)/3; // 16.08.16
- ctrL=append(ctrL,[pQ,pR]);
- flg=2;
- ,
- if(#==1,
- p0=Lcrd(list_(length(list)-1)); // 16.08.16
- p3=Lcrd(list_(#+2)); // 16.08.16
- ,
- p0=Lcrd(list_(#-1)); // 16.08.16
- p3=Lcrd(list_2); // 16.08.16
- );
- );
- );
- if(flg<=1,
- if(flg==0,
- p0=Lcrd(list_(#-1)); // 16.08.16
- p3=Lcrd(list_(#+2)); // 16.08.16
- );
- tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2);
- cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp;
- pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16
- pR=p2+cc*(p1-p3); // 16.08.16
- ctrL=append(ctrL,[pQ,pR]);
- );
- );
-// list=apply(list,LLcrd(#)); // 16.08.16
-// ctrL=apply(ctrL,LLcrd(#));
- if(closed==0, // 15.09.21
- p1=ctrL_2_1;
- p2=Lcrd(list_2); // 16.08.16
- pQ=p2+(p2-p1);
- ctrL_1=[pQ];
- tmp=length(ctrL);
- tmp1=ctrL_(tmp-1);
- p1=ctrL_(tmp-1)_2;
- p2=Lcrd(list_(tmp)); // 16.08.16
- pQ=p2+(p2-p1);
- ctrL_tmp=[pQ];
- );
- Bezier("o"+nm,list,ctrL,options);
-);
-
-CRspline(nm,ptL):=CRspline(nm,ptL,[]);
-CRspline(nm,ptL,options):=(
- // Catmull-Rom spline
-//help:CRspline("1",[A,B,C,A]);
- regional(name,ptlist,ctrpts,eqL,opcindy,c,v,tmp,tmp1,tmp2,ctrlist,cflg);
- name="crsp"+nm;
- if(MeasureDepth(ptL)==1,tmp=[ptL],tmp=ptL);
- ptlist=tmp_1;
- if(length(tmp)==1,
- cflg=1;
- ,
- cflg=0;
- ctrpts=tmp_2;
- );
- c=1/6;
- tmp=Divoptions(options);
- eqL=tmp_5;
- opcindy=tmp_(length(tmp)); // 15.03.05
- forall(eqL,
- if(substring(#,0,1)=="R",
- tmp2=indexof(#,"=");
- c=parse(substring(#,tmp2,length(#)));
- );
- );
- ptlist=apply(ptlist,Lcrd(#)); // 16.08.16
- ctrlist=[];
- forall(1..(length(ptlist)-1),
- if(#==1,
- if(cflg==0,
- tmp1=ctrpts_1;
- ,
- v=ptlist_2-ptlist_(length(ptlist)-1);
- tmp1=ptlist_#+c*v;
- );
- ,
- v=ptlist_(#+1)-ptlist_(#-1);
- tmp1=ptlist_#+c*v;
- );
- if(#==length(ptlist)-1,
- if(cflg==0,
- tmp2=ctrpts_2;
- ,
- v=ptlist_2-ptlist_#;
- tmp2=ptlist_(#+1)-c*v;
- );
- ,
- v=ptlist_(#+2)-ptlist_#;
- tmp2=ptlist_(#+1)-c*v;
- );
- tmp=select(options,indexof(text(#),"->")>0);
- tmp=append(tmp,"notex"); //15.03.05
- Pointdata(name+text(#),[tmp1,tmp2],tmp);
- ctrlist=append(ctrlist,[tmp1,tmp2]);
- );
- Bezier(nm,ptlist,ctrlist,options);
-);
-
-Beziersmooth(nm,ptL):=Bzspline(nm,ptL,[]);
-//help:Beziersmooth("1",[A,B,C,A]);
-Beziersmooth(nm,ptL,options):=Bzspline(nm,ptL,options);
-Bzspline(nm,ptL):=Bzspline(nm,ptL,[]);
-Bzspline(nm,ptLorg,options):=(
- // smooth bezier
- regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr,
- tmp,tmp1,tmp2,cflg,ctrlist);
- name="bzsp"+nm;
- Eps=10^(-3);
- ptL=apply(ptLorg,Lcrd(#)); // 16.08.16
- if(|ptL_1-ptL_(length(ptL))|<Eps,cflg=1,cflg=0);
- forall(2..length(ptL),
- pt=ptL_#;
- pt1=ptL_(#-1);
- tmp1="C"+text(#-1)+"q";// 16.10.07
- Putpoint(tmp1,(pt1+4*pt)/5,Lcrd(parse(tmp1))); // 16.08.16
- );
- forall(2..(length(ptL)-1),
- if(#<length(ptL) % cflg==1,
- lstr="c"+text(#);
- pt=ptLorg_#; // 16.08.16
- pt1=parse("C"+text(#-1)+"q");
- create([lstr],"Join",[pt1,pt]);
- tmp2="C"+text(#)+"p";
- tmp=Append((2*pt.xy-pt1.xy),1);
- create([tmp2],"PointOnLine",[parse(lstr),tmp]);
- );
- );
- if(cflg==0,
- pt=ptL_1;
- pt1=ptL_2;
- tmp1="C1p";
- Putpoint(tmp1,(4*pt+pt1)/5,Lcrd(parse(tmp1))); // 16.08.16
- );
- if(cflg==1,
- lstr="c1";
- pt=ptLorg_1; // 16.08.16
- pt1=parse("C"+text(length(ptL)-1)+"q");
- create([lstr],"Join",[pt1,pt]);
- tmp1="C1p";
- tmp=Append((2*pt.xy-pt1.xy),1);
- create([tmp1],"PointOnLine",[parse(lstr),tmp]);
- );
- ctrlist=[];
- forall(1..(length(ptL)-1),
- if(#>1 % cflg==1,
- tmp1="c"+text(#);
- inspect(parse(tmp1),"alpha",0.3);
- );
- tmp1="C"+text(#)+"p";
- tmp2="C"+text(#)+"q";
- inspect(parse(tmp1),"ptsize",3);
- inspect(parse(tmp1),"color",3);
- inspect(parse(tmp2),"ptsize",3);
- inspect(parse(tmp2),"color",3);
- tmp=[parse(tmp1),parse(tmp2)];
- ctrlist=append(ctrlist,tmp);
- );
- Bezier(nm,ptL,ctrlist,options);
- [ptL,ctrlist];
-);
-
-Beziersym(nm,ptL):=Bzsspline(nm,ptL,[]);
-Beziersym(nm,ptL,options):=Bzsspline(nm,ptL,options);
-Bzsspline(nm,ptL):=Bzsspline(nm,ptL,[]);
-Bzsspline(nm,ptLorg,options):=(
- // smooth bezier with symmetric control points
- regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr,
- tmp,tmp1,tmp2,cflg,ctrlist);
- name="bzssp"+nm;
- Eps=10^(-3);
- ptL=apply(ptLorg,Lcrd(#)); // 16.08.16
- if(|ptL_1-ptL_(length(ptL))|<Eps,cflg=1,cflg=0);
- forall(2..length(ptL),
- pt=ptL_#;
- pt1=ptL_(#-1);
- tmp1="C"+text(#-1)+"q";
- Putpoint(tmp1,(pt1+4*pt)/5,Lcrd(parse(tmp1)));
- );
- forall(2..(length(ptL)-1),
- if(#<length(ptL) % cflg==1,
- pt=ptL_#;
- pt1=parse("C"+text(#-1)+"q");
- tmp2="C"+text(#)+"p=2*pt-pt1";
- parse(tmp2);
- );
- );
- if(cflg==0,
- pt=ptL_1;
- pt1=ptL_2;
- Putpoint("C1p",(4*pt+pt1)/5,Lcrd(C1p)); // 16.08.16
- inspect(C1p,"ptsize",3);
- inspect(C1p,"color",3);
- );
- if(cflg==1,
- pt=ptL_1;
- pt1=Lcrd(parse("C"+text(length(ptL)-1)+"q")); // 16.08.16
- tmp1="Putpoint("+Dq+"C1p"+Dq+",2*pt-pt1)"; // 16.08.16
- parse(tmp1);
- );
- ctrlist=[];
- forall(1..(length(ptL)-1),
- tmp1="C"+text(#)+"p";
- tmp2="C"+text(#)+"q";
- inspect(parse(tmp2),"ptsize",3);
- inspect(parse(tmp2),"color",3);
- tmp=[parse(tmp1),parse(tmp2)];
- ctrlist=append(ctrlist,tmp);
- );
- Bezier(nm,ptL,ctrlist,options);
- [ptL,ctrlist];
-);
-
-Listbspline2bz(listorg):=(
- regional(Eps,list,pcl,ptl,ctrl,k);
- Eps=10^(-3);
- list=apply(listorg,Lcrd(#)); // 16.08.16
- k=length(list);
- if(|list_1-list_k|>Eps,
- pcl=list;
- pcl_1=2*list_1-list_2;
- pcl_k=2*list_k-list_(k-1);
- ,
- pcl=concat(list,[list_2]);
- );
- ctrl=apply(2..(length(pcl)-1),[pcl_#]);
- ptl=apply(1..(length(pcl)-1),(pcl_#+pcl_(#+1))/2);
- [ptl,ctrl];
-);
-
-Bspline(nm,ctrL):=Bspline(nm,ctrL,[]);
-Bspline(nm,ctrL,options):=(
-//help:Bspline("",[A,B,C]);
- regional(list,tmp);
- list=Listbspline2bz(ctrL);
- tmp=BezierCurve("b"+nm,list_1,list_2,options);
- tmp;
-);
-
-MeetCurve(Crv,Xorg,Yorg):=(
- regional(Cv,tmp,tmp1,tmp2,X0,Y0,x1,x2,y1,y2,Ylist,Ban,Tate);
- if(isstring(Crv),Cv=parse(Crv),Cv=Crv);
- if(MeasureDepth(Cv)==2,Cv=Cv_1);
- Cv=apply(Cv,LLcrd(#)); // 14.12.18
- while(length(Cv)==1,
- Cv=Cv_1;
- );
- Cv=apply(Cv,Lcrd(#));
- tmp1=min(apply(Cv,#_1));
- tmp2=max(apply(Cv,#_1));
- if(isstring(Xorg),X0=parse(Xorg),X0=Xorg);
- if(isstring(Yorg),Y0=parse(Yorg),Y0=Yorg);
- if(X0<tmp1,
- X0=tmp1;
- ,
- if(X0>tmp2,
- X0=tmp2;
- );
- );
- tmp1=select(
- 1..(length(Cv)-1),Cv_#_1<=X0 & X0<=Cv_(#+1)_1);
- tmp2=select(
- 1..(length(Cv)-1),Cv_#_1>=X0 & X0>=Cv_(#+1)_1);
- tmp2=remove(tmp2,common(tmp2,tmp1));
- Ban=concat(tmp1,tmp2);
- Tate=select(Ban,
- abs(Cv_#_1-Cv_(#+1)_1)<=
- 10^(-2)*abs(Cv_#_2-Cv_(#+1)_2)
- );
- Ban=remove(Ban,Tate);
- Ylist=[];
- forall(Ban,
- tmp=Cv_#;
- x1=tmp_1; y1=tmp_2;
- tmp=Cv_(#+1);
- x2=tmp_1; y2=tmp_2;
- tmp=((x2-X0)*y1+(X0-x1)*y2)/(x2-x1);
- Ylist=append(Ylist,tmp);
- );
- forall(Tate,
- tmp=Cv_#;
- x1=tmp_1; y1=tmp_2;
- tmp=Cv_(#+1);
- x2=tmp_1; y2=tmp_2;
- tmp1=min([y1,y2]);
- tmp2=max([y1,y2]);
- if(Y0<tmp1,
- tmp=tmp1;
- ,
- if(Y0>tmp2,
- tmp=tmp2;
- ,
- tmp=Y0;
- );
- );
- Ylist=append(Ylist,tmp);
- );
- tmp=sort(Ylist,abs(#_1-Y0));
- [X0,tmp_1];
-);
-
-PutonLine(name,p1,p2):=PutonLine(name,p1,p2,[]);
-PutonLine(name,p1org,p2org,options):=(
-//help:PutonLine("C","sgAB");
-//help:PutonLine("C",pA,pB);
- regional(par,p1,p2,dx,dy,tmp,tmp1,tmp2);
- par=0.5;
- tmp=Divoptions(options);
- if(length(tmp_6)>0,
- par=tmp_6_1;
- );
- p1=Lcrd(p1org);//16.10.11from
- p2=Lcrd(p2org);
- dx=p2_1-p1_1;
- dy=p2_2-p1_2;
- tmp1=(1-par)*p1+par*p2;
- if(abs(dx)>abs(dy),
- tmp=name+".x";
- tmp2="["+tmp+",dy/dx*("+tmp+"-p1_1)+p1_2]";//16.10.11upto
- Putpoint(name,tmp1,parse(tmp2));
- ,
- if(abs(dy)>0,
- tmp=name+".y";
- tmp2="[dx/dy*("+tmp+"-p1.y)+p1_1,"+tmp+"]";
- Putpoint(name,tmp1,parse(tmp2));
- ,
- tmp2=p1;//16.10.11
- Putpoint(name,tmp1,tmp2);
- );
- );
-);
-
-PutonSeg(name,sgstr):=(
- regional(seg,p1,p2);
- if(isstring(sgstr),seg=parse(sgstr),seg=sgstr);
- PutonSeg(name,LLcrd(seg_1),LLcrd(seg_2));
-);
-PutonSeg(name,p1,p2):=PutonSeg(name,p1,p2,[]);
-PutonSeg(name,p1org,p2org,options):=(
-//help:PutonSeg("C","sgAB");
-//help:PutonSeg("C",pA,pB);
- regional(par,dx,dy,p,tmp,tmp1,tmp2);
- par=0.5;
- tmp=Divoptions(options);
- if(length(tmp_6)>0,
- par=tmp_6_1;
- );
- p1=Lcrd(p1org);//16.10.11from
- p2=Lcrd(p2org);
- PutonLine(name,p1,p2,[par]);
- dx=p2_1-p1_1;
- dy=p2_2-p1_2;
- p=parse(name+".xy");
- p=LLcrd(p);
- if(abs(dx)>abs(dy) & (p_1-p1_1)*(p_1-p2_1)>0,
- if(|p-p1|<|p-p2|,
- parse(name+".xy=Pcrd(p1)");
- ,
- parse(name+".xy=Pcrd(p2)");
- );
- );
- if(abs(dx)<abs(dy) & (p_2-p1_2)*(p_2-p2_2)>0,
- if(|p-p1|<|p-p2|,
- parse(name+".xy=Pcrd(p1)");
- ,
- parse(name+".xy=Pcrd(p2)");//16.10.11upto
- );
- );
-);
-
-PutonCurve(pn,crv):=PutonCurve(pn,crv,[]);
-PutonCurve(pn,crv,options):=(
-//help:PutonCurve("A","gr1");
- regional(Pmt,pstr,optionL,leftlim,rightlim,tmp,tmp1,Flg,Msg);
- if(!islist(options),optionL=[options],optionL=options);
- leftlim=XMIN;
- rightlim=XMAX;
- Flg=0;
- Msg="y";
- forall(optionL,
- if(isstring(#), // 16.02.10 from
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,tmp,tmp+1));
- if(tmp1=="N", Msg="n"); // 16.02.10 upto
- ,
- if(Flg==0,
- leftlim=#;
- Flg=Flg+1;
- ,
- rightlim=#;
- );
- );
- );
- Pmt=MeetCurve(crv,leftlim,0);
- pstr=apply(allpoints(),textformat(#,5)); // 15.04.07
- if(!contains(pstr,pn),
- createpoint(pn,Pcrd(Pmt));
- ,
- tmp1=parse(pn+".x");
- if(tmp1< leftlim % tmp1>rightlim,
- if(tmp1< leftlim,tmp= leftlim, tmp=rightlim);
- Pmt=MeetCurve(crv,textformat(tmp,5),pn+".y");
- ,
- Pmt=MeetCurve(crv,pn+".x",pn+".y");
- );
- ptstr=pn+".xy="+textformat(Pcrd(Pmt),5)+";";
- parse(ptstr);
- );
- if(Msg=="y",
- println("Put "+pn+" on Curve "+text(crv));
- );
-);
-
-CrossPoint(name,Crv1,Crv2,range):=(
- regional(Mx1,Mx2,Mx3,tmp,Crs1,Crs2,Crs3,Crs4,df1,df2);
- Mx1=range_1; Mx2=range_2;
- repeat(15,
- Mx3=(Mx1+Mx2)/2;
- Crs1=MeetCurve(Crv1,Mx1,0);
- Crs2=MeetCurve(Crv2,Mx1,0);
- Crs3=MeetCurve(Crv1,Mx3,0);
- Crs4=MeetCurve(Crv2,Mx3,0);
- df1=Crs1_2-Crs2_2;
- df2=Crs3_2-Crs4_2;
- if((df1>0 & df2>0) % (df1<0 & df2<0),
- Mx1=Mx3;
- ,
- Mx2=Mx3;
- );
- );
- Putpoint(name,Crs1);
-);
-
-Setscaling(sc):=(
-//help:Setscaling(3);
- SCALEX=1;
- SCALEY=sc;
- Com0th("Setscaling("+sc+")");
- Setwindow("Msg=no");
-);
-
-Periodfun(defL,rep):=Periodfun(defL,rep,[]);
-Periodfun(defL,rep,optionorg):=( // 16.11.24
-//help:Periodfun(["0",[-1,0],"1",1,[0,1],1],2(num of repetition),options);
-//help:Periodfun(options=["Con=y"]);
-//help:Periodfun(defL=[function string, range, devision number,...]);
- regional(nn,fun,range,num,options,nr,maxfun,
- tmp,tmp1,tmp2,eqL,connect,minx,maxx,pdata,Eps,prept);
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5;
- connect="Y";
- forall(eqL,
- tmp=indexof(#,"=");
- tmp2=substring(#,tmp,tmp+1);
- tmp=substring(#,0,3);
- if(Toupper(tmp)=="CON",
- connect=Toupper(tmp2);
- options=remove(options,[#]);
- );
- );
- minx=10000;
- maxx=-10000;
- mxfun="";
- pdata=[];
- forall(1..(length(defL)/3),nn,
- fun=defL_(3*nn-2);
- range=defL_(3*nn-1);
- tmp1=if(isstring(range_1),parse(range_1),range_1); //17.06.11(2lines)
- tmp2=if(isstring(range_2),parse(range_2),range_2);
- minx=min(minx,tmp1);
- maxx=max(maxx,tmp2);
- num=defL_(3*nn);
- options=append(options,"Num="+text(num));
- Plotdata("pe"+text(nn),fun,
- "x="+textformat([tmp1,tmp2],5),options);
- pdata=append(pdata,"grpe"+text(nn));
- tmp1=range_1; //17.06.11(4lines)
- if(isstring(tmp1),tmp1=replace(tmp1,"pi","%pi"),tmp1=format(tmp1,5));
- tmp2=range_2;
- if(isstring(tmp2),tmp2=replace(tmp2,"pi","%pi"),tmp2=format(tmp2,5));
- mxfun=mxfun+"elseif ("+tmp1+
- "<=x and x<"+tmp2+") then "+fun+" ";
- );
- per=maxx-minx;
- forall(1..rep,nr,
- tmp1=[];
- forall(pdata,
- Translatedata("p"+#+text(nr),#,[per*nr,0],options);
- Translatedata("m"+#+text(nr),#,[-per*nr,0],options);
- tmp1=concat(tmp1,["trp"+#+text(nr),"trm"+#+text(nr)]);
- );
- );
- pdata=concat(pdata,tmp1);
- if(connect=="Y",
- Eps=10^(-5);
- pdata=sort(pdata,[parse(#)_1_1]);
- prept=parse(pdata_1)_1;
- forall(1..(length(pdata)),
- tmp=parse(pdata_#);
- tmp1=tmp_1;
- tmp2=tmp_(length(tmp));
- if(|prept-tmp1|>Eps,
- Listplot("con"+text(#),[prept,tmp1],append(options,"da"));
- );
- prept=tmp_(length(tmp));
- );
- );
- mxfun=substring(mxfun,4,length(mxfun)-1);
- [mxfun,per];
-);
-
-Fourierseries(nm,coeff,per,nterm):=
- Fourierseries(nm,coeff,per,nterm,[]); // 16.11.24
-Fourierseries(nm,coeff,per,nterm,options):=(
-//help:Fourierseries("1",[c0,cn,sn],period,numterm,options);
- regional(c0,cn,sn,fs,tmp,tmp1,tmp2);
- c0=coeff_1;
- if(!isstring(c0),c0=format(c0,5));
- c0=replace(c0,"%pi","pi");
- cn=coeff_2;
- if(!isstring(cn),cn=format(cn,5));
- cn=replace(cn,"%pi","pi");
- sn=coeff_3;
- if(!isstring(sn),sn=format(sn,5));
- sn=replace(sn,"%pi","pi");
- fs=c0;
- forall(1..nterm,
- tmp=parse(Assign(cn,["n",#]));
- tmp1=Assign("("+format(tmp,5)+")*cos(n*2*pi/per*x)",
- ["n",#,"per",per]);
- tmp=parse(Assign(sn,["n",#]));
- tmp2=Assign("("+format(tmp,5)+")*sin(n*2*pi/per*x)",
- ["n",#,"per",per]);
- fs=fs+"+"+tmp1+"+"+tmp2;
- );
- Plotdata("four"+nm,fs,"x",options);
-);
-
-Tabledatalight(nm,xLst,yLst,rmvL):=Tabledatalight(nm,xLst,yLst,rmvL,[]);
-Tabledatalight(nm,xLst,yLst,rmvL,optionorg):=(
-//help:Tabledatalight("",xLst,yLst,rmvL,[2,"Rng=y"]);
- regional(options,rng,name,upleft,ul,flg,tick,eqL,reL,n,m,xsize,ysize,
- rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps);
-// name="tb"+nm;
- name="tb";
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5; //16.12.16from
- reL=tmp_6;
- rng="Y";
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=Toupper(substring(#,tmp,tmp+1));
- if(tmp1=="RN",
- rng=tmp2;
- options=remove(options,[#]);
- );
- );//16.12.16upto
- tick=1;
- flg=0;
- forall(reL,
- if(flg==0,
- tick=#;
- flg=flg+1;
- ,
- upleft=tmp_6_1;
- );
- );
- tmp=sum(yLst);
- upleft=[0,tmp];
- TableOptions=options; // 16.11.28
- println("Tabledatalight "+name+" generated");
- ul=upleft/10;
- m=length(xLst);
- n=length(yLst);
- xsize=sum(xLst);
- ysize=sum(yLst);
- clist=[ul];
- rlist=[ul];
- forall(1..m,
- tmp1=clist_(#)_1+xLst_#/10;
- clist=append(clist,[tmp1,clist_1_2]);
- );
- forall(1..n,
- tmp1=rlist_(#)_2-yLst_#/10;
- rlist=append(rlist,[0,tmp1]);
- );
- Tb=[clist,rlist];
- tmp=name+"="+Tb;
- parse(tmp);
- forall(0..m,
- tmp1="c"+text(#)+"r0";
- tmp2="c"+text(#)+"r"+text(n);
- Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options);
- if(mod(#,tick)==0 % #==m,
- tmp=clist_(#+1);
- drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#));
- );
- );
- forall(0..n,
- tmp1="c0r"+text(#);
- tmp2="c"+text(m)+"r"+text(#);
- Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options);
- if(mod(#,tick)==0 % #==n,
- tmp=rlist_(#+1);
- drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#));
- );
- );
- Tsegrmv(rmvL,options);
- Addax(0);
- Eps=10^(-3);
- tmp1=clist_(length(clist));
- tmp2=rlist_1;
- tmp3=rlist_(length(rlist));
- if(rng=="Y", // 16.12.16
- Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]);
- );
- Tb;
-);
-
-Tabledata(nm,n,m,xsize,ysize,rmvL):=
- Tabledata(nm,n,m,xsize,ysize,rmvL,[]);
-Tabledata(nm,n,m,xsize,ysize,rmvL,options):=(
-//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]);
- regional(Tb,name,tmp,xLst,yLst);
- name="tb"+nm;
- xLst=apply(1..n,xsize/n);
- yLst=apply(1..m,ysize/m);
- Tabledata(nm,xLst,yLst,rmvL,options)
-);
-Tabledata(nm,xLst,yLst,rmvL):=Tabledata(nm,xLst,yLst,rmvL,[]);
-Tabledata(nm,xLst,yLst,rmvL,optionorg):=(
-//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]);
- regional(name,options,eqL,reL,rng,upleft,ul,flg,tick,n,m,xsize,ysize,
- rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps);
-// name="tb"+nm;
- name="tb";
- tmp=sum(yLst);
- upleft=[0,tmp];
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5; //16.12.16from
- reL=tmp_6;
- rng="Y";
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=Toupper(substring(#,tmp,tmp+1));
- if(tmp1=="RN",
- rng=tmp2;
- options=remove(options,[#]);
- );
- );//16.12.16upto
- tick=1;
- flg=0;
- forall(reL,
- if(flg==0,
- tick=#;
- flg=flg+1;
- ,
- upleft=tmp_6_1;
- );
- );
- TableOptions=options; // 16.11.28
- println("Tabledata "+name+" generated");
- ul=upleft/10;
- m=length(xLst);
- n=length(yLst);
- xsize=sum(xLst);
- ysize=sum(yLst);
- clist=[ul];
- rlist=[ul];
- forall(1..m,
- tmp1=clist_(#)_1+xLst_#/10;
- clist=append(clist,[tmp1,clist_1_2]);
- );
- forall(1..n,
- tmp1=rlist_(#)_2-yLst_#/10;
- rlist=append(rlist,[0,tmp1]);
- );
- Tb=[clist,rlist];
- tmp=name+"="+Tb;
- parse(tmp);
- forall(0..m,
- tmp="C"+text(#);
- tmp1="c"+text(#)+"r0";
- if(#==0,
- Putpoint(tmp,Tgrid(tmp1));
- ,
- Putpoint(tmp,Tgrid(tmp1),[parse(tmp+".x"),C0.y]);
- clist_(#+1)=parse(tmp+".xy");
- );
- inspect(parse(tmp),"ptsize",3);
- inspect(parse(tmp),"labeled",false);
- if(mod(#,tick)==0 % #==m,
- tmp=clist_(#+1);
- drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#));
- );
- );
- forall(0..n,
- tmp="R"+text(#);
- tmp1="c0r"+text(#);
- if(#==0,
- Putpoint(tmp,Tgrid(tmp1));
- ,
- Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]);
- rlist_(#+1)=parse(tmp+".xy");
- );
- Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]);
- inspect(parse(tmp),"ptsize",3);
- inspect(parse(tmp),"labeled",false);
- if(mod(#,tick)==0 % #==n,
- tmp=rlist_(#+1);
- drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#));
- );
- );
- Tb=[clist,rlist];
- tmp=name+"="+Tb;
- parse(tmp);
- forall(0..m,
- tmp1="c"+text(#)+"r0";
- tmp2="c"+text(#)+"r"+text(n);
- Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options);
- if(#<m,
- tmp1=parse("C"+text(#));
- tmp2=parse("C"+text(#+1));
- tmp=(tmp1.xy+tmp2.xy)/2;
- drawtext(tmp+[-0.2,0.5],text((tmp2.x-tmp1.x)*10));
- );
- );
- forall(0..n,
- tmp1="c0r"+text(#);
- tmp2="c"+text(m)+"r"+text(#);
- Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options);
- if(#<n,
- tmp1=parse("R"+text(#));
- tmp2=parse("R"+text(#+1));
- tmp=(tmp1.xy+tmp2.xy)/2;
- drawtext(tmp-[1.2,0.1],text(abs(tmp1.y-tmp2.y)*10));
- );
- );
- Tsegrmv(rmvL,options);
- Addax(0);
- Eps=10^(-3);
- tmp1=clist_(length(clist));
- tmp2=rlist_1;
- tmp3=rlist_(length(rlist)); // 15.06.11
- if(rng=="Y", // 16.12.16
- Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]);
- );
- Tb;
-);
-
-Tseginfo(seg):=(
- regional(cr,tp,tpc,n1,n2,n3,tmp,tmp1,tmp2);
- if(substring(seg,0,2)=="sg",
- cr=substring(seg,2,length(seg));
- ,
- cr=seg;
- );
- tp=substring(cr,0,1);
- if(tp=="c",
- tpc="r";
- ,
- tpc="c";
- );
- tmp1=indexof(cr,tpc);
- tmp=substring(cr,tmp1,length(cr));
- tmp2=tmp1+indexof(tmp,tpc);
- n1=substring(cr,1,tmp1-1);
- n2=substring(cr,tmp1,tmp2-1);
- n3=substring(cr,tmp2,length(cr));
- [tp+n1,tpc,parse(n2),parse(n3)];
-);
-
-Tsegrmv(rmvL):=Tsegrmv(rmvL,[]);
-Tsegrmv(rmvL,options):=(
- regional(cr,gcL,flg,gc,hd,tail,tpc,m1,m2,n1,n2,tmp,tmp1,tmp2);
- forall(rmvL,cr,
- tmp1=Tseginfo(cr);
- hd=tmp1_1;
- tpc=tmp1_2;
- m1=tmp1_3;
- m2=tmp1_4;
- gcL=select(GCLIST,Tseginfo(#_1)_1==tmp1_1);
- flg=0;
- forall(gcL,
- if(flg==0,
- tmp=Tseginfo(#_1);
- n1=tmp_3;
- n2=tmp_4;
- if(m1>=n1 & m2<=n2,
- gc=#;
- flg=1;
- );
- );
- );
- if(flg==1,
- Changestyle([gc_1],["nodisp"]);
- tail="";
- if(indexof(hd,"r")>0,
- tail=hd; hd="";
- );
- if(n1<m1,
- tmp1=tpc+text(n1);
- tmp2=tpc+text(m1);
- tmp=hd+tail+tmp1+tmp2;
- Tlistplot(tmp,[hd+tmp1+tail,hd+tmp2+tail],options);
- );
- if(m2<n2,
- tmp1=tpc+text(m2);
- tmp2=tpc+text(n2);
- tmp=hd+tail+tmp1+tmp2;
- Tlistplot(tmp,[hd+tmp1+tail,hd+tmp2+tail],options);
- );
- );
- );
-);
-
-Tgrid(ptstr):=(
-//help:Tgrid("c2r5");
- regional(tmp,tmp1,tmp2);
- tmp=parse(ptstr);
- if(islist(tmp),
- tmp;
- ,
- tmp=indexof(ptstr,"r");
- tmp1=substring(ptstr,1,tmp-1);
- tmp1=parse(tmp1);
- tmp2=substring(ptstr,tmp,length(ptstr));
- tmp2=parse(tmp2);
- [tb_1_(tmp1+1)_1,tb_2_(tmp2+1)_2];
- );
-);
-
-Tlistplot(ptL):=Tlistplot(ptL,[]);
-Tlistplot(Ag1,Ag2):=(
- regional(nm,ptL,options);
- if(isstring(Ag1),
- nm=Ag1;
- ptL=Ag2;
- options=[];
- ,
- ptL=Ag1;
- options=Ag2;
- nm=ptL_1+ptL_2;
- );
- Tlistplot(nm,ptL,options);
-);
-Tlistplot(nm,ptL,options):=(
-//help:Tlistplot(["c0r0","c0r4"]);
-//help:Tlistplot("1",["c0r0","c0r4"]);
- regional(tmp);
- tmp=apply(ptL,Tgrid(#)); // 15.06.03
- Listplot(nm,tmp,append(options,"Msg=no"));
-);
-
-ChangeTablestyle(nameL,style):=(
-////help:ChangeTablestyle(["r0c0c3"],["da"]);
- regional(nmL,grid,head,sb,tmp,tmp1,tmp2,
- tsg,segall,sg,str);
- if(islist(nameL),nmL=nameL,nmL=[nameL]);
- forall(nmL,grid,
- if(substring(grid,0,1)=="r",sb="c",sb="r");
- tmp=Indexall(grid,sb);
- head=substring(grid,0,tmp_1-1);
- tmp1=substring(grid,tmp_1,tmp_2-1);
- tmp2=substring(grid,tmp_2,length(grid));
- tsg=apply([tmp1,tmp2],parse(#));
- tmp1=apply(GCLIST,#_1); // 16.12.06from
- segall=[];
- forall(tmp1,
- tmp2=substring(#,2,length(#));
- tmp=indexof(tmp2,sb);
- tmp2=substring(tmp2,0,tmp-1);
- if(head==tmp2,segall=append(segall,#));
- );// 16.12.06upto
- sg=[];
- forall(segall,
- tmp=Indexall(#,sb);
- tmp1=substring(#,tmp_1,tmp_2-1);
- tmp2=substring(#,tmp_2,length(#));
- tmp=apply([tmp1,tmp2],parse(#));
- if((tsg_1>=tmp_1) & (tsg_2<=tmp_2),
- sg=tmp;
- Changestyle(#,["nodisp"]);
- );
- );
- if(length(sg)==0,
- println("No segment includes "+grid);
- ,
- if(sb=="c",str=sb+"no"+head,str=head+sb+"no");
- if(sg_1<tsg_1,
- tmp1=replace(str,"no",text(sg_1));
- tmp2=replace(str,"no",text(tsg_1));
- tmp=head+sb+text(sg_1)+"c"+text(tsg_1);
- Tlistplot(tmp,[tmp1,tmp2],TableOptions);
- );
- tmp1=replace(str,"no",text(tsg_1));
- tmp2=replace(str,"no",text(tsg_2));
- tmp=head+"c"+text(tsg_1)+"c"+text(tsg_2);
- Tlistplot(tmp,[tmp1,tmp2],style);
- if(tsg_2<sg_2,
- tmp1=replace(str,"no",text(tsg_2));
- tmp2=replace(str,"no",text(sg_2));
- tmp=head+"c"+text(tsg_2)+"c"+text(sg_2);
- Tlistplot(tmp,[tmp1,tmp2],TableOptions);
- );
- );
- );
-);
-
-Findcell(pos1,pos2):=Findcell("",pos1,pos2);
-Findcell(Tbdata,pos1,pos2):=(
-//help:Findcell("c0r0","c2r1");
- regional(tmp1,tmp2,posnw,posse,ctr,dx,dy);
- if(isstring(pos1),
- posnw=Tgrid(pos1); // 15.05.20
- posse=Tgrid(pos2);
- //posnw=parse(pos1);
- //posse=parse(pos2);
- ,
- if(islist(pos1),
- posnw=pos1;
- posse=pos2;
- ,
- tmp1="c"+text(pos1-1)+"r"+text(pos2-1);
- tmp2="c"+text(pos1)+"r"+text(pos2);
- posnw=Tgrid(tmp1);
- posse=Tgrid(tmp2);
-// posnw=parse(tmp1);
-// posse=parse(tmp2);
- );
- );
- ctr=(posnw+posse)/2;
- dx=abs(posse_1-ctr_1);
- dy=abs(posnw_2-ctr_2);
- [ctr,dx,dy];
-);
-
-Putcell(pos1,pos2,dir,lttr):=Putcell("",pos1,pos2,dir,lttr);
-Putcell(Tbdata,pos1,pos2,dir,lttr):=(
-//help:Putcell("c0r0","c2r1","lt","abc");
-//help:Putcell(2,3,"c","xyz");
- regional(tmp,tmp1,tmp2,posnw,posse,
- posdir,posstr,ctr,dx,dy);
- tmp=Findcell(Tbdata,pos1,pos2);
- ctr=tmp_1; dx=tmp_2; dy=tmp_3;
- posdir=ctr;
- posstr=dir;
- if(indexof(dir,"b")>0,
- posdir_2=posdir_2-dy;
- posstr=replace(posstr,"b","n");
- );
- if(indexof(dir,"t")>0,
- posdir_2=posdir_2+dy;
- posstr=replace(posstr,"t","s");
- );
- if(indexof(dir,"l")>0,
- posdir_1=posdir_1-dx;
- posstr=replace(posstr,"l","e");
- );
- if(indexof(dir,"r")>0,
- posdir_1=posdir_1+dx;
- posstr=replace(posstr,"r","w");
- );
- Letter(posdir,posstr,text(lttr));
-);
-
-Putcellexpr(pos1,pos2,dir,ex):=Putcellexpr("",pos1,pos2,dir,ex);
-Putcellexpr(Tbdata,pos1,pos2,dir,ex):=(
-//help:Putcellexpr("c0r0","c2r1","lt","abc");
-//help:Putcellexpr(2,3,"c","\sin x");
- Putcell(Tbdata,pos1,pos2,dir,"$"+text(ex)+"$");
-);
-
-Putrow(nrow,dir,lttrL):=Putrow("",nrow,dir,lttrL);
-Putrow(Tbdata,nrow,dir,lttrL):=(
-//help:Putrow(1,"c",["x","y","z"]);
- regional(tmp,tmp1,mcol);
- mcol=length(lttrL);
- forall(1..mcol,
- Putcell(Tbdata,#,nrow,dir,lttrL_#);
- );
-);
-
-Putrowexpr(nrow,dir,exL):=Putrowexpr("",nrow,dir,exL);
-Putrowexpr(Tbdata,nrow,dir,exL):=(
-//help:Putrowexpr(2,"r",["x","y","z"]);
- regional(lttrL);
- lttrL=apply(exL,"$"+#+"$");
- Putrow(Tbdata,nrow,dir,lttrL);
-);
-
-PutcoL(mcol,dir,lttrL):=PutcoL("",mcol,dir,lttrL);
-PutcoL(Tbdata,mcol,dir,lttrL):=(
-//help:PutcoL(1,"c",["x","y","z"]);
- regional(tmp,tmp1,nrow);
- nrow=length(lttrL);
- forall(1..nrow,
- Putcell(Tbdata,mcol,#,dir,lttrL_#);
- );
-);
-PutcoLexpr(mcol,dir,exL):=PutcoLexpr("",mcol,dir,exL);
-PutcoLexpr(Tbdata,mcol,dir,exL):=(
-//help:PutcoLexpr(2,"r",["x","y","z"]);
- regional(lttrL);
- lttrL=apply(exL,"$"+#+"$");
- PutcoL(Tbdata,mcol,dir,lttrL);
-);
-
-Setrange():=(
-//help:Setrange();
- SW.xy=Pcrd([XMIN,YMIN]);
- NE.xy=Pcrd([XMAX,YMAX]);
- drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]),
- Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]);
-);
-
-Sciform(list):=(
- regional(plotlist,comp,pos,out,out2,nn,strL,flg,
- tmp,tmp1,tmp2,tmp3,Nj);
- plotlist=Flatten([list]);
- out=replace(plotlist_1,".xy","");
- out=replace(out,".x","(1)");
- out=replace(out,".y","(2)");
- if(length(plotlist)==1,
- comp=[];
- forall(1..length(out),
- comp=append(comp,substring(out,#-1,#));
- );
- out="";
- pos=0;
- forall(comp,
- if(#!="'",
- out=out+#;
- ,
- if(pos==0,
- tmp=indexof(out,"Assign(");
- if(substring(out,length(out)-7,length(out))=="Assign(",
- out=out+"'";
- pos=1;
- ,
- out=out+"Assign('";
- pos=2;
- );
- ,
- if(pos==2,
- out=out+"')";
- ,
- out=out+"'";
- );
- pos=0;
- );
- );
- );
- ,
- forall(2..length(plotlist),
- comp=plotlist_#;
- if(isstring(comp),
- pos=indexof(comp,"Assign(");
- if(pos>0,
- comp=substring(comp,6,length(comp));
- );
- out=out+"Assign(";
- comp=replace(comp,".xy","");
- comp=replace(comp,".x","(1)");
- comp=replace(comp,".y","(2)");
- out=out+"'"+comp+"'";
- out=out+"),";
- );
- if(islist(comp),
- forall(comp,
- out=out+"'"+#+"',";
- );
- );
- );
- if(length(plotlist)>1,
- out=substring(out,0,length(out)-1);
- out=out+");";
- );
- );
- pos=[];
- forall(1..length(out),
- tmp=indexof(substring(out,#-1,length(out)),"Assign");
- if(tmp>0,
- tmp1=#-1+tmp;
- if(length(pos)==0,
- pos=[tmp1];
- ,
- if(pos_(length(pos))<tmp1,
- pos=append(pos,tmp1);
- );
- );
- );
- );
- if(length(pos)>0,
- strL=[];
- Nj=0;
- forall(pos,
- tmp=substring(out,Nj,#-1);
- strL=append(strL,tmp);
- Nj=#-1;
- );
- strL=append(strL,substring(out,Nj,length(out)));
- out="";
- forall(strL,
- if(indexof(#,"Assign")==0,
- out=out+#;
- ,
- tmp=indexof(#,"('");
- tmp1=indexof(#,"')");
- tmp2=substring(#,tmp+1,tmp1-2);
- tmp3=substring(#,tmp1-2,length(#));
- if(indexof(tmp2,"=")==0,
- out=out+#;
- ,
- tmp=substring(tmp2,0,indexof(tmp2,"="));
- out=out+"'"+tmp+"'+"+"Assign('";
- tmp=substring(tmp2,indexof(tmp2,"="),length(tmp2));
- out=out+tmp+tmp3;
- );
- );
- );
- );
- out2=""; // patched 16.01.21 from
- nn=length(out);
- flg=0;
- forall(1..nn,
- if(flg==0,
- tmp=indexof(out,"='+Assign('");
- if(tmp==0,
- out2=out2+out;
- flg=1;
- ,
- out2=out2+substring(out,0,tmp);
- out=substring(out,tmp+10,length(out));
- tmp=indexof(out,"'"); // 16.04.19 from
- tmp1=substring(out,0,tmp-1);
- tmp2="1234567890";
- tmp=apply(1..length(tmp1),
- indexof(tmp2,substring(tmp1,#-1,#)));
- tmp=min(tmp);
- if(tmp==0, // 16.04.19 upto
- out2=out2+"'+Assign('";
- ,
- tmp=indexof(out,"'");
- out=substring(out,0,tmp)+substring(out,tmp+1,length(out));
- // 16.04.18 upto
- );
- );
- );
- );
- out2=replace(out2,"Dist=","D=");
- out2=replace(out2,"Dis=","D=");
- out2;
-);
-
-RSform(str):=RSform(str,3);
-RSform(str,listfrom):=(
-//help:RSform(string,listfrom);
- regional(posL,mxlv,rep1,rep2,rep3,prev,out,
- tmp,tmp1,tmp2);
- rep1="c("; rep2="c("; rep3="list(";
- if(listfrom<3,rep2="list(");
- if(listfrom==1,rep1="list(");
- posL=Bracket(str,"[]");
- tmp=apply(posL,#_2);
- mxlv=max(tmp);
- out="";
- prev=0;
- forall(posL,
- out=out+substring(str,prev,#_1-1);
- prev=#_1;
- if(#_2>0,
- tmp1=select(posL,tmp,(tmp_2<0)&(tmp_1>#_1));
- tmp1=tmp1_1_1;
- tmp=substring(str,#_1,tmp1);
- if(#_2==mxlv,out=out+rep1);
- if(#_2==mxlv-1,out=out+rep2);
- if(#_2<=mxlv-2,out=out+rep3);
- ,
- out=out+")";
- );
- );
- out=out+substring(str,prev,length(str));
- out=replace(out,".xy","");
- out=replace(out,".x","[1]");
- out=replace(out,".y","[2]");
- out=replace(out,"c(1)","[1]");//17.10.06(2lines)
- out=replace(out,"c(2)","[2]");
- out;
-);
-
-RSslash(str):=( //17.09.24
- regional(tmp);
- tmp=replace(str,"\","\\");
-// tmp=replace(tmp,"\\\\","\\");
- tmp;
-);
-
-Rform(list):=(
- regional(plotlist,comp,pos,out,strL,tmp,tmp1,tmp2,tmp3,Nj);
- out=list;
- out=replace(out,"[[[","list([[");
- out=replace(out,"[","c(");
- out=replace(out,"]",")");
- out=replace(out,".xy","");
- out=replace(out,".x","[1]");
- out=replace(out,".y","[2]");
- out;
-);
-
-Defvar(varstr):=(
- regional(name,value,tmp,tmp1);
- if(isstring(varstr),
- parse(varstr);
- tmp=indexof(varstr,"=");
- name=substring(varstr,0,tmp-1);
- value=substring(varstr,tmp,length(varstr));
- value=parse(value);
- tmp1=select(1..length(VLIST),VLIST_#_1==name);
- if(length(tmp1)>0,
- tmp=tmp1_1;
- VLIST_tmp=[name,value];
- ,
- VLIST=prepend([name,value],VLIST);
- );
- ,
- forall(1..(length(varstr)/2), // 16.11.16from
- name=varstr_(2*#-1);
- value=varstr_(2*#);
- Defvar(name,value);
- ); // 16.11.16upto
- );
-);
-
-Defvar(name,value):=(
-//help:Defvar("a",0.3);
-//help:Defvar(["a",0.3,"b",2]);
- regional(tmp,tmp1);
- if(islist(value),
- tmp1="[";
- forall(value,
- if(isstring(#), // 16.11.14
- tmp1=tmp1+Dq+#+Dq+","; // 16.11.14
- ,
- tmp1=tmp1+format(#,5)+",";
- );
- );
- tmp1=substring(tmp1,0,length(tmp1)-1)+"]";
- ,
- tmp1=format(value,5);
- );
- tmp=name+"="+tmp1; // 15.02.06
- parse(tmp);
- VLIST=select(VLIST,#_1!=name); // 15.02.08
- VLIST=prepend([name,value],VLIST);
-);
-
-IftoR(strorg):=(
- regional(str,pre,post,sub,ppL,ifstr,out,tmp,tmp1,tmp2);
- str=strorg;
- ifstr=indexof(str,"if(");
- if(ifstr==0,
- out=replace(str,",","}else{");
- ,
- pre=substring(str,0,ifstr-1)+"if(";
- ppL=Bracket(str,"()");
- tmp1=ifstr+2;
- tmp=select(ppL,#_1==tmp1);
- tmp=select(ppL,#_2==-tmp_1_2);
- tmp2=tmp_1_1;
- sub=substring(str,tmp1,tmp2-1);
- post="}"+substring(str,tmp2,length(str));
- tmp=indexof(sub,",");
- tmp1=substring(sub,0,tmp-1);
- tmp2=substring(sub,tmp,length(sub));
- sub=tmp1+"){"+tmp2;
- tmp=IftoR(sub);
- out=pre+tmp+"}";
- );
- out;
-);
-
-FortoR(strorg):=(
- regional(str,pre,post,sub,ppL,forstr,out,tmp,tmp1,tmp2);
- str=strorg;
- forstr=indexof(str,"forall(");
- if(forstr==0,
- out=str;
- ,
- pre=substring(str,0,forstr-1)+"for(";
- ppL=Bracket(str,"()");
- tmp1=forstr+6;
- tmp=select(ppL,#_1==tmp1);
- tmp=select(ppL,#_2==-tmp_1_2);
- tmp2=tmp_1_1;
- sub=substring(str,tmp1,tmp2-1);
- post="}"+substring(str,tmp2,length(str));
- tmp=indexof(sub,",");
- tmp1=substring(sub,0,tmp-1);
- tmp2=substring(sub,tmp,length(sub));
- sub=tmp1+"){"+tmp2;
- tmp1=indexof(sub,"{");
- tmp2=indexof(sub,",");
- tmp=substring(sub,tmp1,tmp2-1);
- pre=pre+tmp+" in "+substring(sub,0,tmp1-1)+"{";
- sub=substring(sub,tmp2,length(sub));
- tmp=FortoR(sub);
- out=pre+tmp+"}";
- );
- out=replace(out,"..",":");
- out;
-);
-
-Deffun(name,bodylist):=(
-//help:Deffun("f(x)",["regional(y)","y=x^2*(x-3)","y"]);
- regional(funstr,str,Pos,nbody,bdy,ppL,bpL,excma,tmp,tmp1,tmp2);
- funstr=name+":=(";
- forall(bodylist,
- funstr=funstr+#+";";
- );
- funstr=funstr+");";
- parse(funstr);
- tmp=indexof(name,"(");
- str=substring(name,0,tmp-1)+"<-function(";
- str=str+substring(name,tmp,length(name))+"{";
- forall(1..(length(bodylist)-1),nbody,
- bdy=bodylist_nbody;
- Pos=indexof(bdy,"regional")+indexof(bdy,"local");
- if(Pos==0,
- bdy=replace(bdy,LFmark,"");
- bdy=replace(bdy," ","");
- ppL=Bracket(bdy,"()");
- bpL=Bracket(bdy,"[]");
- tmp1=select(bpL,#_2==1);
- tmp2=select(bpL,#_2==-1);
- excma=[];
- forall(1..(length(tmp1)),
- excma=append(excma,[tmp1_#_1,tmp2_#_1]);
- );
- tmp1=Indexall(bdy,",");
- forall(tmp1,cma,
- tmp=select(excma,(#_1<cma)&(cma<#_2));
- if(length(tmp)>0,
- bdy=substring(bdy,0,cma-1)+"'"+substring(bdy,cma,length(bdy));
- );
- );
- tmp=indexof(bdy,"forall");
- if(tmp>0,
- bdy=FortoR(bdy);
- );
- tmp=indexof(bdy,"if(");
- if(tmp>0,
- bdy=IftoR(bdy);
- );
- bdy=RSform(replace(bdy,"'",","));
- str=str+bdy+";";
- );
- );
- str=str+"return("+bodylist_(length(bodylist))+")}";
- FUNLIST=append(FUNLIST,str);
-);
-
-Windispg():=(
- regional(Nj,Nk,Dt,Vj,tmp,tmp1,tmp2,opcindy);
- gsave();
- layer(KETPIClayer);
- forall(GCLIST,Nj,
- if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17
- if(islist(Dt) & length(Dt)>0, // 12.19,12.22
- tmp=MeasureDepth(Dt);
- if(tmp==1,Dt=[Dt]);
- opcindy=Nj_3;
- if(Nj_2<0,tmp1=0,tmp1=Nj_2);
- if(tmp1<10,
- forall(Dt,Nk,
-// tmp2=apply(Nk,if(ispoint(#),Lcrd(#),#));
-// tmp2=apply(tmp2,Pcrd(#));
- tmp2=Nk; // 14.12.04
- if(length(Nk)>1,
- tmp="connect("+textformat(tmp2,5)+
- ",dashtype->"+text(tmp1)+",linecolor->"+KCOLOR+opcindy+")";
- parse(tmp);
- ,
- if(length(Nk)==1,
- tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31
- parse(tmp);
- );
- );
- );
- );
- );
- );
-// if(ADDAXES=="1", // 16.10.08from
-// draw([XMIN,0],[XMAX,0],color->[0,0.2,0]);
-// draw([0,YMIIN],[0,YMAX],color->[0,0.2,0]);
-// Letter([[XMAX,0],"e","x",[0,YMAX],"n","y"]);
-// Letter([[0,0],"sw","O"]);
-// ); // 16.10.08upto
- grestore();
- layer(0);
-);
-
-Windispg(pltdata):=(
- regional(pdata,Nj,Nk,Dt,tmp,tmp1,tmp2,opcindy);
- gsave();
- layer(KETPIClayer);
- if(!islist(pltdata),tmp=[pltdata],tmp=pltdata);
- pdata=select(GCLIST,contains(tmp,#_1));
- forall(pdata,Nj,
- if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17
- if(islist(Dt) & length(Dt)>0, // 12.19,12.22
- tmp=MeasureDepth(Dt);
- if(tmp==1,Dt=[Dt]);
- opcindy=Nj_3;
- if(Nj_2<0,tmp1=0,tmp1=Nj_2);
- if(tmp1<10,
- forall(Dt,Nk,
- tmp2=Nk; // 14.12.04
- if(length(Nk)>1,
- tmp="connect("+textformat(tmp2,5)+ // 15.05.11
- ",dashtype->"+text(tmp1)+
- ",linecolor->"+KCOLOR+opcindy+")";
- parse(tmp);
- ,
- if(length(Nk)==1,
- tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31
- parse(tmp);
- );
- );
- );
- );
- );
- );
- grestore();
- layer(0);
-);
-
-WritetoSci():=WritetoRS(); //17.12.19
-WritetoRS():=WritetoRS(FnameR);// 17.09.17from
-WritetoRS(Arg):=(
- regional(string,filename,shch,tmp1,tmp2);
- if(isstring(Arg),
- string=Arg;
- if(indexof(string,".r")>0,
- filename=string;
- shch="";
- ,
- filename=FnameR;
- shch=string;
- );
- WritetoRS(filename,shch);
- ,
- if(Arg<=1,WritetoRS(FnameR,"all"));
- if(Arg==2,WritetoRS(FnameR,"sh"));
- );
-);
-WritetoRS(filename,shchoice):=(
- regional(Plist,Pos,GrL,str,tmp,tmp1,tmp2,cmd);
- println("Write to R "+filename);
- Plist=[];
- Pnamelist=[];
- forall(remove(allpoints(),[SW,NE]),
- tmp=Lcrd(#);
- tmp1=format(re(tmp_1),6);// 15.02.05
- tmp2=format(re(tmp_2),6);
- tmp=#.name+"="+"c("+tmp1+","+tmp2+");";
- tmp=tmp+"Assignadd('"+#.name+"',"+#.name+")";
- Plist=append(Plist,tmp);
- );
- SCEOUTPUT = openfile(filename);
- tmp=Datetime();
- println(SCEOUTPUT,"# date time="+tmp_1+" "+tmp_2);
- if(isstring(CindyPathName), // 16.12.25from
- if(length(CindyPathName)>0,
- println(SCEOUTPUT,
- "# path file="+CindyPathName+" "+CindyFileName+".cdy");
- ,
- println(SCEOUTPUT,"");
- );
- ,
- println(SCEOUTPUT,"");
- );
- tmp=replace(Dirwork,"\","/"); //17.09.24
- println(SCEOUTPUT,"setwd('"+tmp+"')"); //17.09.24
-// if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
-// Libname=Libname+"2e";
-// ); // 17.10.07removed
- tmp=replace(Libname,"\","/"); //17.09.24from
-// println(SCEOUTPUT,"load('"+tmp+".Rdata')"); //17.10.11
- println(SCEOUTPUT,"source('"+tmp+".r')");//temporary
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- // 17.10.07added
- tmp=replace(tmp+"_rep2e","\","/");
- println(SCEOUTPUT,"source('"+tmp+".r')");
- );
- println(SCEOUTPUT,"Ketinit()");
- println(SCEOUTPUT,"cat(ThisVersion,'\n')");
- println(SCEOUTPUT,"Fnametex='"+Fnametex+"'");
- println(SCEOUTPUT,"FnameR='"+FnameR+"'");
- println(SCEOUTPUT,"Fnameout='"+Fnameout+"'");
- println(SCEOUTPUT,"arccos=acos; arcsin=asin; arctan=atan");
- println(SCEOUTPUT,"");
- forall(COM0thlist,
- if(indexof(#,"Texcom")==0, //17.09.22
- println(SCEOUTPUT,RSform(#));
- ,
- println(SCEOUTPUT,#);
- );
- );
- println(SCEOUTPUT,
- "Setwindow(c("+XMIN+","+XMAX+"), c("+YMIN+","+YMAX+"))");
- forall(Plist,
- println(SCEOUTPUT,#);
- );
- forall(VLIST,
- tmp=#_1;
- tmp1=#_2;
- if(!isstring(tmp1),
- if(islist(tmp1),
- tmp2="[";
- forall(tmp1,
- tmp2=tmp2+textformat(#,6)+",";
- );
- tmp1=substring(tmp2,0,length(tmp2)-1)+"]";
- ,
- tmp1=format(tmp1,6);
- );
- );
- tmp1=RSform(tmp1);
- print(SCEOUTPUT,tmp+"="+tmp1+";"); //17.09.22
-// tmp=substring(tmp,0,length(tmp)-1);
- println(SCEOUTPUT,"Assignadd('"+tmp+"',"+tmp+")");
- );
- forall(FUNLIST,
- println(SCEOUTPUT,#);
- );
- forall(GLIST,
- println(SCEOUTPUT,RSform(#));
- );
- tmp=text(Pnamelist);
- tmp=replace(tmp,"[","list(");
- Pnamelist=replace(tmp,"]",")");
- println(SCEOUTPUT,"PtL="+Pnamelist+";");
- tmp=select(GCLIST,#_2==-1);
- GrL=apply(tmp,#_1);
- tmp=text(GrL);
- tmp=replace(tmp,"[","list(");
- tmp=replace(tmp,"]",")");
- println(SCEOUTPUT,"GrL="+tmp);
- tmp1="";
- if(length(tmp1)>0,
- tmp1="WriteOutData(Fnameout"+tmp1+");";
- println(SCEOUTPUT,tmp1);
- );
- forall(COM1stlist,
- if(indexof(#,"Texcom")==0, //17.09.22
- println(SCEOUTPUT,RSform(#));
- ,
- println(SCEOUTPUT,#);
- );
- );
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"# Windisp(GrL)");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"if(1==1){");
- println(SCEOUTPUT,"");
- tmp=replace(Dirwork,"\","/"); //17.10.28(3lines)
- tmp="Openfile('"+tmp+pathsep()+Fnametex+"','"+ULEN+"'";
- tmp=tmp+",'Cdy="+loaddirectory+text(curkernel());
- tmp=replace(tmp,"\","\\");
- println(SCEOUTPUT,tmp+"')");
- forall(COM2ndlist,
- if(indexof(#,"Texcom")==0, //17.09.22
- println(SCEOUTPUT,RSform(#));
- ,
- println(SCEOUTPUT,#);
- );
- );
- if(length(GrL)>0,
- println(SCEOUTPUT," Drwline(GrL)");
- );
- println(SCEOUTPUT,"Closefile('"+ADDAXES+"')");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"}");
- if(shchoice=="sh",
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"quit()");
- ,
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"#quit()");
- );
- closefile(SCEOUTPUT);
-); //17.09.17upto
-
-Extractdata(name):=Extractdata(1,name,[]);
-Extractdata(Arg1,Arg2):=(
- if(isstring(Arg1),
- Extractdata(1,Arg1,Arg2);
- ,
- Extractdata(Arg1,Arg2,[]);
- );
-);
-Extractdata(number,name,options):=(
-//help:ExtractData("ha1");
-//help:ExtractData(1,"ha1");
- regional(dlist,tmp,tmp1,tmp2,tmp3,File,Ltype,Noflg,opstr,opcindy);
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opstr=tmp_(length(tmp)-1);
- opcindy=tmp_(length(tmp));
- tmp1=[];
- forall(1..length(GOUTLIST),
- if(contains(GOUTLIST_#_2,name),
- tmp1=append(tmp1,#);
- );
- );
- if(length(tmp1)==0,
- println(varname+" not found");
- ,
- tmp1=tmp1_number;
- tmp2=GOUTLIST_tmp1;
- tmp=remove(tmp2_2,[name]);
- GOUTLIST_tmp1=[tmp2_1,tmp];
- File=tmp2_1;
- );
- if(Noflg<3,
- println("extract outdata "+name);
- tmp1=parse(name);
- tmp3=[ //17.09.18
- "Tmpout=ReadOutData("+Dq+File+Dq+")"
- ];
- GLIST=concat(GLIST,tmp3);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- tmp2;
-);
-
-RemoveOut(pltlist):=(
- regional(name,tmp,tmp1,tmp2);
- forall(pltlist,name,
- tmp1=[];
- forall(GOUTLIST,
- tmp=remove(#_2,[name]);
- tmp1=append(tmp1,[#_1,tmp]);
- );
- GOUTLIST=tmp1;
- );
-);
-
-ReadOutData():=ReadOutData(Fnameout);
-ReadOutData(filename):=ReadOutData("",filename); //16.03.07
-ReadOutData(pathorg,filenameorg):=(
-//help:ReadOutData();
-//help:Readoutdata();
-//help:ReadOutData("file.txt");
-//help:Readoutdata("file.txt");
-//help:ReadOutData("/datafolder","file.txt");
-//help:Readoutdata("/datafolder","file.txt");
- regional(path,filename,varname,varL,ptL,pts,tmp,tmp1,tmp2,tmp3,tmp4,
- nmbr,cmdall,cmd,cmdorg,outdt,goutdt);
- path=pathorg; //16.03.07 from
- if(length(path)>0,
- setdirectory(path);
- if(indexof(path,"\")>0,tmp1="\",tmp1="/");
- tmp=substring(path,length(path)-1,length(path));
- if(tmp!=tmp1,path=path+tmp1);
- ); //16.03.07 upto
- filename=filenameorg; // 16.04.17
- if(indexof(filename,".")==0,filename=filename+".txt");
- tmp=load(filename);
- cmdall=tokenize(tmp,"//");
- varname=cmdall_1;
- cmdall=cmdall_(2..length(cmdall));
- outdt=[];
- varL=[varname];
- ptL=[];
- forall(cmdall,cmdorg,
- cmd=replace(cmdorg,LFmark,"");
- if(length(cmd)>0,
- if(cmd=="start" % cmd=="end" % substring(cmd,0,1)=="[",
- if(cmd=="start",
- pts=[];
- );
- if(cmd=="end",
- ptL=append(ptL,pts);
- );
- if(substring(cmd,0,1)=="[",
- tmp1=parse(cmd);
- if(length(tmp1_1)==2,
- tmp1=apply(tmp1,Pcrd(#));
- );
- pts=concat(pts,tmp1);
- );
- ,
- if(length(ptL)>0,
- if(length(ptL)==1,
- ptL=ptL_1;
- tmp=apply(ptL,textformat(#,6));
- ,
- tmp="[";
- forall(ptL,tmp1,
- tmp=tmp+apply(tmp1,textformat(#,6))+",";
- );
- tmp=substring(tmp,0,length(tmp)-1)+"]";
- );
- ,
- tmp="[]";
- );
- parse(varname+"="+tmp);
- outdt=append(outdt,ptL);
- ptL=[];
- varname=cmd;
- varL=append(varL,varname);
- );
- );
- );
- if(length(ptL)>0,
- if(length(ptL)==1,
- ptL=ptL_1;
- tmp=apply(ptL,textformat(#,6));
- ,
- tmp="[";
- forall(ptL,tmp1,
- tmp=tmp+apply(tmp1,textformat(#,6))+",";
- );
- tmp=substring(tmp,0,length(tmp)-1)+"]";
- );
- ,
- tmp="[]";
- );
- parse(varname+"="+tmp);
- outdt=append(outdt,ptL);
- if(path=="",tmp=filename,tmp=path+filename); //16.03.07
- GOUTLIST=append(GOUTLIST,[tmp,varL]);
- if(length(path)>0, // 16.03.09
- setdirectory(Dirwork); // 16.03.07
- );
- print("readoutdata from "+tmp+" : ");
- println(varL);
- varL;
-);
-
-WriteOutData(filename,ptlist):=(
-//help:WriteOutData("file.txt",["g1",gr1,"sg",sgAB]);
-//help:Writeoutdata("file.txt",["g1",gr1,"sg",sgAB]);
- regional(nn,Gname,Gdata,Str,Gstr,Gj,Pt,Flg,tmp,tmp1,loopend);
- Flg=0;
- if(isstring(ptlist_(length(ptlist))),
- Flg=1;
- );
- SCEOUTPUT = openfile(filename);
- if(Flg==0,
- loopend=length(ptlist)/2;
- ,
- loopend=length(ptlist);
- );
- Gstr="[";
- forall(1..loopend,nn,
- if(Flg==0,
- Gname=ptlist_(2*nn-1);
- ,
- Gname=ptlist_nn;
- );
- Gstr=Gstr+Gname+",";
- println(SCEOUTPUT,Gname+"//");
- if(Flg==0,
- Gdata=ptlist_(2*nn);
- ,
- Gdata=parse(Gname);
- );
- Gdata=Flattenlist(Gdata);
- if(MeasureDepth(Gdata)==1,Gdata=[Gdata]);
- forall(Gdata,Gj,
- println(SCEOUTPUT,"start//");
- Str="";
- forall(Gj,Pt,
- if(length(Str)>0,
- Str=Str+","
- );
- Str=Str+"["+format(Pt_1,5)+",";
- Str=Str+format(Pt_2,5);
- if(length(Pt)<3,
- Str=Str+"]";
- ,
- Str=Str+","+format(Pt_3,5)+"]";
- );
- if(length(Str)>80,
- println(SCEOUTPUT,"["+Str+"]//");
- Str="";
- );
- );
- if(length(Str)>0,
- println(SCEOUTPUT,"["+Str+"]//");
- );
- if((nn==loopend) & (Gj==Gdata_(length(Gdata))),
- println(SCEOUTPUT,"end////");
- ,
- println(SCEOUTPUT,"end//");
- );
- );
- );
- closefile(SCEOUTPUT);
- Gstr=substring(Gstr,0,length(Gstr)-1)+"]";
- println("writeoutdata "+filename+":"+Gstr);
-);
-
-Makeshell():=(
- if(length(Texmain)>0,
- Texparent=Texmain;
- );
- if(length(Texparent)>0,
- Makeshell(Texparent);
- if(length(FigPdfList)>0,
- SCEOUTPUT=openfile(Texparent+".tex");
- forall(FigPdfList,println(SCEOUTPUT,#));
- closefile(SCEOUTPUT);
- );
- ,
- Makeshell(Fhead+"main");
- );
-);
-Makeshell(texmainfile):=Makeshell(texmainfile,"rtv");
-Makeshell(texmainfile,flow):=(
- regional(parent,tmp,tmp1,tmp2,tmp3,flg,tex,path,shnm);
- parent=Dirwork+Shellparent; // 16.05.29
- kc():=(
- println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04,06.07
- );
- tmp1="";
-// tmp2=parent;
- flg=0;
- forall(reverse(1..length(parent)),
- if(flg==0,
- tmp=substring(parent,#-1,#);
- if(tmp=="/" % tmp=="\", // 14.01.15
- tmp1=substring(parent,0,#-1);
- tmp2=substring(parent,#,length(parent));
- flg=1;
- );
- );
- );
- if(length(tmp1)>0,
- setdirectory(tmp1);
- );
- SCEOUTPUT = openfile(tmp2);
- println(SCEOUTPUT,"#!/bin/sh");
- println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); // 15.07.16
- tmp1=" "+Dq+Fhead+Dq+" "+Dq+texmainfile+Dq; // 15.12.11
- flg=0;
- forall(reverse(1..length(PathT)),
- if(flg==0,
- if(substring(PathT,#-1,#)=="/",
- tex=substring(PathT,#,length(PathT));
- path=substring(PathT,0,#-1);
- flg=1;
- );
- );
- );
- if(flg==0, // 17.10.13(Norbert)
- tex=PathT;
- path="";
- );
- if(indexof(flow,"r")>0,
- tmp=Dq+PathR+Dq+" --vanilla --slave < "+Fhead+".r";
- // 17.09.14
- println(SCEOUTPUT,tmp);
- );
- if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- tmp="rm "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="xelatex",
- tmp="export PATH="+path+":${PATH}";
- println(SCEOUTPUT,tmp);
- tmp="xelatex"+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp="rm "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="pdflatex" % tex=="pdftex",//16.11.22from
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.11.22upto
- if(tex=="lualatex",//16.12.16
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.12.16
- if(!isstring(Pathpdf),
- tmp="preview";
- ,
- tmp=Pathpdf;
- );
- if(tmp=="preview" % tmp=="skim", // 16.09.09from,16.10.20
- tmp="open -a "+Dq+tmp+Dq+" "+texmainfile+".pdf";
- ,
- tmp=Dq+tmp+Dq+" "+texmainfile+".pdf";
- );// 16.09.09upto
- println(SCEOUTPUT,tmp); // 16.07.21upto
- println(SCEOUTPUT,"exit 0");
- closefile(SCEOUTPUT);
- setdirectory(Dirwork);
-);
-
-Makebat():=(
- if(length(Texmain)>0,
- Texparent=Texmain;
- );
- if(length(Texparent)>0,
- Makebat(Texparent);
- if(length(FigPdfList)>0,
- SCEOUTPUT=openfile(Texparent+".tex");
- forall(FigPdfList,println(SCEOUTPUT,#));
- closefile(SCEOUTPUT);
- );
- ,
- Makebat(Fhead+"main");
- );
-);
-Makebat(texmainfile):=Makebat(texmainfile,"rtv");
-Makebat(texmainfile,flow):=(
- regional(drive,fname,tmp,tmp1,tmp2,tmp3,flg,tex,path,batnm);
- drive="C:";
- fname=Dirwork+Batparent;
- kc():=(
- println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04
- );
- tmp=indexof(fname,":");
- if(tmp>0,
- drive=substring(fname,0,tmp);
- fname=substring(fname,tmp,length(fname));
- );
- tmp1="";
- tmp2=fname;
- flg=0;
- forall(reverse(1..length(fname)),
- if(flg==0,
- tmp=substring(fname,#-1,#);
- if(tmp=="/" % tmp=="\" % tmp=="\", // 14.01.15
- tmp1=substring(fname,0,#-1);
- tmp2=substring(fname,#,length(fname));
- flg=1;
- );
- );
- );
- if(length(tmp1)>0,
- setdirectory(drive+tmp1);
- );
- SCEOUTPUT = openfile(tmp2);
- fname=Dirwork;
- tmp=indexof(fname,":");
- if(tmp>0,
- drive=substring(Dirwork,0,tmp);
- fname=substring(Dirwork,tmp,length(Dirwork));
- println(SCEOUTPUT,drive);
- );
- println(SCEOUTPUT,"cd "+Dq+fname+Dq);// 15.07.16
- flg=0;
- tmp=replace(PathT,"\","/");
- forall(reverse(1..length(PathT)),
- if(flg==0,
- if(substring(tmp,#-1,#)=="/",
- tex=substring(PathT,#,length(PathT));
- path=substring(PathT,0,#-1);
- flg=1;
- );
- );
- );
- if(flg==0, // 17.10.13(Norbert)
- tex=PathT;
- path="";
- );
- if(indexof(flow,"r")>0,
- tmp=Dq+PathR+"\R"+Dq+" --vanilla --slave < "+Fhead+".r";
- // 17.09.14
- println(SCEOUTPUT,tmp);
- );
- if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- tmp="del "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="xelatex",
- tmp="set Path = %Path%;"+Dq+path+Dq;
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp="xelatex"+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- tmp="del "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="pdflatex" % tex=="pdftex",//16.11.22from
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.11.22upto
- if(tex=="lualatex",//16.12.16
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.12.16
- if(!isstring(Pathpdf),
- tmp=indexof(PathS,"\scilab");// 15.12.12
- tmp=substring(PathS,0,tmp-1)+"\SumatraPDF\SumatraPDF.exe";
- ,
- tmp=Pathpdf;
- );
- tmp=Dq+tmp+Dq+" "+texmainfile+".pdf";
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"exit 0");
- closefile(SCEOUTPUT);
- if(indexof(Dirwork,":")==0, // 14.01.15
- drive="C:";
- ,
- drive="";
- );
- setdirectory(drive+Dirwork);
-);
-
-Addpackage(packorg):=(
-//help:Addpackage("bm");
-//help:Addpackage(["bm","enumerate"]);
-//help:Addpackage(["bm","[c]{somepackage}"]);
- regional(packL,tmp);
- packL=packorg; //17.06.25from
- if(!islist(packL),packL=[packL]);
- packL=apply(packL,replace(#,"\","/"));
- forall(1..(length(packL)),
- tmp=packL_#;
- if(substring(tmp,0,11)=="ketpicstyle",
- tmp=replace(Dirhead+"/"+tmp,"\","/");
- );
- if(indexof(tmp,"[")==0,
- packL_#="{"+tmp+"}";
- );
- );
- ADDPACK=concat(ADDPACK,packL); //17.06.25upto
-);
-
-Viewtex():=(
- regional(texfile,tmp,tmp1,sep);
- texfile=Fhead+"main";
-// if(iswindows(),sep="\",sep="/"); // 17.04.07
-// sep="/";
- SCEOUTPUT=openfile(texfile+".tex");
- tmp="\documentclass{article}"; // 16.06.09from
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13upto
- ); // 16.06.09upto
- println(SCEOUTPUT,tmp);
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0) ,
- //16.11.23,12.16
- if(indexof(PathT,"pdflatex")>0,
- println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}");//16.11.24
- ,
- println(SCEOUTPUT,"\usepackage{pict2e}");//16.12.16
- println(SCEOUTPUT,"\usepackage{luatexja}");//16.12.18
- );
- tmp=replace(Dirhead,"\","/"); //17.10.30from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}");
- );
- ,
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
- );
- );//17.10.30upto
- println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
- println(SCEOUTPUT,"\usepackage{graphicx}");
- println(SCEOUTPUT,"\usepackage{color}");
- forall(ADDPACK, // 16.05.16from
- println(SCEOUTPUT,"\usepackage"+#); //17.05.25
- );// 16.05.16upto
- println(SCEOUTPUT,"");
-// println(SCEOUTPUT,"\def\ketcindy{{K\kern-.20em%"); // deleted 16.11.27,recovered11.29 redeleted17.04.07
-// println(SCEOUTPUT,"\lower.5ex\hbox{E}\kern-.125em{TCindy}}}");
-// println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\setmargin{20}{20}{20}{20}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\begin{document}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\verb|"+Fhead+"| by \ketcindy");// 16.01.12, 18, 16.04.08
-// println(SCEOUTPUT,"\verb|"+Fhead+"| by KeTCindy");// 16.11.29 temporarily
- println(SCEOUTPUT,"\vspace{5mm}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\input{"+Fhead+".tex}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\end{document}");
- closefile(SCEOUTPUT);
- if(iswindows(),
- kc():=(
- println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04
- );
- Makebat(texfile);
- ,
- kc():=(
- println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04
- );
- Makeshell(texfile);
- );
- WritetoRS(2); //17.09.19
-);
-
-Viewparent():=( //17.04.13
- if(!isexists(Dirwork,Texparent+".tex"),
- if(isstring(Texparent),
- drawtext(mouse().xy,Texparent+".tex not exist",
- size->24,color->[1,0,0]);
- ,
- drawtext(mouse().xy,"Texparent not defined",
- size->24,color->[1,0,0]);
- );
- ,
- if(iswindows(),
- Makebat();
- ,
- Makeshell();
- );
- WritetoRS(2); //17.09.29
- kc();
- );
-);
-
-Makecmdlist(libname):=(
-//help:Makecmdlist("ketcindylib");
- regional(cmdall,cmd,flg,tmp,tmp1,tmp2,out);
- setdirectory(Dirlib);
- tmp=load(libname+".cs");
- cmdall=tokenize(tmp,":=");
- out=[];
- forall(cmdall,cmd,
- tmp=max([0,length(cmd)-50]);
- tmp1=";"+substring(cmd,tmp,length(cmd));
- flg=0;
- forall(reverse(1..length(tmp1)),
- if(flg==0,
- if(substring(tmp1,#-1,#)==";",
- tmp=substring(tmp1,#,length(tmp1));
- tmp2=substring(tmp,0,1);
- if(length(tmp)>0,
- if(!contains([" ","/"],tmp2),
- out=append(out,tmp);
- flg=1;
- );
- );
- );
- );
- );
- );
- setdirectory(Dirwork);
- tmp=length(out)-1;
- out=out_(2..tmp);
- out=sort(out);
-);
-
-Savecmdlist(cmdlist,cmdfile):=(
- SCEOUTPUT=openfile(cmdfile+".cs");
- forall(cmdlist,
- println(SCEOUTPUT,#);
- );
- closefile(SCEOUTPUT);
-);
-
-Quicksort(seq):=(
- regional(pivot,left,right,out);
- if(length(seq)<2,
- out=seq;
- ,
- pivot = max(seq_1,seq_2);
- left = [];
- right = [];
- forall(seq,
- if(#< pivot,
- left=append(left,#);
- ,
- right=append(right,#);
- );
- );
- left = Quicksort(left);
- right = Quicksort(right);
- out=concat(left,right);
- );
- out;
-);
-
-Lessstr(st1,st2):=(
- regional(tmp,tmp1,tmp2,out);
- tmp=min(length(st1),length(st2));
- flg=0;
- forall(1..tmp,
- if(flg==0,
- tmp1=substring(st1,#-1,#);
- tmp2=substring(st2,#-1,#);
- if(tmp1<tmp2,
- out=(1<2);
- flg=1;
- ,
- if(tmp1>tmp2,
- out=(1>2);
- flg=1;
- );
- );
- );
- );
- if(flg==0,
- if(length(st1)<length(str2),
- out=(1<2);
- ,
- out=(1>2);
- );
- );
- out;
-);
-
-Figpdf():=Figpdf(Texparent,[]);
-Figpdf(Arg1):=(
- if(isstring(Arg1),
- Figpdf(Arg1,[]);
- ,
- Figpdf(Texparent,Arg1);
- );
-);
-Figpdf(fnameorg,optionorg):=(
-//help:Figpdf();
-//help:Figpdf([10,,10,,[0,2] ]);(margin(4),move)
-//help:Figpdf([[0,0]]);(move)
-//help:Figpdf(options=[5,5,5,5,[0,0]]]);
- regional(options,fname,mar,pos,dp,sc,tmp,tmp1,tmp2,sep);
- fname=fnameorg;
- if(indexof(fnameorg,".")==0,
- fname=fnameorg+".tex";
- );
- tmp=apply(optionorg,if(isstring(#),parse("["+#+"]"),#)); // 16.04.07
- tmp=select(tmp,#!=[]);
- options=optionorg;//16.11.08from
-// mar=[5,5,5,5];
- dp=[0,-3];
- tmp=select(options,islist(#));
- if(length(tmp)>0,
- dp=tmp_1;
- options=remove(options,tmp);
- );
- tmp=4-length(options);
- tmp1=apply(1..tmp,5);
- mar=concat(options,tmp1);
- mar=apply(mar,if(length(#)==0,5,#));//16.11.08upto
- pos=[mar_1+dp_1,mar_3+dp_2];
- sc=10;
- tmp=indexof(ULEN,"cm");
- if(tmp>0,
- tmp1=Removespace(substring(ULEN,0,tmp-1));
- sc=parse(tmp1)*10;
- );
- tmp=indexof(ULEN,"mm");
- if(tmp>0,
- tmp1=Removespace(substring(ULEN,0,tmp-1));
- sc=parse(tmp1);
- );
- tmp="\documentclass{article}"; // 16.06.09from
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13upto
- );
- FigPdfList=append(FigPdfList,tmp); // 16.06.09upto
- tmp1="\special{papersize=W mm,H mm}";
- tmp=(XMAX-XMIN)*sc+(mar_1+mar_2);
- tmp1=replace(tmp1,"W",text(tmp));
- tmp=(YMAX-YMIN)*sc+(mar_3+mar_4);
- tmp1=replace(tmp1,"H",text(tmp));
-// if(iswindows(),sep="\",sep="/");//17.04.08
-// sep="/";
- FigPdfList=append(FigPdfList,tmp1);
- if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, //17.11.05from
- FigPdfList=append(FigPdfList,
- "\usepackage{pict2e}");
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- FigPdfList=append(FigPdfList,
- "\usepackage{ketpic2e,ketlayer2e}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- FigPdfList=concat(FigPdfList,
- ["\usepackage{"+tmp+"/ketpic2e}",
- "\usepackage{"+tmp+"/ketlayer2e}"]);
- );
- ,
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- FigPdfList=append(FigPdfList,
- "\usepackage{ketpic,ketlayer}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- FigPdfList=concat(FigPdfList,
- ["\usepackage{"+tmp+"/ketpic}",
- "\usepackage{"+tmp+"/ketlayer}"]);
- );
- );//17.11.05upto
- FigPdfList=append(FigPdfList,
- "\usepackage{amsmath,amssymb}");
- FigPdfList=append(FigPdfList,
- "\usepackage{graphicx,color}");
- forall(ADDPACK, // 16.05.16from
- tmp1="\usepackage"+#; //17.07.10
- FigPdfList=append(FigPdfList,tmp1); // 16.09.05upto
- );
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,
- "\setmargin{0}{0}{0}{0}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,"\begin{document}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,
- "\begin{layer}{50}{0}");
- tmp1="\putnotese{X}{Y}{\input{";
- tmp1=replace(tmp1,"X",text(pos_1));
- tmp1=replace(tmp1,"Y",text(pos_2));
- FigPdfList=append(FigPdfList,tmp1+Fhead+".tex}}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,"\end{layer}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,"\end{document}");
- if(fnameorg!=Texparent,
- SCEOUTPUT=openfile(fname);
- forall(FigPdfList,println(SCEOUTPUT,#));
- closefile(SCEOUTPUT);
- );
- FigPdfList;
-);
-
-Makehelplist(libname):=(
- regional(cmdall,cmd,flg,lev,tmp,tmp1,out);
- tmp=load(libname);
- cmdall=tokenize(tmp,"//help:");
- cmdall=select(cmdall,substring(#,1,3)!=");");
- flg=0;
- forall(1..3,
- if(flg==0,
- if(substring(cmdall_#,0,7)=="start()",
- cmdall=cmdall_((#+1)..length(cmdall));
- flg=1;
- );
- );
- );
- flg=0;
- tmp=length(cmdall);
- forall(0..2,
- if(flg==0,
- if(substring(cmdall_(tmp-#),0,5)=="end()",
- cmdall=cmdall_(1..(tmp-#-1));
- flg=1;
- );
- );
- );
- out=[];
- forall(cmdall,cmd,
- tmp1=indexof(cmd,"(");
- lev=1;
- flg=0;
- forall((tmp1+1)..length(cmd),
- if(flg==0,
- tmp=substring(cmd,#-1,#);
- if(tmp=="(",lev=lev+1);
- if(tmp==")",
- lev=lev-1;
- if(lev==0,
- flg=1;
- out=append(out,substring(cmd,0,#)+";");
- );
- );
- );
- );
- );
- sort(out);
-);
-
-Helplist():=Helplist(Dirlib,["+","+3d"],"helpJ");
-// 15.05.22
-Helplist(Arg):=(
- if(islist(Arg),
- Helplist(Dirlib,Arg,"helpJ"); // 15.06.20
- ,
- if(indexof(Arg,"help")>0,
- Helplist(Dirlib,["+","+3d"],Arg);
- ,
- Helplist(Arg,["+","+3d"],"helpJ");
- );
- );
-);
-Helplist(Arg1,Arg2):=(
- if(islist(Arg1),
- Helplist(Dirlib,Arg1,Arg2);
- ,
- if(indexof(Arg2,"help")>0,
- Helplist(Dirlib,Arg1,Arg2);
- ,
- Helplist(Arg,["+","+3d"],Arg2);
- );
- );
-);
-Helplist(dir,files,help):=(
-//help:Helplist();
-//help:Helplist("helpE");
- regional(ketfiles,tmp,tmp1,tmp2);
- setdirectory(dir);
- if(contains(files,"+"),
- tmp=remove(files,["+"]);
- ketfiles=concat(["+basic1","+basic2","+out"],tmp);
- ,
- ketfiles=files;
- );
- ketfiles=apply(ketfiles,replace(#,"+","ketcindylib"));
- ketfiles=apply(ketfiles,#+"r.cs"); // 15.11.05 from
- tmp=apply(files,replace(#,"+","ketcindylib"));
-// tmp=apply(files,replace(#,"r.cs",""));
-// tmp=remove(tmp,["ketcindylibout"]);
-// tmp=apply(tmp,replace(#,"basic",""));
- tmp=apply(tmp,#+help+".txt");
- ketfiles=concat(ketfiles,tmp);// 15.11.05 upto
- tmp1=[];
- forall(ketfiles,
- tmp=Makehelplist(#);
- tmp1=concat(tmp1,tmp);
- );
- if(!islist(HLIST), // 16.12.31from
- HLIST=sort(tmp1);
- ,
- HLIST=sort(concat(HLIST,tmp1));
- ); // 16.12.31upto
- setdirectory(Dirwork);
-);
-
-
-Help():=(
- forall(HLIST,
- println(#);
- );
-);
-Help(strorg):=(
-//help:Help("Plot");
-//help:Help("*");
- regional(str,sel,tmp,tmp1,tmp2,flg,Endflg);
- if(length(HLIST)>0,flg=0,flg=-1);
- str=replace(strorg,"'",Dq); // 15.11.25
- if(length(str)==0,
- forall(HLIST,
- if(indexof(#,"*")>0,
- println(#);
- );
- flg=1;
- );
- ,
- if(str=="*",
- sel=HLIST;
- ,
- sel=select(HLIST,substring(#,0,length(str))==str);
- );
- if(length(sel)>0,flg=1);
- forall(sel,
- tmp=indexof(#,"(");
- if(substring(#,tmp-2,tmp-1)!="*",
- println(#);
- ,
-// println(substring(#,0,tmp-1));
- tmp1=substring(#,tmp,length(#)-2);
- tmp2=indexof(tmp1,"//");
- Endflg=0;
- forall(1..4,
- if(Endflg==0,
- tmp2=indexof(tmp1,"//");
- if(tmp2==0,
- println(" "+tmp1);
- Endflg=1;
- ,
- println(" "+substring(tmp1,0,tmp2-1));
- tmp1=substring(tmp1,tmp2+1,length(tmp1));
- );
- );
- );
- );
- );
- );
- if(flg==-1,println(" Help not read in"));
- if(flg==0,println(" no example"));
-);
-
-Helpkey(str):=(
- regional(tmp,tmp1,tmp2);
- tmp1=select(HLIST,indexof(#,str)>0);
- forall(tmp1,
- tmp=substring(#,0,indexof(#,"*")-1);
- Help(tmp);
- );
-);
-Helpkey(str1,str2):=(
-//help:Helpkey(keyword);
-//help:Helpkey(keyword1,keyword2);
- regional(tmp,tmp1,tmp2);
- tmp1=select(HLIST,indexof(#,str1)>0);
- tmp1=select(tmp1,indexof(#,str2)>0);
- forall(tmp1,
- tmp=substring(#,0,indexof(#,"*")-1);
- Help(tmp);
- );
-);
-
-Slidework():=Slidework(Dirwork); // 16.06.10
-Slidework(dirorg):=(
-//help:Slidework(directory);
- regional(dir,tmp); // 16.06.25
- dir=replace(dirorg,unicode("000a"),""); // 16.06.25
- dir=replace(dir,"/",pathsep());//17.11.20from
- dir=replace(dir,"\",pathsep());
- tmp=length(dir);
- if(substring(dir,tmp-1,tmp)==pathsep(),
- dir=substring(dir,0,tmp-1);
- );//17.11.20upto
- if(isexists(dir,""), // 16.12.20
- Changework(dir);
- println(makedir(dir,"fig"));//17.11.23
- tmp=dir+pathsep()+"fig"; //17.04.16from
- Changework(tmp);// 17.02.19upto
- ,
- println(dir+ " not exists");
- );
-);
-
-Setslidepage():=( // 17.03.05
- regional(tmp1,tmp2,tmp3);
- tmp1=["letterc","boxc","framec","shadowc","xpos","size"];
- tmp2=apply([1,2,4,5,7,8],SlideColorList_#);
- tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
- println(tmp3);
-);
-Setslidepage(list):=( // 16.12.22
-//help:Setslidepage([letterc,boxc,framec,shadowc,xpos,size]);
- regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
- if(!islist(SlideColorList),
- SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
- letterc,mboxc,mboxc,mboxc,62,2,letterc];
- );
- numlist=[1,2,4,5,7,8];
- forall(1..(length(list)),
- if(length(list_#)>0,
- tmp=numlist_#;
- SlideColorList_tmp=list_#;
- );
- );
- SlideColorList_3=SlideColorList_2;
- SlideColorList_6=SlideColorList_5;
-);
-
-Setslidemain():=( // 17.03.05
- regional(tmp1,tmp2,tmp3);
- tmp1=["letterc","boxc","framec","xpos","size"];
- tmp2=apply([9,10,12,13,14],SlideColorList_#);
- tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
- println(tmp3);
-);
-Setslidemain(list):=( // 16.12.22
-//help:Setslidemain([letterc,boxc,framec,xpos,size]);
- regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
- if(!islist(SlideColorList),
- SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
- letterc,mboxc,mboxc,mboxc,62,2,letterc];
- );
- numlist=[9,10,12,13,14];
- forall(1..(length(list)),
- if(length(list_#)>0, //17.01.04
- tmp=numlist_#;
- SlideColorList_tmp=list_#;
- );
- );
- SlideColorList_11=SlideColorList_10;
-);
-
-Setslidebody():=( // 17.03.05
- regional(tmp1,tmp2,tmp3);
- tmp1=["letterc","style","thindense"];
- tmp2=[SlideColorList_(15),BodyStyle,ThinDense];
- tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
- println(tmp3);
-);
-Setslidebody(str):=(
- regional(clr,style,thin);
- if(isstring(str),
- Setslidebody(str,"\Large\bf\boldmath",0.1);
- ,
- if(length(str)==1,Setslidebody(str_1));
- if(length(str)==2,Setslidebody(str_1,str_2));
- if(length(str)==3,Setslidebody(str_1,str_2,str_3));
- );
-);
-Setslidebody(str,Arg):=( //17.01.08
- if(isstring(Arg),
- Setslidebody(str,Arg,0.1);
- ,
- Setslidebody(str,"\Large\bf\boldmath",Arg);
- );
-);
-Setslidebody(str,style,density):=( // 16.12.22,17.01.06,01.08
-//help:Setslidebody(["black",,0]);
-//help:Setslidebody(["blue","\Large\bf\boldmath",0.1]);
- regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
- if(!islist(SlideColorList),
- SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
- letterc,mboxc,mboxc,mboxc,62,2,letterc];
- );
- if(length(str)>0,SlideColorList_(15)=str);
- if(length(style)>0,BodyStyle=style);
- ThinDense=density;//17.01.08
-);
-
-Setslidehyper():=( 17.12.16from
- Setslidehyper(["cl=true,lc=blue,fc=blue",125,70,1]);
-);
-Setslidehyper(Arg):=(
- if(isstring(Arg),
- Setslidehyper(Arg,["cl=true,lc=blue,fc=blue",125,70,1]);
- ,
- Setslidehyper("",Arg);
- );
-);
-Setslidehyper(driverorg,options):=(
-//help:Setslidehyper();
-//help:Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue","Pos=[125,70]","Size=1"]);
- regional(driver,eqL,reL,stL,,str,tmp,tmp1,tmp2);
- driver=driverorg;
- if(length(driver)==0,
- if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")==0,
- driver="dvipdfmx";
- );
- );
- tmp=Divoptions(options);
- eqL=tmp_5;
- reL=tmp_6;
- stL=tmp_7;
- if(length(stL)>0,
- str=stL_1;
- ,
- str="";
- );
- if(length(str)==0,
- str="cl=true,lc=blue,fc=blue";
- );
- if(length(driver)==0,
- tmp1="["+str+"]";
- ,
- tmp1="["+driver+","+str+"]";
- );
- tmp1=replace(tmp1,"cl=","colorlinks=");
- tmp1=replace(tmp1,"lc=","linkcolor=");
- tmp1=replace(tmp1,"fc=","filecolor=");
- tmp1=replace(tmp1,"uc=","urlcolor=");
- ADDPACK=select(ADDPACK,indexof(#,"hyperref")==0);
- Addpackage(tmp1+"{hyperref}");
- LinkPosH=125;
- LinkPosV=70;
- LinkSize=1;
- if(length(reL)>0,
- LinkPosH=reL_1;
- if(length(reL)>1,LinkPosV=reL_2);
- if(length(reL)>2,LinkSize=max(reL_3,0.1));
- );
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,1));
- tmp2=substring(#,tmp,length(#));
- tmp2=parse(tmp2);
- if(tmp1=="P",
- LinkPosH=tmp2_1;
- LinkPosV=tmp2_2;
- );
- if(tmp1=="S",
- LinkSize=max(tmp2,0.1);
- );
- );
-); //17.12.16upto
-
-Settitle(cmdL):=Settitle("slide0",cmdL,[]);
-Settitle(Arg1,Arg2):=(
- if(isstring(Arg1),
- Settitle(Arg1,Arg2,[]);
- ,
- Settitle("slide0",Arg1,Arg2);
- );
-);
-Settitle(name,cmdL,options):=(
-//help:Settitle(cmdL);
-//help:Settitle(name,cmdL);
-//help:Settitle(options=["Layery=0","Color=blue"]);
- regional(tmp,tmp1,tmp2,eqL,layery,color,size,font);
- TitleName=name;
- layery="0";
- color="blue";
- size="\Large";
- font="\bf";
- tmp=Divoptions(options);
- eqL=tmp_5;
- forall(eqL,
- tmp1=Toupper(substring(#,0,1));
- tmp=indexof(#,"=");
- tmp2=substring(#,tmp,length(#));
- if(tmp1=="L",
- layery=tmp2;
- );
- if(tmp1=="C",
- color=tmp2;
- );
- if(tmp1=="S",
- size=tmp2;
- if(substring(size,0,1)!="\",size="\"+size);
- );
- if(tmp1=="F",
- font=tmp2;
- if(substring(font,0,1)!="\",font="\"+font);
- );
- );
- TitleCmdL=["{"+size+font];
- if(indexof(color,"[")>0,
- tmp=replace(color,"[","{");
- tmp=replace(tmp,"]","}");
- tmp1=Indexall(tmp,",");
- if(length(tmp1)>=3,
- tmp="\color[cmyk]"+tmp;
- ,
- tmp="\color[rgb]"+tmp;
- );
- ,
- tmp="\color{"+color+"}";
- );
- TitleCmdL=append(TitleCmdL,tmp);
- TitleCmdL=concat(TitleCmdL,["","\begin{layer}{120}{"+layery+"}"]);
- forall(1..(length(cmdL)),
- tmp=cmdL_#;
- if(length(tmp)>0,
- if(#==1,
- tmp="{\Huge \putnote"+tmp+"}"
- ,
- tmp="\putnote"+tmp;
- );
- TitleCmdL=append(TitleCmdL,tmp);
- );
- );
- TitleCmdL=concat(TitleCmdL,["\end{layer}","","}"]);
-);
-
-Maketitle():=(
- if(!isstring(TitleName), //17.04.13from
- drawtext(mouse().xy,"Settitle not defined",
- size->24,color->[1,0,0]);
- , //17.04.13upto
- Maketitle(TitleName);
- );
-);
-Maketitle(name):=(
-//help:Maketitle();
- regional(texfile,texmain,tmp,tmp1,sep);
- texfile=name;
- texmain=name+"main";
- SCEOUTPUT=openfile(texfile+".tex");
- forall(TitleCmdL,
- println(SCEOUTPUT,#);
- );
- closefile(SCEOUTPUT);
- SCEOUTPUT=openfile(texmain+".tex");
- tmp="\documentclass[landscape,10pt]{article}";
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13upto
- );
- println(SCEOUTPUT,tmp);
- tmp="\special{papersize=\the\paperwidth,\the\paperheight}";
- println(SCEOUTPUT,tmp);
- tmp=replace(Dirhead,"\","/");//17.11.01from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic,ketlayer,ketslide}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}");
- );//17.11.01upto
- println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
- println(SCEOUTPUT,"\usepackage{bm,enumerate}");
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- println(SCEOUTPUT,"\usepackage{graphicx}");
- ,
- println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}");
- );
- println(SCEOUTPUT,"\usepackage[usenames]{xcolor}");
- forall(ADDPACK,
-// if(indexof(#,"[")==0,
-// println(SCEOUTPUT,"\usepackage{"+#+"}");
-// ,
- println(SCEOUTPUT,"\usepackage"+#); // 17.07.10
-// );
- );
- if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE");
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"\ketslideinit");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\begin{document}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\input{"+texfile+".tex}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\end{document}");
- closefile(SCEOUTPUT);
- if(iswindows(),
- Makebat(texmain,"tv");
- ,
- Makeshell(texmain,"tv");
- );
- kc();
-);
-
-Repeatsameslide(repeatflg,sestr,addedL):=(
- regional(seL,flg1,ss,nn,nrep,tmp,tmp1,tmp2,tmp3,str,j,k);
- // global RepeatList, SCEOUTPUT
- nrep=length(RepeatList);
- flg1=0;
- forall(addedL,ss,
- if(repeatflg==0,
- if(substring(ss,0,1)!="%", //16.01.04
- println(SCEOUTPUT,ss);
- );//16.01.04
- ,
- forall(1..nrep,nn,
- if(sestr=="",
- RepeatList_nn=append(RepeatList_nn,ss);
- );
- );
- if(sestr=="",
- seL=[1];
- ,
- tmp1=substring(sestr,1,length(sestr)-1);
- tmp1=replace(tmp1,",-",".."+text(nrep));
- tmp1=replace(tmp1,"-,","1..");
- tmp1="["+tmp1+"]"; //17.01.03
- seL=flatten(parse(tmp1)); //17.01.03
- );
- if(contains(seL,1),
- if(substring(ss,0,1)!="%", //16.01.04
- println(SCEOUTPUT,ss);
- );
- seL=remove(seL,[1]);
- flg1=1;
- );
- forall(1..(length(seL)),nn,
- tmp=seL_nn;
- if(tmp<=length(RepeatList), //17.01.12from
- RepeatList_tmp=append( RepeatList_tmp,ss);
- ,
- println(" "+sestr+" : "+text(tmp)+" > "+text(length(RepeatList)));
- );
- );
- if(ThinFlg==1,//16.01.05from
- if(flg1==1,seL=append(seL,1));
- seL=remove(1..nrep,seL);
- str=ss; // 17.05.28from
- repeat(10,
- tmp1=Indexall(str,"{\color");
- if(length(tmp1)>0,
- tmp2=Indexall(str,"}");
- tmp=select(tmp2,tmp1_1<#);
- tmp=substring(str,tmp1_1,tmp_1);
- str=replace(str,tmp+" ","");
- str=replace(str,tmp,"");
- );
- );//17.05.28upto
- if(contains(seL,1),
- if(substring(str,0,1)!="%",
- if(NonThinFlg==0,
- if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
- println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23
- println(SCEOUTPUT,str);
- println(SCEOUTPUT,"}%");
- ,
- println(SCEOUTPUT,str);
- );
- );
- if(NonThinFlg==1,
- if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
- println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23
- );
- println(SCEOUTPUT,str);
- );
- if(NonThinFlg==2,
- println(SCEOUTPUT,str);
- if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
- println(SCEOUTPUT,"}%");
- );
- );
- seL=remove(seL,[1]);
- );
- );
- if(substring(ss,0,1)!="%", //16.01.04
- forall(1..(length(seL)),nn,
- tmp=seL_nn;
- if(NonThinFlg==0,
- tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23
- tmp1=[tmp1,str,"}%"];
- );
- if(NonThinFlg==1,
- tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23
- tmp1=[tmp1,str];//17.01.08upto
- );
- if(NonThinFlg==2,
- tmp1=[str,"}%"];
- );
- RepeatList_tmp=concat( RepeatList_tmp,tmp1);
- );
- );
- );//16.01.05upto
- );
- );//16.12.05upto
-);
-
-Presentation(texfile):=Presentation(texfile,texfile);
-Presentation(texfile,txtfile):=(
-//help:Presentation(texfile,txtfile);
- regional(file,flgL,flg,verbflg,slideL,ns,slideorgL,wall,sld,slidecmd,tmp,tmp0,tmp1,
- tmp2,tmp3,tmp4,tmp5,newoption,top,repeatflg,nrep,nrepprev,,repstr,
- sestr,npara,paradt,parafiles,hyperflg,paractr,
- letterc,boxc,shadowc,mboxc,sep);
- slidecmd=["\ketcletter","\ketcbox","\ketdbox","\ketcframe",
- "\ketcshadow","\ketdshadow","\slidetitlex","\slidetitlesize",
- "\mketcletter","\mketcbox","\mketdbox","\mketcframe",
- "\mslidetitlex","\mslidetitlesize"];
- if(!isstring(BodyStyle),//17.01.06
- BodyStyle="\Large\bf\boldmath";
- );
- repeatflg=0;
- RepeatList=[];
- paractr=0; //16.12.31
- if(indexof(texfile,".")==0,file=texfile+".tex",file=texfile);
- if(indexof(txtfile,".")==0,tmp1=txtfile+".txt",tmp1=txtfile);
- tmp=load(tmp1);
- tmp=replace(tmp,"////","||||");// 16.05.11, 06.24(reactivated)
- slideL=tokenize(tmp,"//");
- slideorgL=slideL; // 16.07.11
- slideL=apply(slideL,Removespace(#));
- tmp=select(1..length(slideL),length(slideL_#)>0); // 16.07.11from
- slideL=apply(tmp,slideL_#);
- slideorgL=apply(tmp,slideorgL_#);
-// slideL=select(slideL,length(#)>0); // 16.07.11upto
- flg=0; // 16.06.09from
- forall(1..10,
- if(flg==0,
- if(substring(slideL_1,0,1)!="%",
- flg=1;
- ,
- slideL=slideL_(2..length(slideL));
- slideorgL=slideorgL_(2..length(slideorgL));
- );
- );
- ); // 16.06.09upto
- flgL=[];
- SCEOUTPUT = openfile(file);
- tmp=tokenize(slideL_1,"::");
- tmp1=tmp_1;
- if(length(tmp)>1,
- tmp2=tmp_2;
- tmp3=tmp_(3..length(tmp));//16.06.25
- ,
- tmp2="";
- tmp3=tmp_(2..length(tmp));//16.06.25
- );
- wall=""; // 16.06.10
- if(length(tmp3)>0,//16.06.25from
- if(substring(tmp3_1,0,1)!="\" & indexof(tmp3_1,"=")==0,
- wall=tmp3_1;
- tmp3=tmp3_(2..length(tmp3));
- );
- );//16.06.25upto
- tmp="%%% "+tmp1+" "+txtfile;// 16.06.09from
- println(SCEOUTPUT,tmp);
- tmp="\documentclass[landscape,10pt]{article}";
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13upto
- );
- println(SCEOUTPUT,tmp);// 16.06.09from
- tmp=select(1..(length(tmp3)),indexof(tmp3_#,"\usepackage")>0);//17.06.18from
- forall(tmp,
- println(SCEOUTPUT,tmp3_#);
- );
- tmp=remove(1..(length(tmp3)),tmp);
- tmp3=tmp3_tmp;//17.06.18upto
-// if(iswindows(),sep="\",sep="/"); // 17.04.08
-// sep="/";
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- if(indexof(PathT,"lualatex")>0,
- println(SCEOUTPUT,"\usepackage{luatexja}");
- );
- println(SCEOUTPUT,"\usepackage{pict2e}");
- println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");// 17.04.08from
- ,
- println(SCEOUTPUT,"\special{papersize=\the\paperwidth,\the\paperheight}");
- );// 17.04.08upto
- tmp=replace(Dirhead,"\","/");//17.11.01from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
- );
- if(length(wall)==0,
- tmp=replace(Dirhead,"\","/");//17.11.01from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketslide}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}");
- );
- ,
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketslide2}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide2}");
- );
- );//17.04.08upto
- println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
- println(SCEOUTPUT,"\usepackage{bm,enumerate}");
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- println(SCEOUTPUT,"\usepackage{graphicx}");
- ,
- println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}");
- );
-// println(SCEOUTPUT,"\usepackage[usenames]{color}");
-// println(SCEOUTPUT,"\usepackage{color}");//17.06.14
- println(SCEOUTPUT,"\usepackage{xcolor}");//17.07.31
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
-// if(!islist(SlideColorList), //17.03.02from
-// SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
-// letterc,mboxc,mboxc,mboxc,62,2,letterc];
-// , //17.03.02upto
- tmp4="abcdefghijklmno";
- forall(1..15,
- tmp=SlideColorList_#;
- if(islist(tmp),
- tmp=text(tmp);
- tmp=substring(tmp,1,length(tmp)-1);
- if(length(SlideColorList_#)==4,//17.01.07from
- println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{cmyk}{"+tmp+"}");
- );
- if(length(SlideColorList_#)==3,
- println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{rgb}{"+tmp+"}");
- );//17.01.07upto
- SlideColorList_#="slidecolor"+tmp4_#;
- );
- );
-// ); //17.03.02
- println(SCEOUTPUT,"\def\setthin#1{\def\thin{#1}}");//17.08.23
- println(SCEOUTPUT,"\setthin{"+text(ThinDense)+"}");//17.08.23
- forall(ADDPACK,// 16.06.09from
-// if(indexof(#,"[")==0, // 16.09.05from
-// println(SCEOUTPUT,"\usepackage{"+#+"}");
-// ,
- println(SCEOUTPUT,"\usepackage"+#); //17.07.10
-// );
- );// 16.06.09upto
- tmp=select(ADDPACK,indexof(#,"{hyperref}")>0);//16.12.31from
- if(length(tmp)>0,
- hyperflg=1;
- ,
- hyperflg=0; //16.12.31upto
- );
- forall(tmp3,
- println(SCEOUTPUT,#);
- );
- if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); // 16.06.09
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"\ketslideinit");
- println(SCEOUTPUT,"");
- forall(tmp, // 15.07.21
- if(substring(#,0,1)=="\", println(SCEOUTPUT,#));
- );
- if(!isstring(PageStyle),PageStyle="headings");//17.04.09
- println(SCEOUTPUT,"\pagestyle{"+PageStyle+"}");//17.04.09
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\begin{document}");
- println(SCEOUTPUT,"");
- if(length(wall)>0,
- println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
- println(SCEOUTPUT,"");
- );
- if(length(tmp2)>0,
- if(indexof(tmp2," no")==0, // 16.11.11from
- println(SCEOUTPUT,"\begin{layer}{120}{0}");
- if(substring(tmp2,0,1)!="\",
- tmp2="\putnotese{0}{0}{\input{fig/"+tmp2+".tex}}";//16.12.27
- );
- println(SCEOUTPUT,tmp2);
- println(SCEOUTPUT,"\end{layer}");
- println(SCEOUTPUT,"");
- ,
- tmp=indexof(tmp2,"=");
- if(tmp==0,
- top="10mm";
- ,
- top=substring(tmp2,tmp,length(tmp2));
- );
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\vspace*{"+top+"}");
- println(SCEOUTPUT,"");
- ); // 16.11.11upto
- );
- println(SCEOUTPUT,"\def\mainslidetitley{22}");
- forall(1..14, //16.12.22from
- tmp=SlideColorList_#;
- if(!isstring(tmp),tmp=text(tmp));
- if(length(tmp)>0,
- tmp="\def"+slidecmd_#+"{"+tmp+"}";
- println(SCEOUTPUT,tmp);
- );
- );//16.12.22upto
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\color{"+SlideColorList_(15)+"}");
- println(SCEOUTPUT,BodyStyle);//17.01.07
- println(SCEOUTPUT,"\thispagestyle{empty}");//17.01.29
- println(SCEOUTPUT,"\addtocounter{page}{-1}");//17.01.29
- println(SCEOUTPUT,"");
- verbflg=0; //16.06.28
- repeatflg=0;//16.12.02
- nrep=0;//16.12.27
- nrepprev=0;//17.01.03
- npara=0;//16.12.27
- forall(2..length(slideL),ns,
- ThinFlg=0;
- NonThinFlg=0;
- flg=0;
- tmp1="";
- tmp2="";
- tmp3="";
- sld=removespace(slideL_ns); // 16.06.28
- sestr="";
- if((substring(sld,0,1)=="%") & (substring(sld,0,2)!="%%"), // 17.06.23
- Repeatsameslide(repeatflg,"",[slideL_ns]);
- if(repeatflg>0,
- tmp=indexof(sld,"]::");
- if(tmp>0,
- if(substring(sld,1,2)!="%",//17.05.31
- if(substring(sld,1,5)=="thin", ThinFlg=1); // 17.05.28
- sestr=substring(sld,1,tmp);
- sld=substring(sld,tmp+2,length(sld));
- tmp=indexof(sestr,"[");
- sestr=substring(sestr,tmp-1,length(sestr));//17.01.05
- );
- );
- );
- if(substring(sld,1,7)=="repeat", // 16.12.09from
- tmp=indexof(sld,"=");
- tmp5=substring(sld,tmp,length(sld));
- tmp=indexof(tmp5,",");
- if(tmp>0,//17.01.03from
- tmp5=substring(tmp5,0,tmp-1);
- );//17.01.03upto
- repeatflg=1;
- if(length(tmp5)>0,
- nrep=parse(tmp5);
- tmp=[];
- if(length(wall)>0,
- tmp=["","\input{fig/"+wall+".tex}"];
- );
- tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]);
- RepeatList=apply(1..nrep,if(#==1,[],tmp));
- );
- if(sestr=="",flg=1);
- tmp=indexof(sld,",");//17.01.03from
- if(tmp>0,
- sld="%"+substring(sld,tmp,length(sld));
- if(indexof(sld,"=")==0,sld=sld+"=");
- );//17.01.03upto
- );
- if(substring(sld,1,5)=="para",
- paractr=paractr+1;
- repeatflg=1;
- tmp=indexof(sld,"=");
- tmp=substring(sld,tmp,length(sld));
- if(length(tmp)==0, //17.01.03
- npara=0;
- ,
- paradt=tokenize(tmp,":");
- tmp=fileslist(Dirwork+"/fig/"+paradt_1);
- if(length(tmp)>0,
- parafiles=tokenize(tmp,",");
- if(indexof(paradt_4,"input")>0,
- tmp0=indexof(paradt_4,",");//17.01.29from
- if(tmp0>0,
- paradt=append(paradt,substring(paradt_4,tmp0,length(paradt_4)));
- paradt_4=substring(paradt_4,0,tmp0-1);
- );//17.01.29upto
- parafiles=select(parafiles,indexof(#,".tex")>0);
- if(indexof(paradt_4,"\input")==0,paradt_4="\"+paradt_4);//16.12.17
- );
- if(indexof(paradt_4,"include")>0,
- parafiles=select(parafiles,indexof(#,".pdf")>0);
- );
- npara=length(parafiles);
- ,
- println(Dirwork+"/fig/"+paradt_1+" not found");
- parafiles=[];
- npara=0;
- );
- if(nrep==0,
- nrep=npara;
- if(length(wall)>0,
- tmp=["","\input{fig/"+wall+".tex}"];
- );
- tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]);
- RepeatList=apply(1..nrep,if(#==1,[],tmp));
- );
- );
- forall(1..nrep, //16.12.28
- tmp4=[]; //16.12.31from
- if(hyperflg>0,
- tmp4=["\hypertarget{para"+text(paractr)+"pg"+text(#)+"}{}"];
- );//16.12.31upto
- if(npara>0, //17.01.03
- tmp4=concat(tmp4,["","\begin{layer}{120}"+paradt_2]);
- if(#<=npara, //16.12.28from
- tmp=parafiles_#;
- ,
- tmp=parafiles_npara;
- );
- tmp="{"+paradt_4+"{fig/"+paradt_1+"/"+tmp+"}}";
- if(length(paradt)>=5,
- tmp="{\scalebox{"+text(paradt_5)+"}"+tmp+"}";
- );
- if(substring(paradt_3,0,1)=="\",
- tmp=paradt_3+tmp;
- ,
- tmp="\putnote"+paradt_3+tmp;
- );
- tmp4=concat(tmp4,[tmp]);//16.12.31
- ,
- tmp4=concat(tmp4,["","\begin{layer}{120}{0}"]);
- );
- if((hyperflg>0) & (LinkSize>0.15),
- tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; // 17.01.12from
- tmp1=tmp+text(paractr)+"pg";
- tmp2=tmp+text(paractr-1)+"pg"+text(nrepprev);
- if(#>1,tmp=tmp1+text(1),tmp=tmp2);
- tmp3=[text(LinkPosH-29*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut|\!\lhd$}}}}}"];
- if(#>1,tmp=tmp1+text(max(#-3,1)),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-24*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\! \lhd\!\!\lhd\!$}}}}}");
- if(#>1,tmp=tmp1+text(#-1),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-17*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\!\lhd\!\!$}}}}}");
- tmp="{"+text(LinkPosV)+"}{\hyperlink{para";
- tmp2=tmp+text(paractr+1)+"pg"+text(1);
- if(#<nrep,tmp=tmp1+text(#+1),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-10*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\rhd\!$}}}}}");
- if(#<nrep,tmp=tmp1+text(min(#+3,nrep)),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-5*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\!\rhd\!\!\rhd\!$}}}}}");
- if(#<nrep,tmp=tmp1+text(nrep),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH)+"}"+tmp+"}{\fbox{\Ctab{" // 17.01.19
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut \!\rhd\!\!|$}}}}}");
- tmp3=apply(tmp3,tmp,"\putnotew{"+tmp);
- tmp4=concat(tmp4,tmp3);// 17.01.12uptor
- tmp="\putnotew{"+text(LinkPosH)+"}{"+text(LinkPosV+6)+"}";//17.10.21from
- tmp=tmp+"{\scriptsize\color{black} "+text(#)+"/"+text(nrep)+"}";
- tmp4=append(tmp4,tmp);//17.10.21upto
- );
- tmp4=concat(tmp4,["\end{layer}",""]);//16.12.31upto
- Repeatsameslide(repeatflg,text([#]),tmp4);
- );
- );
- );
- if(substring(sld,0,2)=="%%", //17.06.23from
- println(SCEOUTPUT,sld);
- flg=1;
- ); //17.06.23upto
- if(flg==0,
- if(indexof(sld,"\begin{verbatim}")==1, // 16.06.28from
- Repeatsameslide(repeatflg,sestr,[slideL_ns]);
- verbflg=1;
- flg=1;
- ); // 16.06.28
- if(indexof(sld,"\end{verbatim}")==1,
- Repeatsameslide(repeatflg,sestr,[slideL_ns]);
- verbflg=0;
- flg=1;
- ); // 16.06.28upto
- if(flg==0,
- tmp=replace(sld,"||||","//"); // 16.05.11
- tmp=tokenize(tmp,"::"); // 16.05.11
- tmp1=tmp_1;
- if(length(tmp)>1,tmp2=tmp_2,tmp2="");
- if(length(tmp)>2,tmp3=tmp_3,tmp3="");
- if(length(tmp)>3,tmp4=tmp_4,tmp4="");
- if(length(tmp)>4,tmp5=tmp_5,tmp5="");
- if(contains(["main","new","same"],tmp1),
- if(tmp1=="new", // 16.11.09from
- newoption="";
- if(substring(tmp2,0,1)=="[",newoption=tmp2);
- );
- if(tmp1=="same",
- if(length(tmp2)==0,tmp2=newoption);
- );// 16.11.09upto
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"%%%%%%%%%%%%%%%%%%%%");
- println(SCEOUTPUT,"");
- );
- );
- if(flg==0&tmp1=="main",
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- repeatflg=0;RepeatList=[];
- nrepprev=nrep;//17.01.03
- nrep=0;//16.12.27
- npara=0;//16.12.27
- );
- if(length(wall)>0,
- println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
- );
- println(SCEOUTPUT,"\mainslide{"+tmp2+"}");
- println(SCEOUTPUT,"");
- tmp2="";
- flg=1;
- );
- if(flg==0&tmp1=="new",
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- repeatflg=0;RepeatList=[];
- nrepprev=nrep;//17.01.03
- nrep=0;
- npara=0;
- );
- if(length(wall)>0,
- Repeatsameslide(repeatflg,sestr,["\input{fig/"+wall+".tex}"]);
- );
- tmp="\newslide";
- NewSlideOption=""; //17.01.04
- if(substring(tmp2,0,1)=="[",
- NewSlideOption=tmp2; //17.01.04
- tmp=tmp+tmp2;
- tmp2=tmp3;
- tmp3=tmp4;
- tmp4=tmp5;
- );
- tmp=tmp+"{"+tmp2+"}";
- Repeatsameslide(repeatflg,sestr,[tmp,"","\vspace*{18mm}",""]);
- tmp2="";
- flg=1;
- );
- if(flg==0&tmp1=="same",
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- repeatflg=0;RepeatList=[];
- nrepprev=nrep;//17.01.03
- nrep=0;
- npara=0;
- );
- if(length(wall)>0,
- println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
- );
- tmp="\sameslide"+NewSlideOption; //17.01.04;
-// if(substring(tmp2,0,1)=="[",
-// tmp=tmp+tmp2;
-// tmp2=tmp3;
-// tmp3=tmp4;
-// );
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\vspace*{18mm}");
- println(SCEOUTPUT,"");
- tmp4=tmp3;
- tmp3=tmp2;
- tmp2="";
- flg=1;
- );
- if(flg==0&tmp1=="itemize",
- Repeatsameslide(repeatflg,sestr,["\begin{itemize}"]);
- flgL=append(flgL,"i");
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="enumerate",
- Repeatsameslide(repeatflg,sestr,["\begin{enumerate}"+tmp2]);
- flgL=append(flgL,"e");
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="verbatim", //16.06.28from
- Repeatsameslide(repeatflg,sestr,["\begin{verbatim}"]);
- flgL=append(flgL,"v");
- tmp1="";
- tmp2="";
- tmp3="";
- verbflg=1;
- flg=1;
- ); //16.06.28upto
- if(flg==0&tmp1=="layer",
- Repeatsameslide(repeatflg,sestr,[""]);
- tmp="\begin{layer}";
- if(length(tmp2)>0,
- tmp=tmp+tmp2;
- ,
- tmp=tmp+"{120}{0}";
- );
- Repeatsameslide(repeatflg,sestr,[tmp]);
- flgL=append(flgL,"l");
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="putnote",
- tmp="\putnote"+tmp2+"{";
- if(indexof(tmp3,"include")==0,
- tmp1=indexof(tmp3,",");
- if(tmp1==0,
- tmp=tmp+"\input{fig/"+tmp3+".tex}}";
- ,
- tmp2=substring(tmp3,tmp1,length(tmp3));
- tmp3=substring(tmp3,0,tmp1-1);
- tmp=tmp+"\scalebox{"+tmp2+"}{\input{fig/"+tmp3+".tex}}}";
- );
- ,
- tmp2=indexof(tmp3,"[");
- tmp3=substring(tmp3,tmp2-1,length(tmp3));
- tmp=tmp+"\includegraphics"+tmp3+"{fig/"+tmp4+"}}";
- );
- Repeatsameslide(repeatflg,sestr,[tmp]);
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="item",
- NonThinFlg=1;
- Repeatsameslide(repeatflg,sestr,["\item"]);
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="end",
- tmp=flgL_(length(flgL));
- if(tmp=="i",
- Repeatsameslide(repeatflg,sestr,["\end{itemize}"]);
- );
- if(tmp=="e",
- Repeatsameslide(repeatflg,sestr,["\end{enumerate}"]);
- );
- if(tmp=="l",
- Repeatsameslide(repeatflg,sestr,["\end{layer}",""]);
- );
- if(tmp=="v", // 16.06.28from
- Repeatsameslide(repeatflg,sestr,["\end{verbatim}",""]);
- verbflg=0;
- ); // 16.06.28upto
- flgL=flgL_(1..(length(flgL)-1));
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0, // 16.06.28from
- if(verbflg==0,
- tmp2=tmp1;
- ,
- tmp2=slideorgL_ns; // 16.07.11
- tmp2=replace(tmp2,"||","//"); // 16.07.10
- tmp3="";
- );
- ); // 16.06.28upto
- if(length(tmp2)>0,
- if(tmp2=="...", tmp2="");
- if(NonThinFlg==1,NonThinFlg=2);
- Repeatsameslide(repeatflg,sestr,[tmp2]);
- );
- if(length(tmp3)>0,
- Repeatsameslide(repeatflg,sestr,["\begin{layer}{120}{0}"]);
- if(substring(tmp3,0,1)=="{",
- tmp=tmp3;
- tmp3=tmp4;
- ,
- tmp="{60}{0}";
- );
- tmp1=indexof(tmp3,",");
- if(tmp1==0,
- tmp3="\putnotes"+tmp+"{\input{fig/"+tmp3+".tex}}";
- ,
- tmp2=substring(tmp3,tmp1,length(tmp3));
- tmp3=substring(tmp3,0,tmp1-1);
- tmp3="\putnotes"+tmp+"{\scalebox{"+tmp2+"}
- {\input{fig/"+tmp3+".tex}}}";
- );
- Repeatsameslide(repeatflg,sestr,[tmp3,"\end{layer}",""]);
- );
- );
- );
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- );
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\end{document}");
- closefile(SCEOUTPUT);
-);
-
-Mkslides():=(
- regional(sep,parent,texparentorg,tmp,tmp1,tmp2,tmp3,tmp4,flg);
- tmp4=Fhead;
- Fhead="";
- if(!iswindows(), //17.10.13
- Dirwork=replace(Dirwork,"\",pathsep());
- parent=replace(Dirwork+Shellparent,"\",pathsep());
- ,
- Dirwork=replace(Dirwork,"/",pathsep());
- parent=replace(Dirwork+Batparent,"/",pathsep());// 16.05.29
- );
- Dirwork=replace(Dirwork,pathsep()+"fig","");
- Setdirectory(Dirwork);
- if(length(Texmain)>0, // 15.08.14 from
- Texparent=Texmain;
- );
- texparentorg=Texparent; //17.04.10from
- if(isstring(Slidename), // 15.08.14 from
- Texparent=Slidename;
- );//17.04.10upto
- if(!isexists(Dirwork,Texparent+".txt"), // 17.04.12from
- drawtext(mouse().xy,Texparent+".txt not exist in "+Dirwork,
- size->24,color->[1,0,0]);
- , // 17.04.12upto
- Presentation(Texparent); // 15.08.14 upto
- if(iswindows(),
- tmp2=Batparent;
- parent=replace(Dirwork+Batparent,sep+"fig","");// 16.05.29
- if(indexof(Pathpdf,"Adobe")>0, //17.12.09from
- Makebat(Texparent,"ttv");
- ,
- Makebat(Texparent,"tv");
- ); //17.12.09upto
- kc():=(
- println("kc : "+kc(parent,Dirlib,Fnametex)); // 16.06.10, 17.02.19
- );
- kc();
- Batparent=tmp2;
- ,
- tmp2=Shellparent;
- parent=replace(Dirwork+Shellparent,sep+"fig","");// 16.05.29
- Shellparent=replace(Shellparent,sep+"fig","");
- if(indexof(Pathpdf,"Adobe")>0, //17.12.09from
- Makeshell(Texparent,"ttv");
- ,
- Makeshell(Texparent,"tv");
- ); //17.12.09upto
- kc():=(
- println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); // 16.06.10
- );
- kc();
- Shellparent=tmp2;
- );
- );
- Dirwork=Dirwork+pathsep()+"fig"; //17.10.16
- setdirectory(Dirwork);
- Fhead=tmp4;
- Texparent=texparentorg;//17.04.10
-);
-
-Mkslidesummary():=( // 17.10.26 for R
- regional(texparentorg);
- texparentorg=Texparent;
- if(isstring(Slidename),
- Texparent=Slidename;
- );
- Mkslidesummary(Texparent,Texparent+"digest",["m","Wait=3"]);
- Texparent=texparentorg;
-);
-Mkslidesummary(fin,fout):=
- Mkslidesummary(fin,fout,["m","Wait=3"]);
-Mkslidesummary(inputfile,outputfile,options):=(
-//help:Mkslidesummary(fin,fout,options);
- regional(fin,fout,out,figflg,dirworkorg,dirtop,tmp);
- dirworkorg=Dirwork;//17.04.10from
- dirtop=replace(Dirwork,pathsep()+"fig","");
- Changework(dirtop);//17.04.10uptp
- fin=inputfile;
- if(indexof(fin,".")==0,fin=fin+".tex");
- fout=outputfile;
- if(indexof(fout,".")==0,fout=fout+".tex");
- cmdL=[
- "Dt=readLines('"+fin+"')",[],
- "num=grep('\\hypertarget',Dt,fixed=TRUE)",[],
- "Dt=Dt[setdiff(1:length(Dt),num)]",[],
- "Smain=c();Snew=c();Ssame=c()",[],
- "for(J in 1:length(Dt)){",[],
- " Tmp=length(grep('\\mainslide',Dt[J],fixed=TRUE))",[],
- " if(Tmp>0){Smain=c(Smain,1)}else{Smain=c(Smain,0)}",[],
- " Tmp=length(grep('\\newslide',Dt[J],fixed=TRUE))",[],
- " if(Tmp>0){Snew=c(Snew,1)}else{Snew=c(Snew,0)}",[],
- " Tmp=length(grep('\\sameslide',Dt[J],fixed=TRUE))",[],
- " if(Tmp>0){Ssame=c(Ssame,1)}else{Ssame=c(Ssame,0)}",[],
- "}",[],
- "Nnew=c();Nsame=c()",[],
- "for(J in 1:length(Dt)){",[],
- " if((Snew[J]==1)|(Smain[J]==1)){Nnew=c(Nnew,J)}",[],
- " if(Ssame[J]==1){Nsame=c(Nsame,J)}",[],
- "}",[],
- "Out=Dt[1:Nnew[1]]",[],
- "for(J in 2:length(Nnew)){",[],
- " Tmp=max(Nsame[Nsame<Nnew[J]])",[],
- " Tmp=max(c(Nsame[Tmp],Nnew[J-1]))+1",[],
- " Out=c(Out,Dt[Tmp:Nnew[J]])",[],
- "}",[],
- "Tmp=max(c(Nsame[-1],Nnew[-1]))+1",[],
- "Out=c(Out,Dt[Tmp:length(Dt)])",[],
- "writeLines(Out,'"+fout+"',sep='\n')",[],
- "cat('////',file='resultR.txt',sep='')",[],
- "quit()",[]
- ];
- CalcbyR("out",cmdL,append(options,"Cat=n"));
- wait(1000);
- Changework(dirtop);//17.04.10
- tmp=replace(fout,".tex","");
- if(iswindows(),
- Makebat(tmp,"tv");
- ,
- Makeshell(tmp,"tv");
- );
- kc();
- Changework(dirworkorg);//17.04.10
-);
-
-Example(exorg):=Example(exorg,"");
-Example(exorg,suborg):=(
-//help:Example("Mxfun","diff");
- regional(ex,tmp,tmp1,tmp2);
- ex=replace(exorg,"'",Dq);
- sub=replace(suborg,"'",Dq);
- setdirectory(Dirlib);
- tmp=load("examples.txt");
- setdirectory(Dirwork);
- tmp=tokenize(tmp,"//");
- tmp=tmp_(1..(length(tmp)-1));
- tmp1=select(tmp,substring(#,0,length(ex))==ex);
- tmp1=sort(tmp1);
- if(length(sub)>0,
- tmp1=select(tmp1,indexof(#,sub)>0);
- );
- forall(tmp1,
- if((indexof(#,"##")>0) % (indexof(#,"~#")>0),
- tmp=indexof(#,",");
- println(substring(#,tmp,length(#)));
- ,
- println(#);
- );
- );
-);
-
-BBdata():=Bbdata(BBTarget,0);
-BBdata(fname):=Bbdata(fname,0); // 16.04.09
-BBdata(fname,optionorg):=(
-//help:BBdata(filename);
-//help:BBdata(options=0(automatic),1(make),"w=","h=");
- regional(fout,flg,path,file,kcfile,options,eqL,reL,stL,
- waiting,addop,tmp,tmp1,tmp2);
- path="";
- file=fname;
- flg=0;
- waiting=2;
- forall(reverse(1..length(fname)),
- if(flg==0,
- tmp=substring(fname,#-1,#);
- if(tmp=="/" % tmp=="\", // 14.01.15
- path=substring(fname,0,#-1);
- file=substring(fname,#,length(fname));
- flg=1;
- );
- );
- );
- if(path=="",path=Dirwork);//16.10.05
- if(indexof(file,".")==0,file=file+".pdf");
- if(islist(optionorg),options=optionorg,options=[optionorg]);
- tmp=divoptions(options);
- eqL=tmp_5;
- reL=tmp_6;
- stL=tmp_7;
- flg=0;
- addop="";
- if(length(reL)>0,
- tmp=reL_1;
- if(tmp==1,flg=1);
- );
- forall(stL,
- tmp=Toupper(substring(#,0,1));
- if(tmp=="M",flg=1);
- );
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=substring(#,tmp,length(#));
- if(tmp1=="W=",
- addop=addop+",width="+tmp2;
- options=remove(options,[#]);
- );
- if(tmp1=="H=",
- addop=addop+",height="+tmp2;
- options=remove(options,[#]);
- );
- );
- tmp=indexof(file,".");
- tmp1=substring(file,0,tmp-1);
- fout=tmp1+".txt";
- if(iswindows(),
- kcfile="kc.bat";
- ,
- kcfile="kc.sh";
- );
- if(flg==0,
- tmp=load(fout); //
- if(length(tmp)==0,
- flg=1;
- ,
- tmp=tokenize(tmp,"%%");
- tmp=tmp_2;
- tmp1=indexof(tmp,":");
- tmp=substring(tmp,tmp1,length(tmp));
- tmp=Removespace(tmp);
- if(tmp!=file,flg=1);
- );
- );
- if(length(path)==0,
- path=Dirwork;
- );
- if(flg==1,
- setdirectory(path);
- tmp=load(file);
- setdirectory(Dirwork);
- if(length(tmp)==0,
- println(" => "+file+" not exists");
- flg=-1;
- );
- );
- if(flg==1,
- SCEOUTPUT = openfile(kcfile);
- if(!iswindows(),
- println(SCEOUTPUT,"#!/bin/sh");
- );
- println(SCEOUTPUT,"cd "+Dq+path+Dq);
- tmp=replace(PathT,"pdflatex","extractbb"); //16.11.22
- tmp=replace(tmp,"pdftex","extractbb"); //16.11.22
- tmp=replace(tmp,"xelatex","extractbb");
- tmp=replace(tmp,"uplatex","extractbb"); //17.09.20
- tmp=replace(tmp,"platex","extractbb");
- tmp=replace(tmp,"latex","extractbb");
- tmp=tmp+" -O "+file;
- if(iswindows(),
- tmp=tmp+" > "+Dirwork+"\"+fout;
- ,
- tmp=tmp+" > "+Dirwork+"/"+fout;
- );
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"exit 0");
- closefile(SCEOUTPUT);
- kc(Dirwork+"/"+kcfile,Mackc+Dirlib,Fnametex); // 16.06.07
- );
- if(flg>=0,
- tmp1=0;
- repeat(floor(waiting*1000/WaitUnit),
- if(tmp1==0,
- wait(10);
- tmp=load(fout);
- if(indexof(tmp,"CreationDate")>0,
- tmp1=1;
- );
- );
- );
- if(length(tmp)==0,
- println(fout+" not generated. Maybe "+kcfile+" not run.");
- ,
- tmp=tokenize(tmp,"%%");
- tmp=select(tmp,indexof(#,"Bounding")>0);
- tmp=tmp_2; //
- tmp1=indexof(tmp,":");
- tmp=substring(tmp,tmp1,length(tmp));
- tmp=removespace(tmp);
- tmp=tokenize(tmp," ");
- tmp1="";
- forall(tmp,
- tmp1=tmp1+Sprintf(#,2)+" ";
- );
- tmp1=removespace(tmp1)+addop;
- tmp2="\includegraphics[bb="+tmp1+"]{"+file+"}";
- println(tmp2);
- );
- );
-// setdirectory(Dirwork);
- tmp2; // 16.04.25
-);
-
-//help:end();
-
+// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
+//
+//This program is free software: you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation; either version 3 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program. If not, see <http://www.gnu.org/licenses/>
+//
+
+println("ketcindybasic2(20180405) loaded");
+
+//help:start();
+
+Dispchoice():=(
+ if(islist(Ch),
+ if(!isreal(ChNum),ChNum=1);
+ drawtext(mouse().xy,"Ch="+text(Ch)+" N="+text(ChNum),size->24,color->[0,0,1]);
+ );
+);
+
+Datetime():=(
+//help:Datetime();
+ regional(names,dt,tmp);
+ tmp=getdatetime();
+ dt=tokenize(tmp," ");
+ dt=apply(dt,if(!isstring(#),text(#),#));
+ names=["Jan","Feb","Mar","Apr","May","Jun",
+ "Jul","Aug","Sep","Oct","Nov","Dec"];
+ tmp=select(1..12,names_#==dt_2);
+ tmp=text(tmp_1);
+ tmp=[dt_6+"/"+tmp+"/"+dt_3,dt_4];
+);
+
+Rotatepoint(point,Theta,ctr):=(
+//help:Rotatepoint(A,2*pi/3,B);
+ regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
+ tmp=Lcrd(point);
+ X1=tmp_1; Y1=tmp_2;
+ tmp=Lcrd(ctr);
+ Cx=tmp_1; Cy=tmp_2;
+ X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta);
+ Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta);
+ [X2,Y2];
+);
+
+Translatepoint(point,mov):=(
+//help:Translatepoint(A,[2,3]);
+ regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
+ tmp=Lcrd(point);
+ X1=tmp_1; Y1=tmp_2;
+ tmp=Lcrd(mov);
+ Cx=tmp_1; Cy=tmp_2;
+ X2=X1+Cx;
+ Y2=Y1+Cy;
+ [X2,Y2];
+);
+
+Scalepoint(point,ratio,center):=(
+//help:Scalepoint(A,[3,2],[0,0]);
+ regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
+ tmp=Lcrd(point);
+ X1=tmp_1; Y1=tmp_2;
+ tmp=Lcrd(center);
+ Cx=tmp_1; Cy=tmp_2;
+ X2=Cx+ratio_1*(X1-Cx);
+ Y2=Cy+ratio_2*(Y1-Cy);
+ [X2,Y2];
+);
+
+Reflectpoint(point,symL):=(
+//help:Reflectpoint(A,B);
+//help:Reflectpoint(A,[[2,3]]);
+//help:Reflectpoint(A,[C,E]);
+ regional(X1,X2,Y1,Y2,Us,Vs,Pt1,Pt2,Cx,Cy,tmp);
+ tmp=Lcrd(point);
+ X1=tmp_1; Y1=tmp_2;
+ Pt1=Lcrd(symL_1);
+ if(length(symL)==1,
+ Pt2=Pt1;
+ ,
+ Pt2=Lcrd(symL_2);
+ );
+ Us=Pt2_1-Pt1_1;
+ Vs=Pt2_2-Pt1_2;
+ if(Pt1==Pt2,
+ X2=2*Pt1_1-X1;
+ Y2=2*Pt1_2-Y1;
+ ,
+ X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1
+ -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
+ Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1
+ +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
+ );
+ [X2,Y2];
+);
+
+Rotatedata(nm,plist,Theta):=Rotatedata(nm,plist,Theta,[]);
+Rotatedata(nm,plist,angle,options):=(
+//help:Rotatedata("1","crAB",pi/3,[[1,5],"dr,2"]);
+ regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdLL,PdL,
+ opcindy,Nj,Njj,Kj,Mj,X1,Y1,X2,Y2,Ltype,Noflg,name);
+ name="rt"+nm;
+ Pt=[0,0];
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ opcindy=tmp_(length(tmp));
+ tmp1=tmp_6;
+ if(length(tmp1)>0,Pt=Lcrd(tmp1_1));
+ pdata=plist;
+ if(isstring(pdata),pdata=[pdata]);
+ if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
+ pdata=[pdata];
+ );
+ if(isstring(angle),Theta=parse(angle),Theta=angle);
+ Cx=Pt_1; Cy=Pt_2;
+ PdL=[];
+ forall(pdata,Njj,
+ if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
+ if(MeasureDepth(Kj)==0,Kj=[Kj]); //17.11.24
+ if(MeasureDepth(Kj)==1,Kj=[Kj]);
+ tmp2=[];
+ forall(Kj,Nj,
+ tmp1=[];
+ forall(Nj,
+ tmp=LLcrd(#);
+ X1=tmp_1;
+ Y1=tmp_2;
+ X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta);
+ Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta);
+ tmp1=concat(tmp1,[[X2,Y2]]);
+ );
+ tmp2=concat(tmp2,[tmp1]);
+ );
+ PdL=concat(PdL,tmp2);
+ );
+ if(Noflg<3,
+ println("generate Rotatedata "+name);
+ tmp1=[];
+ forall(PdL,tmp2,
+ tmp=apply(tmp2,Pcrd(#));
+ tmp1=append(tmp1,tmp);
+ );
+ if(length(tmp1)==1,tmp1=tmp1_1);
+ tmp=name+"="+textformat(tmp1,5);
+ parse(tmp);
+ tmp1=text(plist);
+ tmp1=RSform(tmp1);// 17.12.23(2lines)
+ tmp=name+"=Rotatedata("+tmp1+","
+ +textformat(angle,5)+","+RSform(textformat(Pt,5))+")"; //17.12.23
+ GLIST=append(GLIST,tmp);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ PdL;
+);
+
+Translatedata(nm,plist,mov):=Translatedata(nm,plist,mov,[]);
+Translatedata(nm,plist,mov,options):=(
+//help:Translatedata("1",["gr1"],[1,2]);
+ regional(tmp,tmp1,tmp2,pdata,Cx,Cy,PdL,Nj,Njj,Kj,
+ opcindy,X2,Y2,Ltype,Noflg,name);
+ name="tr"+nm;
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ opcindy=tmp_(length(tmp));
+ pdata=plist;
+ if(isstring(pdata),pdata=[pdata]);
+ if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
+ pdata=[pdata];
+ );
+ tmp=Lcrd(mov);
+ Cx=tmp_1; Cy=tmp_2;
+ PdL=[];
+ forall(pdata,Njj,
+ if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
+ if(MeasureDepth(Kj)==1,Kj=[Kj]);
+ tmp2=[];
+ forall(Kj,Nj,
+ tmp1=[];
+ forall(Nj,
+ tmp=LLcrd(#);
+ X2=tmp_1+Cx;
+ Y2=tmp_2+Cy;
+ tmp1=concat(tmp1,[[X2,Y2]]);
+ );
+ tmp2=concat(tmp2,[tmp1]);
+ );
+ PdL=concat(PdL,tmp2);
+ );
+ if(Noflg<3,
+ println("generate Translatedata "+name);
+ tmp1=[];
+ forall(PdL,tmp2,
+ tmp=apply(tmp2,Pcrd(#));
+ tmp1=append(tmp1,tmp);
+ );
+ if(length(tmp1)==1,tmp1=tmp1_1);
+ tmp=name+"="+textformat(tmp1,5);
+ parse(tmp);
+ tmp1=text(plist);
+ tmp1=RSform(tmp1);// 17.12.23
+ tmp=name+"=Translatedata("+tmp1+","+RSform(textformat(mov,5))+")";
+ GLIST=append(GLIST,tmp);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ PdL;
+);
+
+Scaledata(nm,plist,ratioV):=(
+ regional(tmp);
+ tmp=Lcrd(ratioV);
+ Scaledata(nm,plist,tmp_1,tmp_2,[]);
+);
+Scaledata(nm,plist,Arg1,Arg2):=(
+//help:Scaledata("1","crAB",3,2,[[0,0]]);
+ regional(tmp,options);
+ if(islist(Arg2),
+ tmp=Lcrd(Arg1);
+ options=Arg2;
+ Scaledata(nm,plist,tmp_1,tmp_2,options);
+ ,
+ Scaledata(nm,plist,Arg1,Arg2,[]);
+ );
+);
+Scaledata(nm,plist,rx,ry,options):=(
+ regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdL,
+ opcindy,Nj,Njj,Kj,X2,Y2,Ltype,Noflg,name);
+ name="sc"+nm;
+ Pt=[0,0];
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ opcindy=tmp_(length(tmp));
+ tmp1=tmp_6;
+ if(length(tmp1)>0,
+ Pt=Lcrd(tmp1_1);
+ );
+ pdata=plist;
+ if(isstring(pdata),pdata=[pdata]);
+ if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
+ pdata=[pdata];
+ );
+ Cx=Pt_1; Cy=Pt_2;
+ PdL=[];
+ forall(pdata,Njj,
+ if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
+ if(MeasureDepth(Kj)==1,Kj=[Kj]);
+ tmp2=[];
+ forall(Kj,Nj,
+ tmp1=[];
+ forall(Nj,
+ tmp=LLcrd(#);
+ X2=Cx+rx*(tmp_1-Cx);
+ Y2=Cy+ry*(tmp_2-Cy);
+ tmp1=concat(tmp1,[[X2,Y2]]);
+ );
+ tmp2=concat(tmp2,[tmp1]);
+ );
+ PdL=concat(PdL,tmp2);
+ );
+ if(Noflg<3,
+ println("generate Scaledata "+name);
+ tmp1=[];
+ forall(PdL,tmp2,
+ tmp=apply(tmp2,Pcrd(#));
+ tmp1=append(tmp1,tmp);
+ );
+ if(length(tmp1)==1,tmp1=tmp1_1);
+ tmp=name+"="+textformat(tmp1,5);
+ parse(tmp);
+ tmp1=text(plist);
+ tmp1=RSform(tmp1); // 17.12.23
+ tmp=name+"=Scaledata("+tmp1+","
+ +textformat(rx,5)+","+textformat(ry,5)+","+RSform(textformat(Pt,5))+")";
+ GLIST=append(GLIST,tmp);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ PdL;
+);
+
+Reflectdata(nm,plist,symL):=Reflectdata(nm,plist,symL,[]);
+Reflectdata(nm,plist,symL,options):=(
+//help:Reflectdata("1","crAB",[C]);
+ regional(tmp,tmp1,tmp2,pdata,Us,Vs,Pt1,Pt2,Cx,Cy,PdL,
+ opcindy,Nj,Njj,Kj,X1,Y1,X2,Y2,Ltype,Noflg,name);
+ name="re"+nm;
+ Pt=[0,0];
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ opcindy=tmp_(length(tmp));
+ pdata=plist;
+ if(isstring(pdata),pdata=[pdata]);
+ if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
+ pdata=[pdata];
+ );
+ Pt1=Lcrd(symL_1);
+ if(length(symL)==1,
+ Pt2=Pt1;
+ ,
+ Pt2=Lcrd(symL_2);
+ );
+ Us=Pt2_1-Pt1_1;
+ Vs=Pt2_2-Pt1_2;
+ PdL=[];
+ forall(pdata,Njj,
+ if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
+ if(MeasureDepth(Kj)==1,Kj=[Kj]);
+ tmp2=[];
+ forall(Kj,Nj,
+ tmp1=[];
+ forall(Nj,
+ tmp=LLcrd(#);
+ X1=tmp_1;
+ Y1=tmp_2;
+ if(Pt1==Pt2,
+ X2=2*Pt1_1-X1;
+ Y2=2*Pt1_2-Y1;
+ ,
+ X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1
+ -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
+ Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1
+ +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
+ );
+ tmp1=concat(tmp1,[[X2,Y2]]);
+ );
+ tmp2=concat(tmp2,[tmp1]);
+ );
+ PdL=concat(PdL,tmp2);
+ );
+ if(Noflg<3,
+ println("generate Reflectdata "+name);
+ tmp1=[];
+ forall(PdL,tmp2,
+ tmp=apply(tmp2,Pcrd(#));
+ tmp1=append(tmp1,tmp);
+ );
+ if(length(tmp1)==1,tmp1=tmp1_1);
+ tmp=name+"="+textformat(tmp1,5);
+ parse(tmp);
+ tmp1=text(plist);
+ tmp1=RSform(tmp1);// 17.12.23
+ tmp=name+"=Reflectdata("+tmp1+","+RSform(textformat(symL,5))+")";//17.12.23
+ GLIST=append(GLIST,tmp);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ PdL;
+);
+
+Mksegments():=Mksegments([]);
+Mksegments(options):=(
+//help:Mksegments();
+ regional(segstr,p,q,r,tmp1,tmp2,tmp3);
+ forall(allsegments(),seg,
+ str=text(inspect(seg,"definition"));
+ tmp1=indexof(str,"(");
+ tmp2=indexof(str,";");
+ tmp3=indexof(str,")");
+ p=substring(str,tmp1,tmp2-1);
+ q=substring(str,tmp2,tmp3-1);
+ Listplot([parse(p),parse(q)]);
+ );
+);
+
+Mkcircles():=Mkcircles([]);
+Mkcircles(options):=(
+//help:Mkcircles():
+ regional(seg,cir,str,p,q,r,tmp1,tmp2,tmp3,tmp4);
+ forall(allcircles(),cir,
+ str=text(inspect(cir,"definition"));
+ tmp1=indexof(str,"(");
+ tmp2=indexof(str,";");
+ tmp3=indexof(str,")");
+ tmp4=indexof(str,";",tmp2+1);
+ if(tmp4==0,
+ p=substring(str,tmp1,tmp2-1);
+ q=substring(str,tmp2,tmp3-1);
+ Circledata([parse(p),parse(q)]);
+ ,
+ p=substring(str,tmp1,tmp2-1);
+ q=substring(str,tmp2,tmp4-1);
+ r=substring(str,tmp4,tmp3-1);
+ Circledata([parse(p),parse(q),parse(r)]);
+ );
+ );
+);
+
+MakeRarg(arglist):=(
+ regional(str,tmpstr);
+ str="";
+ forall(arglist,
+ if(isstring(#),
+ tmpstr=Dq+RSslash(#)+Dq;
+ ,
+ tmpstr=textformat(#,6);
+ );
+ str=str+tmpstr+",";
+ );
+ str=substring(str,0,length(str)-1);
+ str;
+);
+
+Setax(arglist):=(
+//help:Setax(["l","x","e","y","n","O","sw"]);
+//help:Setax([7,"nw"]);
+ regional(tmp);
+ tmp=MakeRarg(arglist);
+ Com1st("Setax("+tmp+")");
+);
+
+Htickmark(arglist):=(
+//help:Htickmark([1,"1",2,"sw","2"]);
+ regional(tmp);
+ tmp="";
+ tmp=MakeRarg(arglist);
+ Com2nd("Htickmark("+tmp+")");
+);
+
+Vtickmark(arglist):=(
+//help:Vtickmark([1,"1",2,"sw","2"]);
+ regional(tmp);
+ tmp=MakeRarg(arglist);
+ Com2nd("Vtickmark("+tmp+")");
+);
+
+Vtick(py):=Vtick(py,MARKLEN,[]);
+Vtick(py,len):=Vtick(py,len,[]);
+Vtick(py,len,options):=(
+//help:Vtick(1,0.1,options);
+ regional(tmp,tmp1,tmp2);
+ tmp="v"+text(round(py*100));
+ tmp=replace(tmp,"-","m");
+ tmp1=[0-len/2,py];
+ tmp2=[0+len/2,py];
+ Listplot(tmp,[tmp1,tmp2],options);
+);
+
+Htick(px):=Htick(px,MARKLEN,[]);
+Htick(px,len):=Htick(px,len,[]);
+Htick(px,lenorg,options):=(
+//help:Htick(-1,0.1,options);
+ regional(len,tmp,tmp1,tmp2);
+ tmp=LLcrd([0,lenorg]);
+ len=tmp_2;
+ tmp="h"+text(round(px*100));
+ tmp=replace(tmp,"-","m");
+ tmp1=[px,0-len/2];
+ tmp2=[px,0+len/2];
+ Listplot(tmp,[tmp1,tmp2],options);
+);
+
+Drwxy():=(
+//help:Drwxy();
+ Com2nd("Drwxy()");
+ Addax(0); // 16.01.21
+);
+
+Drwpt(pstr):=Drawpoint(pstr);
+Drwpt(ptlist,nn):=( // 16.03.05 from
+//help:Drwpt(A);
+//help:Drwpt("[1,1],0");
+//help:Drwpt(A,0);
+//help:Drwpt([1,2],0);
+ Drawpoint(ptlist,nn);
+);
+Drawpoint(pstr):=(
+ if(isstring(pstr),
+ println("Drwpt : "+pstr);
+ Com2nd("Drwpt("+pstr+")");
+ ,
+ Drawpoint(pstr,1);
+ );
+);
+Drawpoint(ptlistorg,nn):=(
+ regional(ptlist,thick,tmp,tmp1);
+ println("Drwpt : "+text(ptlistorg));
+ if(islist(ptlistorg),
+ if(MeasureDepth(ptlistorg)==1,
+ ptlist=ptlistorg
+ ,
+ ptlist=[ptlistorg]
+ );
+ ,
+ ptlist=[ptlistorg]
+ );
+ thick=PenThick/PenThickInit;// 16.04.09 from
+ tmp1=max(TenSize/TenSizeInit,1)/8;
+ Setpen(tmp1); // 16.04.09 until
+ forall(ptlist,
+ tmp=textformat(#,5)+","+text(nn);
+ Com2nd("Drwpt("+tmp+")"); // 16.04.09
+ );
+ Setpen(thick); // 16.04.09
+);// 16.03.05 until
+
+Addax(param):=(
+//help:Addax(0);
+ ADDAXES=textformat(param,5);
+);
+
+Expr(Pt,Dr,St):=Expr([Pt,Dr,St]);
+Expr(list):=Expr(list,[]);
+Expr(listorg,options):=( //16.10.09
+//help:Expr([A,"e","f(x)=x^2"]);
+ regional(list,str,tmp,tmp1,tmp2);
+ list=listorg;
+ forall(1..round(length(list)/3),
+ str=list_(3*#);
+ if(!isstring(str),str=format(str,5));
+ str="$"+str+"$";
+ list_(3*#)=str;
+ );
+ Letter(list,options);
+);
+
+Letter(Pt,Dr,St):=Letter([Pt,Dr,St]);
+Letter(list):=Letter(list,[]);
+Letter(list,options):=(
+//help:Letter([C,"c","Graph of f(x)"]);
+ regional(Nj,Pos,Dir,Str,Off,Dmv,Xmv,Ymv,Noflg,opcindy,
+ opL,aln,sz,clr,bld,ita,tmp,tmp1,tmp2);
+ tmp=Divoptions(options);
+ Noflg=tmp_2;
+ opL=select(options,indexof(#,"->")>0); //16.10.09from
+ tmp=select(opL,indexof(#,"color"));
+ size=12;
+ clr=[0,0,0];
+ bld=false;
+ ita=false;
+ aln="left";
+ forall(opL,
+ tmp=indexof(#,"->");
+ tmp1=removespace(substring(#,0,tmp-1));
+ tmp2=substring(#,tmp+1,length(#));
+ if(tmp1=="size",sz=parse(tmp2));
+ if(tmp1=="color",clr=parse(tmp2));
+ if(tmp1=="bold",bld=parse(tmp2));
+ if(tmp1=="ita",ita=parse(tmp2));
+ );//16.10.09until
+ Off=-4;
+ Dmv=8;
+ Nj=1;
+ while(Nj+2<=length(list),
+// Pos=textformat(list_Nj,5);
+ Pos=list_Nj;
+ Dir=list_(Nj+1);
+ tmp=indexof(Dir,"s")+indexof(Dir,"n");//16.10.19from
+ if(tmp>0,
+ tmp=indexof(Dir,"w")+indexof(Dir,"e");
+ if(tmp==0,
+ Dir="c"+Dir;//16.10.08
+ );
+ );//16.10.19until
+ Str=list_(Nj+2);
+ if(!isstring(Str),Str=format(Str,5)); // 16.09.30,10.09
+ tmp=replace(Str,".xy","");
+ tmp=replace(tmp,".x","(1)");
+ Str=replace(tmp,".y","(2)");
+ Str=RSslash(Str); // 17.09.24
+ Str=replace(Str,"`","'");//180303
+ tmp=Dq+","+Dq+Str+Dq+")";
+ if(Noflg==0,
+ Com2nd("Letter("+Lcrd(Pos)+","+Dq+Dir+tmp);//16.10.10
+ );
+ if(Noflg<2,
+ Xmv=0;//16.10.13
+ Ymv=-4;
+ if(indexof(Dir,"n")>0,
+ Ymv=Dmv/2;
+ );
+ if(indexof(Dir,"s")>0,
+ Ymv=-Dmv*3/2;//16.10.13
+ );
+ if(indexof(Dir,"e")>0,
+ Xmv=Dmv/2;
+ Off=0;
+ aln="left";
+ );
+ if(indexof(Dir,"w")>0,
+ Xmv=-Dmv/2;
+ Off=0; // 16.09.30from
+ aln="right";
+ );
+ if(indexof(Dir,"c")>0,
+ Xmv=0;//16.10.13
+ Off=0;
+ if(Ymv==0,Ymv=-4);//16.10.08
+ aln="mid"; // 16.09.30until
+ );
+ Str=list_(Nj+2); //17.10.17
+ drawtext(Pcrd(Pos),Str,offset->[Off+Xmv,Off+Ymv],
+ size->sz,color->clr,align->aln,bold->bld,italics->ita);//16.10.09
+ );
+ Nj=Nj+3;
+ );
+);
+
+Letterrot(pt,dir,str):=Letterrot(pt,dir,0,0,str);
+Letterrot(pt,dir,movstr,str):=(
+//help:Letterrot(C,B-A,"AB"):
+//help:Letterrot(C,B-A,0,5,"AB"):
+//help:Letterrot(C,B-A,"t0n5","AB"):
+ regional(tmov,nmov,tmp,tmp1,tmp2);
+ tmp1=indexof(movstr,"t");
+ tmp2=indexof(movstr,"n");
+ if(tmp1>0,
+ if(tmp2>0,tmp=tmp2-1,tmp=length(movstr));
+ tmov=parse(substring(movstr,tmp1,tmp));
+ ,
+ tmov=0;
+ );
+ if(tmp2>0,
+ nmov=parse(substring(movstr,tmp2,length(movstr)));
+ ,
+ nmov=0;
+ );
+ Letterrot(pt,dir,tmov,nmov,str);
+);
+Letterrot(pt,dir,tmov,nmov,str):=(
+ regional(tmp);
+ Letter([pt,"c",str],["notex"]);
+ tmp=replace(str,"\","\\"); //17.10.18
+ Com2nd("Letterrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')");
+);
+
+Exprrot(pt,dir,str):=Exprrot(pt,dir,0,0,str);
+Exprrot(pt,dir,movstr,str):=(
+//help:Exprrot(C,B-A,"d"):
+//help:Exprrot(C,B-A,0,5,"d"):
+//help:Exprrot(C,B-A,"t0n5","d"):
+ regional(tmov,nmov,tmp,tmp1,tmp2);
+ tmp1=indexof(movstr,"t");
+ tmp2=indexof(movstr,"n");
+ if(tmp1>0,
+ if(tmp2>0,tmp=tmp2-1,tmp=length(movstr));
+ tmov=parse(substring(movstr,tmp1,tmp));
+ ,
+ tmov=0;
+ );
+ if(tmp2>0,
+ nmov=parse(substring(movstr,tmp2,length(movstr)));
+ ,
+ nmov=0;
+ );
+ Exprrot(pt,dir,tmov,nmov,str);
+);
+Exprrot(pt,dir,tmov,nmov,str):=(
+ regional(tmp);
+ Expr([pt,"c",str],["notex"]);
+ tmp=replace(str,"\","\\"); //17.10.18
+ Com2nd("Exprrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')");
+);
+
+Putslider(ptstr,p1,p2):=Slider(ptstr,p1,p2);
+Slider(ptstr,p1,p2):=( //17.04.11
+//help:Slider("A-C-B",[-3,0],[3,0]);
+ regional(pA,pB,pC,seg,sname,Alpha,tmp,tmp1);
+ tmp=indexall(ptstr,"-");
+ pA=substring(ptstr,0,tmp_1-1);
+ pC=substring(ptstr,tmp_1,tmp_2-1);
+ pB=substring(ptstr,tmp_2,length(ptstr));
+ seg=pA+pB;
+ Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+ sname="";
+ forall(1..(length(seg)),
+ tmp=substring(seg,#-1,#);
+ tmp1=indexof(Alpha,tmp);
+ if(tmp1>0,
+ sname=sname+unicode(text(tmp1+96),base->10);
+ ,
+ sname=sname+tmp;
+ );
+ );
+ Putpoint(pA,p1);
+ Putpoint(pB,p2);
+ Listplot([parse(pA),parse(pB)],["notex","color->[0,0.4,0.4]","size->2"]);
+// create([sname],"Segment",[parse(pA),parse(pB)]);
+// tmp2=Listplot("",[p1,p2],["nodata"]);
+ Putonseg(pC,parse("sg"+pA+pB));
+// create([pC],"PointOn",[parse(sname),0.5]);
+);
+
+Putpoint(name,Pt):=Putpoint(name,Pt,Pt);
+Putpoint(name,Ptinit,Pt):=(
+//help:Putpoint("A",[1,2],[1,A.y]);
+ regional(ptstr);
+ ptstr=apply(allpoints(),#.name);//16.10.06
+ if(!contains(ptstr,name),
+ createpoint(name,Pcrd([Ptinit_1,Ptinit_2]));
+ ,
+ ptstr=name+".xy="+textformat(Pcrd(Pt),5);
+ parse(ptstr);
+ );
+);
+
+Bezierpt(t,ptlist,ctrlist):=(
+ regional(flg3,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9);
+ p0=ptlist_1;
+ p3=ptlist_2;
+ p1=ctrlist_1;
+ if(length(ctrlist)==1,
+ p2=p3;
+ flg3=0;
+ ,
+ p2=ctrlist_2;
+ flg3=1;
+ );
+ if(length(p0)<3, // 15.02.08
+ p0=Lcrd(p0);
+ p3=Lcrd(p3);
+ p1=Lcrd(p1);
+ p2=Lcrd(p2);
+ );
+ p4=(1-t)*p0+t*p1;
+ p5=(1-t)*p1+t*p2;
+ p6=(1-t)*p2+t*p3;
+ p7=(1-t)*p4+t*p5;
+ p8=(1-t)*p5+t*p6;
+ p9=(1-t)*p7+t*p8;
+ if(flg3==0,p7,p9);
+);
+
+Bezier(ptctrlist):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,[]);
+Bezier(ptctrlist,options):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,options);
+Bezier(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]);
+Bezier(nm,ptlist,ctrlist,options):=BezierCurve(nm,ptlist,ctrlist,options);
+BezierCurve(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]);
+BezierCurve(nm,ptlistorg,ctrlistorg,options):=(
+//help:Bezier("1",[A,D],[B,C]);
+//help:Bezier(options=["Num=10"]);
+ regional(name,Ltype,Noflg,opstr,opcindy,Num,
+ ptlist,ctrlist,tmp,tmp1,tmp2,ii,st,out,list);
+ name="bz"+nm;
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ opstr=tmp_(length(tmp)-1);
+ opcindy=tmp_(length(tmp));
+ Num=10;
+ tmp1=tmp_5;
+ forall(tmp1, // 14.12.31
+ if(substring(#,0,1)=="N",
+ tmp2=indexof(#,"=");
+ Num=parse(substring(#,tmp2,length(#)));
+ opstr=opstr+","+Dq+#+Dq;
+ );
+ );
+ ptlist=apply(ptlistorg,Lcrd(#)); // 16.08.16
+ ctrlist=[]; // 14.12.31
+ if(length(ctrlistorg)==length(ptlist)-1,
+ forall(ctrlistorg,tmp1,
+ if(MeasureDepth(tmp1)==0,tmp=[tmp1],tmp=tmp1);
+ tmp=apply(tmp,Lcrd(#)); // 16.08.16
+ ctrlist=append(ctrlist,tmp);
+ );
+ ,
+ forall(1..(length(ptlist)-1),ii,
+ tmp=ctrlistorg_((2*ii-1)..(2*ii));
+ tmp=apply(tmp,Lcrd(#)); // 16.08.16
+ ctrlist=append(ctrlist,tmp);
+ );
+ );
+ if(!islist(Num),
+ Num=apply(ctrlist,Num);
+ );
+ list=[];
+ forall(1..(length(ptlist)-1),ii,
+ tmp1=ptlist_(ii..(ii+1));
+ tmp2=ctrlist_ii;
+ if(ii==1,st=0,st=1);
+ forall(st..Num_ii,
+ tmp=Bezierpt(#/Num_ii,tmp1,tmp2);
+ list=append(list,tmp);
+ );
+ );
+ if(Noflg<3,
+ println("generate Bezier "+name);
+ out=apply(list,Pcrd(#));
+ tmp=name+"="+textformat(out,5);
+ parse(tmp);
+ tmp1=textformat(ptlist,5);
+ tmp1=RSform(tmp1,2); //17.12.23
+ tmp2=textformat(ctrlist,5);
+ tmp2=RSform(tmp2,3); //17.12.23
+ GLIST=append(GLIST,name+"=Bezier("+tmp1+","+tmp2+opstr+")");
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ list;
+);
+
+Readcsvsla(fname):=Readplotdigdata(fname,[]);
+Readcsvsla(fname,options):=Readplotdigdata(fname,options);
+Readplotdigdata(fname):=Readplotdigdata(fname,[]);
+Readplotdigdata(fname,options):=(
+ regional(fsc,mv,cmdall,dataL,nd,npt,ptdata,ii,tmp,tmp1,tmp2,tmp3);
+ tmp=Divoptions(options);
+ tmp1=tmp_6;
+ sc=1;//10;
+ mv=[0,0];//[5,5];
+ forall(tmp1,
+ if(!islist(#),sc=#,mv=#);
+ );
+ if(indexof(fname,".")>0,
+ tmp=load(fname);
+ ,
+ tmp=load(fname+".txt");
+ );
+ cmdall=tokenize(tmp,"//");
+ dataL=[];
+ forall(2..length(cmdall),ii,
+ tmp1=parse("["+cmdall_ii+"]");
+ dataL=append(dataL,tmp1);
+ );
+ if(length(dataL_(length(dataL)))<2,
+ dataL=dataL_(1..(length(dataL)-1));
+ );
+ nd=length(dataL_1)/2;
+ npt=length(dataL);
+ ptdata=[];
+ forall(1..nd,ii,
+ tmp3=[];
+ forall(1..npt,
+ tmp1=dataL_#_(2*ii-1);
+ tmp2=dataL_#_(2*ii);
+ if(isreal(tmp1),
+ tmp3=append(tmp3,[tmp1,tmp2]);
+ );
+ );
+ ptdata=append(ptdata,tmp3);
+ );
+ tmp1=[];
+ forall(ptdata,
+ tmp=#/sc;
+ tmp=Translatedata("1",[tmp],-mv,["nodata"]);
+ tmp1=append(tmp1,tmp);
+ );
+ ptdata=tmp1;
+ ptdata;
+);
+
+Putbezierdata(name,ptL):=Putbezierdata(name,ptL,[]);
+Putbezierdata(name,ptL,options):=(
+ regional(psize,Deg,tmp,tmp1,tmp2,p1,p2,pts,ctrs);
+ tmp=Divoptions(options);
+ psize=3;
+ Deg=3;
+ tmp1=tmp_5;
+ forall(tmp1,
+ if(substring(#,0,1)=="D",
+ tmp=indexof(#,"=");
+ Deg=parse(substring(#,tmp,length(#)));
+ );
+ if(substring(#,0,1)=="S",
+ tmp=indexof(#,"=");
+ psize=parse(substring(#,tmp,length(#)));
+ );
+ );
+ pts=[];
+ ctrs=[];
+ forall(1..length(ptL),
+ p2=ptL_#; // 16.08.16
+ if(ispoint(p2),
+ tmp1=text(p2);
+ ,
+ tmp1=name+text(#);
+ Putpoint(tmp1,p2,Lcrd(parse(tmp1))); // 16.08.16
+ );
+ inspect(parse(tmp1),"ptsize",psize);
+ pts=append(pts,parse(tmp1));
+ inspect(parse(tmp1),"color",4);
+ if(#>1,
+ p1=Lcrd(ptL_(#-1)); // 16.08.16
+ p2=Lcrd(ptL_#); // 16.08.16
+ if(Deg==3,
+ tmp=(2*p1+p2)/3;
+ tmp1=name+"p"+text(#-1);
+ Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16
+ inspect(parse(tmp1),"labeled",false); //15.01.22
+ Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22
+ inspect(parse(tmp1),"ptsize",psize);
+ inspect(parse(tmp1),"color",3);
+ tmp=(p1+2*p2)/3;
+ tmp2=name+"q"+text(#-1);
+ Putpoint(tmp2,tmp,Lcrd(parse(tmp2))); // 16.08.16
+ inspect(parse(tmp2),"labeled",false); //15.01.22
+ Letter([parse(tmp2),"ne",tmp2],["notex"]); //15.01.22
+ inspect(parse(tmp2),"ptsize",psize);
+ inspect(parse(tmp2),"color",3);
+ ctrs=append(ctrs,[parse(tmp1),parse(tmp2)]);
+ ,
+ tmp=(p1+p2)/2;
+ tmp1=name+"p"+text(#-1);
+ Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16
+ inspect(parse(tmp1),"labeled",false); //15.01.22
+ Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22
+ inspect(parse(tmp1),"ptsize",psize);
+ inspect(parse(tmp1),"color",3);
+ ctrs=append(ctrs,[parse(tmp1)]);
+ );
+ );
+ );
+ [pts,ctrs,name];
+);
+
+Bezierstart(n):=( // 2016.02.26
+ BezierNumber=n;
+);
+
+Mkbezierptcrv(ptdata):=Mkbezierptcrv(ptdata,[]);
+Mkbezierptcrv(ptdata,options):=(
+ //help:Mkbezierptcrv([A,B,C,D]);
+ //help:Mkbezierptcrv([[A,B],[C,D]]);
+ //help:Mkbezierptcrv(options=["Num=10"]);
+ // global BezierNumber
+ regional(ptlist,Out,tmp,tmp1,tmp2);
+ if(isstring(ptdata),
+ ptlist=Readcsvsla(ptdata,options);
+ ,
+ ptlist=ptdata;
+ );
+ if(MeasureDepth(ptlist)==1,ptlist=[ptlist]);
+ Out=[];
+ forall(1..length(ptlist),
+ tmp=floor((BezierNumber-1)/26);// 15.02.23
+ if(tmp==0,tmp="",tmp=text(tmp));
+ tmp2=mod(BezierNumber,26);
+ if(tmp2==0,tmp2=26);
+ tmp1=unicode(text(96+tmp2),base->10)+tmp;// 15.03.11
+ tmp2=Putbezierdata(tmp1,ptlist_#,options);
+ Bezier(tmp2,options);
+ BezierNumber=BezierNumber+1;
+ Out=append(Out,tmp2_(1..2));
+ );
+ Out;
+);
+
+Mkbeziercrv(nm,ptctrL):=Mkbeziercrv(nm,ptctrL,[]);
+Mkbeziercrv(nm,ptctrL,options):=(
+ //help:Mkbeziercrv("1",[[A,B,C,D],[[P,Q],[R,S],T]]);
+ regional(ptctrLL,name,ptlist,ctrlist,tmp,tmp1,tmp2);
+ if(MeasureDepth(ptctrL)==2,ptctrLL=[ptctrL],ptctrLL=ptctrL);
+ forall(1..length(ptctrLL),
+ name=nm+text(#);
+ ptlist=ptctrLL_#_1;
+ ctrlist=ptctrLL_#_2;
+ Bezier(nm,ptlist,ctrlist,options); // 17.01.06
+ );
+);
+
+Writebezier():=Writebezier(Fhead,"all");
+Writebezier(head):=Writebezier(head,"all");
+Writebezier(head,seL):=(
+//help:Writebezier(file);
+//help:Writebezier(file,"acd");
+ regional(bz,dt,name,tmp,tmp1,tmp2);
+ bz=select(GLIST,indexof(#,"=Bezier")>0);
+ tmp1=[]; // 16.04.22from
+ if(seL!="all",
+ forall(1..length(seL),
+ tmp=substring(seL,#-1,#);
+ tmp=select(bz,indexof(#,"bz"+tmp)>0);
+ tmp1=concat(tmp1,tmp);
+ );
+ bz=tmp1;// 16.04.22until
+ );
+ dt=[head+"n",[[length(bz),0]]];
+ forall(1..length(bz),
+ tmp=indexof(bz_#,"=");
+ name=substring(bz_#,0,tmp-1);
+ tmp=indexof(bz_#,","+Dq);
+ if(tmp>0,
+ tmp1=substring(bz_#,0,tmp-1)+")";
+ ,
+ tmp1=bz_#;
+ );
+ tmp1=replace(tmp1,"Bezier(","[");
+ tmp1=replace(tmp1,"list(","[");
+ tmp1=replace(tmp1,")","]");
+ tmp1=replace(tmp1,",",".xy,");
+ tmp1=replace(tmp1,"]",".xy]");
+ tmp1=replace(tmp1,".xy,[",",[");
+ tmp1=replace(tmp1,"].xy","]");
+ tmp1=replace(tmp1,name,head+text(#));
+ parse(tmp1);
+ tmp=parse(head+text(#)+"_1");
+ dt=concat(dt,[head+text(#)+"k",tmp]);
+ tmp=parse(head+text(#)+"_2");
+ dt=concat(dt,[head+text(#)+"c",tmp]);
+ );
+ WriteOutData(head+".txt",dt);
+ dt;
+);
+
+Readbezier(file):=Readbezier(file,[]);
+Readbezier(file,optionorg):=(
+//help:Readbezier("xsr");
+//help:Readbezier(options=["Num=10","nogeo"]);
+ regional(nn,options,stL,geo,nc,alpha,out,tmp,tmp1,tmp2,tmp3);
+ options=optionorg;
+ tmp=Divoptions(options);
+ stL=tmp_7;
+ geo=0;
+ forall(stL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="G",geo=1);
+ options=remove(options,[#]);
+ );
+ ReadOutData(file);
+ tmp=file+"n_1_1";
+ nn=parse(tmp);
+ out=[];
+ forall(1..nn,nc,
+ tmp=file+text(nc);
+ tmp1=parse(tmp+"k");
+ tmp2=parse(tmp+"c");
+ if(MeasureDepth(tmp2)==1,tmp2=[tmp2]); // 16.04.22from
+ if(geo==1,
+ alpha="abcdefghijklmnopqrstuvwxyz";
+ forall(1..length(tmp1),
+ tmp="k"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#);
+ Putpoint(tmp,tmp1_#,parse(tmp+".xy"));
+ inspect(parse(tmp),"labeled",false);
+ inspect(parse(tmp),"ptsize",3);
+ tmp1_#=parse(tmp+".xy");
+ );
+ forall(1..length(tmp2),
+ tmp="c"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#)+"1";
+ Putpoint(tmp,tmp2_#_1,parse(tmp+".xy"));
+ inspect(parse(tmp),"labeled",false);
+ inspect(parse(tmp),"color",4);
+ inspect(parse(tmp),"ptsize",3);
+ tmp2_#_1=parse(tmp+".xy");
+ tmp="c"+BezierNumber+"no"+text(nc)+substring(alpha,#-1,#)+"2";
+ Putpoint(tmp,tmp2_#_2,parse(tmp+".xy"));
+ inspect(parse(tmp),"labeled",false);
+ inspect(parse(tmp),"color",4);
+ inspect(parse(tmp),"ptsize",3);
+ tmp2_#_2=parse(tmp+".xy");
+ );
+ BezierNumber=BezierNumber+1;
+ );
+ Bezier(file+text(nc),tmp1,tmp2,options);// 16.04.22until
+ out=append(out,"bz"+tmp);
+ );
+ out;
+);
+
+Ospline(nm,ptlist):=Ospline(nm,ptlist,[]);
+Ospline(nm,ptlist,options):=(
+//help:Ospline("1",ptlist,[options]);
+ regional(tmp,tmp1,tmp2,list,ptL,ctrL,name,closed,flg,
+ p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32);
+ name="o"+nm;
+ if(isstring(ptlist),list=parse(ptlist),list=ptlist);
+ if(|list_1-list_(length(list))|<10^(-6),closed=1,closed=0);
+// list=apply(list,LLcrd(#));
+ ctrL=[];
+ forall(1..(length(list)-1),
+ flg=0;
+ p1=Lcrd(list_#); // 16.08.16
+ p2=Lcrd(list_(#+1)); // 16.08.16
+ if(#==1 % #==length(list)-1,
+ flg=1;
+ if(closed==0,
+ pQ=(p1+2*p2)/3; // 15.09.21 // 16.08.16
+ pR=(2*p1+p2)/3; // 16.08.16
+ ctrL=append(ctrL,[pQ,pR]);
+ flg=2;
+ ,
+ if(#==1,
+ p0=Lcrd(list_(length(list)-1)); // 16.08.16
+ p3=Lcrd(list_(#+2)); // 16.08.16
+ ,
+ p0=Lcrd(list_(#-1)); // 16.08.16
+ p3=Lcrd(list_2); // 16.08.16
+ );
+ );
+ );
+ if(flg<=1,
+ if(flg==0,
+ p0=Lcrd(list_(#-1)); // 16.08.16
+ p3=Lcrd(list_(#+2)); // 16.08.16
+ );
+ tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2);
+ cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp;
+ pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16
+ pR=p2+cc*(p1-p3); // 16.08.16
+ ctrL=append(ctrL,[pQ,pR]);
+ );
+ );
+// list=apply(list,LLcrd(#)); // 16.08.16
+// ctrL=apply(ctrL,LLcrd(#));
+ if(closed==0, // 15.09.21
+ p1=ctrL_2_1;
+ p2=Lcrd(list_2); // 16.08.16
+ pQ=p2+(p2-p1);
+ ctrL_1=[pQ];
+ tmp=length(ctrL);
+ tmp1=ctrL_(tmp-1);
+ p1=ctrL_(tmp-1)_2;
+ p2=Lcrd(list_(tmp)); // 16.08.16
+ pQ=p2+(p2-p1);
+ ctrL_tmp=[pQ];
+ );
+ Bezier("o"+nm,list,ctrL,options);
+);
+
+CRspline(nm,ptL):=CRspline(nm,ptL,[]);
+CRspline(nm,ptL,options):=(
+ // Catmull-Rom spline
+//help:CRspline("1",[A,B,C,A]);
+ regional(name,ptlist,ctrpts,eqL,opcindy,c,v,tmp,tmp1,tmp2,ctrlist,cflg);
+ name="crsp"+nm;
+ if(MeasureDepth(ptL)==1,tmp=[ptL],tmp=ptL);
+ ptlist=tmp_1;
+ if(length(tmp)==1,
+ cflg=1;
+ ,
+ cflg=0;
+ ctrpts=tmp_2;
+ );
+ c=1/6;
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ opcindy=tmp_(length(tmp)); // 15.03.05
+ forall(eqL,
+ if(substring(#,0,1)=="R",
+ tmp2=indexof(#,"=");
+ c=parse(substring(#,tmp2,length(#)));
+ );
+ );
+ ptlist=apply(ptlist,Lcrd(#)); // 16.08.16
+ ctrlist=[];
+ forall(1..(length(ptlist)-1),
+ if(#==1,
+ if(cflg==0,
+ tmp1=ctrpts_1;
+ ,
+ v=ptlist_2-ptlist_(length(ptlist)-1);
+ tmp1=ptlist_#+c*v;
+ );
+ ,
+ v=ptlist_(#+1)-ptlist_(#-1);
+ tmp1=ptlist_#+c*v;
+ );
+ if(#==length(ptlist)-1,
+ if(cflg==0,
+ tmp2=ctrpts_2;
+ ,
+ v=ptlist_2-ptlist_#;
+ tmp2=ptlist_(#+1)-c*v;
+ );
+ ,
+ v=ptlist_(#+2)-ptlist_#;
+ tmp2=ptlist_(#+1)-c*v;
+ );
+ tmp=select(options,indexof(text(#),"->")>0);
+ tmp=append(tmp,"notex"); //15.03.05
+ Pointdata(name+text(#),[tmp1,tmp2],tmp);
+ ctrlist=append(ctrlist,[tmp1,tmp2]);
+ );
+ Bezier(nm,ptlist,ctrlist,options);
+);
+
+Beziersmooth(nm,ptL):=Bzspline(nm,ptL,[]);
+//help:Beziersmooth("1",[A,B,C,A]);
+Beziersmooth(nm,ptL,options):=Bzspline(nm,ptL,options);
+Bzspline(nm,ptL):=Bzspline(nm,ptL,[]);
+Bzspline(nm,ptLorg,options):=(
+ // smooth bezier
+ regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr,
+ tmp,tmp1,tmp2,cflg,ctrlist);
+ name="bzsp"+nm;
+ Eps=10^(-3);
+ ptL=apply(ptLorg,Lcrd(#)); // 16.08.16
+ if(|ptL_1-ptL_(length(ptL))|<Eps,cflg=1,cflg=0);
+ forall(2..length(ptL),
+ pt=ptL_#;
+ pt1=ptL_(#-1);
+ tmp1="C"+text(#-1)+"q";// 16.10.07
+ Putpoint(tmp1,(pt1+4*pt)/5,Lcrd(parse(tmp1))); // 16.08.16
+ );
+ forall(2..(length(ptL)-1),
+ if(#<length(ptL) % cflg==1,
+ lstr="c"+text(#);
+ pt=ptLorg_#; // 16.08.16
+ pt1=parse("C"+text(#-1)+"q");
+ create([lstr],"Join",[pt1,pt]);
+ tmp2="C"+text(#)+"p";
+ tmp=Append((2*pt.xy-pt1.xy),1);
+ create([tmp2],"PointOnLine",[parse(lstr),tmp]);
+ );
+ );
+ if(cflg==0,
+ pt=ptL_1;
+ pt1=ptL_2;
+ tmp1="C1p";
+ Putpoint(tmp1,(4*pt+pt1)/5,Lcrd(parse(tmp1))); // 16.08.16
+ );
+ if(cflg==1,
+ lstr="c1";
+ pt=ptLorg_1; // 16.08.16
+ pt1=parse("C"+text(length(ptL)-1)+"q");
+ create([lstr],"Join",[pt1,pt]);
+ tmp1="C1p";
+ tmp=Append((2*pt.xy-pt1.xy),1);
+ create([tmp1],"PointOnLine",[parse(lstr),tmp]);
+ );
+ ctrlist=[];
+ forall(1..(length(ptL)-1),
+ if(#>1 % cflg==1,
+ tmp1="c"+text(#);
+ inspect(parse(tmp1),"alpha",0.3);
+ );
+ tmp1="C"+text(#)+"p";
+ tmp2="C"+text(#)+"q";
+ inspect(parse(tmp1),"ptsize",3);
+ inspect(parse(tmp1),"color",3);
+ inspect(parse(tmp2),"ptsize",3);
+ inspect(parse(tmp2),"color",3);
+ tmp=[parse(tmp1),parse(tmp2)];
+ ctrlist=append(ctrlist,tmp);
+ );
+ Bezier(nm,ptL,ctrlist,options);
+ [ptL,ctrlist];
+);
+
+Beziersym(nm,ptL):=Bzsspline(nm,ptL,[]);
+Beziersym(nm,ptL,options):=Bzsspline(nm,ptL,options);
+Bzsspline(nm,ptL):=Bzsspline(nm,ptL,[]);
+Bzsspline(nm,ptLorg,options):=(
+ // smooth bezier with symmetric control points
+ regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr,
+ tmp,tmp1,tmp2,cflg,ctrlist);
+ name="bzssp"+nm;
+ Eps=10^(-3);
+ ptL=apply(ptLorg,Lcrd(#)); // 16.08.16
+ if(|ptL_1-ptL_(length(ptL))|<Eps,cflg=1,cflg=0);
+ forall(2..length(ptL),
+ pt=ptL_#;
+ pt1=ptL_(#-1);
+ tmp1="C"+text(#-1)+"q";
+ Putpoint(tmp1,(pt1+4*pt)/5,Lcrd(parse(tmp1)));
+ );
+ forall(2..(length(ptL)-1),
+ if(#<length(ptL) % cflg==1,
+ pt=ptL_#;
+ pt1=parse("C"+text(#-1)+"q");
+ tmp2="C"+text(#)+"p=2*pt-pt1";
+ parse(tmp2);
+ );
+ );
+ if(cflg==0,
+ pt=ptL_1;
+ pt1=ptL_2;
+ Putpoint("C1p",(4*pt+pt1)/5,Lcrd(C1p)); // 16.08.16
+ inspect(C1p,"ptsize",3);
+ inspect(C1p,"color",3);
+ );
+ if(cflg==1,
+ pt=ptL_1;
+ pt1=Lcrd(parse("C"+text(length(ptL)-1)+"q")); // 16.08.16
+ tmp1="Putpoint("+Dq+"C1p"+Dq+",2*pt-pt1)"; // 16.08.16
+ parse(tmp1);
+ );
+ ctrlist=[];
+ forall(1..(length(ptL)-1),
+ tmp1="C"+text(#)+"p";
+ tmp2="C"+text(#)+"q";
+ inspect(parse(tmp2),"ptsize",3);
+ inspect(parse(tmp2),"color",3);
+ tmp=[parse(tmp1),parse(tmp2)];
+ ctrlist=append(ctrlist,tmp);
+ );
+ Bezier(nm,ptL,ctrlist,options);
+ [ptL,ctrlist];
+);
+
+Listbspline2bz(listorg):=(
+ regional(Eps,list,pcl,ptl,ctrl,k);
+ Eps=10^(-3);
+ list=apply(listorg,Lcrd(#)); // 16.08.16
+ k=length(list);
+ if(|list_1-list_k|>Eps,
+ pcl=list;
+ pcl_1=2*list_1-list_2;
+ pcl_k=2*list_k-list_(k-1);
+ ,
+ pcl=concat(list,[list_2]);
+ );
+ ctrl=apply(2..(length(pcl)-1),[pcl_#]);
+ ptl=apply(1..(length(pcl)-1),(pcl_#+pcl_(#+1))/2);
+ [ptl,ctrl];
+);
+
+Bspline(nm,ctrL):=Bspline(nm,ctrL,[]);
+Bspline(nm,ctrL,options):=(
+//help:Bspline("",[A,B,C]);
+ regional(list,tmp);
+ list=Listbspline2bz(ctrL);
+ tmp=BezierCurve("b"+nm,list_1,list_2,options);
+ tmp;
+);
+
+MeetCurve(Crv,Xorg,Yorg):=(
+ regional(Cv,tmp,tmp1,tmp2,X0,Y0,x1,x2,y1,y2,Ylist,Ban,Tate);
+ if(isstring(Crv),Cv=parse(Crv),Cv=Crv);
+ if(MeasureDepth(Cv)==2,Cv=Cv_1);
+ Cv=apply(Cv,LLcrd(#)); // 14.12.18
+ while(length(Cv)==1,
+ Cv=Cv_1;
+ );
+ Cv=apply(Cv,Lcrd(#));
+ tmp1=min(apply(Cv,#_1));
+ tmp2=max(apply(Cv,#_1));
+ if(isstring(Xorg),X0=parse(Xorg),X0=Xorg);
+ if(isstring(Yorg),Y0=parse(Yorg),Y0=Yorg);
+ if(X0<tmp1,
+ X0=tmp1;
+ ,
+ if(X0>tmp2,
+ X0=tmp2;
+ );
+ );
+ tmp1=select(
+ 1..(length(Cv)-1),Cv_#_1<=X0 & X0<=Cv_(#+1)_1);
+ tmp2=select(
+ 1..(length(Cv)-1),Cv_#_1>=X0 & X0>=Cv_(#+1)_1);
+ tmp2=remove(tmp2,common(tmp2,tmp1));
+ Ban=concat(tmp1,tmp2);
+ Tate=select(Ban,
+ abs(Cv_#_1-Cv_(#+1)_1)<=
+ 10^(-2)*abs(Cv_#_2-Cv_(#+1)_2)
+ );
+ Ban=remove(Ban,Tate);
+ Ylist=[];
+ forall(Ban,
+ tmp=Cv_#;
+ x1=tmp_1; y1=tmp_2;
+ tmp=Cv_(#+1);
+ x2=tmp_1; y2=tmp_2;
+ tmp=((x2-X0)*y1+(X0-x1)*y2)/(x2-x1);
+ Ylist=append(Ylist,tmp);
+ );
+ forall(Tate,
+ tmp=Cv_#;
+ x1=tmp_1; y1=tmp_2;
+ tmp=Cv_(#+1);
+ x2=tmp_1; y2=tmp_2;
+ tmp1=min([y1,y2]);
+ tmp2=max([y1,y2]);
+ if(Y0<tmp1,
+ tmp=tmp1;
+ ,
+ if(Y0>tmp2,
+ tmp=tmp2;
+ ,
+ tmp=Y0;
+ );
+ );
+ Ylist=append(Ylist,tmp);
+ );
+ tmp=sort(Ylist,abs(#_1-Y0));
+ [X0,tmp_1];
+);
+
+PutonLine(name,p1,p2):=PutonLine(name,p1,p2,[]);
+PutonLine(name,p1org,p2org,options):=(
+//help:PutonLine("C","sgAB");
+//help:PutonLine("C",pA,pB);
+ regional(par,p1,p2,dx,dy,tmp,tmp1,tmp2);
+ par=0.5;
+ tmp=Divoptions(options);
+ if(length(tmp_6)>0,
+ par=tmp_6_1;
+ );
+ p1=Lcrd(p1org);//16.10.11from
+ p2=Lcrd(p2org);
+ dx=p2_1-p1_1;
+ dy=p2_2-p1_2;
+ tmp1=(1-par)*p1+par*p2;
+ if(abs(dx)>abs(dy),
+ tmp=name+".x";
+ tmp2="["+tmp+",dy/dx*("+tmp+"-p1_1)+p1_2]";//16.10.11until
+ Putpoint(name,tmp1,parse(tmp2));
+ ,
+ if(abs(dy)>0,
+ tmp=name+".y";
+ tmp2="[dx/dy*("+tmp+"-p1.y)+p1_1,"+tmp+"]";
+ Putpoint(name,tmp1,parse(tmp2));
+ ,
+ tmp2=p1;//16.10.11
+ Putpoint(name,tmp1,tmp2);
+ );
+ );
+);
+
+PutonSeg(name,sgstr):=(
+ regional(seg,p1,p2);
+ if(isstring(sgstr),seg=parse(sgstr),seg=sgstr);
+ PutonSeg(name,LLcrd(seg_1),LLcrd(seg_2));
+);
+PutonSeg(name,p1,p2):=PutonSeg(name,p1,p2,[]);
+PutonSeg(name,p1org,p2org,options):=(
+//help:PutonSeg("C","sgAB");
+//help:PutonSeg("C",pA,pB);
+ regional(par,dx,dy,p,tmp,tmp1,tmp2);
+ par=0.5;
+ tmp=Divoptions(options);
+ if(length(tmp_6)>0,
+ par=tmp_6_1;
+ );
+ p1=Lcrd(p1org);//16.10.11from
+ p2=Lcrd(p2org);
+ PutonLine(name,p1,p2,[par]);
+ dx=p2_1-p1_1;
+ dy=p2_2-p1_2;
+ p=parse(name+".xy");
+ p=LLcrd(p);
+ if(abs(dx)>abs(dy) & (p_1-p1_1)*(p_1-p2_1)>0,
+ if(|p-p1|<|p-p2|,
+ parse(name+".xy=Pcrd(p1)");
+ ,
+ parse(name+".xy=Pcrd(p2)");
+ );
+ );
+ if(abs(dx)<abs(dy) & (p_2-p1_2)*(p_2-p2_2)>0,
+ if(|p-p1|<|p-p2|,
+ parse(name+".xy=Pcrd(p1)");
+ ,
+ parse(name+".xy=Pcrd(p2)");//16.10.11until
+ );
+ );
+);
+
+PutonCurve(pn,crv):=PutonCurve(pn,crv,[]);
+PutonCurve(pn,crv,options):=(
+//help:PutonCurve("A","gr1");
+ regional(Pmt,pstr,optionL,leftlim,rightlim,tmp,tmp1,Flg,Msg);
+ if(!islist(options),optionL=[options],optionL=options);
+ leftlim=XMIN;
+ rightlim=XMAX;
+ Flg=0;
+ Msg="y";
+ forall(optionL,
+ if(isstring(#), // 16.02.10 from
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,tmp,tmp+1));
+ if(tmp1=="N", Msg="n"); // 16.02.10 until
+ ,
+ if(Flg==0,
+ leftlim=#;
+ Flg=Flg+1;
+ ,
+ rightlim=#;
+ );
+ );
+ );
+ Pmt=MeetCurve(crv,leftlim,0);
+ pstr=apply(allpoints(),textformat(#,5)); // 15.04.07
+ if(!contains(pstr,pn),
+ createpoint(pn,Pcrd(Pmt));
+ ,
+ tmp1=parse(pn+".x");
+ if(tmp1< leftlim % tmp1>rightlim,
+ if(tmp1< leftlim,tmp= leftlim, tmp=rightlim);
+ Pmt=MeetCurve(crv,textformat(tmp,5),pn+".y");
+ ,
+ Pmt=MeetCurve(crv,pn+".x",pn+".y");
+ );
+ ptstr=pn+".xy="+textformat(Pcrd(Pmt),5)+";";
+ parse(ptstr);
+ );
+ if(Msg=="y",
+ println("Put "+pn+" on Curve "+text(crv));
+ );
+);
+
+CrossPoint(name,Crv1,Crv2,range):=(
+ regional(Mx1,Mx2,Mx3,tmp,Crs1,Crs2,Crs3,Crs4,df1,df2);
+ Mx1=range_1; Mx2=range_2;
+ repeat(15,
+ Mx3=(Mx1+Mx2)/2;
+ Crs1=MeetCurve(Crv1,Mx1,0);
+ Crs2=MeetCurve(Crv2,Mx1,0);
+ Crs3=MeetCurve(Crv1,Mx3,0);
+ Crs4=MeetCurve(Crv2,Mx3,0);
+ df1=Crs1_2-Crs2_2;
+ df2=Crs3_2-Crs4_2;
+ if((df1>0 & df2>0) % (df1<0 & df2<0),
+ Mx1=Mx3;
+ ,
+ Mx2=Mx3;
+ );
+ );
+ Putpoint(name,Crs1);
+);
+
+Setscaling(sc):=(
+//help:Setscaling(3);
+ SCALEX=1;
+ SCALEY=sc;
+ Com0th("Setscaling("+sc+")");
+ Setwindow("Msg=no");
+);
+
+Periodfun(defL,rep):=Periodfun(defL,rep,[]);
+Periodfun(defL,rep,optionorg):=( // 16.11.24
+//help:Periodfun(["0",[-1,0],"1",1,[0,1],1],2(num of repetition),options);
+//help:Periodfun(options=["Con=y"]);
+//help:Periodfun(defL=[function string, range, devision number,...]);
+ regional(nn,fun,range,num,options,nr,maxfun,
+ tmp,tmp1,tmp2,eqL,connect,minx,maxx,pdata,Eps,prept);
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ connect="Y";
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp2=substring(#,tmp,tmp+1);
+ tmp=substring(#,0,3);
+ if(Toupper(tmp)=="CON",
+ connect=Toupper(tmp2);
+ options=remove(options,[#]);
+ );
+ );
+ minx=10000;
+ maxx=-10000;
+ mxfun="";
+ pdata=[];
+ forall(1..(length(defL)/3),nn,
+ fun=defL_(3*nn-2);
+ range=defL_(3*nn-1);
+ tmp1=if(isstring(range_1),parse(range_1),range_1); //17.06.11(2lines)
+ tmp2=if(isstring(range_2),parse(range_2),range_2);
+ minx=min(minx,tmp1);
+ maxx=max(maxx,tmp2);
+ num=defL_(3*nn);
+ options=append(options,"Num="+text(num));
+ Plotdata("pe"+text(nn),fun,
+ "x="+textformat([tmp1,tmp2],5),options);
+ pdata=append(pdata,"grpe"+text(nn));
+ tmp1=range_1; //17.06.11(4lines)
+ if(isstring(tmp1),tmp1=replace(tmp1,"pi","%pi"),tmp1=format(tmp1,5));
+ tmp2=range_2;
+ if(isstring(tmp2),tmp2=replace(tmp2,"pi","%pi"),tmp2=format(tmp2,5));
+ mxfun=mxfun+"elseif ("+tmp1+
+ "<=x and x<"+tmp2+") then "+fun+" ";
+ );
+ per=maxx-minx;
+ forall(1..rep,nr,
+ tmp1=[];
+ forall(pdata,
+ Translatedata("p"+#+text(nr),#,[per*nr,0],options);
+ Translatedata("m"+#+text(nr),#,[-per*nr,0],options);
+ tmp1=concat(tmp1,["trp"+#+text(nr),"trm"+#+text(nr)]);
+ );
+ );
+ pdata=concat(pdata,tmp1);
+ if(connect=="Y",
+ Eps=10^(-5);
+ pdata=sort(pdata,[parse(#)_1_1]);
+ prept=parse(pdata_1)_1;
+ forall(1..(length(pdata)),
+ tmp=parse(pdata_#);
+ tmp1=tmp_1;
+ tmp2=tmp_(length(tmp));
+ if(|prept-tmp1|>Eps,
+ Listplot("con"+text(#),[prept,tmp1],append(options,"da"));
+ );
+ prept=tmp_(length(tmp));
+ );
+ );
+ mxfun=substring(mxfun,4,length(mxfun)-1);
+ [mxfun,per];
+);
+
+Fourierseries(nm,coeff,per,nterm):=
+ Fourierseries(nm,coeff,per,nterm,[]); // 16.11.24
+Fourierseries(nm,coeff,per,nterm,options):=(
+//help:Fourierseries("1",[c0,cn,sn],period,numterm,options);
+ regional(c0,cn,sn,fs,tmp,tmp1,tmp2);
+ c0=coeff_1;
+ if(!isstring(c0),c0=format(c0,5));
+ c0=replace(c0,"%pi","pi");
+ cn=coeff_2;
+ if(!isstring(cn),cn=format(cn,5));
+ cn=replace(cn,"%pi","pi");
+ sn=coeff_3;
+ if(!isstring(sn),sn=format(sn,5));
+ sn=replace(sn,"%pi","pi");
+ fs=c0;
+ forall(1..nterm,
+ tmp=parse(Assign(cn,["n",#]));
+ tmp1=Assign("("+format(tmp,5)+")*cos(n*2*pi/per*x)",
+ ["n",#,"per",per]);
+ tmp=parse(Assign(sn,["n",#]));
+ tmp2=Assign("("+format(tmp,5)+")*sin(n*2*pi/per*x)",
+ ["n",#,"per",per]);
+ fs=fs+"+"+tmp1+"+"+tmp2;
+ );
+ Plotdata("four"+nm,fs,"x",options);
+);
+
+Tabledatalight(nm,xLst,yLst,rmvL):=Tabledatalight(nm,xLst,yLst,rmvL,[]);
+Tabledatalight(nm,xLst,yLst,rmvL,optionorg):=(
+//help:Tabledatalight("",xLst,yLst,rmvL,[2,"Rng=y"]);
+ regional(options,rng,name,upleft,ul,flg,tick,eqL,reL,n,m,xsize,ysize,
+ rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps);
+// name="tb"+nm;
+ name="tb";
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5; //16.12.16from
+ reL=tmp_6;
+ rng="Y";
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,2));
+ tmp2=Toupper(substring(#,tmp,tmp+1));
+ if(tmp1=="RN",
+ rng=tmp2;
+ options=remove(options,[#]);
+ );
+ );//16.12.16until
+ tick=1;
+ flg=0;
+ forall(reL,
+ if(flg==0,
+ tick=#;
+ flg=flg+1;
+ ,
+ upleft=tmp_6_1;
+ );
+ );
+ tmp=sum(yLst);
+ upleft=[0,tmp];
+ TableOptions=options; // 16.11.28
+ println("Tabledatalight "+name+" generated");
+ ul=upleft/10;
+ m=length(xLst);
+ n=length(yLst);
+ xsize=sum(xLst);
+ ysize=sum(yLst);
+ clist=[ul];
+ rlist=[ul];
+ forall(1..m,
+ tmp1=clist_(#)_1+xLst_#/10;
+ clist=append(clist,[tmp1,clist_1_2]);
+ );
+ forall(1..n,
+ tmp1=rlist_(#)_2-yLst_#/10;
+ rlist=append(rlist,[0,tmp1]);
+ );
+ Tb=[clist,rlist];
+ tmp=name+"="+Tb;
+ parse(tmp);
+ forall(0..m,
+ tmp1="c"+text(#)+"r0";
+ tmp2="c"+text(#)+"r"+text(n);
+ Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options);
+ if(mod(#,tick)==0 % #==m,
+ tmp=clist_(#+1);
+ drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#));
+ );
+ );
+ forall(0..n,
+ tmp1="c0r"+text(#);
+ tmp2="c"+text(m)+"r"+text(#);
+ Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options);
+ if(mod(#,tick)==0 % #==n,
+ tmp=rlist_(#+1);
+ drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#));
+ );
+ );
+ Tsegrmv(rmvL,options);
+ Addax(0);
+ Eps=10^(-3);
+ tmp1=clist_(length(clist));
+ tmp2=rlist_1;
+ tmp3=rlist_(length(rlist));
+ if(rng=="Y", // 16.12.16
+ Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]);
+ );
+ Tb;
+);
+
+Tabledata(nm,n,m,xsize,ysize,rmvL):=
+ Tabledata(nm,n,m,xsize,ysize,rmvL,[]);
+Tabledata(nm,n,m,xsize,ysize,rmvL,options):=(
+//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]);
+ regional(Tb,name,tmp,xLst,yLst);
+ name="tb"+nm;
+ xLst=apply(1..n,xsize/n);
+ yLst=apply(1..m,ysize/m);
+ Tabledata(nm,xLst,yLst,rmvL,options)
+);
+Tabledata(nm,xLst,yLst,rmvL):=Tabledata(nm,xLst,yLst,rmvL,[]);
+Tabledata(nm,xLst,yLst,rmvL,optionorg):=(
+//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]);
+ regional(name,options,eqL,reL,rng,upleft,ul,flg,tick,n,m,xsize,ysize,
+ rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps);
+// name="tb"+nm;
+ name="tb";
+ tmp=sum(yLst);
+ upleft=[0,tmp];
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5; //16.12.16from
+ reL=tmp_6;
+ rng="Y";
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,2));
+ tmp2=Toupper(substring(#,tmp,tmp+1));
+ if(tmp1=="RN",
+ rng=tmp2;
+ options=remove(options,[#]);
+ );
+ );//16.12.16until
+ tick=1;
+ flg=0;
+ forall(reL,
+ if(flg==0,
+ tick=#;
+ flg=flg+1;
+ ,
+ upleft=tmp_6_1;
+ );
+ );
+ TableOptions=options; // 16.11.28
+ println("Tabledata "+name+" generated");
+ ul=upleft/10;
+ m=length(xLst);
+ n=length(yLst);
+ xsize=sum(xLst);
+ ysize=sum(yLst);
+ clist=[ul];
+ rlist=[ul];
+ forall(1..m,
+ tmp1=clist_(#)_1+xLst_#/10;
+ clist=append(clist,[tmp1,clist_1_2]);
+ );
+ forall(1..n,
+ tmp1=rlist_(#)_2-yLst_#/10;
+ rlist=append(rlist,[0,tmp1]);
+ );
+ Tb=[clist,rlist];
+ tmp=name+"="+Tb;
+ parse(tmp);
+ forall(0..m,
+ tmp="C"+text(#);
+ tmp1="c"+text(#)+"r0";
+ if(#==0,
+ Putpoint(tmp,Tgrid(tmp1));
+ ,
+ Putpoint(tmp,Tgrid(tmp1),[parse(tmp+".x"),C0.y]);
+ clist_(#+1)=parse(tmp+".xy");
+ );
+ inspect(parse(tmp),"ptsize",3);
+ inspect(parse(tmp),"labeled",false);
+ if(mod(#,tick)==0 % #==m,
+ tmp=clist_(#+1);
+ drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#));
+ );
+ );
+ forall(0..n,
+ tmp="R"+text(#);
+ tmp1="c0r"+text(#);
+ if(#==0,
+ Putpoint(tmp,Tgrid(tmp1));
+ ,
+ Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]);
+ rlist_(#+1)=parse(tmp+".xy");
+ );
+ Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]);
+ inspect(parse(tmp),"ptsize",3);
+ inspect(parse(tmp),"labeled",false);
+ if(mod(#,tick)==0 % #==n,
+ tmp=rlist_(#+1);
+ drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#));
+ );
+ );
+ Tb=[clist,rlist];
+ tmp=name+"="+Tb;
+ parse(tmp);
+ forall(0..m,
+ tmp1="c"+text(#)+"r0";
+ tmp2="c"+text(#)+"r"+text(n);
+ Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options);
+ if(#<m,
+ tmp1=parse("C"+text(#));
+ tmp2=parse("C"+text(#+1));
+ tmp=(tmp1.xy+tmp2.xy)/2;
+ drawtext(tmp+[-0.2,0.5],text((tmp2.x-tmp1.x)*10));
+ );
+ );
+ forall(0..n,
+ tmp1="c0r"+text(#);
+ tmp2="c"+text(m)+"r"+text(#);
+ Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options);
+ if(#<n,
+ tmp1=parse("R"+text(#));
+ tmp2=parse("R"+text(#+1));
+ tmp=(tmp1.xy+tmp2.xy)/2;
+ drawtext(tmp-[1.2,0.1],text(abs(tmp1.y-tmp2.y)*10));
+ );
+ );
+ Tsegrmv(rmvL,options);
+ Addax(0);
+ Eps=10^(-3);
+ tmp1=clist_(length(clist));
+ tmp2=rlist_1;
+ tmp3=rlist_(length(rlist)); // 15.06.11
+ if(rng=="Y", // 16.12.16
+ Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]);
+ );
+ Tb;
+);
+
+Tseginfo(seg):=(
+ regional(cr,tp,tpc,n1,n2,n3,tmp,tmp1,tmp2);
+ if(substring(seg,0,2)=="sg",
+ cr=substring(seg,2,length(seg));
+ ,
+ cr=seg;
+ );
+ tp=substring(cr,0,1);
+ if(tp=="c",
+ tpc="r";
+ ,
+ tpc="c";
+ );
+ tmp1=indexof(cr,tpc);
+ tmp=substring(cr,tmp1,length(cr));
+ tmp2=tmp1+indexof(tmp,tpc);
+ n1=substring(cr,1,tmp1-1);
+ n2=substring(cr,tmp1,tmp2-1);
+ n3=substring(cr,tmp2,length(cr));
+ [tp+n1,tpc,parse(n2),parse(n3)];
+);
+
+Tsegrmv(rmvL):=Tsegrmv(rmvL,[]);
+Tsegrmv(rmvL,options):=(
+ regional(cr,gcL,flg,gc,hd,tail,tpc,m1,m2,n1,n2,tmp,tmp1,tmp2);
+ forall(rmvL,cr,
+ tmp1=Tseginfo(cr);
+ hd=tmp1_1;
+ tpc=tmp1_2;
+ m1=tmp1_3;
+ m2=tmp1_4;
+ gcL=select(GCLIST,Tseginfo(#_1)_1==tmp1_1);
+ flg=0;
+ forall(gcL,
+ if(flg==0,
+ tmp=Tseginfo(#_1);
+ n1=tmp_3;
+ n2=tmp_4;
+ if(m1>=n1 & m2<=n2,
+ gc=#;
+ flg=1;
+ );
+ );
+ );
+ if(flg==1,
+ Changestyle([gc_1],["nodisp"]);
+ tail="";
+ if(indexof(hd,"r")>0,
+ tail=hd; hd="";
+ );
+ if(n1<m1,
+ tmp1=tpc+text(n1);
+ tmp2=tpc+text(m1);
+ tmp=hd+tail+tmp1+tmp2;
+ Tlistplot(tmp,[hd+tmp1+tail,hd+tmp2+tail],options);
+ );
+ if(m2<n2,
+ tmp1=tpc+text(m2);
+ tmp2=tpc+text(n2);
+ tmp=hd+tail+tmp1+tmp2;
+ Tlistplot(tmp,[hd+tmp1+tail,hd+tmp2+tail],options);
+ );
+ );
+ );
+);
+
+Tgrid(ptstr):=(
+//help:Tgrid("c2r5");
+ regional(tmp,tmp1,tmp2);
+ tmp=parse(ptstr);
+ if(islist(tmp),
+ tmp;
+ ,
+ tmp=indexof(ptstr,"r");
+ tmp1=substring(ptstr,1,tmp-1);
+ tmp1=parse(tmp1);
+ tmp2=substring(ptstr,tmp,length(ptstr));
+ tmp2=parse(tmp2);
+ [tb_1_(tmp1+1)_1,tb_2_(tmp2+1)_2];
+ );
+);
+
+Tlistplot(ptL):=Tlistplot(ptL,[]);
+Tlistplot(Ag1,Ag2):=(
+ regional(nm,ptL,options);
+ if(isstring(Ag1),
+ nm=Ag1;
+ ptL=Ag2;
+ options=[];
+ ,
+ ptL=Ag1;
+ options=Ag2;
+ nm=ptL_1+ptL_2;
+ );
+ Tlistplot(nm,ptL,options);
+);
+Tlistplot(nm,ptL,options):=(
+//help:Tlistplot(["c0r0","c0r4"]);
+//help:Tlistplot("1",["c0r0","c0r4"]);
+//help:Tlistplot([options2="Msg=y"]);
+ regional(tmp,tmp1);
+ tmp1=divoptions(options);//180404from
+ tmp1=tmp1_5;
+ tmp1=apply(tmp1,Toupper(substring(#,0,1)));
+ if(contains(tmp1,"M"),
+ tmp1=options;
+ ,
+ tmp1=append(options,"Msg=n");
+ );//180404to
+ tmp=apply(ptL,Tgrid(#)); // 15.06.03
+ Listplot(nm,tmp,tmp1);
+);
+
+ChangeTablestyle(nameL,style):=(
+////help:ChangeTablestyle(["r0c0c3"],["da"]);
+ regional(nmL,grid,head,sb,tmp,tmp1,tmp2,
+ tsg,segall,sg,str);
+ if(islist(nameL),nmL=nameL,nmL=[nameL]);
+ forall(nmL,grid,
+ if(substring(grid,0,1)=="r",sb="c",sb="r");
+ tmp=Indexall(grid,sb);
+ head=substring(grid,0,tmp_1-1);
+ tmp1=substring(grid,tmp_1,tmp_2-1);
+ tmp2=substring(grid,tmp_2,length(grid));
+ tsg=apply([tmp1,tmp2],parse(#));
+ tmp1=apply(GCLIST,#_1); // 16.12.06from
+ segall=[];
+ forall(tmp1,
+ tmp2=substring(#,2,length(#));
+ tmp=indexof(tmp2,sb);
+ tmp2=substring(tmp2,0,tmp-1);
+ if(head==tmp2,segall=append(segall,#));
+ );// 16.12.06until
+ sg=[];
+ forall(segall,
+ tmp=Indexall(#,sb);
+ tmp1=substring(#,tmp_1,tmp_2-1);
+ tmp2=substring(#,tmp_2,length(#));
+ tmp=apply([tmp1,tmp2],parse(#));
+ if((tsg_1>=tmp_1) & (tsg_2<=tmp_2),
+ sg=tmp;
+ Changestyle(#,["nodisp"]);
+ );
+ );
+ if(length(sg)==0,
+ println("No segment includes "+grid);
+ ,
+ if(sb=="c",str=sb+"no"+head,str=head+sb+"no");
+ if(sg_1<tsg_1,
+ tmp1=replace(str,"no",text(sg_1));
+ tmp2=replace(str,"no",text(tsg_1));
+ tmp=head+sb+text(sg_1)+"c"+text(tsg_1);
+ Tlistplot(tmp,[tmp1,tmp2],TableOptions);
+ );
+ tmp1=replace(str,"no",text(tsg_1));
+ tmp2=replace(str,"no",text(tsg_2));
+ tmp=head+"c"+text(tsg_1)+"c"+text(tsg_2);
+ Tlistplot(tmp,[tmp1,tmp2],style);
+ if(tsg_2<sg_2,
+ tmp1=replace(str,"no",text(tsg_2));
+ tmp2=replace(str,"no",text(sg_2));
+ tmp=head+"c"+text(tsg_2)+"c"+text(sg_2);
+ Tlistplot(tmp,[tmp1,tmp2],TableOptions);
+ );
+ );
+ );
+);
+
+Findcell(pos1,pos2):=Findcell("",pos1,pos2);
+Findcell(Tbdata,pos1,pos2):=(
+//help:Findcell("c0r0","c2r1");
+ regional(tmp1,tmp2,posnw,posse,ctr,dx,dy);
+ if(isstring(pos1),
+ posnw=Tgrid(pos1); // 15.05.20
+ posse=Tgrid(pos2);
+ //posnw=parse(pos1);
+ //posse=parse(pos2);
+ ,
+ if(islist(pos1),
+ posnw=pos1;
+ posse=pos2;
+ ,
+ tmp1="c"+text(pos1-1)+"r"+text(pos2-1);
+ tmp2="c"+text(pos1)+"r"+text(pos2);
+ posnw=Tgrid(tmp1);
+ posse=Tgrid(tmp2);
+// posnw=parse(tmp1);
+// posse=parse(tmp2);
+ );
+ );
+ ctr=(posnw+posse)/2;
+ dx=abs(posse_1-ctr_1);
+ dy=abs(posnw_2-ctr_2);
+ [ctr,dx,dy];
+);
+
+Putcell(pos1,pos2,dir,lttr):=Putcell("",pos1,pos2,dir,lttr);
+Putcell(Tbdata,pos1,pos2,dir,lttr):=(
+//help:Putcell("c0r0","c2r1","lt","abc");
+//help:Putcell(2,3,"c","xyz");
+ regional(tmp,tmp1,tmp2,posnw,posse,
+ posdir,posstr,ctr,dx,dy);
+ tmp=Findcell(Tbdata,pos1,pos2);
+ ctr=tmp_1; dx=tmp_2; dy=tmp_3;
+ posdir=ctr;
+ posstr=dir;
+ if(indexof(dir,"b")>0,
+ posdir_2=posdir_2-dy;
+ posstr=replace(posstr,"b","n");
+ );
+ if(indexof(dir,"t")>0,
+ posdir_2=posdir_2+dy;
+ posstr=replace(posstr,"t","s");
+ );
+ if(indexof(dir,"l")>0,
+ posdir_1=posdir_1-dx;
+ posstr=replace(posstr,"l","e");
+ );
+ if(indexof(dir,"r")>0,
+ posdir_1=posdir_1+dx;
+ posstr=replace(posstr,"r","w");
+ );
+ Letter(posdir,posstr,text(lttr));
+);
+
+Putcellexpr(pos1,pos2,dir,ex):=Putcellexpr("",pos1,pos2,dir,ex);
+Putcellexpr(Tbdata,pos1,pos2,dir,ex):=(
+//help:Putcellexpr("c0r0","c2r1","lt","abc");
+//help:Putcellexpr(2,3,"c","\sin x");
+ Putcell(Tbdata,pos1,pos2,dir,"$"+text(ex)+"$");
+);
+
+Putrow(nrow,dir,lttrL):=Putrow("",nrow,dir,lttrL);
+Putrow(Tbdata,nrow,dir,lttrL):=(
+//help:Putrow(1,"c",["x","y","z"]);
+ regional(tmp,tmp1,mcol);
+ mcol=length(lttrL);
+ forall(1..mcol,
+ Putcell(Tbdata,#,nrow,dir,lttrL_#);
+ );
+);
+
+Putrowexpr(nrow,dir,exL):=Putrowexpr("",nrow,dir,exL);
+Putrowexpr(Tbdata,nrow,dir,exL):=(
+//help:Putrowexpr(2,"r",["x","y","z"]);
+ regional(lttrL);
+ lttrL=apply(exL,"$"+#+"$");
+ Putrow(Tbdata,nrow,dir,lttrL);
+);
+
+PutcoL(mcol,dir,lttrL):=PutcoL("",mcol,dir,lttrL);
+PutcoL(Tbdata,mcol,dir,lttrL):=(
+//help:PutcoL(1,"c",["x","y","z"]);
+ regional(tmp,tmp1,nrow);
+ nrow=length(lttrL);
+ forall(1..nrow,
+ Putcell(Tbdata,mcol,#,dir,lttrL_#);
+ );
+);
+PutcoLexpr(mcol,dir,exL):=PutcoLexpr("",mcol,dir,exL);
+PutcoLexpr(Tbdata,mcol,dir,exL):=(
+//help:PutcoLexpr(2,"r",["x","y","z"]);
+ regional(lttrL);
+ lttrL=apply(exL,"$"+#+"$");
+ PutcoL(Tbdata,mcol,dir,lttrL);
+);
+
+Setrange():=(
+//help:Setrange();
+ SW.xy=Pcrd([XMIN,YMIN]);
+ NE.xy=Pcrd([XMAX,YMAX]);
+ drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]),
+ Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]);
+);
+
+Sciform(list):=(
+ regional(plotlist,comp,pos,out,out2,nn,strL,flg,
+ tmp,tmp1,tmp2,tmp3,Nj);
+ plotlist=Flatten([list]);
+ out=replace(plotlist_1,".xy","");
+ out=replace(out,".x","(1)");
+ out=replace(out,".y","(2)");
+ if(length(plotlist)==1,
+ comp=[];
+ forall(1..length(out),
+ comp=append(comp,substring(out,#-1,#));
+ );
+ out="";
+ pos=0;
+ forall(comp,
+ if(#!="'",
+ out=out+#;
+ ,
+ if(pos==0,
+ tmp=indexof(out,"Assign(");
+ if(substring(out,length(out)-7,length(out))=="Assign(",
+ out=out+"'";
+ pos=1;
+ ,
+ out=out+"Assign('";
+ pos=2;
+ );
+ ,
+ if(pos==2,
+ out=out+"')";
+ ,
+ out=out+"'";
+ );
+ pos=0;
+ );
+ );
+ );
+ ,
+ forall(2..length(plotlist),
+ comp=plotlist_#;
+ if(isstring(comp),
+ pos=indexof(comp,"Assign(");
+ if(pos>0,
+ comp=substring(comp,6,length(comp));
+ );
+ out=out+"Assign(";
+ comp=replace(comp,".xy","");
+ comp=replace(comp,".x","(1)");
+ comp=replace(comp,".y","(2)");
+ out=out+"'"+comp+"'";
+ out=out+"),";
+ );
+ if(islist(comp),
+ forall(comp,
+ out=out+"'"+#+"',";
+ );
+ );
+ );
+ if(length(plotlist)>1,
+ out=substring(out,0,length(out)-1);
+ out=out+");";
+ );
+ );
+ pos=[];
+ forall(1..length(out),
+ tmp=indexof(substring(out,#-1,length(out)),"Assign");
+ if(tmp>0,
+ tmp1=#-1+tmp;
+ if(length(pos)==0,
+ pos=[tmp1];
+ ,
+ if(pos_(length(pos))<tmp1,
+ pos=append(pos,tmp1);
+ );
+ );
+ );
+ );
+ if(length(pos)>0,
+ strL=[];
+ Nj=0;
+ forall(pos,
+ tmp=substring(out,Nj,#-1);
+ strL=append(strL,tmp);
+ Nj=#-1;
+ );
+ strL=append(strL,substring(out,Nj,length(out)));
+ out="";
+ forall(strL,
+ if(indexof(#,"Assign")==0,
+ out=out+#;
+ ,
+ tmp=indexof(#,"('");
+ tmp1=indexof(#,"')");
+ tmp2=substring(#,tmp+1,tmp1-2);
+ tmp3=substring(#,tmp1-2,length(#));
+ if(indexof(tmp2,"=")==0,
+ out=out+#;
+ ,
+ tmp=substring(tmp2,0,indexof(tmp2,"="));
+ out=out+"'"+tmp+"'+"+"Assign('";
+ tmp=substring(tmp2,indexof(tmp2,"="),length(tmp2));
+ out=out+tmp+tmp3;
+ );
+ );
+ );
+ );
+ out2=""; // patched 16.01.21 from
+ nn=length(out);
+ flg=0;
+ forall(1..nn,
+ if(flg==0,
+ tmp=indexof(out,"='+Assign('");
+ if(tmp==0,
+ out2=out2+out;
+ flg=1;
+ ,
+ out2=out2+substring(out,0,tmp);
+ out=substring(out,tmp+10,length(out));
+ tmp=indexof(out,"'"); // 16.04.19 from
+ tmp1=substring(out,0,tmp-1);
+ tmp2="1234567890";
+ tmp=apply(1..length(tmp1),
+ indexof(tmp2,substring(tmp1,#-1,#)));
+ tmp=min(tmp);
+ if(tmp==0, // 16.04.19 until
+ out2=out2+"'+Assign('";
+ ,
+ tmp=indexof(out,"'");
+ out=substring(out,0,tmp)+substring(out,tmp+1,length(out));
+ // 16.04.18 until
+ );
+ );
+ );
+ );
+ out2=replace(out2,"Dist=","D=");
+ out2=replace(out2,"Dis=","D=");
+ out2;
+);
+
+RSform(str):=RSform(str,3);
+RSform(str,listfrom):=(
+//help:RSform(string,listfrom);
+ regional(posL,mxlv,rep1,rep2,rep3,prev,out,
+ tmp,tmp1,tmp2);
+ rep1="c("; rep2="c("; rep3="list(";
+ if(listfrom<3,rep2="list(");
+ if(listfrom==1,rep1="list(");
+ posL=Bracket(str,"[]");
+ tmp=apply(posL,#_2);
+ mxlv=max(tmp);
+ out="";
+ prev=0;
+ forall(posL,
+ out=out+substring(str,prev,#_1-1);
+ prev=#_1;
+ if(#_2>0,
+ tmp1=select(posL,tmp,(tmp_2<0)&(tmp_1>#_1));
+ tmp1=tmp1_1_1;
+ tmp=substring(str,#_1,tmp1);
+ if(#_2==mxlv,out=out+rep1);
+ if(#_2==mxlv-1,out=out+rep2);
+ if(#_2<=mxlv-2,out=out+rep3);
+ ,
+ out=out+")";
+ );
+ );
+ out=out+substring(str,prev,length(str));
+ out=replace(out,".xy","");
+ out=replace(out,".x","[1]");
+ out=replace(out,".y","[2]");
+ out=replace(out,"c(1)","[1]");//17.10.06(2lines)
+ out=replace(out,"c(2)","[2]");
+ out;
+);
+
+RSslash(str):=( //17.09.24
+ regional(tmp);
+ tmp=replace(str,"\","\\");
+// tmp=replace(tmp,"\\\\","\\");
+ tmp;
+);
+
+Rform(list):=(
+ regional(plotlist,comp,pos,out,strL,tmp,tmp1,tmp2,tmp3,Nj);
+ out=list;
+ out=replace(out,"[[[","list([[");
+ out=replace(out,"[","c(");
+ out=replace(out,"]",")");
+ out=replace(out,".xy","");
+ out=replace(out,".x","[1]");
+ out=replace(out,".y","[2]");
+ out;
+);
+
+Defvar(varstr):=(
+ regional(name,value,tmp,tmp1);
+ if(isstring(varstr),
+ parse(varstr);
+ tmp=indexof(varstr,"=");
+ name=substring(varstr,0,tmp-1);
+ value=substring(varstr,tmp,length(varstr));
+ value=parse(value);
+ tmp1=select(1..length(VLIST),VLIST_#_1==name);
+ if(length(tmp1)>0,
+ tmp=tmp1_1;
+ VLIST_tmp=[name,value];
+ ,
+ VLIST=prepend([name,value],VLIST);
+ );
+ ,
+ forall(1..(length(varstr)/2), // 16.11.16from
+ name=varstr_(2*#-1);
+ value=varstr_(2*#);
+ Defvar(name,value);
+ ); // 16.11.16until
+ );
+);
+
+Defvar(name,value):=(
+//help:Defvar("a",0.3);
+//help:Defvar(["a",0.3,"b",2]);
+ regional(tmp,tmp1);
+ if(islist(value),
+ tmp1="[";
+ forall(value,
+ if(isstring(#), // 16.11.14
+ tmp1=tmp1+Dq+#+Dq+","; // 16.11.14
+ ,
+ tmp1=tmp1+format(#,5)+",";
+ );
+ );
+ tmp1=substring(tmp1,0,length(tmp1)-1)+"]";
+ ,
+ tmp1=format(value,5);
+ );
+ tmp=name+"="+tmp1; // 15.02.06
+ parse(tmp);
+ VLIST=select(VLIST,#_1!=name); // 15.02.08
+ VLIST=prepend([name,value],VLIST);
+);
+
+IftoR(strorg):=(
+ regional(str,pre,post,sub,ppL,ifstr,out,tmp,tmp1,tmp2);
+ str=strorg;
+ ifstr=indexof(str,"if(");
+ if(ifstr==0,
+ out=replace(str,",","}else{");
+ ,
+ pre=substring(str,0,ifstr-1)+"if(";
+ ppL=Bracket(str,"()");
+ tmp1=ifstr+2;
+ tmp=select(ppL,#_1==tmp1);
+ tmp=select(ppL,#_2==-tmp_1_2);
+ tmp2=tmp_1_1;
+ sub=substring(str,tmp1,tmp2-1);
+ post="}"+substring(str,tmp2,length(str));
+ tmp=indexof(sub,",");
+ tmp1=substring(sub,0,tmp-1);
+ tmp2=substring(sub,tmp,length(sub));
+ sub=tmp1+"){"+tmp2;
+ tmp=IftoR(sub);
+ out=pre+tmp+"}";
+ );
+ out;
+);
+
+FortoR(strorg):=(
+ regional(str,pre,post,sub,ppL,forstr,out,tmp,tmp1,tmp2);
+ str=strorg;
+ forstr=indexof(str,"forall(");
+ if(forstr==0,
+ out=str;
+ ,
+ pre=substring(str,0,forstr-1)+"for(";
+ ppL=Bracket(str,"()");
+ tmp1=forstr+6;
+ tmp=select(ppL,#_1==tmp1);
+ tmp=select(ppL,#_2==-tmp_1_2);
+ tmp2=tmp_1_1;
+ sub=substring(str,tmp1,tmp2-1);
+ post="}"+substring(str,tmp2,length(str));
+ tmp=indexof(sub,",");
+ tmp1=substring(sub,0,tmp-1);
+ tmp2=substring(sub,tmp,length(sub));
+ sub=tmp1+"){"+tmp2;
+ tmp1=indexof(sub,"{");
+ tmp2=indexof(sub,",");
+ tmp=substring(sub,tmp1,tmp2-1);
+ pre=pre+tmp+" in "+substring(sub,0,tmp1-1)+"{";
+ sub=substring(sub,tmp2,length(sub));
+ tmp=FortoR(sub);
+ out=pre+tmp+"}";
+ );
+ out=replace(out,"..",":");
+ out;
+);
+
+Deffun(name,bodylist):=(
+//help:Deffun("f(x)",["regional(y)","y=x^2*(x-3)","y"]);
+ regional(funstr,str,Pos,nbody,bdy,ppL,bpL,excma,tmp,tmp1,tmp2);
+ funstr=name+":=(";
+ forall(bodylist,
+ funstr=funstr+#+";";
+ );
+ funstr=funstr+");";
+ parse(funstr);
+ tmp=indexof(name,"(");
+ str=substring(name,0,tmp-1)+"<-function(";
+ str=str+substring(name,tmp,length(name))+"{";
+ forall(1..(length(bodylist)-1),nbody,
+ bdy=bodylist_nbody;
+ Pos=indexof(bdy,"regional")+indexof(bdy,"local");
+ if(Pos==0,
+ bdy=replace(bdy,LFmark,"");
+ bdy=replace(bdy," ","");
+ ppL=Bracket(bdy,"()");
+ bpL=Bracket(bdy,"[]");
+ tmp1=select(bpL,#_2==1);
+ tmp2=select(bpL,#_2==-1);
+ excma=[];
+ forall(1..(length(tmp1)),
+ excma=append(excma,[tmp1_#_1,tmp2_#_1]);
+ );
+ tmp1=Indexall(bdy,",");
+ forall(tmp1,cma,
+ tmp=select(excma,(#_1<cma)&(cma<#_2));
+ if(length(tmp)>0,
+ bdy=substring(bdy,0,cma-1)+"'"+substring(bdy,cma,length(bdy));
+ );
+ );
+ tmp=indexof(bdy,"forall");
+ if(tmp>0,
+ bdy=FortoR(bdy);
+ );
+ tmp=indexof(bdy,"if(");
+ if(tmp>0,
+ bdy=IftoR(bdy);
+ );
+ bdy=RSform(replace(bdy,"'",","));
+ str=str+bdy+";";
+ );
+ );
+ str=str+"return("+bodylist_(length(bodylist))+")}";
+ FUNLIST=append(FUNLIST,str);
+);
+
+Windispg():=(
+ regional(Nj,Nk,Dt,Vj,tmp,tmp1,tmp2,opcindy);
+ gsave();
+ layer(KETPIClayer);
+ forall(GCLIST,Nj,
+ if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17
+ if(islist(Dt) & length(Dt)>0, // 12.19,12.22
+ tmp=MeasureDepth(Dt);
+ if(tmp==1,Dt=[Dt]);
+ opcindy=Nj_3;
+ if(Nj_2<0,tmp1=0,tmp1=Nj_2);
+ if(tmp1<10,
+ forall(Dt,Nk,
+// tmp2=apply(Nk,if(ispoint(#),Lcrd(#),#));
+// tmp2=apply(tmp2,Pcrd(#));
+ tmp2=Nk; // 14.12.04
+ if(length(Nk)>1,
+ tmp="connect("+textformat(tmp2,5)+
+ ",dashtype->"+text(tmp1)+",linecolor->"+KCOLOR+opcindy+")";
+ parse(tmp);
+ ,
+ if(length(Nk)==1,
+ tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31
+ parse(tmp);
+ );
+ );
+ );
+ );
+ );
+ );
+// if(ADDAXES=="1", // 16.10.08from
+// draw([XMIN,0],[XMAX,0],color->[0,0.2,0]);
+// draw([0,YMIIN],[0,YMAX],color->[0,0.2,0]);
+// Letter([[XMAX,0],"e","x",[0,YMAX],"n","y"]);
+// Letter([[0,0],"sw","O"]);
+// ); // 16.10.08until
+ grestore();
+ layer(0);
+);
+
+Windispg(pltdata):=(
+ regional(pdata,Nj,Nk,Dt,tmp,tmp1,tmp2,opcindy);
+ gsave();
+ layer(KETPIClayer);
+ if(!islist(pltdata),tmp=[pltdata],tmp=pltdata);
+ pdata=select(GCLIST,contains(tmp,#_1));
+ forall(pdata,Nj,
+ if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17
+ if(islist(Dt) & length(Dt)>0, // 12.19,12.22
+ tmp=MeasureDepth(Dt);
+ if(tmp==1,Dt=[Dt]);
+ opcindy=Nj_3;
+ if(Nj_2<0,tmp1=0,tmp1=Nj_2);
+ if(tmp1<10,
+ forall(Dt,Nk,
+ tmp2=Nk; // 14.12.04
+ if(length(Nk)>1,
+ tmp="connect("+textformat(tmp2,5)+ // 15.05.11
+ ",dashtype->"+text(tmp1)+
+ ",linecolor->"+KCOLOR+opcindy+")";
+ parse(tmp);
+ ,
+ if(length(Nk)==1,
+ tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31
+ parse(tmp);
+ );
+ );
+ );
+ );
+ );
+ );
+ grestore();
+ layer(0);
+);
+
+WritetoSci():=WritetoRS(); //17.12.19
+WritetoRS():=WritetoRS(FnameR);// 17.09.17from
+WritetoRS(Arg):=(
+ regional(string,filename,shch,tmp1,tmp2);
+ if(isstring(Arg),
+ string=Arg;
+ if(indexof(string,".r")>0,
+ filename=string;
+ shch="";
+ ,
+ filename=FnameR;
+ shch=string;
+ );
+ WritetoRS(filename,shch);
+ ,
+ if(Arg<=1,WritetoRS(FnameR,"all"));
+ if(Arg==2,WritetoRS(FnameR,"sh"));
+ );
+);
+WritetoRS(filename,shchoice):=(
+ regional(Plist,Pos,GrL,str,tmp,tmp1,tmp2,cmd);
+ println("Write to R "+filename);
+ Plist=[];
+ Pnamelist=[];
+ forall(remove(allpoints(),[SW,NE]),
+ tmp=Lcrd(#);
+ tmp1=format(re(tmp_1),6);// 15.02.05
+ tmp2=format(re(tmp_2),6);
+ tmp=#.name+"="+"c("+tmp1+","+tmp2+");";
+ tmp=tmp+"Assignadd('"+#.name+"',"+#.name+")";
+ Plist=append(Plist,tmp);
+ );
+ SCEOUTPUT = openfile(filename);
+ tmp=Datetime();
+ println(SCEOUTPUT,"# date time="+tmp_1+" "+tmp_2);
+ if(isstring(CindyPathName), // 16.12.25from
+ if(length(CindyPathName)>0,
+ println(SCEOUTPUT,
+ "# path file="+CindyPathName+" "+CindyFileName+".cdy");
+ ,
+ println(SCEOUTPUT,"");
+ );
+ ,
+ println(SCEOUTPUT,"");
+ );
+// tmp1=replace(Dirwork,"\","/");//180403(2lines removed)
+// println(SCEOUTPUT,"setwd('"+tmp1+"')");
+ tmp=replace(Libname,"\","/"); //17.09.24from
+ println(SCEOUTPUT,"source('"+tmp+".r')");//temporary
+ if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
+ // 17.10.07added
+ tmp=replace(tmp+"_rep2e","\","/");
+ println(SCEOUTPUT,"source('"+tmp+".r')");
+ );
+ println(SCEOUTPUT,"Ketinit()");
+ println(SCEOUTPUT,"cat(ThisVersion,'\n')");
+ println(SCEOUTPUT,"Fnametex='"+Fnametex+"'");
+ println(SCEOUTPUT,"FnameR='"+FnameR+"'");
+ println(SCEOUTPUT,"Fnameout='"+Fnameout+"'");
+ println(SCEOUTPUT,"arccos=acos; arcsin=asin; arctan=atan");
+ println(SCEOUTPUT,"");
+ forall(COM0thlist,
+ if(indexof(#,"Texcom")==0, //17.09.22
+ println(SCEOUTPUT,RSform(#));
+ ,
+ println(SCEOUTPUT,#);
+ );
+ );
+ println(SCEOUTPUT,
+ "Setwindow(c("+XMIN+","+XMAX+"), c("+YMIN+","+YMAX+"))");
+ forall(Plist,
+ println(SCEOUTPUT,#);
+ );
+ forall(VLIST,
+ tmp=#_1;
+ tmp1=#_2;
+ if(!isstring(tmp1),
+ if(islist(tmp1),
+ tmp2="[";
+ forall(tmp1,
+ tmp2=tmp2+textformat(#,6)+",";
+ );
+ tmp1=substring(tmp2,0,length(tmp2)-1)+"]";
+ ,
+ tmp1=format(tmp1,6);
+ );
+ );
+ tmp1=RSform(tmp1);
+ print(SCEOUTPUT,tmp+"="+tmp1+";"); //17.09.22
+// tmp=substring(tmp,0,length(tmp)-1);
+ println(SCEOUTPUT,"Assignadd('"+tmp+"',"+tmp+")");
+ );
+ forall(FUNLIST,
+ println(SCEOUTPUT,#);
+ );
+ forall(GLIST,
+ println(SCEOUTPUT,RSform(#));
+ );
+ tmp=text(Pnamelist);
+ tmp=replace(tmp,"[","list(");
+ Pnamelist=replace(tmp,"]",")");
+ println(SCEOUTPUT,"PtL="+Pnamelist+";");
+ tmp=select(GCLIST,#_2==-1);
+ GrL=apply(tmp,#_1);
+ tmp=text(GrL);
+ tmp=replace(tmp,"[","list(");
+ tmp=replace(tmp,"]",")");
+ println(SCEOUTPUT,"GrL="+tmp);
+ tmp1="";
+ if(length(tmp1)>0,
+ tmp1="WriteOutData(Fnameout"+tmp1+");";
+ println(SCEOUTPUT,tmp1);
+ );
+ forall(COM1stlist,
+ if(indexof(#,"Texcom")==0, //17.09.22
+ println(SCEOUTPUT,RSform(#));
+ ,
+ println(SCEOUTPUT,#);
+ );
+ );
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"# Windisp(GrL)");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"if(1==1){");
+ println(SCEOUTPUT,"");
+// tmp=replace(Dirwork,"\","/"); //180403from
+// tmp="Openfile('"+tmp+pathsep()+Fnametex+"','"+ULEN+"'";
+ tmp="Openfile('"+Fnametex+"','"+ULEN+"'"; //180403to
+ tmp=tmp+",'Cdy="+text(curkernel()); //180404
+ tmp=replace(tmp,"\","\\");
+ println(SCEOUTPUT,tmp+"')");
+ forall(COM2ndlist,
+ if(indexof(#,"Texcom")==0, //17.09.22
+ println(SCEOUTPUT,RSform(#));
+ ,
+ println(SCEOUTPUT,#);
+ );
+ );
+ if(length(GrL)>0,
+ println(SCEOUTPUT," Drwline(GrL)");
+ );
+ println(SCEOUTPUT,"Closefile('"+ADDAXES+"')");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"}");
+ if(shchoice=="sh",
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"quit()");
+ ,
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"#quit()");
+ );
+ closefile(SCEOUTPUT);
+); //17.09.17to
+
+Extractdata(name):=Extractdata(1,name,[]);
+Extractdata(Arg1,Arg2):=(
+ if(isstring(Arg1),
+ Extractdata(1,Arg1,Arg2);
+ ,
+ Extractdata(Arg1,Arg2,[]);
+ );
+);
+Extractdata(number,name,options):=(
+//help:ExtractData("ha1");
+//help:ExtractData(1,"ha1");
+ regional(dlist,tmp,tmp1,tmp2,tmp3,File,Ltype,Noflg,opstr,opcindy);
+ tmp=Divoptions(options);
+ Ltype=tmp_1;
+ Noflg=tmp_2;
+ opstr=tmp_(length(tmp)-1);
+ opcindy=tmp_(length(tmp));
+ tmp1=[];
+ forall(1..length(GOUTLIST),
+ if(contains(GOUTLIST_#_2,name),
+ tmp1=append(tmp1,#);
+ );
+ );
+ if(length(tmp1)==0,
+ println(name+" not found");
+ ,
+ tmp1=tmp1_number;
+ tmp2=GOUTLIST_tmp1;
+ tmp=remove(tmp2_2,[name]);
+ GOUTLIST_tmp1=[tmp2_1,tmp];
+ File=tmp2_1;
+ );
+ if(Noflg<3,
+ println("extract outdata "+name);
+ tmp1=parse(name);
+ tmp3=[ //17.09.18
+ "Tmpout=ReadOutData("+Dq+File+Dq+")"
+ ];
+ GLIST=concat(GLIST,tmp3);
+ );
+ if(Noflg<2,
+ if(isstring(Ltype),
+ Ltype=GetLinestyle(text(Noflg)+Ltype,name);
+ ,
+ if(Noflg==1,Ltype=0);
+ );
+ GCLIST=append(GCLIST,[name,Ltype,opcindy]);
+ );
+ tmp2;
+);
+
+RemoveOut(pltlist):=(
+ regional(name,tmp,tmp1,tmp2);
+ forall(pltlist,name,
+ tmp1=[];
+ forall(GOUTLIST,
+ tmp=remove(#_2,[name]);
+ tmp1=append(tmp1,[#_1,tmp]);
+ );
+ GOUTLIST=tmp1;
+ );
+);
+
+ReadOutData():=ReadOutData(Fnameout);
+ReadOutData(filename):=ReadOutData("",filename); //16.03.07
+ReadOutData(pathorg,filenameorg):=(
+//help:ReadOutData();
+//help:Readoutdata();
+//help:ReadOutData("file.txt");
+//help:Readoutdata("file.txt");
+//help:ReadOutData("/datafolder","file.txt");
+//help:Readoutdata("/datafolder","file.txt");
+ regional(path,filename,varname,varL,ptL,pts,tmp,tmp1,tmp2,tmp3,tmp4,
+ nmbr,cmdall,cmd,cmdorg,outdt,goutdt);
+ path=pathorg; //16.03.07 from
+ if(length(path)>0,
+ setdirectory(path);
+ if(indexof(path,"\")>0,tmp1="\",tmp1="/");
+ tmp=substring(path,length(path)-1,length(path));
+ if(tmp!=tmp1,path=path+tmp1);
+ ); //16.03.07 until
+ filename=filenameorg; // 16.04.17
+ if(indexof(filename,".")==0,filename=filename+".txt");
+ tmp=load(filename);
+ cmdall=tokenize(tmp,"//");
+ varname=cmdall_1;
+ cmdall=cmdall_(2..length(cmdall));
+ outdt=[];
+ varL=[varname];
+ ptL=[];
+ forall(cmdall,cmdorg,
+ cmd=replace(cmdorg,LFmark,"");
+ if(length(cmd)>0,
+ if(cmd=="start" % cmd=="end" % substring(cmd,0,1)=="[",
+ if(cmd=="start",
+ pts=[];
+ );
+ if(cmd=="end",
+ ptL=append(ptL,pts);
+ );
+ if(substring(cmd,0,1)=="[",
+ tmp1=parse(cmd);
+ if(length(tmp1_1)==2,
+ tmp1=apply(tmp1,Pcrd(#));
+ );
+ pts=concat(pts,tmp1);
+ );
+ ,
+ if(length(ptL)>0,
+ if(length(ptL)==1,
+ ptL=ptL_1;
+ tmp=apply(ptL,textformat(#,6));
+ ,
+ tmp="[";
+ forall(ptL,tmp1,
+ tmp=tmp+apply(tmp1,textformat(#,6))+",";
+ );
+ tmp=substring(tmp,0,length(tmp)-1)+"]";
+ );
+ ,
+ tmp="[]";
+ );
+ parse(varname+"="+tmp);
+ outdt=append(outdt,ptL);
+ ptL=[];
+ varname=cmd;
+ varL=append(varL,varname);
+ );
+ );
+ );
+ if(length(ptL)>0,
+ if(length(ptL)==1,
+ ptL=ptL_1;
+ tmp=apply(ptL,textformat(#,6));
+ ,
+ tmp="[";
+ forall(ptL,tmp1,
+ tmp=tmp+apply(tmp1,textformat(#,6))+",";
+ );
+ tmp=substring(tmp,0,length(tmp)-1)+"]";
+ );
+ ,
+ tmp="[]";
+ );
+ parse(varname+"="+tmp);
+ outdt=append(outdt,ptL);
+ if(path=="",tmp=filename,tmp=path+filename); //16.03.07
+ GOUTLIST=append(GOUTLIST,[tmp,varL]);
+ if(length(path)>0, // 16.03.09
+ setdirectory(Dirwork); // 16.03.07
+ );
+ print("readoutdata from "+tmp+" : ");
+ println(varL);
+ varL;
+);
+
+WriteOutData(filename,ptlist):=(
+//help:WriteOutData("file.txt",["g1",gr1,"sg",sgAB]);
+//help:Writeoutdata("file.txt",["g1",gr1,"sg",sgAB]);
+ regional(nn,Gname,Gdata,Str,Gstr,Gj,Pt,Flg,tmp,tmp1,loopend);
+ Flg=0;
+ if(isstring(ptlist_(length(ptlist))),
+ Flg=1;
+ );
+ SCEOUTPUT = openfile(filename);
+ if(Flg==0,
+ loopend=length(ptlist)/2;
+ ,
+ loopend=length(ptlist);
+ );
+ Gstr="[";
+ forall(1..loopend,nn,
+ if(Flg==0,
+ Gname=ptlist_(2*nn-1);
+ ,
+ Gname=ptlist_nn;
+ );
+ Gstr=Gstr+Gname+",";
+ println(SCEOUTPUT,Gname+"//");
+ if(Flg==0,
+ Gdata=ptlist_(2*nn);
+ ,
+ Gdata=parse(Gname);
+ );
+ Gdata=Flattenlist(Gdata);
+ if(MeasureDepth(Gdata)==1,Gdata=[Gdata]);
+ forall(Gdata,Gj,
+ println(SCEOUTPUT,"start//");
+ Str="";
+ forall(Gj,Pt,
+ if(length(Str)>0,
+ Str=Str+","
+ );
+ Str=Str+"["+format(Pt_1,5)+",";
+ Str=Str+format(Pt_2,5);
+ if(length(Pt)<3,
+ Str=Str+"]";
+ ,
+ Str=Str+","+format(Pt_3,5)+"]";
+ );
+ if(length(Str)>80,
+ println(SCEOUTPUT,"["+Str+"]//");
+ Str="";
+ );
+ );
+ if(length(Str)>0,
+ println(SCEOUTPUT,"["+Str+"]//");
+ );
+ if((nn==loopend) & (Gj==Gdata_(length(Gdata))),
+ println(SCEOUTPUT,"end////");
+ ,
+ println(SCEOUTPUT,"end//");
+ );
+ );
+ );
+ closefile(SCEOUTPUT);
+ Gstr=substring(Gstr,0,length(Gstr)-1)+"]";
+ println("writeoutdata "+filename+":"+Gstr);
+);
+
+Makeshell():=(
+ if(length(Texmain)>0,
+ Texparent=Texmain;
+ );
+ if(length(Texparent)>0,
+ Makeshell(Texparent);
+ if(length(FigPdfList)>0,
+ SCEOUTPUT=openfile(Texparent+".tex");
+ forall(FigPdfList,println(SCEOUTPUT,#));
+ closefile(SCEOUTPUT);
+ );
+ ,
+ Makeshell(Fhead+"main");
+ );
+);
+Makeshell(texmainfile):=Makeshell(texmainfile,"rtv");
+Makeshell(texmainfile,flow):=(
+ regional(parent,tmp,tmp1,tmp2,tmp3,flg,tex,path,shnm);
+ parent=Dirwork+Shellparent; // 16.05.29
+ kc():=(
+ println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04,06.07
+ );
+ tmp1="";
+// tmp2=parent;
+ flg=0;
+ forall(reverse(1..length(parent)),
+ if(flg==0,
+ tmp=substring(parent,#-1,#);
+ if(tmp=="/" % tmp=="\", // 14.01.15
+ tmp1=substring(parent,0,#-1);
+ tmp2=substring(parent,#,length(parent));
+ flg=1;
+ );
+ );
+ );
+ if(length(tmp1)>0,
+ setdirectory(tmp1);
+ );
+ SCEOUTPUT = openfile(tmp2);
+ println(SCEOUTPUT,"#!/bin/sh");
+ println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); // 15.07.16
+ tmp1=" "+Dq+Fhead+Dq+" "+Dq+texmainfile+Dq; // 15.12.11
+ flg=0;
+ forall(reverse(1..length(PathT)),
+ if(flg==0,
+ if(substring(PathT,#-1,#)=="/",
+ tex=substring(PathT,#,length(PathT));
+ path=substring(PathT,0,#-1);
+ flg=1;
+ );
+ );
+ );
+ if(flg==0, // 17.10.13(Norbert)
+ tex=PathT;
+ path="";
+ );
+ if(indexof(flow,"r")>0,
+ tmp=Dq+PathR+Dq+" --vanilla --slave < "+Fhead+".r";
+ // 17.09.14
+ println(SCEOUTPUT,tmp);
+ );
+ if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13
+ tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi";
+ println(SCEOUTPUT,tmp);
+ tmp="rm "+texmainfile+".dvi";
+ println(SCEOUTPUT,tmp);
+ );
+ if(tex=="xelatex",
+ tmp="export PATH="+path+":${PATH}";
+ println(SCEOUTPUT,tmp);
+ tmp="xelatex"+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ tmp="rm "+texmainfile+".dvi";
+ println(SCEOUTPUT,tmp);
+ );
+ if(tex=="pdflatex" % tex=="pdftex",//16.11.22from
+ tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ );//16.11.22until
+ if(tex=="lualatex",//16.12.16
+ tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ );//16.12.16
+ if(!isstring(Pathpdf),
+ tmp="preview";
+ ,
+ tmp=Pathpdf;
+ );
+ if(tmp=="preview" % tmp=="skim", // 16.09.09from,16.10.20
+ tmp="open -a "+Dq+tmp+Dq+" "+texmainfile+".pdf";
+ ,
+ tmp=Dq+tmp+Dq+" "+texmainfile+".pdf";
+ );// 16.09.09until
+ println(SCEOUTPUT,tmp); // 16.07.21until
+ println(SCEOUTPUT,"exit 0");
+ closefile(SCEOUTPUT);
+ setdirectory(Dirwork);
+);
+
+Convsjiswin(dir,fname,ext):=( //180401
+ regional(ctr,flg,mx,tmp);
+ mx=200;
+ ctr=0;flg=0;
+ nkfwin(dir,fname,ext);
+ while((!isexists(dir,fname+".out"))&(ctr<mx),
+ wait(100);ctr=ctr+1;
+ );
+ if(ctr==mx,flg=1);
+ if(flg==0,
+ wait(100);ctr=0;
+ nkfcpdel(dir,fname,ext);
+ while((isexists(dir,fname+".out"))&(ctr<mx),
+ wait(100);ctr=ctr+1;
+ );
+ if(ctr==mx,flg=2);
+ );
+ tmp=dir+pathsep()+fname+"."+ext;
+ if(flg==0,
+ tmp=
+ println(tmp+" converted");
+ ,
+ println(tmp+" not converted "+text(flg));
+ );
+);
+
+Makebat():=(
+ if(length(Texmain)>0,
+ Texparent=Texmain;
+ );
+ if(length(Texparent)>0,
+ Makebat(Texparent);
+ if(length(FigPdfList)>0,
+ SCEOUTPUT=openfile(Texparent+".tex");
+ forall(FigPdfList,println(SCEOUTPUT,#));
+ closefile(SCEOUTPUT);
+ );
+ ,
+ Makebat(Fhead+"main");
+ );
+);
+Makebat(texmainfile):=Makebat(texmainfile,"rtv");
+Makebat(texmainfile,flow):=(
+ regional(drive,fname,tmp,tmp1,tmp2,tmp3,flg,tex,path,batnm);
+ drive="C:";
+ fname=Dirwork+Batparent;
+ kc():=(
+ println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04
+ );
+ tmp=indexof(fname,":");
+ if(tmp>0,
+ drive=substring(fname,0,tmp);
+ fname=substring(fname,tmp,length(fname));
+ );
+ tmp1="";
+ tmp2=fname;
+ flg=0;
+ forall(reverse(1..length(fname)),
+ if(flg==0,
+ tmp=substring(fname,#-1,#);
+ if(tmp=="/" % tmp=="\" % tmp=="\", // 14.01.15
+ tmp1=substring(fname,0,#-1);
+ tmp2=substring(fname,#,length(fname));
+ flg=1;
+ );
+ );
+ );
+ if(length(tmp1)>0,
+ setdirectory(drive+tmp1);
+ );
+ SCEOUTPUT = openfile(tmp2);
+ fname=replace(Dirwork,"/","\");
+ tmp=indexof(fname,":");
+ if(tmp>0,
+ drive=substring(Dirwork,0,tmp);
+ fname=substring(Dirwork,tmp,length(Dirwork));
+ println(SCEOUTPUT,drive);
+ );
+ tmp1=indexof(fname,"Users");//180405
+ tmp2=indexof(fname,Homehead);//180403from
+ if((tmp1>0)%(tmp2>0),
+ if(tmp1>0,
+ fname=substring(fname,tmp1+length("Users")-1,length(fname));
+ ,
+ fname=substring(fname,tmp2+length(Homehead)-1,length(fname));
+ );
+ tmp=Indexall(fname,"\");//180403from
+ fname=substring(fname,tmp_2,length(fname));
+ fname="%HOMEPATH%\"+fname;
+ );//180403to
+ println(SCEOUTPUT,"cd "+Dq+fname+Dq);// 150716
+ flg=0;
+ tmp=replace(PathT,"\","/");
+ forall(reverse(1..length(PathT)),
+ if(flg==0,
+ if(substring(tmp,#-1,#)=="/",
+ tex=substring(PathT,#,length(PathT));
+ path=substring(PathT,0,#-1);
+ flg=1;
+ );
+ );
+ );
+ if(flg==0, // 17.10.13(Norbert)
+ tex=PathT;
+ path="";
+ );
+ if(indexof(flow,"r")>0,
+ tmp=Dq+PathR+"\R"+Dq+" --vanilla --slave < "+Fhead+".r";
+ // 17.09.14
+ println(SCEOUTPUT,tmp);
+ );
+ if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13
+ tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi";
+ println(SCEOUTPUT,tmp);
+ tmp="del "+texmainfile+".dvi";
+ println(SCEOUTPUT,tmp);
+ );
+ if(tex=="xelatex",
+ tmp="set Path = %Path%;"+Dq+path+Dq;
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ tmp="xelatex"+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ tmp="del "+texmainfile+".dvi";
+ println(SCEOUTPUT,tmp);
+ );
+ if(tex=="pdflatex" % tex=="pdftex",//16.11.22from
+ tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ );//16.11.22until
+ if(tex=="lualatex",//16.12.16
+ tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
+ println(SCEOUTPUT,tmp);
+ if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
+ );//16.12.16
+ if(!isstring(Pathpdf),
+ tmp=indexof(PathS,"\scilab");// 15.12.12
+ tmp=substring(PathS,0,tmp-1)+"\SumatraPDF\SumatraPDF.exe";
+ ,
+ tmp=Pathpdf;
+ );
+ tmp=Dq+tmp+Dq+" "+texmainfile+".pdf";
+ println(SCEOUTPUT,tmp);
+ println(SCEOUTPUT,"exit 0");
+ closefile(SCEOUTPUT);
+ if(indexof(Dirwork,":")==0, // 14.01.15
+ drive="C:";
+ ,
+ drive="";
+ );
+ setdirectory(drive+Dirwork);
+);
+
+Addpackage(packorg):=(
+//help:Addpackage("bm");
+//help:Addpackage(["bm","enumerate"]);
+//help:Addpackage(["bm","[c]{somepackage}"]);
+ regional(packL,tmp);
+ packL=packorg; //17.06.25from
+ if(!islist(packL),packL=[packL]);
+ packL=apply(packL,replace(#,"\","/"));
+ forall(1..(length(packL)),
+ tmp=packL_#;
+ if(substring(tmp,0,11)=="ketpicstyle",
+ tmp=replace(Dirhead+"/"+tmp,"\","/");
+ );
+ if(indexof(tmp,"[")==0,
+ packL_#="{"+tmp+"}";
+ );
+ );
+ ADDPACK=concat(ADDPACK,packL); //17.06.25until
+);
+
+Viewtex():=(
+ regional(texfile,tmp,tmp1,sep);
+ texfile=Fhead+"main";
+// if(iswindows(),sep="\",sep="/"); // 17.04.07
+// sep="/";
+ SCEOUTPUT=openfile(texfile+".tex");
+ tmp="\documentclass{article}"; // 16.06.09from
+ if(indexof(PathT,"platex")>0,
+ tmp=replace(tmp,"article","jarticle");
+ if(indexof(PathT,"uplatex")>0, //17.08.13from
+ tmp=replace(tmp,"jarticle","ujarticle");
+ );//17.08.13until
+ ); // 16.06.09until
+ println(SCEOUTPUT,tmp);
+ if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0) ,
+ //16.11.23,12.16
+ if(indexof(PathT,"pdflatex")>0,
+ println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}");//16.11.24
+ ,
+ println(SCEOUTPUT,"\usepackage{pict2e}");//16.12.16
+ println(SCEOUTPUT,"\usepackage{luatexja}");//16.12.18
+ );
+ tmp=replace(Dirhead,"\","/"); //17.10.30from
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}");
+ );
+ ,
+ tmp=replace(Dirhead,"\","/");
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
+ );
+ );//17.10.30until
+ println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
+ println(SCEOUTPUT,"\usepackage{graphicx}");
+ println(SCEOUTPUT,"\usepackage{color}");
+ forall(ADDPACK, // 16.05.16from
+ println(SCEOUTPUT,"\usepackage"+#); //17.05.25
+ );// 16.05.16until
+ println(SCEOUTPUT,"");
+// println(SCEOUTPUT,"\def\ketcindy{{K\kern-.20em%"); // deleted 16.11.27,recovered11.29 redeleted17.04.07
+// println(SCEOUTPUT,"\lower.5ex\hbox{E}\kern-.125em{TCindy}}}");
+// println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\setmargin{20}{20}{20}{20}");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\begin{document}");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\verb|"+Fhead+"| by \ketcindy");// 16.01.12, 18, 16.04.08
+// println(SCEOUTPUT,"\verb|"+Fhead+"| by KeTCindy");// 16.11.29 temporarily
+ println(SCEOUTPUT,"\vspace{5mm}");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\input{"+Fhead+".tex}");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\end{document}");
+ closefile(SCEOUTPUT);
+ if(iswindows(),
+ kc():=(
+ println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04
+ );
+ Makebat(texfile);
+ ,
+ kc():=(
+ println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04
+ );
+ Makeshell(texfile);
+ );
+ WritetoRS(2); //17.09.19
+);
+
+Viewparent():=( //17.04.13
+ if(!isexists(Dirwork,Texparent+".tex"),
+ if(isstring(Texparent),
+ drawtext(mouse().xy,Texparent+".tex not exist",
+ size->24,color->[1,0,0]);
+ ,
+ drawtext(mouse().xy,"Texparent not defined",
+ size->24,color->[1,0,0]);
+ );
+ ,
+ if(iswindows(),
+ Makebat();
+ ,
+ Makeshell();
+ );
+ WritetoRS(2); //17.09.29
+ kc();
+ );
+);
+
+Makecmdlist(libname):=(
+//help:Makecmdlist("ketcindylib");
+ regional(cmdall,cmd,flg,tmp,tmp1,tmp2,out);
+ setdirectory(Dirlib);
+ tmp=load(libname+".cs");
+ cmdall=tokenize(tmp,":=");
+ out=[];
+ forall(cmdall,cmd,
+ tmp=max([0,length(cmd)-50]);
+ tmp1=";"+substring(cmd,tmp,length(cmd));
+ flg=0;
+ forall(reverse(1..length(tmp1)),
+ if(flg==0,
+ if(substring(tmp1,#-1,#)==";",
+ tmp=substring(tmp1,#,length(tmp1));
+ tmp2=substring(tmp,0,1);
+ if(length(tmp)>0,
+ if(!contains([" ","/"],tmp2),
+ out=append(out,tmp);
+ flg=1;
+ );
+ );
+ );
+ );
+ );
+ );
+ setdirectory(Dirwork);
+ tmp=length(out)-1;
+ out=out_(2..tmp);
+ out=sort(out);
+);
+
+Savecmdlist(cmdlist,cmdfile):=(
+ SCEOUTPUT=openfile(cmdfile+".cs");
+ forall(cmdlist,
+ println(SCEOUTPUT,#);
+ );
+ closefile(SCEOUTPUT);
+);
+
+Quicksort(seq):=(
+ regional(pivot,left,right,out);
+ if(length(seq)<2,
+ out=seq;
+ ,
+ pivot = max(seq_1,seq_2);
+ left = [];
+ right = [];
+ forall(seq,
+ if(#< pivot,
+ left=append(left,#);
+ ,
+ right=append(right,#);
+ );
+ );
+ left = Quicksort(left);
+ right = Quicksort(right);
+ out=concat(left,right);
+ );
+ out;
+);
+
+Lessstr(st1,st2):=(
+ regional(tmp,tmp1,tmp2,out);
+ tmp=min(length(st1),length(st2));
+ flg=0;
+ forall(1..tmp,
+ if(flg==0,
+ tmp1=substring(st1,#-1,#);
+ tmp2=substring(st2,#-1,#);
+ if(tmp1<tmp2,
+ out=(1<2);
+ flg=1;
+ ,
+ if(tmp1>tmp2,
+ out=(1>2);
+ flg=1;
+ );
+ );
+ );
+ );
+ if(flg==0,
+ if(length(st1)<length(str2),
+ out=(1<2);
+ ,
+ out=(1>2);
+ );
+ );
+ out;
+);
+
+Figpdf():=Figpdf(Texparent,[]);
+Figpdf(Arg1):=(
+ if(isstring(Arg1),
+ Figpdf(Arg1,[]);
+ ,
+ Figpdf(Texparent,Arg1);
+ );
+);
+Figpdf(fnameorg,optionorg):=(
+//help:Figpdf();
+//help:Figpdf([10,,10,,[0,2] ]);(margin(4),move)
+//help:Figpdf([[0,0]]);(move)
+//help:Figpdf(options=[5,5,5,5,[0,0]]]);
+ regional(options,fname,mar,pos,dp,sc,tmp,tmp1,tmp2,sep);
+ fname=fnameorg;
+ if(indexof(fnameorg,".")==0,
+ fname=fnameorg+".tex";
+ );
+ tmp=apply(optionorg,if(isstring(#),parse("["+#+"]"),#)); // 16.04.07
+ tmp=select(tmp,#!=[]);
+ options=optionorg;//16.11.08from
+// mar=[5,5,5,5];
+ dp=[0,-3];
+ tmp=select(options,islist(#));
+ if(length(tmp)>0,
+ dp=tmp_1;
+ options=remove(options,tmp);
+ );
+ tmp=4-length(options);
+ tmp1=apply(1..tmp,5);
+ mar=concat(options,tmp1);
+ mar=apply(mar,if(length(#)==0,5,#));//16.11.08until
+ pos=[mar_1+dp_1,mar_3+dp_2];
+ sc=10;
+ tmp=indexof(ULEN,"cm");
+ if(tmp>0,
+ tmp1=Removespace(substring(ULEN,0,tmp-1));
+ sc=parse(tmp1)*10;
+ );
+ tmp=indexof(ULEN,"mm");
+ if(tmp>0,
+ tmp1=Removespace(substring(ULEN,0,tmp-1));
+ sc=parse(tmp1);
+ );
+ tmp="\documentclass{article}"; // 16.06.09from
+ if(indexof(PathT,"platex")>0,
+ tmp=replace(tmp,"article","jarticle");
+ if(indexof(PathT,"uplatex")>0, //17.08.13from
+ tmp=replace(tmp,"jarticle","ujarticle");
+ );//17.08.13until
+ );
+ FigPdfList=append(FigPdfList,tmp); // 16.06.09until
+ tmp1="\special{papersize=W mm,H mm}";
+ tmp=(XMAX-XMIN)*sc+(mar_1+mar_2);
+ tmp1=replace(tmp1,"W",text(tmp));
+ tmp=(YMAX-YMIN)*sc+(mar_3+mar_4);
+ tmp1=replace(tmp1,"H",text(tmp));
+// if(iswindows(),sep="\",sep="/");//17.04.08
+// sep="/";
+ FigPdfList=append(FigPdfList,tmp1);
+ if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, //17.11.05from
+ FigPdfList=append(FigPdfList,
+ "\usepackage{pict2e}");
+ tmp=replace(Dirhead,"\","/");
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ FigPdfList=append(FigPdfList,
+ "\usepackage{ketpic2e,ketlayer2e}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ FigPdfList=concat(FigPdfList,
+ ["\usepackage{"+tmp+"/ketpic2e}",
+ "\usepackage{"+tmp+"/ketlayer2e}"]);
+ );
+ ,
+ tmp=replace(Dirhead,"\","/");
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ FigPdfList=append(FigPdfList,
+ "\usepackage{ketpic,ketlayer}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ FigPdfList=concat(FigPdfList,
+ ["\usepackage{"+tmp+"/ketpic}",
+ "\usepackage{"+tmp+"/ketlayer}"]);
+ );
+ );//17.11.05until
+ FigPdfList=append(FigPdfList,
+ "\usepackage{amsmath,amssymb}");
+ FigPdfList=append(FigPdfList,
+ "\usepackage{graphicx,color}");
+ forall(ADDPACK, // 16.05.16from
+ tmp1="\usepackage"+#; //17.07.10
+ FigPdfList=append(FigPdfList,tmp1); // 16.09.05until
+ );
+ FigPdfList=append(FigPdfList,"");
+ FigPdfList=append(FigPdfList,
+ "\setmargin{0}{0}{0}{0}");
+ FigPdfList=append(FigPdfList,"");
+ FigPdfList=append(FigPdfList,"\begin{document}");
+ FigPdfList=append(FigPdfList,"");
+ FigPdfList=append(FigPdfList,
+ "\begin{layer}{50}{0}");
+ tmp1="\putnotese{X}{Y}{\input{";
+ tmp1=replace(tmp1,"X",text(pos_1));
+ tmp1=replace(tmp1,"Y",text(pos_2));
+ FigPdfList=append(FigPdfList,tmp1+Fhead+".tex}}");
+ FigPdfList=append(FigPdfList,"");
+ FigPdfList=append(FigPdfList,"\end{layer}");
+ FigPdfList=append(FigPdfList,"");
+ FigPdfList=append(FigPdfList,"\end{document}");
+ if(fnameorg!=Texparent,
+ SCEOUTPUT=openfile(fname);
+ forall(FigPdfList,println(SCEOUTPUT,#));
+ closefile(SCEOUTPUT);
+ );
+ FigPdfList;
+);
+
+Makehelplist(libname):=(
+ regional(cmdall,cmd,flg,lev,tmp,tmp1,out);
+ tmp=load(libname);
+ cmdall=tokenize(tmp,"//help:");
+ cmdall=select(cmdall,substring(#,1,3)!=");");
+ flg=0;
+ forall(1..3,
+ if(flg==0,
+ if(substring(cmdall_#,0,7)=="start()",
+ cmdall=cmdall_((#+1)..length(cmdall));
+ flg=1;
+ );
+ );
+ );
+ flg=0;
+ tmp=length(cmdall);
+ forall(0..2,
+ if(flg==0,
+ if(substring(cmdall_(tmp-#),0,5)=="end()",
+ cmdall=cmdall_(1..(tmp-#-1));
+ flg=1;
+ );
+ );
+ );
+ out=[];
+ forall(cmdall,cmd,
+ tmp1=indexof(cmd,"(");
+ lev=1;
+ flg=0;
+ forall((tmp1+1)..length(cmd),
+ if(flg==0,
+ tmp=substring(cmd,#-1,#);
+ if(tmp=="(",lev=lev+1);
+ if(tmp==")",
+ lev=lev-1;
+ if(lev==0,
+ flg=1;
+ out=append(out,substring(cmd,0,#)+";");
+ );
+ );
+ );
+ );
+ );
+ sort(out);
+);
+
+Helplist():=Helplist(Dirlib,["+","+3d"],"helpJ");
+// 15.05.22
+Helplist(Arg):=(
+ if(islist(Arg),
+ Helplist(Dirlib,Arg,"helpJ"); // 15.06.20
+ ,
+ if(indexof(Arg,"help")>0,
+ Helplist(Dirlib,["+","+3d"],Arg);
+ ,
+ Helplist(Arg,["+","+3d"],"helpJ");
+ );
+ );
+);
+Helplist(Arg1,Arg2):=(
+ if(islist(Arg1),
+ Helplist(Dirlib,Arg1,Arg2);
+ ,
+ if(indexof(Arg2,"help")>0,
+ Helplist(Dirlib,Arg1,Arg2);
+ ,
+ Helplist(Arg,["+","+3d"],Arg2);
+ );
+ );
+);
+Helplist(dir,files,help):=(
+//help:Helplist();
+//help:Helplist("helpE");
+ regional(ketfiles,tmp,tmp1,tmp2);
+ setdirectory(dir);
+ if(contains(files,"+"),
+ tmp=remove(files,["+"]);
+ ketfiles=concat(["+basic1","+basic2","+out"],tmp);
+ ,
+ ketfiles=files;
+ );
+ ketfiles=apply(ketfiles,replace(#,"+","ketcindylib"));
+ ketfiles=apply(ketfiles,#+"r.cs"); // 15.11.05 from
+ tmp=apply(files,replace(#,"+","ketcindylib"));
+// tmp=apply(files,replace(#,"r.cs",""));
+// tmp=remove(tmp,["ketcindylibout"]);
+// tmp=apply(tmp,replace(#,"basic",""));
+ tmp=apply(tmp,#+help+".txt");
+ ketfiles=concat(ketfiles,tmp);// 15.11.05 until
+ tmp1=[];
+ forall(ketfiles,
+ tmp=Makehelplist(#);
+ tmp1=concat(tmp1,tmp);
+ );
+ if(!islist(HLIST), // 16.12.31from
+ HLIST=sort(tmp1);
+ ,
+ HLIST=sort(concat(HLIST,tmp1));
+ ); // 16.12.31until
+ setdirectory(Dirwork);
+);
+
+
+Help():=(
+ forall(HLIST,
+ println(#);
+ );
+);
+Help(strorg):=(
+//help:Help("Plot");
+//help:Help("*");
+ regional(str,sel,tmp,tmp1,tmp2,flg,Endflg);
+ if(length(HLIST)>0,flg=0,flg=-1);
+ str=replace(strorg,"'",Dq); // 15.11.25
+ if(length(str)==0,
+ forall(HLIST,
+ if(indexof(#,"*")>0,
+ println(#);
+ );
+ flg=1;
+ );
+ ,
+ if(str=="*",
+ sel=HLIST;
+ ,
+ sel=select(HLIST,substring(#,0,length(str))==str);
+ );
+ if(length(sel)>0,flg=1);
+ forall(sel,
+ tmp=indexof(#,"(");
+ if(substring(#,tmp-2,tmp-1)!="*",
+ println(#);
+ ,
+// println(substring(#,0,tmp-1));
+ tmp1=substring(#,tmp,length(#)-2);
+ tmp2=indexof(tmp1,"//");
+ Endflg=0;
+ forall(1..4,
+ if(Endflg==0,
+ tmp2=indexof(tmp1,"//");
+ if(tmp2==0,
+ println(" "+tmp1);
+ Endflg=1;
+ ,
+ println(" "+substring(tmp1,0,tmp2-1));
+ tmp1=substring(tmp1,tmp2+1,length(tmp1));
+ );
+ );
+ );
+ );
+ );
+ );
+ if(flg==-1,println(" Help not read in"));
+ if(flg==0,println(" no example"));
+);
+
+Helpkey(str):=(
+ regional(tmp,tmp1,tmp2);
+ tmp1=select(HLIST,indexof(#,str)>0);
+ forall(tmp1,
+ tmp=substring(#,0,indexof(#,"*")-1);
+ Help(tmp);
+ );
+);
+Helpkey(str1,str2):=(
+//help:Helpkey(keyword);
+//help:Helpkey(keyword1,keyword2);
+ regional(tmp,tmp1,tmp2);
+ tmp1=select(HLIST,indexof(#,str1)>0);
+ tmp1=select(tmp1,indexof(#,str2)>0);
+ forall(tmp1,
+ tmp=substring(#,0,indexof(#,"*")-1);
+ Help(tmp);
+ );
+);
+
+Slidework():=Slidework(Dirwork); // 16.06.10
+Slidework(dirorg):=(
+//help:Slidework(directory);
+ regional(dir,tmp); // 16.06.25
+ dir=replace(dirorg,unicode("000a"),""); // 16.06.25
+ dir=replace(dir,"/",pathsep());//17.11.20from
+ dir=replace(dir,"\",pathsep());
+ tmp=length(dir);
+ if(substring(dir,tmp-1,tmp)==pathsep(),
+ dir=substring(dir,0,tmp-1);
+ );//17.11.20until
+ if(isexists(dir,""), // 16.12.20
+ Changework(dir);
+ println(makedir(dir,"fig"));//17.11.23
+ tmp=dir+pathsep()+"fig"; //17.04.16from
+ Changework(tmp);// 17.02.19until
+ ,
+ println(dir+ " not exists");
+ );
+);
+
+Setslidepage():=( // 17.03.05
+ regional(tmp1,tmp2,tmp3);
+ tmp1=["letterc","boxc","framec","shadowc","xpos","size"];
+ tmp2=apply([1,2,4,5,7,8],SlideColorList_#);
+ tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
+ println(tmp3);
+);
+Setslidepage(list):=( // 16.12.22
+//help:Setslidepage([letterc,boxc,framec,shadowc,xpos,size]);
+ regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
+ letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
+ shadowc=[0,0,0,0.5]; mboxc="yellow";
+ if(!islist(SlideColorList),
+ SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
+ letterc,mboxc,mboxc,mboxc,62,2,letterc];
+ );
+ numlist=[1,2,4,5,7,8];
+ forall(1..(length(list)),
+ if(length(list_#)>0,
+ tmp=numlist_#;
+ SlideColorList_tmp=list_#;
+ );
+ );
+ SlideColorList_3=SlideColorList_2;
+ SlideColorList_6=SlideColorList_5;
+);
+
+Setslidemain():=( // 17.03.05
+ regional(tmp1,tmp2,tmp3);
+ tmp1=["letterc","boxc","framec","xpos","size"];
+ tmp2=apply([9,10,12,13,14],SlideColorList_#);
+ tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
+ println(tmp3);
+);
+Setslidemain(list):=( // 16.12.22
+//help:Setslidemain([letterc,boxc,framec,xpos,size]);
+ regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
+ letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
+ shadowc=[0,0,0,0.5]; mboxc="yellow";
+ if(!islist(SlideColorList),
+ SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
+ letterc,mboxc,mboxc,mboxc,62,2,letterc];
+ );
+ numlist=[9,10,12,13,14];
+ forall(1..(length(list)),
+ if(length(list_#)>0, //17.01.04
+ tmp=numlist_#;
+ SlideColorList_tmp=list_#;
+ );
+ );
+ SlideColorList_11=SlideColorList_10;
+);
+
+Setslidebody():=( // 17.03.05
+ regional(tmp1,tmp2,tmp3);
+ tmp1=["letterc","style","thindense"];
+ tmp2=[SlideColorList_(15),BodyStyle,ThinDense];
+ tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
+ println(tmp3);
+);
+Setslidebody(str):=(
+ regional(clr,style,thin);
+ if(isstring(str),
+ Setslidebody(str,"\Large\bf\boldmath",0.1);
+ ,
+ if(length(str)==1,Setslidebody(str_1));
+ if(length(str)==2,Setslidebody(str_1,str_2));
+ if(length(str)==3,Setslidebody(str_1,str_2,str_3));
+ );
+);
+Setslidebody(str,Arg):=( //17.01.08
+ if(isstring(Arg),
+ Setslidebody(str,Arg,0.1);
+ ,
+ Setslidebody(str,"\Large\bf\boldmath",Arg);
+ );
+);
+Setslidebody(str,style,density):=( // 16.12.22,17.01.06,01.08
+//help:Setslidebody(["black",,0]);
+//help:Setslidebody(["blue","\Large\bf\boldmath",0.1]);
+ regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
+ letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
+ shadowc=[0,0,0,0.5]; mboxc="yellow";
+ if(!islist(SlideColorList),
+ SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
+ letterc,mboxc,mboxc,mboxc,62,2,letterc];
+ );
+ if(length(str)>0,SlideColorList_(15)=str);
+ if(length(style)>0,BodyStyle=style);
+ ThinDense=density;//17.01.08
+);
+
+Setslidehyper():=( 17.12.16from
+ Setslidehyper(["cl=true,lc=blue,fc=blue",125,70,1]);
+);
+Setslidehyper(Arg):=(
+ if(isstring(Arg),
+ Setslidehyper(Arg,["cl=true,lc=blue,fc=blue",125,70,1]);
+ ,
+ Setslidehyper("",Arg);
+ );
+);
+Setslidehyper(driverorg,options):=(
+//help:Setslidehyper();
+//help:Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue","Pos=[125,70]","Size=1"]);
+ regional(driver,eqL,reL,stL,,str,tmp,tmp1,tmp2);
+ driver=driverorg;
+ if(length(driver)==0,
+ if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")==0,
+ driver="dvipdfmx";
+ );
+ );
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ reL=tmp_6;
+ stL=tmp_7;
+ if(length(stL)>0,
+ str=stL_1;
+ ,
+ str="";
+ );
+ if(length(str)==0,
+ str="cl=true,lc=blue,fc=blue";
+ );
+ if(length(driver)==0,
+ tmp1="["+str+"]";
+ ,
+ tmp1="["+driver+","+str+"]";
+ );
+ tmp1=replace(tmp1,"cl=","colorlinks=");
+ tmp1=replace(tmp1,"lc=","linkcolor=");
+ tmp1=replace(tmp1,"fc=","filecolor=");
+ tmp1=replace(tmp1,"uc=","urlcolor=");
+ ADDPACK=select(ADDPACK,indexof(#,"hyperref")==0);
+ Addpackage(tmp1+"{hyperref}");
+ LinkPosH=125;
+ LinkPosV=70;
+ LinkSize=1;
+ if(length(reL)>0,
+ LinkPosH=reL_1;
+ if(length(reL)>1,LinkPosV=reL_2);
+ if(length(reL)>2,LinkSize=max(reL_3,0.1));
+ );
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,1));
+ tmp2=substring(#,tmp,length(#));
+ tmp2=parse(tmp2);
+ if(tmp1=="P",
+ LinkPosH=tmp2_1;
+ LinkPosV=tmp2_2;
+ );
+ if(tmp1=="S",
+ LinkSize=max(tmp2,0.1);
+ );
+ );
+); //17.12.16until
+
+Settitle(cmdL):=Settitle(cmdL,[]); // 180330changed
+Settitle(cmdL,options):=(
+//help:Settitle(cmdL);
+//help:Settitle(name,cmdL);
+//help:Settitle(options=["Title=slide0","Layery=0","Color=blue"]);
+ regional(tmp,tmp1,tmp2,eqL,layery,color,size,font);
+ TitleName="slide0"; //180330
+ layery="0";
+ color="blue";
+ size="\Large";
+ font="\bf";
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ forall(eqL,
+ tmp1=Toupper(substring(#,0,1));
+ tmp=indexof(#,"=");
+ tmp2=substring(#,tmp,length(#));
+ if(tmp1=="L",
+ layery=tmp2;
+ );
+ if(tmp1=="C",
+ color=tmp2;
+ );
+ if(tmp1=="S",
+ size=tmp2;
+ if(substring(size,0,1)!="\",size="\"+size);
+ );
+ if(tmp1=="F",
+ font=tmp2;
+ if(substring(font,0,1)!="\",font="\"+font);
+ );
+ if(tmp1=="T", //180330
+ TitleName=tmp2;
+ );
+ );
+ TitleCmdL=["{"+size+font];
+ if(indexof(color,"[")>0,
+ tmp=replace(color,"[","{");
+ tmp=replace(tmp,"]","}");
+ tmp1=Indexall(tmp,",");
+ if(length(tmp1)>=3,
+ tmp="\color[cmyk]"+tmp;
+ ,
+ tmp="\color[rgb]"+tmp;
+ );
+ ,
+ tmp="\color{"+color+"}";
+ );
+ TitleCmdL=append(TitleCmdL,tmp);
+ TitleCmdL=concat(TitleCmdL,["","\begin{layer}{120}{"+layery+"}"]);
+ forall(1..(length(cmdL)),
+ tmp=cmdL_#;
+ if(length(tmp)>0,
+ if(#==1,
+ tmp="{\Huge \putnote"+tmp+"}"
+ ,
+ tmp="\putnote"+tmp;
+ );
+ TitleCmdL=append(TitleCmdL,tmp);
+ );
+ );
+ TitleCmdL=concat(TitleCmdL,["\end{layer}","","}"]);
+);
+
+Maketitle():=(
+ if(!isstring(TitleName), //17.04.13from
+ drawtext(mouse().xy,"Settitle not defined",
+ size->24,color->[1,0,0]);
+ , //17.04.13until
+ Maketitle(TitleName);
+ );
+);
+Maketitle(name):=(
+//help:Maketitle();
+ regional(texfile,texmain,tmp,tmp1,sep);
+ texfile=name;
+ texmain=name+"main";
+ SCEOUTPUT=openfile(texfile+".tex");
+ forall(TitleCmdL,
+ println(SCEOUTPUT,#);
+ );
+ closefile(SCEOUTPUT);
+ SCEOUTPUT=openfile(texmain+".tex");
+ tmp="\documentclass[landscape,10pt]{article}";
+ if(indexof(PathT,"platex")>0,
+ tmp=replace(tmp,"article","jarticle");
+ if(indexof(PathT,"uplatex")>0, //17.08.13from
+ tmp=replace(tmp,"jarticle","ujarticle");
+ );//17.08.13until
+ );
+ println(SCEOUTPUT,tmp);
+ tmp="\special{papersize=\the\paperwidth,\the\paperheight}";
+ println(SCEOUTPUT,tmp);
+ tmp=replace(Dirhead,"\","/");//17.11.01from
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ println(SCEOUTPUT,"\usepackage{ketpic,ketlayer,ketslide}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}");
+ );//17.11.01until
+ println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
+ println(SCEOUTPUT,"\usepackage{bm,enumerate}");
+ if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
+ println(SCEOUTPUT,"\usepackage{graphicx}");
+ ,
+ println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}");
+ );
+ println(SCEOUTPUT,"\usepackage[usenames]{xcolor}");
+ forall(ADDPACK,
+// if(indexof(#,"[")==0,
+// println(SCEOUTPUT,"\usepackage{"+#+"}");
+// ,
+ println(SCEOUTPUT,"\usepackage"+#); // 17.07.10
+// );
+ );
+ if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE");
+ println(SCEOUTPUT,tmp);
+ println(SCEOUTPUT,"\ketslideinit");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\begin{document}");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\input{"+texfile+".tex}");
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\end{document}");
+ closefile(SCEOUTPUT);
+ if(iswindows(),
+ Makebat(texmain,"tv");
+ ,
+ Makeshell(texmain,"tv");
+ );
+ kc();
+);
+
+Repeatsameslide(repeatflg,sestr,addedL):=(
+ regional(seL,flg1,ss,nn,nrep,tmp,tmp1,tmp2,tmp3,str,j,k);
+ // global RepeatList, SCEOUTPUT
+ nrep=length(RepeatList);
+ flg1=0;
+ forall(addedL,ss,
+ if(repeatflg==0,
+ if(substring(ss,0,1)!="%", //16.01.04
+ println(SCEOUTPUT,ss);
+ );//16.01.04
+ ,
+ forall(1..nrep,nn,
+ if(sestr=="",
+ RepeatList_nn=append(RepeatList_nn,ss);
+ );
+ );
+ if(sestr=="",
+ seL=[1];
+ ,
+ tmp1=substring(sestr,1,length(sestr)-1);
+ tmp1=replace(tmp1,",-",".."+text(nrep));
+ tmp1=replace(tmp1,"-,","1..");
+ tmp1="["+tmp1+"]"; //17.01.03
+ seL=flatten(parse(tmp1)); //17.01.03
+ );
+ if(contains(seL,1),
+ if(substring(ss,0,1)!="%", //16.01.04
+ println(SCEOUTPUT,ss);
+ );
+ seL=remove(seL,[1]);
+ flg1=1;
+ );
+ forall(1..(length(seL)),nn,
+ tmp=seL_nn;
+ if(tmp<=length(RepeatList), //17.01.12from
+ RepeatList_tmp=append( RepeatList_tmp,ss);
+ ,
+ println(" "+sestr+" : "+text(tmp)+" > "+text(length(RepeatList)));
+ );
+ );
+ if(ThinFlg==1,//16.01.05from
+ if(flg1==1,seL=append(seL,1));
+ seL=remove(1..nrep,seL);
+ str=ss; // 17.05.28from
+ repeat(10,
+ tmp1=Indexall(str,"{\color");
+ if(length(tmp1)>0,
+ tmp2=Indexall(str,"}");
+ tmp=select(tmp2,tmp1_1<#);
+ tmp=substring(str,tmp1_1,tmp_1);
+ str=replace(str,tmp+" ","");
+ str=replace(str,tmp,"");
+ );
+ );//17.05.28until
+ if(contains(seL,1),
+ if(substring(str,0,1)!="%",
+ if(NonThinFlg==0,
+ if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
+ println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23
+ println(SCEOUTPUT,str);
+ println(SCEOUTPUT,"}%");
+ ,
+ println(SCEOUTPUT,str);
+ );
+ );
+ if(NonThinFlg==1,
+ if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
+ println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23
+ );
+ println(SCEOUTPUT,str);
+ );
+ if(NonThinFlg==2,
+ println(SCEOUTPUT,str);
+ if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
+ println(SCEOUTPUT,"}%");
+ );
+ );
+ seL=remove(seL,[1]);
+ );
+ );
+ if(substring(ss,0,1)!="%", //16.01.04
+ forall(1..(length(seL)),nn,
+ tmp=seL_nn;
+ if(NonThinFlg==0,
+ tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23
+ tmp1=[tmp1,str,"}%"];
+ );
+ if(NonThinFlg==1,
+ tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23
+ tmp1=[tmp1,str];//17.01.08until
+ );
+ if(NonThinFlg==2,
+ tmp1=[str,"}%"];
+ );
+ RepeatList_tmp=concat( RepeatList_tmp,tmp1);
+ );
+ );
+ );//16.01.05until
+ );
+ );//16.12.05until
+);
+
+Presentation(texfile):=Presentation(texfile,texfile);
+Presentation(texfile,txtfile):=(
+//help:Presentation(texfile,txtfile);
+ regional(file,flgL,flg,verbflg,slideL,ns,slideorgL,wall,sld,slidecmd,tmp,tmp0,tmp1,
+ tmp2,tmp3,tmp4,tmp5,newoption,top,repeatflg,nrep,nrepprev,,repstr,
+ sestr,npara,paradt,parafiles,hyperflg,paractr,
+ letterc,boxc,shadowc,mboxc,sep);
+ slidecmd=["\ketcletter","\ketcbox","\ketdbox","\ketcframe",
+ "\ketcshadow","\ketdshadow","\slidetitlex","\slidetitlesize",
+ "\mketcletter","\mketcbox","\mketdbox","\mketcframe",
+ "\mslidetitlex","\mslidetitlesize"];
+ if(!isstring(BodyStyle),//17.01.06
+ BodyStyle="\Large\bf\boldmath";
+ );
+ repeatflg=0;
+ RepeatList=[];
+ paractr=0; //16.12.31
+ if(indexof(texfile,".")==0,file=texfile+".tex",file=texfile);
+ if(indexof(txtfile,".")==0,tmp1=txtfile+".txt",tmp1=txtfile);
+ tmp=load(tmp1);
+ tmp=replace(tmp,"////","||||");// 16.05.11, 06.24(reactivated)
+ slideL=tokenize(tmp,"//");
+ slideorgL=slideL; // 16.07.11
+ slideL=apply(slideL,Removespace(#));
+ tmp=select(1..length(slideL),length(slideL_#)>0); // 16.07.11from
+ slideL=apply(tmp,slideL_#);
+ slideorgL=apply(tmp,slideorgL_#);
+// slideL=select(slideL,length(#)>0); // 16.07.11until
+ flg=0; // 16.06.09from
+ forall(1..10,
+ if(flg==0,
+ if(substring(slideL_1,0,1)!="%",
+ flg=1;
+ ,
+ slideL=slideL_(2..length(slideL));
+ slideorgL=slideorgL_(2..length(slideorgL));
+ );
+ );
+ ); // 16.06.09until
+ flgL=[];
+ SCEOUTPUT = openfile(file);
+ tmp=tokenize(slideL_1,"::");
+ tmp1=tmp_1;
+ if(length(tmp)>1,
+ tmp2=tmp_2;
+ tmp3=tmp_(3..length(tmp));//16.06.25
+ ,
+ tmp2="";
+ tmp3=tmp_(2..length(tmp));//16.06.25
+ );
+ wall=""; // 16.06.10
+ if(length(tmp3)>0,//16.06.25from
+ tmp=substring(tmp3_1,0,1);//180330
+ if((tmp!="\")&(tmp!="%")&(indexof(tmp3_1,"=")==0), //180330
+ wall=tmp3_1;
+ tmp3=tmp3_(2..length(tmp3));
+ );
+ );//16.06.25until
+ tmp="%%% "+tmp1+" "+txtfile;// 16.06.09from
+ println(SCEOUTPUT,tmp);
+ tmp="\documentclass[landscape,10pt]{article}";
+ if(indexof(PathT,"platex")>0,
+ tmp=replace(tmp,"article","jarticle");
+ if(indexof(PathT,"uplatex")>0, //17.08.13from
+ tmp=replace(tmp,"jarticle","ujarticle");
+ );//17.08.13until
+ );
+ println(SCEOUTPUT,tmp);// 16.06.09from
+ tmp=select(1..(length(tmp3)),indexof(tmp3_#,"\usepackage")>0);//17.06.18from
+ forall(tmp,
+ println(SCEOUTPUT,tmp3_#);
+ );
+ tmp=remove(1..(length(tmp3)),tmp);
+ tmp3=tmp3_tmp;//17.06.18until
+// if(iswindows(),sep="\",sep="/"); // 17.04.08
+// sep="/";
+ if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
+ if(indexof(PathT,"lualatex")>0,
+ println(SCEOUTPUT,"\usepackage{luatexja}");
+ );
+ println(SCEOUTPUT,"\usepackage{pict2e}");
+ println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");// 17.04.08from
+ ,
+ println(SCEOUTPUT,"\special{papersize=\the\paperwidth,\the\paperheight}");
+ );// 17.04.08until
+ tmp=replace(Dirhead,"\","/");//17.11.01from
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
+ );
+ if(length(wall)==0,
+ tmp=replace(Dirhead,"\","/");//17.11.01from
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ println(SCEOUTPUT,"\usepackage{ketslide}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}");
+ );
+ ,
+ tmp=replace(Dirhead,"\","/");
+ tmp=replace(tmp,"scripts","tex/latex");
+ if(isexists(tmp,""),
+ println(SCEOUTPUT,"\usepackage{ketslide2}");
+ ,
+ tmp=replace(Dirhead+"/ketpicstyle","\","/");
+ println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide2}");
+ );
+ );//17.04.08until
+ println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
+ println(SCEOUTPUT,"\usepackage{bm,enumerate}");
+ if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
+ println(SCEOUTPUT,"\usepackage{graphicx}");
+ ,
+ println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}");
+ );
+// println(SCEOUTPUT,"\usepackage[usenames]{color}");
+// println(SCEOUTPUT,"\usepackage{color}");//17.06.14
+ println(SCEOUTPUT,"\usepackage{xcolor}");//17.07.31
+ letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
+ shadowc=[0,0,0,0.5]; mboxc="yellow";
+// if(!islist(SlideColorList), //17.03.02from
+// SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
+// letterc,mboxc,mboxc,mboxc,62,2,letterc];
+// , //17.03.02until
+ tmp4="abcdefghijklmno";
+ forall(1..15,
+ tmp=SlideColorList_#;
+ if(islist(tmp),
+ tmp=text(tmp);
+ tmp=substring(tmp,1,length(tmp)-1);
+ if(length(SlideColorList_#)==4,//17.01.07from
+ println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{cmyk}{"+tmp+"}");
+ );
+ if(length(SlideColorList_#)==3,
+ println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{rgb}{"+tmp+"}");
+ );//17.01.07until
+ SlideColorList_#="slidecolor"+tmp4_#;
+ );
+ );
+// ); //17.03.02
+ println(SCEOUTPUT,"\def\setthin#1{\def\thin{#1}}");//17.08.23
+ println(SCEOUTPUT,"\setthin{"+text(ThinDense)+"}");//17.08.23
+ forall(ADDPACK,// 16.06.09from
+// if(indexof(#,"[")==0, // 16.09.05from
+// println(SCEOUTPUT,"\usepackage{"+#+"}");
+// ,
+ println(SCEOUTPUT,"\usepackage"+#); //17.07.10
+// );
+ );// 16.06.09until
+ tmp=select(ADDPACK,indexof(#,"{hyperref}")>0);//16.12.31from
+ if(length(tmp)>0,
+ hyperflg=1;
+ ,
+ hyperflg=0; //16.12.31until
+ );
+ forall(tmp3,
+ println(SCEOUTPUT,#);
+ );
+ if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); // 16.06.09
+ println(SCEOUTPUT,tmp);
+ println(SCEOUTPUT,"\ketslideinit");
+ println(SCEOUTPUT,"");
+ forall(tmp, // 15.07.21
+ if(substring(#,0,1)=="\", println(SCEOUTPUT,#));
+ );
+ if(!isstring(PageStyle),PageStyle="headings");//17.04.09
+ println(SCEOUTPUT,"\pagestyle{"+PageStyle+"}");//17.04.09
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\begin{document}");
+ println(SCEOUTPUT,"");
+ if(length(wall)>0,
+ println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
+ println(SCEOUTPUT,"");
+ );
+ if(length(tmp2)>0,
+ if(indexof(tmp2," no")==0, // 16.11.11from
+ println(SCEOUTPUT,"\begin{layer}{120}{0}");
+ if(substring(tmp2,0,1)!="\",
+ tmp2="\putnotese{0}{0}{\input{fig/"+tmp2+".tex}}";//16.12.27
+ );
+ println(SCEOUTPUT,tmp2);
+ println(SCEOUTPUT,"\end{layer}");
+ println(SCEOUTPUT,"");
+ ,
+ tmp=indexof(tmp2,"=");
+ if(tmp==0,
+ top="10mm";
+ ,
+ top=substring(tmp2,tmp,length(tmp2));
+ );
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\vspace*{"+top+"}");
+ println(SCEOUTPUT,"");
+ ); // 16.11.11until
+ );
+ println(SCEOUTPUT,"\def\mainslidetitley{22}");
+ forall(1..14, //16.12.22from
+ tmp=SlideColorList_#;
+ if(!isstring(tmp),tmp=text(tmp));
+ if(length(tmp)>0,
+ tmp="\def"+slidecmd_#+"{"+tmp+"}";
+ println(SCEOUTPUT,tmp);
+ );
+ );//16.12.22until
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\color{"+SlideColorList_(15)+"}");
+ println(SCEOUTPUT,BodyStyle);//17.01.07
+ println(SCEOUTPUT,"\thispagestyle{empty}");//17.01.29
+ println(SCEOUTPUT,"\addtocounter{page}{-1}");//17.01.29
+ println(SCEOUTPUT,"");
+ verbflg=0; //16.06.28
+ repeatflg=0;//16.12.02
+ nrep=0;//16.12.27
+ nrepprev=0;//17.01.03
+ npara=0;//16.12.27
+ forall(2..length(slideL),ns,
+ ThinFlg=0;
+ NonThinFlg=0;
+ flg=0;
+ tmp1="";
+ tmp2="";
+ tmp3="";
+ sld=removespace(slideL_ns); // 16.06.28
+ sestr="";
+ if((substring(sld,0,1)=="%") & (substring(sld,0,2)!="%%"), // 17.06.23
+ Repeatsameslide(repeatflg,"",[slideL_ns]);
+ if(repeatflg>0,
+ tmp=indexof(sld,"]::");
+ if(tmp>0,
+ if(substring(sld,1,2)!="%",//17.05.31
+ if(substring(sld,1,5)=="thin", ThinFlg=1); // 17.05.28
+ sestr=substring(sld,1,tmp);
+ sld=substring(sld,tmp+2,length(sld));
+ tmp=indexof(sestr,"[");
+ sestr=substring(sestr,tmp-1,length(sestr));//17.01.05
+ );
+ );
+ );
+ if(substring(sld,1,7)=="repeat", // 16.12.09from
+ tmp=indexof(sld,"=");
+ tmp5=substring(sld,tmp,length(sld));
+ tmp=indexof(tmp5,",");
+ if(tmp>0,//17.01.03from
+ tmp5=substring(tmp5,0,tmp-1);
+ );//17.01.03until
+ repeatflg=1;
+ if(length(tmp5)>0,
+ nrep=parse(tmp5);
+ tmp=[];
+ if(length(wall)>0,
+ tmp=["","\input{fig/"+wall+".tex}"];
+ );
+ tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]);
+ RepeatList=apply(1..nrep,if(#==1,[],tmp));
+ );
+ if(sestr=="",flg=1);
+ tmp=indexof(sld,",");//17.01.03from
+ if(tmp>0,
+ sld="%"+substring(sld,tmp,length(sld));
+ if(indexof(sld,"=")==0,sld=sld+"=");
+ );//17.01.03until
+ );
+ if(substring(sld,1,5)=="para",
+ paractr=paractr+1;
+ repeatflg=1;
+ tmp=indexof(sld,"=");
+ tmp=substring(sld,tmp,length(sld));
+ if(length(tmp)==0, //17.01.03
+ npara=0;
+ ,
+ paradt=tokenize(tmp,":");
+ tmp=fileslist(Dirwork+"/fig/"+paradt_1);
+ if(length(tmp)>0,
+ parafiles=tokenize(tmp,",");
+ if(indexof(paradt_4,"input")>0,
+ tmp0=indexof(paradt_4,",");//17.01.29from
+ if(tmp0>0,
+ paradt=append(paradt,substring(paradt_4,tmp0,length(paradt_4)));
+ paradt_4=substring(paradt_4,0,tmp0-1);
+ );//17.01.29until
+ parafiles=select(parafiles,indexof(#,".tex")>0);
+ if(indexof(paradt_4,"\input")==0,paradt_4="\"+paradt_4);//16.12.17
+ );
+ if(indexof(paradt_4,"include")>0,
+ parafiles=select(parafiles,indexof(#,".pdf")>0);
+ );
+ npara=length(parafiles);
+ ,
+ println(Dirwork+"/fig/"+paradt_1+" not found");
+ parafiles=[];
+ npara=0;
+ );
+ if(nrep==0,
+ nrep=npara;
+ if(length(wall)>0,
+ tmp=["","\input{fig/"+wall+".tex}"];
+ );
+ tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]);
+ RepeatList=apply(1..nrep,if(#==1,[],tmp));
+ );
+ );
+ forall(1..nrep, //16.12.28
+ tmp4=[]; //16.12.31from
+ if(hyperflg>0,
+ tmp4=["\hypertarget{para"+text(paractr)+"pg"+text(#)+"}{}"];
+ );//16.12.31until
+ if(npara>0, //17.01.03
+ tmp4=concat(tmp4,["","\begin{layer}{120}"+paradt_2]);
+ if(#<=npara, //16.12.28from
+ tmp=parafiles_#;
+ ,
+ tmp=parafiles_npara;
+ );
+ tmp="{"+paradt_4+"{fig/"+paradt_1+"/"+tmp+"}}";
+ if(length(paradt)>=5,
+ tmp="{\scalebox{"+text(paradt_5)+"}"+tmp+"}";
+ );
+ if(substring(paradt_3,0,1)=="\",
+ tmp=paradt_3+tmp;
+ ,
+ tmp="\putnote"+paradt_3+tmp;
+ );
+ tmp4=concat(tmp4,[tmp]);//16.12.31
+ ,
+ tmp4=concat(tmp4,["","\begin{layer}{120}{0}"]);
+ );
+ if((hyperflg>0) & (LinkSize>0.15),
+ tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; // 17.01.12from
+ tmp1=tmp+text(paractr)+"pg";
+ tmp2=tmp+text(paractr-1)+"pg"+text(nrepprev);
+ if(#>1,tmp=tmp1+text(1),tmp=tmp2);
+ tmp3=[text(LinkPosH-29*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
+ +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
+ +"}{\scriptsize $\mathstrut|\!\lhd$}}}}}"];
+ if(#>1,tmp=tmp1+text(max(#-3,1)),tmp=tmp2);
+ tmp3=append(tmp3,
+ text(LinkPosH-24*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
+ +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
+ +"}{\scriptsize $\mathstrut\!\! \lhd\!\!\lhd\!$}}}}}");
+ if(#>1,tmp=tmp1+text(#-1),tmp=tmp2);
+ tmp3=append(tmp3,
+ text(LinkPosH-17*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
+ +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
+ +"}{\scriptsize $\mathstrut\!\!\lhd\!\!$}}}}}");
+ tmp="{"+text(LinkPosV)+"}{\hyperlink{para";
+ tmp2=tmp+text(paractr+1)+"pg"+text(1);
+ if(#<nrep,tmp=tmp1+text(#+1),tmp=tmp2);
+ tmp3=append(tmp3,
+ text(LinkPosH-10*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
+ +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
+ +"}{\scriptsize $\mathstrut\!\rhd\!$}}}}}");
+ if(#<nrep,tmp=tmp1+text(min(#+3,nrep)),tmp=tmp2);
+ tmp3=append(tmp3,
+ text(LinkPosH-5*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
+ +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
+ +"}{\scriptsize $\mathstrut\!\!\rhd\!\!\rhd\!$}}}}}");
+ if(#<nrep,tmp=tmp1+text(nrep),tmp=tmp2);
+ tmp3=append(tmp3,
+ text(LinkPosH)+"}"+tmp+"}{\fbox{\Ctab{" // 17.01.19
+ +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
+ +"}{\scriptsize $\mathstrut \!\rhd\!\!|$}}}}}");
+ tmp3=apply(tmp3,tmp,"\putnotew{"+tmp);
+ tmp4=concat(tmp4,tmp3);// 17.01.12untilr
+ tmp="\putnotew{"+text(LinkPosH)+"}{"+text(LinkPosV+6)+"}";//17.10.21from
+ tmp=tmp+"{\scriptsize\color{black} "+text(#)+"/"+text(nrep)+"}";
+ tmp4=append(tmp4,tmp);//17.10.21until
+ );
+ tmp4=concat(tmp4,["\end{layer}",""]);//16.12.31until
+ Repeatsameslide(repeatflg,text([#]),tmp4);
+ );
+ );
+ );
+ if(substring(sld,0,2)=="%%", //17.06.23from
+ println(SCEOUTPUT,sld);
+ flg=1;
+ ); //17.06.23until
+ if(flg==0,
+ if(indexof(sld,"\begin{verbatim}")==1, // 16.06.28from
+ Repeatsameslide(repeatflg,sestr,[slideL_ns]);
+ verbflg=1;
+ flg=1;
+ ); // 16.06.28
+ if(indexof(sld,"\end{verbatim}")==1,
+ Repeatsameslide(repeatflg,sestr,[slideL_ns]);
+ verbflg=0;
+ flg=1;
+ ); // 16.06.28until
+ if(flg==0,
+ tmp=replace(sld,"||||","//"); // 16.05.11
+ tmp=tokenize(tmp,"::"); // 16.05.11
+ tmp1=tmp_1;
+ if(length(tmp)>1,tmp2=tmp_2,tmp2="");
+ if(length(tmp)>2,tmp3=tmp_3,tmp3="");
+ if(length(tmp)>3,tmp4=tmp_4,tmp4="");
+ if(length(tmp)>4,tmp5=tmp_5,tmp5="");
+ if(contains(["main","new","same"],tmp1),
+ if(tmp1=="new", // 16.11.09from
+ newoption="";
+ if(substring(tmp2,0,1)=="[",newoption=tmp2);
+ );
+ if(tmp1=="same",
+ if(length(tmp2)==0,tmp2=newoption);
+ );// 16.11.09until
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"%%%%%%%%%%%%%%%%%%%%");
+ println(SCEOUTPUT,"");
+ );
+ );
+ if(flg==0&tmp1=="main",
+ if(repeatflg==1,
+ forall(2..(length(RepeatList)),nrep,
+ tmp=RepeatList_nrep;
+ forall(tmp,
+ if(substring(#,0,1)!="%", //16.01.04
+ println(SCEOUTPUT,#);
+ );
+ );
+ );
+ println(SCEOUTPUT,"");
+ repeatflg=0;RepeatList=[];
+ nrepprev=nrep;//17.01.03
+ nrep=0;//16.12.27
+ npara=0;//16.12.27
+ );
+ if(length(wall)>0,
+ println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
+ );
+ println(SCEOUTPUT,"\mainslide{"+tmp2+"}");
+ println(SCEOUTPUT,"");
+ tmp2="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="new",
+ if(repeatflg==1,
+ forall(2..(length(RepeatList)),nrep,
+ tmp=RepeatList_nrep;
+ forall(tmp,
+ if(substring(#,0,1)!="%", //16.01.04
+ println(SCEOUTPUT,#);
+ );
+ );
+ );
+ println(SCEOUTPUT,"");
+ repeatflg=0;RepeatList=[];
+ nrepprev=nrep;//17.01.03
+ nrep=0;
+ npara=0;
+ );
+ if(length(wall)>0,
+ Repeatsameslide(repeatflg,sestr,["\input{fig/"+wall+".tex}"]);
+ );
+ tmp="\newslide";
+ NewSlideOption=""; //17.01.04
+ if(substring(tmp2,0,1)=="[",
+ NewSlideOption=tmp2; //17.01.04
+ tmp=tmp+tmp2;
+ tmp2=tmp3;
+ tmp3=tmp4;
+ tmp4=tmp5;
+ );
+ tmp=tmp+"{"+tmp2+"}";
+ Repeatsameslide(repeatflg,sestr,[tmp,"","\vspace*{18mm}",""]);
+ tmp2="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="same",
+ if(repeatflg==1,
+ forall(2..(length(RepeatList)),nrep,
+ tmp=RepeatList_nrep;
+ forall(tmp,
+ if(substring(#,0,1)!="%", //16.01.04
+ println(SCEOUTPUT,#);
+ );
+ );
+ );
+ println(SCEOUTPUT,"");
+ repeatflg=0;RepeatList=[];
+ nrepprev=nrep;//17.01.03
+ nrep=0;
+ npara=0;
+ );
+ if(length(wall)>0,
+ println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
+ );
+ tmp="\sameslide"+NewSlideOption; //17.01.04;
+// if(substring(tmp2,0,1)=="[",
+// tmp=tmp+tmp2;
+// tmp2=tmp3;
+// tmp3=tmp4;
+// );
+ println(SCEOUTPUT,tmp);
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\vspace*{18mm}");
+ println(SCEOUTPUT,"");
+ tmp4=tmp3;
+ tmp3=tmp2;
+ tmp2="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="itemize",
+ Repeatsameslide(repeatflg,sestr,["\begin{itemize}"]);
+ flgL=append(flgL,"i");
+ tmp2="";
+ tmp3="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="enumerate",
+ Repeatsameslide(repeatflg,sestr,["\begin{enumerate}"+tmp2]);
+ flgL=append(flgL,"e");
+ tmp2="";
+ tmp3="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="verbatim", //16.06.28from
+ Repeatsameslide(repeatflg,sestr,["\begin{verbatim}"]);
+ flgL=append(flgL,"v");
+ tmp1="";
+ tmp2="";
+ tmp3="";
+ verbflg=1;
+ flg=1;
+ ); //16.06.28until
+ if(flg==0&tmp1=="layer",
+ Repeatsameslide(repeatflg,sestr,[""]);
+ tmp="\begin{layer}";
+ if(length(tmp2)>0,
+ tmp=tmp+tmp2;
+ ,
+ tmp=tmp+"{120}{0}";
+ );
+ Repeatsameslide(repeatflg,sestr,[tmp]);
+ flgL=append(flgL,"l");
+ tmp2="";
+ tmp3="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="putnote",
+ tmp="\putnote"+tmp2+"{";
+ if(indexof(tmp3,"include")==0,
+ tmp1=indexof(tmp3,",");
+ if(tmp1==0,
+ tmp=tmp+"\input{fig/"+tmp3+".tex}}";
+ ,
+ tmp2=substring(tmp3,tmp1,length(tmp3));
+ tmp3=substring(tmp3,0,tmp1-1);
+ tmp=tmp+"\scalebox{"+tmp2+"}{\input{fig/"+tmp3+".tex}}}";
+ );
+ ,
+ tmp2=indexof(tmp3,"[");
+ tmp3=substring(tmp3,tmp2-1,length(tmp3));
+ tmp=tmp+"\includegraphics"+tmp3+"{fig/"+tmp4+"}}";
+ );
+ Repeatsameslide(repeatflg,sestr,[tmp]);
+ tmp2="";
+ tmp3="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="item",
+ NonThinFlg=1;
+ Repeatsameslide(repeatflg,sestr,["\item"]);
+ tmp3="";
+ flg=1;
+ );
+ if(flg==0&tmp1=="end",
+ tmp=flgL_(length(flgL));
+ if(tmp=="i",
+ Repeatsameslide(repeatflg,sestr,["\end{itemize}"]);
+ );
+ if(tmp=="e",
+ Repeatsameslide(repeatflg,sestr,["\end{enumerate}"]);
+ );
+ if(tmp=="l",
+ Repeatsameslide(repeatflg,sestr,["\end{layer}",""]);
+ );
+ if(tmp=="v", // 16.06.28from
+ Repeatsameslide(repeatflg,sestr,["\end{verbatim}",""]);
+ verbflg=0;
+ ); // 16.06.28until
+ flgL=flgL_(1..(length(flgL)-1));
+ tmp2="";
+ tmp3="";
+ flg=1;
+ );
+ if(flg==0, // 16.06.28from
+ if(verbflg==0,
+ tmp2=tmp1;
+ ,
+ tmp2=slideorgL_ns; // 16.07.11
+ tmp2=replace(tmp2,"||","//"); // 16.07.10
+ tmp3="";
+ );
+ ); // 16.06.28until
+ if(length(tmp2)>0,
+ if(tmp2=="...", tmp2="");
+ if(NonThinFlg==1,NonThinFlg=2);
+ Repeatsameslide(repeatflg,sestr,[tmp2]);
+ );
+ if(length(tmp3)>0,
+ Repeatsameslide(repeatflg,sestr,["\begin{layer}{120}{0}"]);
+ if(substring(tmp3,0,1)=="{",
+ tmp=tmp3;
+ tmp3=tmp4;
+ ,
+ tmp="{60}{0}";
+ );
+ tmp1=indexof(tmp3,",");
+ if(tmp1==0,
+ tmp3="\putnotes"+tmp+"{\input{fig/"+tmp3+".tex}}";
+ ,
+ tmp2=substring(tmp3,tmp1,length(tmp3));
+ tmp3=substring(tmp3,0,tmp1-1);
+ tmp3="\putnotes"+tmp+"{\scalebox{"+tmp2+"}
+ {\input{fig/"+tmp3+".tex}}}";
+ );
+ Repeatsameslide(repeatflg,sestr,[tmp3,"\end{layer}",""]);
+ );
+ );
+ );
+ if(repeatflg==1,
+ forall(2..(length(RepeatList)),nrep,
+ tmp=RepeatList_nrep;
+ forall(tmp,
+ if(substring(#,0,1)!="%", //16.01.04
+ println(SCEOUTPUT,#);
+ );
+ );
+ );
+ println(SCEOUTPUT,"");
+ );
+ println(SCEOUTPUT,"");
+ println(SCEOUTPUT,"\end{document}");
+ closefile(SCEOUTPUT);
+);
+
+Mkslides():=(
+ regional(sep,parent,texparentorg,tmp,tmp1,tmp2,tmp3,tmp4,flg);
+ tmp4=Fhead;
+ Fhead="";
+ if(!iswindows(), //17.10.13
+ Dirwork=replace(Dirwork,"\",pathsep());
+ parent=replace(Dirwork+Shellparent,"\",pathsep());
+ ,
+ Dirwork=replace(Dirwork,"/",pathsep());
+ parent=replace(Dirwork+Batparent,"/",pathsep());// 16.05.29
+ );
+ Dirwork=replace(Dirwork,pathsep()+"fig","");
+ Setdirectory(Dirwork);
+ if(length(Texmain)>0, // 15.08.14 from
+ Texparent=Texmain;
+ );
+ texparentorg=Texparent; //17.04.10from
+ if(isstring(Slidename), // 15.08.14 from
+ Texparent=Slidename;
+ );//17.04.10until
+ if(!isexists(Dirwork,Texparent+".txt"), // 17.04.12from
+ drawtext(mouse().xy,Texparent+".txt not exist in "+Dirwork,
+ size->24,color->[1,0,0]);
+ , // 17.04.12until
+ Presentation(Texparent); // 15.08.14 until
+ if(iswindows(),
+ tmp2=Batparent;
+ parent=replace(Dirwork+Batparent,sep+"fig","");// 16.05.29
+ if(indexof(Pathpdf,"Adobe")>0, //17.12.09from
+ Makebat(Texparent,"ttv");
+ ,
+ Makebat(Texparent,"tv");
+ ); //17.12.09until
+ kc():=(
+ println("kc : "+kc(parent,Dirlib,Fnametex)); // 16.06.10, 17.02.19
+ );
+ kc();
+ Batparent=tmp2;
+ ,
+ tmp2=Shellparent;
+ parent=replace(Dirwork+Shellparent,sep+"fig","");// 16.05.29
+ Shellparent=replace(Shellparent,sep+"fig","");
+ if(indexof(Pathpdf,"Adobe")>0, //17.12.09from
+ Makeshell(Texparent,"ttv");
+ ,
+ Makeshell(Texparent,"tv");
+ ); //17.12.09until
+ kc():=(
+ println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); // 16.06.10
+ );
+ kc();
+ Shellparent=tmp2;
+ );
+ );
+ Dirwork=Dirwork+pathsep()+"fig"; //17.10.16
+ setdirectory(Dirwork);
+ Fhead=tmp4;
+ Texparent=texparentorg;//17.04.10
+);
+
+Mkslidesummary():=( // 17.10.26 for R
+ regional(texparentorg);
+ texparentorg=Texparent;
+ if(isstring(Slidename),
+ Texparent=Slidename;
+ );
+ Mkslidesummary(Texparent,Texparent+"digest",["m","Wait=3"]);
+ Texparent=texparentorg;
+);
+Mkslidesummary(fin,fout):=
+ Mkslidesummary(fin,fout,["m","Wait=3"]);
+Mkslidesummary(inputfile,outputfile,options):=(
+//help:Mkslidesummary(fin,fout,options);
+ regional(fin,fout,out,figflg,dirworkorg,dirtop,tmp);
+ dirworkorg=Dirwork;//17.04.10from
+ dirtop=replace(Dirwork,pathsep()+"fig","");
+ Changework(dirtop);//17.04.10uptp
+ fin=inputfile;
+ if(indexof(fin,".")==0,fin=fin+".tex");
+ fout=outputfile;
+ if(indexof(fout,".")==0,fout=fout+".tex");
+ cmdL=[
+ "Dt=readLines('"+fin+"')",[],
+ "num=grep('\\hypertarget',Dt,fixed=TRUE)",[],
+ "Dt=Dt[setdiff(1:length(Dt),num)]",[],
+ "Smain=c();Snew=c();Ssame=c()",[],
+ "for(J in 1:length(Dt)){",[],
+ " Tmp=length(grep('\\mainslide{',Dt[J],fixed=TRUE))",[],
+ " if(Tmp>0){Smain=c(Smain,1)}else{Smain=c(Smain,0)}",[],
+ " Tmp=length(grep('\\newslide{',Dt[J],fixed=TRUE))",[],
+ " if(Tmp>0){Snew=c(Snew,1)}else{Snew=c(Snew,0)}",[],
+ " Tmp=length(grep('\\sameslide',Dt[J],fixed=TRUE))",[],
+ " if(Tmp>0){Ssame=c(Ssame,1)}else{Ssame=c(Ssame,0)}",[],
+ "}",[],
+ "Nnew=c();Nsame=c()",[],
+ "for(J in 1:length(Dt)){",[],
+ " if((Snew[J]==1)|(Smain[J]==1)){Nnew=c(Nnew,J)}",[],
+ " if(Ssame[J]==1){Nsame=c(Nsame,J)}",[],
+ "}",[],
+ "Out=Dt[1:Nnew[1]]",[],
+ "for(J in Looprange(2,length(Nnew))){",[],
+ " Tmp=max(c(1,Nsame[Nsame<Nnew[J]]))",[],
+ " Tmp=max(c(Tmp,Nnew[J-1]))+1",[],
+ " Out=c(Out,Dt[Tmp:Nnew[J]])",[],
+ "}",[],
+ "Tmp=max(c(Nsame[-1],Nnew[-1]))+1",[],
+ "Out=c(Out,Dt[Tmp:length(Dt)])",[],
+ "writeLines(Out,'"+fout+"',sep='\n')",[],
+ "cat('////',file='resultR.txt',sep='')",[],
+ "quit()",[]
+ ];
+ CalcbyR("out",cmdL,append(options,"Cat=n"));
+ wait(1000);
+ Changework(dirtop);//17.04.10
+ tmp=replace(fout,".tex","");
+ if(iswindows(),
+ Makebat(tmp,"tv");
+ ,
+ Makeshell(tmp,"tv");
+ );
+ kc();
+ Changework(dirworkorg);//17.04.10
+);
+
+Example(exorg):=Example(exorg,"");
+Example(exorg,suborg):=(
+//help:Example("Mxfun","diff");
+ regional(ex,tmp,tmp1,tmp2);
+ ex=replace(exorg,"'",Dq);
+ sub=replace(suborg,"'",Dq);
+ setdirectory(Dirlib);
+ tmp=load("examples.txt");
+ setdirectory(Dirwork);
+ tmp=tokenize(tmp,"//");
+ tmp=tmp_(1..(length(tmp)-1));
+ tmp1=select(tmp,substring(#,0,length(ex))==ex);
+ tmp1=sort(tmp1);
+ if(length(sub)>0,
+ tmp1=select(tmp1,indexof(#,sub)>0);
+ );
+ forall(tmp1,
+ if((indexof(#,"##")>0) % (indexof(#,"~#")>0),
+ tmp=indexof(#,",");
+ println(substring(#,tmp,length(#)));
+ ,
+ println(#);
+ );
+ );
+);
+
+BBdata():=Bbdata(BBTarget,0);
+BBdata(fname):=Bbdata(fname,0); // 16.04.09
+BBdata(fname,optionorg):=(
+//help:BBdata(filename);
+//help:BBdata(options=0(automatic),1(make),"w=","h=");
+ regional(fout,flg,path,file,kcfile,options,eqL,reL,stL,
+ waiting,addop,tmp,tmp1,tmp2);
+ path="";
+ file=fname;
+ flg=0;
+ waiting=2;
+ forall(reverse(1..length(fname)),
+ if(flg==0,
+ tmp=substring(fname,#-1,#);
+ if(tmp=="/" % tmp=="\", // 14.01.15
+ path=substring(fname,0,#-1);
+ file=substring(fname,#,length(fname));
+ flg=1;
+ );
+ );
+ );
+ if(path=="",path=Dirwork);//16.10.05
+ if(indexof(file,".")==0,file=file+".pdf");
+ if(islist(optionorg),options=optionorg,options=[optionorg]);
+ tmp=divoptions(options);
+ eqL=tmp_5;
+ reL=tmp_6;
+ stL=tmp_7;
+ flg=0;
+ addop="";
+ if(length(reL)>0,
+ tmp=reL_1;
+ if(tmp==1,flg=1);
+ );
+ forall(stL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="M",flg=1);
+ );
+ forall(eqL,
+ tmp=indexof(#,"=");
+ tmp1=Toupper(substring(#,0,2));
+ tmp2=substring(#,tmp,length(#));
+ if(tmp1=="W=",
+ addop=addop+",width="+tmp2;
+ options=remove(options,[#]);
+ );
+ if(tmp1=="H=",
+ addop=addop+",height="+tmp2;
+ options=remove(options,[#]);
+ );
+ );
+ tmp=indexof(file,".");
+ tmp1=substring(file,0,tmp-1);
+ fout=tmp1+".txt";
+ if(iswindows(),
+ kcfile="kc.bat";
+ ,
+ kcfile="kc.sh";
+ );
+ if(flg==0,
+ tmp=load(fout); //
+ if(length(tmp)==0,
+ flg=1;
+ ,
+ tmp=tokenize(tmp,"%%");
+ tmp=tmp_2;
+ tmp1=indexof(tmp,":");
+ tmp=substring(tmp,tmp1,length(tmp));
+ tmp=Removespace(tmp);
+ if(tmp!=file,flg=1);
+ );
+ );
+ if(length(path)==0,
+ path=Dirwork;
+ );
+ if(flg==1,
+ setdirectory(path);
+ tmp=load(file);
+ setdirectory(Dirwork);
+ if(length(tmp)==0,
+ println(" => "+file+" not exists");
+ flg=-1;
+ );
+ );
+ if(flg==1,
+ SCEOUTPUT = openfile(kcfile);
+ if(!iswindows(),
+ println(SCEOUTPUT,"#!/bin/sh");
+ );
+ println(SCEOUTPUT,"cd "+Dq+path+Dq);
+ tmp=replace(PathT,"pdflatex","extractbb"); //16.11.22
+ tmp=replace(tmp,"pdftex","extractbb"); //16.11.22
+ tmp=replace(tmp,"xelatex","extractbb");
+ tmp=replace(tmp,"uplatex","extractbb"); //17.09.20
+ tmp=replace(tmp,"platex","extractbb");
+ tmp=replace(tmp,"latex","extractbb");
+ tmp=tmp+" -O "+file;
+ if(iswindows(),
+ tmp=tmp+" > "+Dirwork+"\"+fout;
+ ,
+ tmp=tmp+" > "+Dirwork+"/"+fout;
+ );
+ println(SCEOUTPUT,tmp);
+ println(SCEOUTPUT,"exit 0");
+ closefile(SCEOUTPUT);
+ kc(Dirwork+"/"+kcfile,Mackc+Dirlib,Fnametex); // 16.06.07
+ );
+ if(flg>=0,
+ tmp1=0;
+ repeat(floor(waiting*1000/WaitUnit),
+ if(tmp1==0,
+ wait(10);
+ tmp=load(fout);
+ if(indexof(tmp,"CreationDate")>0,
+ tmp1=1;
+ );
+ );
+ );
+ if(length(tmp)==0,
+ println(fout+" not generated. Maybe "+kcfile+" not run.");
+ ,
+ tmp=tokenize(tmp,"%%");
+ tmp=select(tmp,indexof(#,"Bounding")>0);
+ tmp=tmp_2; //
+ tmp1=indexof(tmp,":");
+ tmp=substring(tmp,tmp1,length(tmp));
+ tmp=removespace(tmp);
+ tmp=tokenize(tmp," ");
+ tmp1="";
+ forall(tmp,
+ tmp1=tmp1+Sprintf(#,2)+" ";
+ );
+ tmp1=removespace(tmp1)+addop;
+ tmp2="\includegraphics[bb="+tmp1+"]{"+file+"}";
+ println(tmp2);
+ );
+ );
+// setdirectory(Dirwork);
+ tmp2; // 16.04.25
+);
+
+//help:end();
+
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt
index 437bdefd..0c89e3e7 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt
@@ -24,9 +24,8 @@
//help:Integrate*(numerical integration);
//help:Findarea*(calculate the area of the region surrounded by a closed curve);
//help:Findlength*(calculate the length of curve);
-//help:Com2nd*(add the Scilab command to write out plot data into TeX);
+//help:Com2nd*(add the R command to write out plot data into TeX);
//help:Texcom*(write command into TeX output exactly as written here);
-//help:SetEnglish*(display Scilab messages in English language);
//help:Setunitlen*(specify the unit length);
//help:Setmarklen*(specify the unit length of the tickmarks on coordinate axis);
//help:Setorigin*(specify the position the origin);
@@ -107,8 +106,8 @@
//help:PutcoL*(write letters in a specific column of the table));
//help:PutcoLexpr*(write mathematical expressions in a specific column of the table));
//help:Setwindow*(specify the area of drawing);
-//help:Defvar*(the definition of a variable is called by Scilab);
-//help:Deffun*(the definition of a function is called by Scilab);
+//help:Defvar*(the definition of a variable is called by R);
+//help:Deffun*(the definition of a function is called by R);
//help:Extractdata*(endow attribute to the imported plot data);
//help:ReadOutData*(import the plot data);
//help:WriteOutData*(export the plot data);
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt
index 330a47c4..93e5e323 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt
@@ -26,7 +26,6 @@
//help:Findlength*(曲線の長さ);
//help:Com2nd*(TeXの書き出しコマンドを入れる);
//help:Texcom*(TeXのコマンドを直接記述);
-//help:SetEnglish*(Scilabのメッセージを英語にする);
//help:Setunitlen*(単位長を指定);
//help:Setmarklen*(微小単位長を指定);
//help:Setorigin*(原点の位置を指定);
@@ -107,8 +106,8 @@
//help:PutcoL*(表の列に文字を書き入れる));
//help:PutcoLexpr*(表の列に数式を書き入れる));
//help:Setwindow*(描画領域を指定);
-//help:Defvar*(変数をScilabに渡す);
-//help:Deffun*(関数をScilabに渡す);
+//help:Defvar*(変数をRに渡す);
+//help:Deffun*(関数をRに渡す);
//help:Extractdata*(読み込んだデータに属性を与える);
//help:ReadOutData*(データを読み込む);
//help:WriteOutData*(データを書き出す);
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs
index 5cc91de2..e9978e7b 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs
@@ -14,7 +14,7 @@
// along with this program. If not, see <http://www.gnu.org/licenses/>
//
-println("ketcindymv(2017.11.24) loaded");
+println("ketcindymv(20171124) loaded");
//help:start();
@@ -132,7 +132,7 @@ Parafolder(path,fstr,sLorg,optionorg):=(
repeat(1..30,
if(length(fileslist(tmp))>0,wait(10));
);
- );//17.02.20upto
+ );//17.02.20until
);
sfL=[];
forall(1..(length(sL)),nn,
@@ -255,7 +255,7 @@ Animatefile(path,folder):=(
,
tmp="\scalebox{\figsize}{\input{\parapath/";//17.12.07
tmp=tmp+folder+"/"+tmp1_#+"}}%";
- ); // 17.08.30upto
+ ); // 17.08.30until
println(SCEOUTPUT,tmp);
// println(SCEOUTPUT,""); //17.06.25
if(#<length(tmp1),
@@ -272,7 +272,7 @@ Mkanimation():=(
if(!isexists(Dirwork,ParaPath), //17.10.14from
Parafolder();
);
- Animatefile(); //17.10.14upto
+ Animatefile(); //17.10.14until
Mkanimation(Dirwork,ParaPath);
);
Mkanimation(folder):=Mkanimation(Dirwork,folder);
@@ -295,7 +295,7 @@ Mkanimation(path,folder):=(
if(tmp1=="T",
title=tmp2;
);
- ); //17.11.25upto
+ ); //17.11.25until
Fheadbkup=Fhead;
Fhead="animate"+folder;
Pathpdfbkup=Pathpdf;
@@ -306,7 +306,7 @@ Mkanimation(path,folder):=(
tex=substring(tmp1,tmp_(length(tmp)),length(tmp1));
,
tex=tmp1;
- );//17.10.14upto
+ );//17.10.14until
if((tex=="platex")%(tex=="uplatex"),
if(tex=="platex",article="jarticle",article="ujarticle");
,
@@ -441,7 +441,7 @@ Mkflipanime(path,folder):=(
if(tmp1=="T",
title=tmp2;
);
- ); //17.11.25upto
+ ); //17.11.25until
Fheadbkup=Fhead;
Fhead="flipanime"+folder;
tmp1=replace(PathT,pathsep(),"/");
@@ -450,7 +450,7 @@ Mkflipanime(path,folder):=(
tex=substring(tmp1,tmp_(length(tmp)),length(tmp1));
,
tex=tmp1;
- );//17.10.14upto
+ );//17.10.14until
if((tex=="platex")%(tex=="uplatex"),
if(tex=="platex",article="jarticle",article="ujarticle");
,
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt
index 2050e5fe..94752a33 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt
@@ -1,3 +1,24 @@
+// 2018.03.27
+// functions of C changed
+// CalcbyC added
+// Sfbdparadata,Crvsfparadata added
+// 2018.03.24
+// WriteCdata changed ( 99999 )
+// 2018.03.03
+// ConvertFdtoC changed ( varnames converted to u,v )
+// 2018.03.01
+// Cform,ConvertFdtoC added
+// 2018.02.27
+// Rfun debugged
+// 2018.02.22
+// CalcbyR changed (adding ".txt" to wfile)
+// 2018.02.20
+// CalcbyR changed (Quick return of Erromessage)
+// 2018.02.12
+// MkprecommandR changed ( for GLIST )
+// 2018.02.11
+// Mkprecommand debugged
+// CalcbyR debugged ("ans" replaced to name )
// 2018.02.01
// CalcbyR changed (for matrix, wait=5 )
// 2018.01.31
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs
index 233a723a..1bb3e343 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs
@@ -14,7 +14,7 @@
// along with this program. If not, see <http://www.gnu.org/licenses/>
//
-println("ketcindyout(2018.02.01) loaded");
+println("ketcindyout(20180327) loaded");
//help:start();
@@ -36,10 +36,10 @@ WritetoS(fname,cmdL):=(
println(SCEOUTPUT,tmp);
tmp="Setwindow([XMIN,XMAX],[YMIN,YMAX]);"; // 16.06.26from
tmp=Assign(tmp,["XMIN",XMIN,"XMAX",XMAX,"YMIN",YMIN,"YMAX",YMAX]);
- println(SCEOUTPUT,tmp); // 16.06.26upto
+ println(SCEOUTPUT,tmp); // 16.06.26until
if(iswindows(), // 17.01.11from
println(SCEOUTPUT,"setlanguage('en')");
- ); // 17.01.11upto
+ ); // 17.01.11until
tmp="pi=%pi;////";
println(SCEOUTPUT,tmp);
forall(cmdL,
@@ -234,7 +234,7 @@ CalcbyS(name,path,cmd,optionorg):=(
if(tmp1=="FI", // 16.06.26from
wfile=tmp2;
options=remove(options,[#]);
- ); // 16.06.26upto
+ ); // 16.06.26until
);
if(wfile=="",
if(cat=="Y",
@@ -245,7 +245,7 @@ CalcbyS(name,path,cmd,optionorg):=(
);
if(indexof(wfile,".")==0,// 16.06.26from
wfile=wfile+ext;
- ); // 16.06.26upto
+ ); // 16.06.26until
wflg=0;
forall(strL,
tmp=Toupper(substring(#,0,1));
@@ -310,7 +310,7 @@ CalcbyS(name,path,cmd,optionorg):=(
tmp=textformat(#,dig);
tmp=replace(tmp,"],[","];[");
tmp3=tmp3+tmp+",";
- ); // 15.11.01 upto
+ ); // 15.11.01 until
);
);
tmp3=substring(tmp3,0,length(tmp3)-1)+tmp4+",";
@@ -343,10 +343,10 @@ CalcbyS(name,path,cmd,optionorg):=(
tmp=append(tmp,"mclose(Fd);");
cmdlist=concat(cmdlist,tmp);
// tmp="fprintfMat("+Dq+file+".txt"+Dq+","+name+")";
-// cmdlist=append(cmdlist,tmp); // 16.03.11 upto
+// cmdlist=append(cmdlist,tmp); // 16.03.11 until
,
// tmp="mputl(['????'],"+Dq+file+".txt"+Dq+");"; // 16.06.2 from
-// cmdlist=concat(cmdlist,[tmp]); // 16.06.2 upto
+// cmdlist=concat(cmdlist,[tmp]); // 16.06.2 until
);
if(cat!="Y", // 16.12.18
cmdlist=append(cmdlist,"mputl('||||','"+wfile+"')");
@@ -656,7 +656,7 @@ CalcbyR(name,Arg1,Arg2):=(
);
CalcbyR(name,path,cmd,optionorg):=(
//help:CalcbyR(name,cmd);
-//help:CalcbyR(options=["m/r","Wait=2","Out=yes","Pre=yes","File=result" ]);
+//help:CalcbyR(options=["m/r","Wait=2","Out=yes","Pre=yes","Res=" ]);
regional(options,tmp,tmp1,tmp2,tmp3,realL,strL,eqL,
cat,dig,preflg,flg,wflg,file,nc,arg,cmdR,cmdlist,wfile,waiting);
options=optionorg;
@@ -692,7 +692,11 @@ CalcbyR(name,path,cmd,optionorg):=(
options=remove(options,[#]);
);
if(tmp1=="F",
- wfile=tmp2;
+ wfile=tmp2; //18.02.27
+ options=remove(options,[#]);
+ );
+ if(tmp1=="R",
+ wfile=tmp2; //180227
options=remove(options,[#]);
);
);
@@ -700,7 +704,7 @@ CalcbyR(name,path,cmd,optionorg):=(
if(cat=="Y",
wfile=Fhead+name+".txt";
,
- wfile="resultR.txt";
+ wfile="result.txt";
);
);
wflg=0;
@@ -726,11 +730,11 @@ CalcbyR(name,path,cmd,optionorg):=(
if(preflg==1, //18.01.27from
cmdR=MkprecommandR();
);
- cmdR=concat(cmdR,cmd); //18.01.27upto
+ cmdR=concat(cmdR,cmd); //18.01.27until
cmdlist=[];
if(dig>5, //16.10.28from
cmdlist=append(cmdlist,"options(digits="+text(dig+2)+");");
- ); //16.10.28upto
+ ); //16.10.28until
forall(1..floor(length(cmdR)/2),nc, //17.05.18
tmp1=cmdR_(2*nc-1);
tmp1=replace(tmp1,LFmark,""); // 16.06.12
@@ -790,10 +794,10 @@ CalcbyR(name,path,cmd,optionorg):=(
cmdlist=append(cmdlist,"if(is.matrix("+name+")){");
cmdlist=append(cmdlist," tmp=list()");//18.02.01from
cmdlist=append(cmdlist," for(ii in 1:Length("+name+")){");
- cmdlist=append(cmdlist," tmp=c(tmp,list(Op(ii,ans)))");
+ cmdlist=append(cmdlist," tmp=c(tmp,list(Op(ii,"+name+")))");
cmdlist=append(cmdlist," }");
- cmdlist=append(cmdlist," ans=tmp");
- cmdlist=append(cmdlist,"}");//18.02.01upto
+ cmdlist=append(cmdlist," "+name+"=tmp");
+ cmdlist=append(cmdlist,"}");//18.02.01until
cmdlist=append(cmdlist,"if(is.list("+name+")){");
// tmp=" cat(names("+name+"),file='"+wfile+"',sep=',')"; //18.01.27deleted
// cmdlist=append(cmdlist,tmp);
@@ -805,7 +809,7 @@ CalcbyR(name,path,cmd,optionorg):=(
cmdlist=append(cmdlist,tmp);
tmp=" cat(sharps,file='"+wfile+"',sep='',append=TRUE)";
cmdlist=append(cmdlist,tmp);
- tmp=" for(jj in Looprange(1,length(ans[[ii]]))){";
+ tmp=" for(jj in Looprange(1,length("+name+"[[ii]]))){";
cmdlist=append(cmdlist,tmp);
tmp=" cat("+name+"[[ii]][[jj]],file='"+wfile+"',sep=',',append=TRUE)";
cmdlist=append(cmdlist,tmp);
@@ -833,7 +837,7 @@ CalcbyR(name,path,cmd,optionorg):=(
cmdlist=append(cmdlist,"}");
tmp="cat('////',file='"+wfile+"',sep=',',append=TRUE)";
cmdlist=append(cmdlist,tmp);
- ); //16.10.23upto
+ ); //16.10.23until
if(cat!="Y", // 16.12.18
cmdlist=append(cmdlist,"cat('////',file='"+wfile+"',sep='')");
);
@@ -862,6 +866,9 @@ CalcbyR(name,path,cmd,optionorg):=(
closefile(SCEOUTPUT);
);
WritetoR(file+".r",cmdlist); //17.10.08
+ SCEOUTPUT=openfile("errormessageR.txt");//18.02.20from
+ println(SCEOUTPUT,"");
+ closefile(SCEOUTPUT);//18.02.20until
kcR(PathR,file,concat(options,["m"])); // 15.09.25
);
flg=0;
@@ -881,6 +888,11 @@ CalcbyR(name,path,cmd,optionorg):=(
flg=-1;
,
wait(WaitUnit);
+ tmp=load("errormessageR.txt");//18.02.20
+ if(length(tmp)>1,
+ println(tmp);
+ flg=-2;
+ );//18.02.20
);
);
);
@@ -890,10 +902,10 @@ CalcbyR(name,path,cmd,optionorg):=(
if(flg==-1,
println(wfile+" does not exist");
,
- tmp="("+text(waiting)+" s )";
- println(wfile+" not generated "+tmp);
- tmp=load("errormessageR.txt");//16.10.22
- if(length(tmp)>1,println(tmp));//16.10.22
+ if(flg==0,
+ tmp="("+text(waiting)+" s )";
+ println(wfile+" not generated "+tmp);
+ );
);
,
println(" CalcbyR succeeded "+name+" ("+text(tmp2)+" sec)");
@@ -906,9 +918,13 @@ CalcbyR(name,path,cmd,optionorg):=(
tmp=format(tmp3,dig);
,
if(indexof(tmp3,",")==0,
- tmp=tmp3;
+ tmp=Dqq(tmp3); //180227
,
- tmp=tokenize(tmp3,",");
+ tmp=tmp3;
+ if(substring(tmp3,0,2)=="c(",
+ tmp=substring(tmp3,2,length(tmp3)-1);
+ );
+ tmp=tokenize(tmp,",");
tmp=textformat(tmp,dig);
);
);
@@ -918,9 +934,10 @@ CalcbyR(name,path,cmd,optionorg):=(
tmp2=tmp2_1;
if(length(tmp2)==1,tmp2=tmp2_1);
if(isstring(tmp2),
- if(indexof(tmp2,"nodata")>0,tmp2=[]);
+ if(indexof(tmp2,"nodata")>0,tmp2="[]"); //180227from
+ tmp2=parse(tmp2);
);
- tmp=name+"="+textformat(tmp2,dig);
+ tmp3=textformat(tmp2,dig);//180227until
,
tmp3="";
forall(tmp2,
@@ -934,7 +951,7 @@ CalcbyR(name,path,cmd,optionorg):=(
tmp3=replace(tmp3,"[,","[");
tmp3=replace(tmp3,",]","]");
);
- tmp=name+"="+tmp3;
+ tmp=name+"="+tmp3;//180227
parse(tmp);
);
);
@@ -970,7 +987,7 @@ Rfun(name,fun,argL,optionorg):=(
);
cmdL=[];
cmdL=concat(cmdL,[
- nm+"="+fun,argL
+ nm+"="+fun,argL,
]);
options=concat(options,["Wait=2"]);
CalcbyR(nm,cmdL,options);
@@ -1077,7 +1094,7 @@ Readcsv(pathorg,file,optionorg):=(
"writeLines",["tmp2",Dq+fout+Dq]
];
CalcbyR("sep",cmdL,concat(options,["Cat=n"]));
- ); // 16.12.20upto
+ ); // 16.12.20until
if(ErrFlag==1,
println("Readcsv not completed");
,
@@ -1088,7 +1105,7 @@ Readcsv(pathorg,file,optionorg):=(
if(indexof(dt_1,",")==0,csv="N");
,
csv="N";
- );// 17.02.10upto
+ );// 17.02.10until
if(csv=="Y",
dt=apply(dt,tokenize(#,","));
,
@@ -1136,7 +1153,7 @@ Writecsv(nmL,dataorg,file,optionorg):=(
if(islist(data_1),
ncol=length(data_1);
data=flatten(data);
- ); // 17.02.09upto
+ ); // 17.02.09until
options=optionorg;
tmp=divoptions(options);
eqL=tmp_5;
@@ -1434,7 +1451,7 @@ Boxplot(nm,dataorg,ypos,dy,optionorg):=(
);
setdirectory(tmp3);
tmp=load(tmp4);
- if(length(tmp)==0, ErrFlag=2); // 15.11.07 upto
+ if(length(tmp)==0, ErrFlag=2); // 15.11.07 until
setdirectory(Dirwork);
,
file=Fhead+name+".dat";
@@ -1617,7 +1634,7 @@ Histplot(nm,dataorg,optionorg):=(
);
setdirectory(tmp3);
tmp=load(tmp4);
- if(length(tmp)==0, ErrFlag=2); // 15.11.07 upto
+ if(length(tmp)==0, ErrFlag=2); // 15.11.07 until
setdirectory(Dirwork);
,
file=Fhead+name+".dat";
@@ -1897,6 +1914,8 @@ MkprecommandR(prec):=(
cmdL=concat(cmdL,[Plist_#,[]]);
);
tmp2=sort(apply(VLIST,#_1)); // 16.02.03 from
+ tmp=apply(allpoints(),text(#));//18.02.11
+ tmp2=remove(tmp2,tmp);
tmp1=[];
forall(tmp2,tmp,
tmp1=concat(tmp1,select(VLIST,#_1==tmp));
@@ -1919,7 +1938,7 @@ MkprecommandR(prec):=(
tmp1=RSform(tmp1);
tmp1=tmp+"="+tmp1+";";
tmp1=tmp1+"Assignadd('"+tmp+"',"+tmp+")";
- cmdL=concat(cmdL,[tmp1,[]]);//17.09.24upto
+ cmdL=concat(cmdL,[tmp1,[]]);//17.09.24until
);
forall(OutFileList,
cmdL=concat(cmdL,["tmp=ReadOutData",[Dq+#+Dq]]);
@@ -1928,12 +1947,15 @@ MkprecommandR(prec):=(
cmdL=concat(cmdL,[#,[]]);
);
forall(GLIST,
- tmp1=Rform(#);
- cmdL=concat(cmdL,[tmp1,[]]);
+ if(indexof(#,"ReadOutData")==0, //18.02.12
+ tmp1=Rform(#);
+ cmdL=concat(cmdL,[tmp1,[]]);
+ );
);
cmdL;
);
+
MkprecommandS():=MkprecommandS(6);
MkprecommandS(prec):=(
regional(cmdL,Plist,Pnamelist,Pvaluelist,tmp,tmp1,tmp2);
@@ -1959,7 +1981,7 @@ MkprecommandS(prec):=(
forall(tmp2,tmp,
tmp1=concat(tmp1,select(VLIST,#_1==tmp));
);
- VLIST=tmp1;// 16.02.03 upto
+ VLIST=tmp1;// 16.02.03 until
forall(VLIST,
tmp=Sciform(#_1);
tmp1=#_2; // 15.02.06
@@ -1981,7 +2003,7 @@ MkprecommandS(prec):=(
tmp2=tmp2+#+",";
);
tmp1=substring(tmp2,0,length(tmp2)-1)+")";
- ); // 16.11.14upto
+ ); // 16.11.14until
,
tmp1=format(tmp1,prec);
);
@@ -1997,7 +2019,7 @@ MkprecommandS(prec):=(
);
forall(FUNLIST, // 16.02.17 from
cmdL=concat(cmdL,[#,[]]);
- ); // 16.02.17 upto
+ ); // 16.02.17 until
forall(GLIST,
tmp1=Sciform(#);
cmdL=concat(cmdL,[tmp1,[]]);
@@ -2079,7 +2101,7 @@ PlotdataS(nm,fun,variable,optionorg):=(
);
options=append(options,"Wait="+text(waiting));
if(wflg==1,options=append(options,"m"));
- if(wflg==-1,options=append(options,"r"));// 16.03.02 upto
+ if(wflg==-1,options=append(options,"r"));// 16.03.02 until
if(ErrFlag==0,
CalcbyS(name,cmdL,concat(options,["cat=middle","Wait="+text(waiting)]));
);
@@ -2101,96 +2123,6 @@ PlotdataS(nm,fun,variable,optionorg):=(
);
);
-Implicitplot(nm,fun,varx,vary):=
- Implicitplot(nm,fun,varx,vary,[]);
-Implicitplot(nm,fnorg,varx,vary,optionorg):=(
-//help:Implicitplot("1","3*x^2+y^2=1","x=[-3,3]","y=[-3,3]");
-//help:Implicitplot(options2=["Wait=10","Out=no","Mx=no"]);
- regional(options,name,fun,waiting,mxcheck,outreg,
- eqL,reL,strL,fname,var,rng,val,tmp,tmp1,tmp2,cmdL,flg,wflg);
- name="imp"+nm;
- fname=Fhead+name+".txt";
- fun=fnorg;
- tmp=indexof(fun,"=");
- if(tmp>0,
- tmp1=substring(fun,0,tmp-1);
- tmp2=substring(fun,tmp,length(fun));
- fun=tmp1+"-("+tmp2+")";
- );
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5;
- reL=tmp_6;
- strL=tmp_7;
- waiting=5; // 16.02.29
- mxcheck=0; // 16.02.29
- outreg=0;
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=substring(#,tmp,length(#));
- if(tmp1=="WA",
- waiting=parse(tmp2);
- options=remove(options,[#]);
- );
- if(tmp1=="OU",
- tmp=Toupper(substring(tmp2,0,1));
- if(tmp=="T" % tmp=="Y", outreg=1);
- options=remove(options,[#]);
- );
- if(tmp1=="MX",
- tmp=Toupper(substring(tmp2,0,1));
- if(tmp=="T" % tmp=="Y", mxcheck=1);
- options=remove(options,[#]);
- );
- );
- wflg=0;
- forall(strL,
- tmp=Toupper(substring(#,0,1));
- if(length(#)==0,
- options=remove(options,[#]);
- );
- if(tmp=="M",
- wflg=1;
- options=remove(options,[#]);
- );
- if(tmp=="R",
- wflg=-1;
- options=remove(options,[#]);
- );
- );
- tmp1=Testfunstr(fun,varx,vary);
- tmp=apply([fun,varx,vary],Dq+Rsform(#)+Dq); //17.09.30
-// tmp_1=RSform(tmp_1);
- tmp=concat(tmp,reL);
-// tmp=append(tmp,"Error"); // 16.02.29
- cmdL=MkprecommandR();//17.09.30
- cmdL=concat(cmdL,[
-// "evstr",[tmp1,"Error"],
- name+"=Implicitplot",tmp, // 16.03.15
- "WriteOutData",[Dq+fname+Dq,Dq+name+Dq,name]
- ]);
- options=concat(options,["Wait="+text(waiting),"Cat=n"]);
- if(wflg==1,options=append(options,"m"));
- if(wflg==-1,options=append(options,"r"));
- CalcbyR(name,cmdL,options);
- if(ErrFlag==1,
- println(" Implicitplot not completed");
- ,
- if(outreg==1,
- OutFileList=remove(OutFileList,[fname]);
- OutFileList=append(OutFileList,fname);
- );
- ReadOutData(fname);
- Extractdata(name,options);
- tmp=parse(name);
- tmp1=name+"="+textformat(tmp,5);
- parse(tmp1);
- tmp2=apply(tmp,Lcrd(#));
- tmp2;
- );
-);
-
Dotfilldata(nm,iostr,pltlist):=
Dotfilldata(nm,iostr,pltlist,[]);
Dotfilldata(nm,iostr,pltlist,optionorg):=(
@@ -2320,12 +2252,12 @@ WritetoA(fname,cmdL):=(
tmp="/*####*/"; // 16.03.11
println(SCEOUTPUT,tmp);
tmp="output("+Dq+wfilename+Dq+")$/*##*/"; // 16.05.18from
- println(SCEOUTPUT,tmp); // 16.05.18upto
+ println(SCEOUTPUT,tmp); // 16.05.18until
forall(1..(length(cmdL)),
tmp1=cmdL_#;
tmp=indexof(tmp1,";"); // 16.05.18from
if(tmp>0,endmark=";",endmark="$");
- tmp1=replace(tmp1,";",""); // 16.05.18upto
+ tmp1=replace(tmp1,";",""); // 16.05.18until
if(#==length(cmdL)-1,
println(SCEOUTPUT,tmp1+";/*##*/");
,
@@ -2576,7 +2508,7 @@ CalcbyA(name,cmd,optionorg):=(
);
tmp=Indexof(tmp1,"/start/,"); // 16.05.18from
tmp1="["+Dq+substring(tmp1,tmp+7,length(tmp1)-1)+"]";
- // 16.05.18upto
+ // 16.05.18until
// tmp1=substring(tmp1,0,length(tmp1)-1)+"]";
parse(name+"="+tmp1);
tmp=parse(name);
@@ -2634,7 +2566,7 @@ AsirfunO(name,fun,argLorg,options):=(
);
);
);
- ); // 16.05.26upto
+ ); // 16.05.26until
Asirfun(name,"os_md."+fun,argL,options);
);
Asirfun(name,fun,argL):=Asirfun(name,fun,argL,[]);
@@ -2727,7 +2659,7 @@ Asirfun(name,fun,argL,optionorg):=(
println(parse(nm));
);
);
- out; //16.05.26upto
+ out; //16.05.26until
);
WritetoM(fname,cmdL,allflg):=(
@@ -3051,7 +2983,7 @@ CalcbyM(name,cmd,optionorg):=(
if(tmp>0,
println("Some error(s) occurred"); //2016.02.24 from
tmp2=tokenize(tmp1,"(%");
- forall(4..length(tmp2),println(tmp2_#)); //2016.02.24 upto
+ forall(4..length(tmp2),println(tmp2_#)); //2016.02.24 until
flg=2; //2016.02.23
,
if(indexof(tmp1,"closefile()")>0, // 15.11.24
@@ -3071,7 +3003,7 @@ CalcbyM(name,cmd,optionorg):=(
tmp4=append(tmp4,tmp3);
tmp0=1;
);
- );// 16.04.26upto
+ );// 16.04.26until
);
);
num="1234567890+-.";
@@ -3481,7 +3413,7 @@ Mkviewobj(Arg1,Arg2,Arg3):=(
if(!isstring(OCNAME), //17.04.13from
drawtext(mouse().xy,"Mkobjcmd not defined",
size->24,color->[1,0,0]);
- , //17.04.13upto
+ , //17.04.13until
if(islist(Arg2),
Mkviewobj(Dirwork,Arg1,Arg2,Arg3);
,
@@ -3529,7 +3461,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=(
if(tmp1=="U", // 16.06.30from
unit=tmp2;
options=remove(options,[#]);
- ); // 16.06.30upto
+ ); // 16.06.30until
);
forall(strL,
tmp=Toupper(substring(#,0,1));
@@ -3573,7 +3505,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=(
tmp1=select(tmp1,#=="W");
if(length(tmp1)==0,
tmp=append(tmp,"Wait=5");
- );// 16.04.23upto
+ );// 16.04.23until
CalcbyR("ans",cmdlist,tmp);
wait(WaitUnit*100); // 16.03.18
,
@@ -3603,7 +3535,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=(
);
if(length(unit)>0, // 16.06.30from
Changeobjscale(fname,["Unit="+unit]);//16.10.04
- ); // 16.06.30upto
+ ); // 16.06.30until
if(view==1,
flg=0; // 16.03.14 from
if(isstring(ViewFile),
@@ -3612,7 +3544,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=(
if(flg==0,
kcV3(path,fname);
ViewFile=fname;
- ); // 16.03.14 upto
+ ); // 16.03.14 until
);
);
@@ -3634,7 +3566,7 @@ Objname(str,optionsorg):=(
OCOPTION=options;
,
OCOPTION=["m","v"];
- ); //17.12.23upto
+ ); //17.12.23until
println([OCNAME,OCOPTION]);
);
@@ -3685,7 +3617,7 @@ Mkobjcmd(nm,fd,options):=(
tmp2=append(tmp2,tmp);
);
parse("oc"+nm+"="+tmp2);
- println("cmd seq oc"+nm+" generated"); // 16.06.10upto
+ println("cmd seq oc"+nm+" generated"); // 16.06.10until
OBJCMD=concat(OBJCMD,out);//16.11.29
out;
);
@@ -3752,7 +3684,7 @@ Mkobjnrm(nm,fd,optionorg):=(
"n:[nx,ny,nz]",[], // 16.04.21from
"n:ratsimp(n)",[],
"n:trigsimp(n)",[],
- "n:factor(n)",[], // 16.04.21upto
+ "n:factor(n)",[], // 16.04.21until
"n",[]
]);
CalcbyM(name,cmdL,options); // 16.05.12
@@ -3780,7 +3712,7 @@ Mkobjnrm(nm,fd,optionorg):=(
if(disp=="Y", // 16.05.02
println(out);
// println(out_2);
- ); // 16.05.02upto
+ ); // 16.05.02until
out;
);
@@ -3829,7 +3761,7 @@ Mkobjthickcmd(nm,fd,fnrm,optionorg):=(
);
tmp2=tmp2+1;
);
- ); // 16.04.21upto
+ ); // 16.04.21until
options=remove(options,reL);
forall(stL,
if(length(#)>0,
@@ -3868,7 +3800,7 @@ Mkobjthickcmd(nm,fd,fnrm,optionorg):=(
tmp1=RSform(fnrm);
// if(indexof(tmp1,"Out=")==0, // 16.05.09from
// tmp1="Out="+tmp1;
-// ); // 16.05.09upto
+// ); // 16.05.09until
);
out=concat(out,[tmp1,[]]);
out=concat(out,["}",[]]);
@@ -3885,7 +3817,7 @@ Mkobjthickcmd(nm,fd,fnrm,optionorg):=(
tmp2=append(tmp2,tmp);
);
parse("oc"+nm+"="+tmp2);
- println("cmd seq oc"+nm+" generated"); // 16.06.10upto
+ println("cmd seq oc"+nm+" generated"); // 16.06.10until
OBJCMD=concat(OBJCMD,out);//16.11.29
out;
);
@@ -3944,7 +3876,7 @@ Mkobjpolycmd(nm,pd,optionorg):=(
);
tmp1=RSform(textformat(vtx,5),2);//17.12.24from
tmp2=RSform(textformat(face,5),2);
- out=["Objpolyhedron",[tmp1,tmp2]];//17.12.24upto
+ out=["Objpolyhedron",[tmp1,tmp2]];//17.12.24until
tmp2=[]; // 16.06.10from
forall(out,tmp1,
if(islist(tmp1),
@@ -3955,7 +3887,7 @@ Mkobjpolycmd(nm,pd,optionorg):=(
tmp2=append(tmp2,tmp);
);
parse("oc"+nm+"="+tmp2);
- println("cmd seq oc"+nm+" generated"); // 16.06.10upto
+ println("cmd seq oc"+nm+" generated"); // 16.06.10until
OBJCMD=concat(OBJCMD,out);//16.11.29
out;
);
@@ -3976,8 +3908,8 @@ Mkobjplatecmd(nm,pdorg,optionorg):=( // 16.06.18
if(length(pdn)==1,face=[1..(length(vtx))],face=pdn_2);
vtx=apply(vtx,if(isstring(#),parse(#),#));
vtx=apply(vtx,if(ispoint(#),parse(text(#)+"3d"),#));
- pd_nn=[vtx,face];//16.10.04upto
- ); // 16.06.19upto
+ pd_nn=[vtx,face];//16.10.04until
+ ); // 16.06.19until
thick1=0.05;
thick2=-0.05;
options=select(optionorg,length(#)>0);
@@ -4016,7 +3948,7 @@ Mkobjplatecmd(nm,pdorg,optionorg):=( // 16.06.18
tmp2=append(tmp2,tmp);
tmp3=RSform(textformat(vtx,5),2);//17.12.24from
tmp4=RSform(textformat(tmp2,5),2);
- out=concat(out,["Objpolyhedron",[tmp3,tmp4]]);//17.12.24upto
+ out=concat(out,["Objpolyhedron",[tmp3,tmp4]]);//17.12.24until
);
);
tmp3="["; // 16.06.10from
@@ -4077,7 +4009,7 @@ Mkobjcrvcmd(nm,pstorg,options):=(
if(MeasureDepth(tmp1)==0,
if(islist(tmp1),flg=1);
);
- if(flg==1, // 16.04.23upto
+ if(flg==1, // 16.04.23until
if(!isstring(tmp1_1),
forall(1..length(tmp1),
tmp=["Objcurve",[pst+"[["+text(#)+"]]",thick,poly,dir]];//17.12.22
@@ -4087,7 +4019,7 @@ Mkobjcrvcmd(nm,pstorg,options):=(
forall(1..length(tmp1), // 16.11.14from
tmp=["Objcurve",[tmp1_#,thick,poly,dir]];
out=concat(out,tmp);
- );// 16.11.14upto
+ );// 16.11.14until
);
,
tmp1=Chunderscore(pst);
@@ -4104,7 +4036,7 @@ Mkobjcrvcmd(nm,pstorg,options):=(
tmp2=append(tmp2,tmp);
);
parse("oc"+nm+"="+tmp2);
- println("cmd seq oc"+nm+" generated"); // 16.06.10upto
+ println("cmd seq oc"+nm+" generated"); // 16.06.10until
OBJCMD=concat(OBJCMD,out);//16.11.29
out;
);
@@ -4152,7 +4084,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=(
dtL=[symb];
,
dtL=symb;
- ); //17.12.24upto
+ ); //17.12.24until
,
tmp=substring(symb,0,1);
if(tmp>="a" & tmp<="z",tmp1=tmp+"s");
@@ -4174,7 +4106,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=(
,
tmp=Dirhead+"/data/fontF"; // 16.05.10
setdirectory(tmp);
- ); // 16.04.23upto
+ ); // 16.04.23until
dtL=Readbezier(symb,opbez);
dtLstr=dtL; //17.12.23
setdirectory(Dirwork);
@@ -4184,7 +4116,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=(
if(length(tmp1)>0,//17.12.23from
tmp1=tmp1_1;
out=concat(out,[tmp1,[]]);
- ); //17.12.23upto
+ ); //17.12.23until
);
mx=100;Mx=-100;my=100;My=-100;
forall(dtL,dt,
@@ -4209,7 +4141,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=(
if(length(tmp1)>0, //17.12.23from
tmp1=tmp1_1;
out=concat(out,[tmp1,[]]);
- ); //17.12.23upto
+ ); //17.12.23until
);
);
tmp1=text(options);
@@ -4218,7 +4150,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=(
forall(dtL,
tmp2=tmp2+","+#;
);
- tmp2="list("+substring(tmp2,1,length(tmp2))+")"; //17.12.23upto
+ tmp2="list("+substring(tmp2,1,length(tmp2))+")"; //17.12.23until
out=concat(out,[
"Sd=Symb3data",[tmp2,size,0,dir,pos], //17.12.23
"Objsymb(Sd,"+tmp1+")",[]
@@ -4233,7 +4165,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=(
tmp2=append(tmp2,tmp);
);
parse("oc"+symborg+"="+tmp2);
- println("cmd seq oc"+symborg+" generated"); // 16.06.10upto
+ println("cmd seq oc"+symborg+" generated"); // 16.06.10until
OBJCMD=concat(OBJCMD,out);//16.11.29
out;
);
@@ -4723,6 +4655,148 @@ Mkketcindyjs(libname,options):=( //17.11.18
);
);
+///////////////// C function //////////////////
+
+Cform(strorg):=(
+//help:Cform(str)
+ regional(str,ter,out,hat,ns,ne,nn,jj,flg,
+ lv,str1,str2,tmp,tmp1,tmp2);
+ ter=["+","-","*","/","(",")"];
+ str=replace(strorg,"pi","M_PI");
+ hat=Indexall(str,"^");
+ out="";
+ ns=0;
+ forall(hat,nn,
+ tmp=substring(str,nn-2,nn-1);
+ if(tmp==")",
+ tmp1=substring(str,ns,nn-1);
+ tmp2=Parlevel(tmp1);
+ tmp=tmp2_(length(tmp2))_2;
+ lv=select(tmp2,#_2==-tmp);
+ tmp=lv_1_1;
+ out=out+substring(str,ns,ns+tmp-1);
+ str1=substring(str,ns+tmp,nn-2);
+ ,
+ flg=0;
+ tmp2=reverse(ns..(nn-1));
+ forall(tmp2,jj,
+ if(flg==0,
+ tmp1=substring(str,jj-1,jj);
+ if(contains(ter,tmp1),
+ tmp=jj;
+ flg=1;
+ );
+ );
+ );
+ tmp1=substring(str,ns,tmp);
+ out=out+tmp1;
+ str1=substring(str,tmp,nn-1);
+ );
+ tmp=substring(str,nn,nn+1);
+ if(tmp=="(",
+ tmp1=substring(str,nn,length(str));
+ tmp2=Parlevel(tmp1);
+ lv=select(tmp2,#_2==-1);
+ tmp=lv_1_1;
+ str2=substring(tmp1,1,tmp-1);
+ ns=nn+tmp;
+ ,
+ flg=0;tmp=0;
+ forall(nn..(length(str)),jj,
+ if(flg==0,
+ tmp1=substring(str,jj,jj+1);
+ if((length(tmp1)==0)%(contains(ter,tmp1)),
+ tmp=jj;
+ flg=1;
+ );
+ );
+ );
+ str2=substring(str,nn,tmp);
+ ns=nn+1;
+ );
+ out=out+"pow("+str1+","+str2+")";
+ );
+ str=out+substring(str,ns,length(str));
+ str=str+"#";
+ ter=apply(0..9,text(#));
+ ter=append(ter,".");
+ out="";
+ tmp=substring(str,0,1);
+ if(contains(ter,tmp),
+ flg=1;out="";tmp1=tmp;
+ ,
+ flg=0;out=tmp;tmp1="";
+ );
+ forall(2..(length(str)),
+ tmp=substring(str,#-1,#);
+ if(contains(ter,tmp),
+ if(flg==1,
+ tmp1=tmp1+tmp;
+ ,
+ tmp1=tmp;
+ );
+ flg=1;
+ ,
+ if(flg==1,
+ if(indexof(tmp1,".")==0,
+ tmp1=tmp1+".0";
+ );
+ out=out+tmp1+tmp;
+ ,
+ out=out+tmp;
+ );
+ tmp1="";flg=0;
+ );
+ );
+ out=substring(out,0,length(out)-1);
+ out;
+);
+
+ConvertFdtoC(Fd):=ConvertFdtoC(Fd,["x","y","z"]);
+ConvertFdtoC(Fd,name):=(
+//help:ConvertFd(Fd);
+ regional(FdL,FdC,uvar,vvar,tmp,tmp1);
+ FdL=Fullformfunc(Fd);
+ tmp=indexof(FdL_5,"="); //180303from
+ uvar=substring(FdL_5,0,tmp-1);
+ tmp=indexof(FdL_6,"=");
+ vvar=substring(FdL_6,0,tmp-1);
+ tmp1=apply(2..6,Assign(FdL_#,uvar,"u"));
+ tmp1=apply(tmp1,Assign(#,vvar,"v"));
+ tmp1=concat(tmp1,FdL_(7..8));
+ FdC=apply(1..3,name_#+"="+Cform(tmp1_#));
+ FdC=concat(FdC,[Cform(tmp1_4),Cform(tmp1_5)]);
+ FdC=concat(FdC,[tmp1_6]);
+);
+
+ConstC(setlist):=( //180323
+ regional(divL,sizeL,epsL);
+ //Mdv=50; Ndv=50;
+ //DsizeLL=5000; DsizeL=1500; DsizeM=500; DsizeS=200;
+ //Eps=0.00001; Eps1=0.01; Eps2=0.1;
+ forall(setlist,
+ if((#_1>1)&(#_1<=200),
+ divL=#;
+ if(length(divL)==0,divL=[50]);
+ if(length(divL)==1,divL=append(divL,divL_1));
+ ,
+ if(#_1>=100,
+ sizeL=#;
+ if(length(sizeL)==0,sizeL=[5000]);
+ if(length(sizeL)==1,sizeL=append(sizeL,1500));
+ if(length(sizeL)==2,sizeL=append(sizeL,500));
+ if(length(sizeL)==3,sizeL=append(sizeL,200));
+ ,
+ epsL=#;
+ if(length(epsL)==0,epsL=[0.01]);
+ if(length(epsL)==1,epsL=append(epsL,0.1));
+ epsL=prepend(0.00001,epsL);
+ );
+ );
+ );
+ ConstantListC=[divL,sizeL,epsL];
+);
+
Cheader():=Cheader(FdC,FheadC+"header.h");
Cheader(fdc,fname):=(
regional(tmp,tmp1,tmp2,j, dW,dE,dS,dN,dstr,
@@ -4766,7 +4840,7 @@ Cheader(fdc,fname):=(
,
if(length(tmp_1)>0, Eps1=tmp_1);
if(length(tmp_1)>0, Eps2=tmp_2);
- ); //17.05.24upto
+ ); //17.05.24until
);
if(length(tmp)==3,
if(length(tmp_1)>0, DsizeLL=tmp_1);//17.06.09(3lines)
@@ -4785,7 +4859,7 @@ Cheader(fdc,fname):=(
if(length(tmp_3)>0, DsizeM=tmp_3);
if(length(tmp_4)>0, DsizeS=tmp_4);
)
- );//17.05.21upto
+ );//17.05.21until
);
tmp1=text(fdc_5_1);
tmp2=text(fdc_5_2);
@@ -5049,7 +5123,7 @@ Cmain(fname,cmdLorg):=(
tmp3=cmdL_((nL_#+2)..(length(cmdL)));
cmdL=concat(cmd,tmp3);
);
- );// 17.05.29upto
+ );// 17.05.29until
nL=select(1..(length(cmdL)),cmdL_#=="skeleton");// 17.06.05from
cmd=[];
if(length(nL)>0,
@@ -5103,8 +5177,8 @@ Cmain(fname,cmdLorg):=(
,
tmp3=cmdL_((nL_nn+2)..(length(cmdL)));
cmdL=concat(cmd,tmp3);
- );//17.06.08upto
- );// 17.06.05upto
+ );//17.06.08until
+ );// 17.06.05until
path=DirlibC+"/";
path=replace(path,"\","/");
cmd=[
@@ -5122,7 +5196,7 @@ Cmain(fname,cmdLorg):=(
if(cutctr==0, //17.06.02
cmdL=prepend(["1"],cmdL);
cmdL=prepend("cutfun",cmdL);
- );// 17.05.26upto
+ );// 17.05.26until
cutctr=0;
forall(1..(floor(length(cmdL))/2),nn,
tmp1=cmdL_(2*nn-1); tmp2=cmdL_(2*nn);
@@ -5196,7 +5270,7 @@ Cmain(fname,cmdLorg):=(
);
);
);
- cmd=append(cmd, tmp);// 17.05.26upto
+ cmd=append(cmd, tmp);// 17.05.26until
);
);
tmp=select(1..(length(cmd)), indexof(cmd_#,"main")>0);//17.06.02from
@@ -5209,7 +5283,7 @@ Cmain(fname,cmdLorg):=(
cmd=append(cmd," if(ch=="+tmp+"){val=cutfun"+tmp+"(u,v);}");
);
cmd=concat(cmd,[" return val;", "}"]);
- cmd=concat(cmd, tmp3);//17.06.02upto
+ cmd=concat(cmd, tmp3);//17.06.02until
cmd=concat(cmd, [" return 0;", "}"]);
SCEOUTPUT = openfile(fname);
forall(cmd,
@@ -5224,12 +5298,13 @@ Cmain(fname,cmdLorg):=(
SCEOUTPUT = openfile(#);
println(SCEOUTPUT,"");
closefile(SCEOUTPUT);
- ); // 17.05.20upto
+ ); // 17.05.20until
);
kcC():=kcC(FheadC);
kcC(cname):=(
- regional(tmp, tmp1, flg);
+ regional(tmp, tmp1,flg,rfile);
+ rfile="resultC"+cname+".txt";
if(iswindows(),
SCEOUTPUT = openfile("kc.bat");
println(SCEOUTPUT,"set path="+Dirwork);
@@ -5241,7 +5316,7 @@ kcC(cname):=(
tmp=tmp+" -o %path%\main.exe";
println(SCEOUTPUT,tmp);
println(SCEOUTPUT,"%path%\main.exe");
- println(SCEOUTPUT,"echo //// > %path%\resultC.txt");
+ println(SCEOUTPUT,"echo //// > %path%\"+rfile);
println(SCEOUTPUT,"exit");
closefile(SCEOUTPUT);
tmp=cname+".txt";
@@ -5253,19 +5328,19 @@ kcC(cname):=(
tmp=PathC+" "+cname+".c -o main.out";
println(SCEOUTPUT,tmp);
println(SCEOUTPUT,"./main.out");
- println(SCEOUTPUT,"echo //// > resultC.txt");
+ println(SCEOUTPUT,"echo //// >"+rfile);
println(SCEOUTPUT,"exit 0");
closefile(SCEOUTPUT);
tmp=cname+".txt";
println(kc(Dirwork+Shellparent,Mackc+Dirlib,tmp));
);
- SCEOUTPUT=openfile("resultC.txt");
+ SCEOUTPUT=openfile(wfile);
println(SCEOUTPUT,"");
closefile(SCEOUTPUT);
flg=0;
repeat(floor(10*1000/WaitUnit),
if(flg==0,
- tmp1=load("resultC.txt");
+ tmp1=load(wfile);
if(substring(tmp1,0,4)=="////",
flg=1;
);
@@ -5279,7 +5354,7 @@ kcC(cname):=(
);
);
-ReadCdata(var, fname):=ReadCdata(var, fname,[]);
+ReadCdataold(var, fname):=ReadCdata(var, fname,[]);
ReadCdata(var, fname,options):=(
regional(file,dt,name,str,tmp,tmp1,opstr,gout, out3,out2);
if(indexof(fname,".")==0,
@@ -5302,7 +5377,30 @@ ReadCdata(var, fname,options):=(
if(length(parse(gout_2))>0,
Projpara(var+"3d",options);
);
- );//17.06.16upto
+ );//17.06.16until
+);
+
+ReadCdata(fnameorg):=(
+ regional(tmp,tmp1,fname,data,out);
+ fname=fnameorg;
+ if(indexof(fname,".")==0, fname=fname+".txt");
+ data=load(fname);
+ data=tokenize(data," -99999");
+ out=[];
+ tmp1=[];
+ forall(1..(length(data)-1),
+ tmp=replace(data_#," ",",");
+ if(indexof(tmp,"99999.")==0,
+ tmp="["+replace(data_#," ",",")+"]";
+ tmp=parse(tmp);
+ tmp1=append(tmp1,tmp);
+ ,
+ out=append(out,tmp1);
+ tmp1=[];
+ );
+ );
+ if(length(tmp1)>0,out=append(out,tmp1));
+ out;
);
WriteCdata(fnameorg,dataorg):=(
@@ -5317,11 +5415,11 @@ WriteCdata(fnameorg,dataorg):=(
forall(1..(length(data)),kk,
forall(1..(length(data_kk)),nn,
pt=apply(1..3,Sprintf(data_kk_nn_#,5));
- tmp=pt_1+" "+pt_2+" "+pt_3;
+ tmp=pt_1+" "+pt_2+" "+pt_3+" -99999";
println(SCEOUTPUT,tmp);
);
if(kk<length(data),
- println(SCEOUTPUT,"99999.00000 2.00000 0.00000");
+ println(SCEOUTPUT,"99999.00000 2.00000 0.00000 -99999");
);
);
closefile(SCEOUTPUT);
@@ -5374,5 +5472,464 @@ DisplayC(dispc):=(
);
);
+Cheadsurf():=(
+ regional(cmd,jj,divL,sizeL,epsL,nf,var1,var2,tmp,tmp1,tmp2);
+ divL=ConstantListC_1;
+ sizeL=ConstantListC_2;
+ epsL=ConstantListC_3;
+ cmd=[];
+ tmp="const double XMIN="+Sprintf(XMIN,6);
+ tmp=tmp+",XMAX="+Sprintf(XMAX,6)+";";
+ cmd=append(cmd,tmp);
+ tmp="const double THETA="+Sprintf(THETA,6);
+ tmp=tmp+",PHI="+Sprintf(PHI,6)+";";
+ cmd=append(cmd,tmp);
+ tmp=" //THETA:"+Sprintf(THETA*180/pi,2);
+ tmp=tmp+", PHI:"+Sprintf(PHI*180/pi,2)+";";
+ cmd=append(cmd,tmp);
+ tmp1=apply(divL,text(#));
+ tmp="const int Mdv="+tmp1_1+",Ndv="+tmp1_2+";";
+ cmd=append(cmd,tmp);
+ tmp1=apply(sizeL,text(#));
+ tmp="#define DsizeLL "+tmp1_1;
+ cmd=append(cmd,tmp);
+ tmp="#define DsizeL "+tmp1_2;
+ cmd=append(cmd,tmp);
+ tmp="#define DsizeM "+tmp1_3;
+ cmd=append(cmd,tmp);
+ tmp="#define DsizeS "+tmp1_4;
+ cmd=append(cmd,tmp);
+ tmp1=apply(epsL,format(#,7));
+ tmp="const double Eps="+tmp1_1;
+ tmp=tmp+", Eps1="+tmp1_2;
+ tmp=tmp+", Eps2="+tmp1_3+";";
+ cmd=append(cmd,tmp);
+ tmp="const char dirname[]="+Dq+Dirwork+"/"+Dq+";";
+ cmd=append(cmd,tmp);
+ cmd=append(cmd,"double Urng[2],Vrng[2];");
+ cmd=append(cmd, "int DrawE,DrawW,DrawS,DrawN;");
+ cmd=append(cmd,"void rangeUV(short ch){");
+ cmd=append(cmd," switch(ch){");
+ forall(1..(length(FuncListC)),nf,
+ tmp2=" case "+text(nf)+" : ";
+ forall(4..5,
+ tmp1=FuncListC_nf_#; tmp=indexof(tmp1,"=");
+ tmp1=substring(tmp1,tmp+1,length(tmp1)-1);
+ tmp1=tokenize(tmp1,",");
+ if(#==4,tmp="Urng",tmp="Vrng");
+ tmp2=tmp2+tmp+"[0]="+tmp1_1+";"+tmp+"[1]="+tmp1_2+";";
+ );
+ cmd=append(cmd,tmp2);
+ );
+ cmd=append(cmd," }");
+ cmd=append(cmd, "}");
+ cmd=append(cmd,"void boundary(short ch){");
+ cmd=append(cmd," switch(ch){");
+ forall(1..(length(FuncListC)),nf,
+ tmp2=" case "+text(nf)+" : ";
+ tmp=FuncListC_nf_6;
+ tmp2=tmp2+"DrawE=";
+ if(indexof(tmp,"e")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;");
+ tmp2=tmp2+"DrawW=";
+ if(indexof(tmp,"w")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;");
+ tmp2=tmp2+"DrawS=";
+ if(indexof(tmp,"s")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;");
+ tmp2=tmp2+"DrawN=";
+ if(indexof(tmp,"n")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;");
+ cmd=append(cmd,tmp2);
+ );
+ cmd=append(cmd," }");
+ cmd=append(cmd,"}");
+ tmp="void surffun(short ch,double u, double v, double p[3]){";
+ cmd=append(cmd,tmp);
+ cmd=append(cmd," switch(ch){");
+ forall(1..(length(FuncListC)),nf,
+ tmp2=" case "+text(nf)+" : ";
+ forall(1..3,
+ tmp1=FuncListC_nf_#; tmp=indexof(tmp1,"=");
+ tmp1=substring(tmp1,tmp,length(tmp1));
+ tmp2=tmp2+"p["+text(#-1)+"]="+tmp1+";";
+ );
+ cmd=append(cmd,tmp2);
+ );
+ cmd=append(cmd," }");
+ cmd=append(cmd,"}");
+ cmd;
+);
+
+Ctopsurf(name):=Ctopsurf(name,[]);
+Ctopsurf(name,cmdadd):=(
+ regional(path,cmd);
+ path=DirlibC+"/";
+ path=replace(path,"\","/");
+ cmd=[
+ "#include <stdio.h>", "#include <math.h>",
+ "#include "+Dqq(Fhead+name+"header.h"),
+ "#include "+Dqq(path+"ketcommonhead.h"),
+ "#include "+Dqq(path+"ketcommon.h"),
+ "#include "+Dq+path+"surflibhead.h"+Dq,
+ "#include "+Dq+path+"surflib.h"+Dq,
+ "double cutfun1(short ch,double u, double v){",
+ " double p[3],val;",
+ " surffun(ch,u,v,p);",
+ " val=1;",
+ " return val;",
+ "}",
+ "double cutfun(short ch, int chcut, double u, double v){",
+ " double p[3],val;",
+ " switch(chcut){",
+ " case 1: val=cutfun1(ch,u,v);",
+ " }",
+ " return val;",
+ "}",
+ "int main(void){",
+ " double out[DsizeL][3], data[DsizeLL][3];",
+ " int i, j, nall, din[DsizeS][2];",
+ " char dirfname[256] = {'\0'};"
+ ];
+ cmd;
+);
+
+WritetoC(nm,header,main):=(
+ regional(hfile,mfile,top,body,tmp,tmp1,tmp2);
+ hfile=Fhead+nm+"header.h";
+ mfile=Fhead+nm+".c";
+ top=main_1;
+ body=main_2;
+ SCEOUTPUT=openfile(hfile);
+ forall(header,
+ println(SCEOUTPUT,#+"/**/");
+ );
+ closefile(SCEOUTPUT);
+ SCEOUTPUT=openfile(mfile);
+ forall(top,
+ println(SCEOUTPUT,#);
+ );
+ println(SCEOUTPUT,"/**/");
+ forall(body,
+ println(SCEOUTPUT,#+"/**/");
+ );
+ println(SCEOUTPUT," return 0;");
+ println(SCEOUTPUT,"}");
+ closefile(SCEOUTPUT);
+);
+
+CalcbyC(name,cmd):=CalcbyC(name,PathC,cmd,[]);
+CalcbyC(name,Arg1,Arg2):=(
+ if(isstring(Arg1),
+ CalcbyC(name,Arg1,Arg2,[]);
+ ,
+ CalcbyC(name,PathC,Arg1,Arg2);
+ );
+);
+CalcbyC(name,path,cmd,optionorg):=(
+ regional(options,eqL,strL,waiting,wflg,header,top,body,
+ wfile,hfile,mfile,flg,tmp,tmp1,tmp2,tmp3);
+ header=cmd_1;
+ top=cmd_2;
+ body=cmd_3;
+ options=optionorg;
+ tmp=divoptions(options);
+// eqL=tmp_5;
+ strL=tmp_7;
+ waiting=30;
+ wfile="resultC"+Fhead+name+".txt";
+ hfile=Fhead+name+"header.h";
+ println(Dirwork);
+ println(hfile);
+ mfile=Fhead+name+".c";
+ wflg=0;
+ forall(strL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="M",
+ wflg=1;
+ options=remove(options,[#]);
+ );
+ if(tmp=="R",
+ wflg=-1;
+ options=remove(options,[#]);
+ );
+ );
+ if(wflg==0,
+ tmp1=header;
+ if(!isexists(Dirwork,hfile),wflg=1);
+ if(wflg==0,
+ tmp2=load(hfile);
+ tmp2=tokenize(tmp2,"/**/");
+ tmp2=tmp2_(1..(length(tmp2)-1));
+ if(length(tmp1)!=length(tmp2),wflg=1);
+ );
+ if(wflg==0,
+ forall(1..(length(tmp1)),
+ if(tmp1_#!=tmp2_#,wflg=1);
+ );
+ );
+ if(wflg==0,
+ tmp1=body;
+ if(!isexists(Dirwork+"/",mfile),wflg=1);
+ if(wflg==0,
+ tmp2=load(mfile);
+ tmp2=tokenize(tmp2,"/**/");
+ tmp2=tmp2_(2..(length(tmp2)-1));
+ if(length(tmp1)!=length(tmp2),wflg=1);
+ );
+ if(wflg==0,
+ forall(1..(length(tmp1)),
+ if(tmp1_#!=tmp2_#,wflg=1);
+ );
+ );
+ );
+ if(wflg==0,wflg=-1);
+ );
+ if(wflg==1,
+ WritetoC(name,header,[top,body]);
+ SCEOUTPUT=openfile(wfile);
+ println(SCEOUTPUT,"");
+ closefile(SCEOUTPUT);
+ kcC(Fhead+name);
+ );
+ flg=0;
+ tmp1=floor(waiting*1000/WaitUnit);
+ repeat(tmp1,
+ if(flg==0,
+ tmp=load(wfile);
+ if(length(tmp)>=4,
+ tmp2=substring(tmp,length(tmp)-4,length(tmp));
+ if(tmp2=="////",
+ tmp=substring(tmp,0,length(tmp)-4);
+ flg=1;
+ tmp2=#*WaitUnit/1000;
+ );
+ ,
+ if(wflg==-1,
+ flg=-1;
+ ,
+ wait(WaitUnit);
+ );
+ );
+ );
+ if(flg<=0,
+ ErrFlag=1;
+ if(flg==-1,
+ println(wfile+" does not exist");
+ ,
+ if(flg==0,
+ tmp="("+text(waiting)+" s )";
+ println(wfile+" not generated "+tmp);
+ );
+ );
+ );
+ );
+);
+
+SfbdparadataC(nm,fd):=
+ SfbdparadataC(nm,fd,[],["nodisp"]);
+SfbdparadataC(nm,fd,options):=
+ SfbdparadataC(nm,fd,options,["nodisp"]);
+SfbdparadataC(nm,fdorg,optionorg,optionsh):=(
+//help:SfbdparadataC("1",Fd);
+//help:SfbdparadataC(options2=["r/m"]);
+ regional(funnm,fd,options,name2,name3,name2h,name3h,waiting,
+ eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg);
+ if(ChNumber==0,ChNumber=Ch);
+ fd=ConvertFdtoC(fdorg);
+ FuncListC=append(FuncListC,fd);
+ funnm=text(length(FuncListC));
+ name2="sfbd2d"+nm;
+ name3="sfbd3d"+nm;
+ name2h="sfbdh2d"+nm;
+ name3h="sfbdh3d"+nm;
+ fname=Fhead+"sfbd"+nm+".txt";
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ reL=tmp_6;
+ strL=tmp_7;
+ waiting=120;
+ wflg=0;
+ forall(strL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="M",
+ wflg=1;
+ options=remove(options,[#]);
+ );
+ if(tmp=="R",
+ wflg=-1;
+ options=remove(options,[#]);
+ );
+ );
+ options=remove(options,eqL);
+ options=remove(options,reL);
+ options=select(options,length(#)>0);
+ cmdL=[
+ " double sfbd"+funnm+"[DsizeL][3];",
+ " char fname"+funnm+"[]="+Dqq(fname)+";",
+ " rangeUV("+funnm+");",
+ " boundary("+funnm+");",
+ " sfbdparadata("+funnm+",sfbd"+funnm+");",
+ " sprintf(dirfname,"+Dqq("%s%s")+",dirname,fname"+funnm+");",
+ " output3h("+Dqq("sfbd3d"+nm)+","+Dqq("sfbdh3d"+nm)+",dirfname,sfbd"+funnm+");";
+ ];
+ if(wflg==1,tmp1=append(options,"m"));
+ if(wflg==-1,tmp1=append(options,"r"));
+ if(ErrFlag==0,
+ tmp="sfbd"+nm;
+ CalcbyC(tmp,[Cheadsurf(),Ctopsurf(tmp),cmdL],tmp1);
+ );
+ if(ErrFlag==1,
+ err("Sfbdparadata not completed");
+ ,
+ ReadOutData(fname);
+ GLIST=append(GLIST,"ReadOutData("+Dqq(fname)+")");
+ if(islist(parse(name3)),
+ tmp1=name2+"=Projpara("+Dqq(name3)+",[";
+ tmp2="";
+ if(length(options)>0,
+ forall(options,
+ tmp2=tmp2+Dqq(#)+",";
+ );
+ tmp2=substring(tmp2,0,length(tmp2)-1);
+ );
+ tmp1=tmp1+tmp2+"]);";
+ parse(tmp1);
+ if(length(optionsh)==0,tmp2=["nodisp"],tmp2=optionsh);
+ tmp1=name2h+"=Projpara("+Dqq(name3h)+",[";
+ forall(tmp2,
+ tmp1=tmp1+Dqq(#)+",";
+ );
+ tmp1=substring(tmp1,0,length(tmp1)-1)+"]);";
+ parse(tmp1);
+ ,
+ ErrFlag=1;
+ );
+ );
+);
+
+CrvsfparadataC(nm,fk,fbdy,fd):=
+ CrvsfparadataC(nm,fk,fbdy,fd,[],["nodisp"]);
+CrvsfparadataC(nm,fk,fbdy,fd,options):=
+ SfbdparadataC(nm,fk,fbdy,fd,options,["nodisp"]);
+CrvsfparadataC(nm,Fk,Fbdy,fdorg,optionorg,optionsh):=(
+//help:CrvsfparadataC("1","ax3d","sfbd3d1",Fd);
+//help:CrvsfparadataC(options2=["r/m"]);
+//help:CrvsfparadataC(optionsh=["nodisp"]);
+ regional(funnm,fd,options,name2,name3,name2h,name3h,waiting,
+ eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg,flg,ii,jj,eps);
+ eps=10^(-5);
+ fd=ConvertFdtoC(fdorg);
+ tmp=select(1..(length(FuncListC)),FuncListC_#==fd);
+ funcnum=tmp_1;
+ name2="crvsf2d"+nm;
+ name3="crvsf3d"+nm;
+ name2h="crvsfh2d"+nm;
+ name3h="crvsfh3d"+nm;
+ fname=Fhead+"crvsf"+nm+".txt";
+ options=optionorg;
+ tmp=Divoptions(options);
+ eqL=tmp_5;
+ reL=tmp_6;
+ strL=tmp_7;
+ waiting=120;
+ wflg=0;
+ forall(strL,
+ tmp=Toupper(substring(#,0,1));
+ if(tmp=="M",
+ wflg=1;
+ options=remove(options,[#]);
+ );
+ if(tmp=="R",
+ wflg=-1;
+ options=remove(options,[#]);
+ );
+ );
+ options=remove(options,eqL);
+ options=remove(options,reL);
+ options=select(options,length(#)>0);
+// tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2];
+// tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]);
+ tmp2=parse(Fbdy);
+ flg=0;
+ tmp=Fhead+Fbdy+".dat";
+ if(!isexists(Dirwork,tmp),flg=1);
+ if(flg==0,
+ tmp1=ReadCdata(tmp);
+ if(length(tmp1)!=length(tmp2),flg=1);
+ if(flg==0,
+ forall(1..(length(tmp1)),ii,
+ if(length(tmp1_ii)!=length(tmp2_ii),flg=1);
+ forall(1..(length(tmp1_ii)),jj,
+ if(flg==0,
+ if(Norm(tmp1_ii_jj-tmp2_ii_jj)>eps,flg=1);
+ );
+ );
+ );
+ );
+ );
+ if(flg==1,WriteCdata(tmp,Fbdy));
+ tmp2=parse(Fk);
+ flg=0;
+ tmp=Fhead+Fk+".dat";
+ if(!isexists(Dirwork,tmp),flg=1);
+ if(flg==0,
+ tmp1=ReadCdata(tmp);
+ if(length(tmp1)!=length(tmp2),flg=1);
+ if(flg==0,
+ forall(1..(length(tmp1)),ii,
+ if(length(tmp1_ii)!=length(tmp2_ii),flg=1);
+ forall(1..(length(tmp1_ii)),jj,
+ if(flg==0,
+ if(Norm(tmp1_ii_jj-tmp2_ii_jj)>eps,flg=1);
+ );
+ );
+ );
+ );
+ );
+ if(flg==1,WriteCdata(tmp,Fk));
+ cmdL=[
+ " double fbdy[DsizeL][3],fk[DsizeL][3];",
+ " char fname"+nm+"[]="+Dqq(fname)+";",
+ " rangeUV("+funnm+");",
+ " boundary("+funnm+");",
+ " readdata3("+Dqq(Fhead+Fbdy+".dat")+",fbdy);",
+ " readdata3("+Dqq(Fhead+Fk+".dat")+",fk);",
+ " crvsfparadata(fk,fbdy, 0, out);",
+ " sprintf(dirfname,"+Dqq("%s%s")+",dirname,fname"+nm+");",
+ " output3h("+Dqq("crvsf3d"+nm)+","+Dqq("crvsfh3d"+nm)+",dirfname,out);"
+ ];
+ if(wflg==1,tmp1=append(options,"m"));
+ if(wflg==-1,tmp1=append(options,"r"));
+ if(ErrFlag==0,
+ tmp="crvsf"+nm;
+ CalcbyC(tmp,[Cheadsurf(),Ctopsurf(tmp),cmdL],tmp1);
+ );
+ if(ErrFlag==1,
+ err("Crvsfparadata not completed");
+ ,
+ ReadOutData(fname);
+ GLIST=append(GLIST,"ReadOutData("+Dqq(fname)+")");
+ if(islist(parse(name3)),
+ tmp1=name2+"=Projpara("+Dqq(name3)+",[";
+ tmp2="";
+ if(length(options)>0,
+ forall(options,
+ tmp2=tmp2+Dqq(#)+",";
+ );
+ tmp2=substring(tmp2,0,length(tmp2)-1);
+ );
+ tmp1=tmp1+tmp2+"]);";
+ parse(tmp1);
+ if(length(optionsh)==0,tmp2=["nodisp"],tmp2=optionsh);
+ tmp1=name2h+"=Projpara("+Dqq(name3h)+",[";
+ forall(tmp2,
+ tmp1=tmp1+Dqq(#)+",";
+ );
+ tmp1=substring(tmp1,0,length(tmp1)-1)+"]);";
+ parse(tmp1);
+ ,
+ ErrFlag=1;
+ );
+ );
+);
+
//help:end();
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r
index 2478a8fb..a53dd021 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r
@@ -16,8 +16,75 @@
#########################################
-ThisVersion<- "KeTpic for R v5_2_3(18.02.02)"
-
+ThisVersion<- "KeTpic for R v5_2_4(18.02.26)"
+
+print(ThisVersion)
+
+# 2018.02.26
+# Sfcutparadata changed
+# Partcrv3 debugged
+# Projcurve rewritten
+# Nohiddenparadata debugged
+# PthiddenQ debugged
+# 2018.02.24
+# Sfcutdata added ( for functions )
+# Meetpoints debugged (case Norm(PtB-PtA)<Eps0)
+# 2018.02.23
+# Makevaltable2 added ( for functions )
+# 2018.02.23
+# Crvonsfparadata,Crv3onsfparadata added
+# Wireparadata added
+# 2018.02.22
+# PthiddenQ,Nohiddenpara2 changed (Eps2)
+# 2018.02.21
+# PthiddenQ,Meetpoints debugged
+# Crvsfparadata debugged (OTHERPARTITION)
+# Partitionseg debugged (for non-list) and changed (Ns=0)
+# Intersectcrvsf added
+# 2018.02.19
+# Groupnearpt added
+# Collectnear debugged
+# Meetpoints,PthiddenQ debugged and changed (Groupnearpt used )
+# Parapt changed (for point list )
+# Partitionseg changed (remove close value )
+# Fullformfunc changed (Initialization of ADDPOINT)
+# Addpoints added
+# 2018.02.18
+# Projpara debugged ( for empty data, Mix replace )
+# WriteOutData debugged (for emply data )
+# Sfbdparadata,Cuspparadata debugged
+# Meetpoints replaced
+# 2018.02.17
+# PthiddenQ replaced
+# 2018.02.15
+# Cancoordpara debugged (X=-... )
+# 2018.02.14
+# Paramoncrv,Pointoncrv renamed to ...curve
+# 2018.02.12
+# Nohiddenpara2 debugged ( CUSPPT should be a list )
+# Dropnumlistcrv changed (Eps)
+# 2018.02.11
+# Paramocrv debugged ( case N=Length(PtL) )
+# Sfbdparadata, Borderparadata, Makexybdy, Partitionseg,
+# Evlptablepara, Fullformfunc, Dropnumlistcrv, Cuspsplitpara,
+# PthiddenQ, Nohiddenpara2 added
+# Crvsfparadata, Meetpoints, Clipdomain added
+# 2018.02.10
+# Partcrv3 debugged
+# 2018.02.09
+# Ptstart,Ptend changed ( for the case fig is empty)
+# Norm changed (Dotprod used )
+# 2018.02.07
+# Collectnear debugged (Looprange )
+# Intersectcurves debugged (sum)
+# 2018.02.06
+# Kukeiiwake debugged ( ParamonCurve -> Paramoncrv )
+# 2018.02.05
+# Dotprod changed ( crossprod not used )
+# Intersectpartseg changed ( case of length of result =1)
+# 2018.02.04
+# Diff added ( func, withvar, (varnamevalue1,... ))
+# Funvalue added ( for an expression )
# 2018.02.02
# Enclosing2 changed ( for distant curves, startpt option removed )
# 2018.02.01
@@ -422,10 +489,10 @@ Appendrow<- function(...)
{
Dt<- varargin[[I]]
Nc<- max(Nc,Ncol(Dt))
- if (class(Dt)=="matrix") Dt<-as.numeric(t(Dt))
+ if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt))
Out<- c(Out,Dt)
}
- if (Nc>0)
+ if(Nc>0)
{
Out<-matrix(Out, nrow=Nc)
Out<-t(Out)
@@ -439,7 +506,7 @@ Appendrow<- function(...)
Crossprod<-function(a,b)
{
- if (length(a)==3)
+ if(length(a)==3)
{
Tmp1<-a[2]*b[3]-a[3]*b[2]
Tmp2=a[3]*b[1]-a[1]*b[3]
@@ -455,10 +522,10 @@ Crossprod<-function(a,b)
Datalength<-function(Data)
{
- if (length(Data)==0) return(0)
- if (mode(Data)=="numeric") return(Nrow(Data))
- if (mode(Data)=="character") return(nchar(Data))
- if (mode(Data)=="list") return(length(Data))
+ if(length(Data)==0) return(0)
+ if(mode(Data)=="numeric") return(Nrow(Data))
+ if(mode(Data)=="character") return(nchar(Data))
+ if(mode(Data)=="list") return(length(Data))
}
Crossprod<- function (a,b){ # 17.12.22
@@ -472,10 +539,13 @@ Crossprod<- function (a,b){ # 17.12.22
}
}
-Dotprod<-function(a,b)
-{
- Tmp=crossprod(a,b)
- return(Tmp)
+Dotprod<-function(a,b){ # 18.02.05
+ nn=min(length(a),length(b))
+ out=0
+ for(jj in Looprange(1,nn)){
+ out=out+a[jj]*b[jj]
+ }
+ return(out)
}
Dist<- function(...) # 17.09.17
@@ -496,10 +566,10 @@ Dist<- function(...) # 17.09.17
Member<-function(A,L)
{
N<-length(L);
- if (length(N)==0) return(FALSE)
+ if(length(N)==0) return(FALSE)
for (I in 1:N)
{
- if (class(L)=="list")
+ if(class(L)=="list")
{
Tmp<-L[[I]]
}
@@ -507,13 +577,13 @@ Member<-function(A,L)
{
Tmp<-L[I]
}
- if (mode(A)=="numeric")
+ if(mode(A)=="numeric")
{
- if (Norm(A-Tmp)==0) return(TRUE)
+ if(Norm(A-Tmp)==0) return(TRUE)
}
else
{
- if (A==Tmp) return(TRUE)
+ if(A==Tmp) return(TRUE)
}
}
return(FALSE)
@@ -521,28 +591,29 @@ Member<-function(A,L)
Norm<-function(V)
{
- Tmp<-as.vector(V);
- Tmp<-crossprod(Tmp,Tmp);
- Tmp<-sqrt(Tmp);
- as.numeric(Tmp)
+ Tmp=Dotprod(V,V) #18.02.09
+# Tmp<-as.vector(V);
+# Tmp<-crossprod(Tmp,Tmp)
+ Tmp<-sqrt(Tmp)
+# as.numeric(Tmp)
}
Ncol<-function(P)
{
- if (class(P)=="matrix") return(ncol(P))
+ if(class(P)=="matrix") return(ncol(P))
else return(length(P))
}
Nrow<-function(P)
{
- if (length(P)==0) return(0)
- if (class(P)=="matrix") return(nrow(P))
+ if(length(P)==0) return(0)
+ if(class(P)=="matrix") return(nrow(P))
else return(1)
}
Looprange<- function(a,b)
{
-if (a<=b) return(a:b)
+if(a<=b) return(a:b)
return(c())
}
@@ -604,7 +675,7 @@ Derivative<- function(...)
}
f<- eval(parse(text=Str))
if(Flg==1){
- if (NvaL<=3){
+ if(NvaL<=3){
if(NvaL==1){V<- f(VaL[1])}
if(NvaL==2){V<- f(VaL[1],VaL[2])}
if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])}
@@ -625,6 +696,54 @@ Derivative<- function(...)
return(Out)
}
+Diff<- function(...){ #18.02.04
+ varargin=list(...)
+ Nargs=length(varargin)
+ fun=varargin[[1]]
+ withvar=varargin[[2]]
+ tmp=paste("f<- expression(",fun,")",sep="")
+ eval(parse(text=tmp))
+ nn=nchar(withvar)
+ for(jj in Looprange(1,nn)){
+ tmp=substring(withvar,jj,jj)
+ f=D(f,tmp)
+ }
+ var=c()
+ val=""
+ for(jj in Looprange(3,Nargs)){
+ tmp=strsplit(varargin[[jj]],"=")
+ var=c(var,tmp[[1]][1])
+ val=paste(val,tmp[[1]][2],",",sep="")
+ }
+ if(Length(val)>1){
+ val=substring(val,1,Length(val)-1)
+ f=deriv(f,var,func=TRUE)
+ tmp=paste("out=f(",val,")",sep="")
+ out=eval(parse(text=tmp))
+ return(out[1])
+ }else{
+ return(f)
+ }
+}
+
+Funvalue<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ df=varargin[[1]]
+ var=c()
+ val=""
+ for(jj in Looprange(2,Nargs)){
+ tmp=strsplit(varargin[[jj]],"=")
+ var=c(var,tmp[[1]][1])
+ val=paste(val,tmp[[1]][2],",",sep="")
+ }
+ val=substring(val,1,Length(val)-1)
+ dfun=deriv(df,var,func=TRUE)
+ tmp=paste("out=dfun(",val,")",sep="")
+ eval(parse(text=tmp))
+ return(out[1])
+}
+
Integrate<- function(...)
{
varargin<- list(...)
@@ -658,7 +777,7 @@ Anglemark<- function(...)
PB<- varargin[[2]]
PC=varargin[[3]]
r <- 0.5
- if (Nargs>=4){
+ if(Nargs>=4){
r<- varargin[[4]]*r
}
Out=c()
@@ -670,11 +789,11 @@ Anglemark<- function(...)
P1<- Op(2,Op(1,Tmp))
Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB))
P2<- Op(2,Op(1,Tmp))
- if (abs(P1-P2)<Eps){
+ if(abs(P1-P2)<Eps){
Out<-c()
return(Out)
}
- if (P1<P2-Eps){
+ if(P1<P2-Eps){
Out<- Partcrv(P1,P2,Cir)
}
else{
@@ -704,37 +823,37 @@ Arrowdata<- function(...)
Flg<- 0
for (I in Looprange(3,Nargs)){
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric"){
- if (length(Tmp)>1){
+ if(mode(Tmp)=="numeric"){
+ if(length(Tmp)>1){
R<- Tmp
}
else{
- if (Flg==0){
+ if(Flg==0){
Ookisa<- Ookisa*Tmp
}
- if (Flg==1){
- if (Tmp<5){
+ if(Flg==1){
+ if(Tmp<5){
Hiraki<- Tmp*Hiraki
}
else{
Hiraki<- Tmp
}
}
- if (Flg==2){
+ if(Flg==2){
R<- P+Tmp*(Q-P)
}
else{
R<- P+Yapos*(Q-P)
}
- if (Flg==3){
+ if(Flg==3){
Futosa<- Tmp
}
Flg<- Flg+1
}
}
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Tmp<- grep("=", Tmp)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
eval(parse(text=Tmp))
Futosa<- Futosa*Thickness
R<- P+Position*(Q-P)
@@ -768,12 +887,12 @@ Arrowhead<-function(...)
Flg<- 0
for (I in Looprange(3,Nargs)){
Tmp<-varargin[[I]]
- if (is.character(Tmp)){
+ if(is.character(Tmp)){
Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from
if(length(Equal)>0){
Tmp1<- strsplit(Tmp,"=",fixed=TRUE)
Tmp2<- Tmp1[[1]]
- if (Tmp2[1]=="Cut" || Tmp2[1]=="cut"){
+ if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){
Tmp<- paste("Cut=",Tmp2[2],sep="")
eval(parse(text=Tmp))
}
@@ -781,19 +900,19 @@ Arrowhead<-function(...)
Str<- Tmp
} # 12.01.07 upto
}
- if (is.numeric(Tmp) && length(Tmp)==1){
- if (Flg==0) Ookisa<-Ookisa*Tmp
- if (Flg==1){
- if (Tmp<5) Hiraki<-Tmp*Hiraki
+ if(is.numeric(Tmp) && length(Tmp)==1){
+ if(Flg==0) Ookisa<-Ookisa*Tmp
+ if(Flg==1){
+ if(Tmp<5) Hiraki<-Tmp*Hiraki
else Hiraki<-Tmp
}
- if (Flg==2) Futosa<-Tmp
+ if(Flg==2) Futosa<-Tmp
Flg<-Flg+1
}
}
Ookisa<-1000/2.54/MilliIn*Ookisa
Theta<-Hiraki*pi/180
- if (Nrow(Houkou)>1){
+ if(Nrow(Houkou)>1){
P<- Doscaling(P)
Houkou<- Doscaling(Houkou)
Tmp<-Nearestpt(P,Houkou)
@@ -805,13 +924,13 @@ Arrowhead<-function(...)
for (J in JL){
B<-Ptcrv(J,Houkou)
Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Flg<- 1
break
}
A<-B
}
- if (Flg==0){ # 13.11.13
+ if(Flg==0){ # 13.11.13
print("Arrowhead may be too large (no intersect)")
return(P)
}
@@ -823,15 +942,15 @@ Arrowhead<-function(...)
Houkou<- Doscaling(Houkou)
Ev<--1/Norm(Houkou)*Houkou
Nv<-c(-Ev[2],Ev[1])
- if (length(grep("c",Str))>0){
+ if(length(grep("c",Str))>0){
P<-P-0.5*Ookisa*cos(Theta)*Ev
}
- if (length(grep("b",Str))>0){
+ if(length(grep("b",Str))>0){
P<-P-Ookisa*cos(Theta)*Ev
}
A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv
B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv
- if (length(grep("l",Str))>0){
+ if(length(grep("l",Str))>0){
Tmp<-Listplot(list(A,P,B))
Tmp1<- Unscaling(Tmp)
Drwline(Tmp1,Futosa)
@@ -865,9 +984,9 @@ Arrowheaddata<- function(...)
Flg<- 0
for (I in Looprange(3,Nargs)){
Tmp<-varargin[[I]]
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Tmp1<-grep("=",Tmp)
- if (length(Tmp1)>0){
+ if(length(Tmp1)>0){
eval(parse(text=Tmp))
Futosa<- Thickness
}
@@ -875,18 +994,18 @@ Arrowheaddata<- function(...)
Str<- Tmp
}
}
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
- if (Flg==0) Ookisa<-Ookisa*Tmp
- if (Flg==1){
- if (Tmp<5) Hiraki<-Tmp*Hiraki
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(Flg==0) Ookisa<-Ookisa*Tmp
+ if(Flg==1){
+ if(Tmp<5) Hiraki<-Tmp*Hiraki
else Hiraki<-Tmp
}
- if (Flg==2) Futosa<-Tmp
+ if(Flg==2) Futosa<-Tmp
Flg<-Flg+1
}
}
Theta<- Hiraki*pi/180
- if (Nrow(Houkou)>1){
+ if(Nrow(Houkou)>1){
P<- Doscaling(P)
Houkou<- Doscaling(Houkou)
Tmp<-Nearestpt(P,Houkou)
@@ -898,13 +1017,13 @@ Arrowheaddata<- function(...)
for (J in JL){
B<- Ptcrv(J,Houkou)
Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Flg<- 1
break
}
A<-B
}
- if (Flg==0){ # 13.11.13
+ if(Flg==0){ # 13.11.13
print("Arrowhead may be too large (no intersect)")
return(P)
}
@@ -916,10 +1035,10 @@ Arrowheaddata<- function(...)
Houkou<- Doscaling(Houkou)
Ev<- -1/Norm(Houkou)*Houkou
Nv<- c(-Ev[2],Ev[1])
- if (length(grep("c",Str))>0){
+ if(length(grep("c",Str))>0){
P<-P-0.5*Ookisa*cos(Theta)*Ev
}
- if (length(grep("b",Str))>0){
+ if(length(grep("b",Str))>0){
P<-P-Ookisa*cos(Theta)*Ev
}
A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv
@@ -946,7 +1065,7 @@ Arrowline<- function(...)
Flg<- 0
for (I in Looprange(3,Nargs)){
Tmp<- varargin[[I]]
- if (is.character(Tmp)){
+ if(is.character(Tmp)){
Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from
if(length(Equal)>0){
Tmp1<- strsplit(Tmp,"=")
@@ -960,14 +1079,14 @@ Arrowline<- function(...)
Str<- Tmp
} # 12.01.07 upto
}
- if (is.numeric(Tmp) && length(Tmp)==1){
- if (Flg==0) Ookisa<- Ookisa*Tmp
- if (Flg==1){
- if (Tmp<5) Hiraki<- Tmp*Hiraki
+ if(is.numeric(Tmp) && length(Tmp)==1){
+ if(Flg==0) Ookisa<- Ookisa*Tmp
+ if(Flg==1){
+ if(Tmp<5) Hiraki<- Tmp*Hiraki
else Hiraki<- Tmp
}
- if (Flg==2) Yapos<- Tmp
- if (Flg==3) Futosa<- Tmp
+ if(Flg==2) Yapos<- Tmp
+ if(Flg==3) Futosa<- Tmp
Flg<- Flg+1
}
}
@@ -983,48 +1102,48 @@ Assign<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0){
+ if(Nargs==0){
ASSIGNLIST<<- list("`",Prime())
Out<- ASSIGNLIST
return()
# return("Assign reset done");
}
L<- list("`","'")
- if (Nargs%%2==0){
+ if(Nargs%%2==0){
L<- Mixjoin(L,varargin)
ASSIGNLIST<<- L
Out<- L
return()
# return("Assign set done");
}
- if (Nargs==1){
+ if(Nargs==1){
Fnstr<- varargin[[1]]
- if (nchar(Fnstr)==0){ # case of ""
+ if(nchar(Fnstr)==0){ # case of ""
L<- ASSIGNLIST
Out<- c()
for (I in seq(1,length(L),by=2)){
Tmp1<- L[[I]]
Tmp2<- L[[I+1]]
- if (length(Tmp2)==1){
+ if(length(Tmp2)==1){
Tmp3<- as.character(Tmp2)
}
else{
- if (mode(Tmp2)=="character"){
+ if(mode(Tmp2)=="character"){
Tmp3<- Tmp2
}
- else if (mode(Tmp2)=="list"){
+ else if(mode(Tmp2)=="list"){
Tmp3<- makeliststr(Tmp2)
}
- else if (mode(Tmp2)=="numeric"){
+ else if(mode(Tmp2)=="numeric"){
Tmp3<- "c("
for (J in Looprange(1,length(Tmp2))){
Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="")
- if (J<length(Tmp2)){
+ if(J<length(Tmp2)){
Tmp3<- paste(Tmp3,",",sep="")
}
}
Tmp3<- paste(Tmp3,")",sep="")
- if (class(Tmp2)=="matrix"){
+ if(class(Tmp2)=="matrix"){
Nr<- as.character(nrow(Tmp2))
Tmp3<- paste("matrix(",Tmp3,"nrow=",Nr,")",sep="")
}
@@ -1035,11 +1154,11 @@ Assign<- function(...)
}
return(Out);
}
- if (substr(Fnstr,1,1)=="?"){
+ if(substr(Fnstr,1,1)=="?"){
Fnstr<- substr(Fnstr,2,nchar(Fnstr))
for (I in seq(1,length(ASSIGNLIST),by=2)){
Tmp<- ASSIGNLIST[[I]]
- if (Tmp==Fnstr){
+ if(Tmp==Fnstr){
Out<- Mixjoin(list(I),ASSIGNLIST[I+1])
return(Out)
}
@@ -1050,7 +1169,7 @@ Assign<- function(...)
L<- ASSIGNLIST
}
else{
- if (mode(varargin[[2]])=="numeric"){
+ if(mode(varargin[[2]])=="numeric"){
Fnstr<- varargin[[Nargs]]
for (I in Looprange(1,Nargs-1)){
L[[I]]=varargin[[I]]
@@ -1066,11 +1185,11 @@ Assign<- function(...)
for (I in seq(1,length(L),by=2)){
Vname<- L[[I]]
Val<- L[[I+1]]
- if (mode(Val)=="numeric"){
- if (Nrow(Val)==1){
+ if(mode(Val)=="numeric"){
+ if(Nrow(Val)==1){
for (K in Looprange(1,length(Val))){
Tmp<- paste(Vname,"[", as.character(K),"]",sep="")
- if (mode(Val[K])=="numeric"){
+ if(mode(Val[K])=="numeric"){
Tmp1<- paste("(",as.character(Val[K]),")",sep="")
}
else{
@@ -1083,7 +1202,7 @@ Assign<- function(...)
for (J in Looprange(1,Nrow(Val))){
for (K in Looprange(1,Ncol(Val))){
Tmp<- paste(Vname,"(",as.character(J),",",as.character(K),")",sep="")
- if (mode(Val[J,K])=="numeric"){
+ if(mode(Val[J,K])=="numeric"){
Tmp1<- paste("(",as.character(Val[J,K]),")",sep="")
}
else{
@@ -1093,34 +1212,34 @@ Assign<- function(...)
}
}
}
- if (length(Val)==1){
+ if(length(Val)==1){
Rep<- as.character(Val)
}
else{
Rep<-""
- if (class(Val)=="matrix"){
+ if(class(Val)=="matrix"){
Rep<- "matrix("
}
Rep<- paste(Rep,"c(",sep="")
for (J in Looprange(1,length(Val))){
Rep<- paste(Rep,as.character(Val[J]),sep="")
- if (J<length(Val)){
+ if(J<length(Val)){
Rep<- paste(Rep,",",sep="")
}
else{
Rep<- paste(Rep,")",sep="")
}
}
- if (class(Val)=="matrix"){
+ if(class(Val)=="matrix"){
Rep<- paste(Rep,",nrow=",as.character(nrow(Val)),")",sep="")
}
}
Tmp1<- paste("(",Rep,")",sep="")
}
- if (mode(Val)=="character"){
+ if(mode(Val)=="character"){
Tmp1<- Val
}
- if (mode(Val)=="list"){
+ if(mode(Val)=="list"){
Tmp1<- Makeliststr(Val)
}
Fnstr<- gsub(Vname,Tmp1,Fnstr,fixed=TRUE) # 10.11.20
@@ -1151,7 +1270,7 @@ Assignrep<- function(...)
Val<- varargin[[I+1]]
Tmp1<- paste("?",Vname,sep="")
Tmp<- Assign(Tmp)
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
next
}
I<- Tmp[[1]]
@@ -1182,7 +1301,7 @@ Beginpicture<-function(ul)
Sym<-".0123456789 +-*/"
SL<-Sym
OL<-"+-*/"
- if (ul!=""){
+ if(ul!=""){
ULEN<<-ul;
}
Is<-1;
@@ -1190,8 +1309,8 @@ Beginpicture<-function(ul)
Ucode<-ULEN
for (I in Looprange(1,nchar(Ucode))){
C<-substring(Ucode,I,I);
- if (length(grep(C,SL))>0){
- if (length(grep(C,OL))>0){
+ if(length(grep(C,SL))>0){
+ if(length(grep(C,OL))>0){
Tmp<-substring(Ucode,Is,I-1);
Str<-paste(VL,Tmp,C,sep="")
VL<-Str
@@ -1208,15 +1327,15 @@ Beginpicture<-function(ul)
Valu<-eval(parse(text=VL))
Str<-as.character(Valu);
ULEN<<- paste(Str,Unit,sep="")
- if (Unit=="cm") MilliIn<<-1000/2.54*Valu
- if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10
- if (Unit=="in") MilliIn<<-1000*Valu
- if (Unit=="pt") MilliIn<<-1000/72.27*Valu
- if (Unit=="pc") MilliIn<<-1000/6.022*Valu
- if (Unit=="bp") MilliIn<<-1000/72*Valu
- if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
- if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu;
- if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
+ if(Unit=="cm") MilliIn<<-1000/2.54*Valu
+ if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10
+ if(Unit=="in") MilliIn<<-1000*Valu
+ if(Unit=="pt") MilliIn<<-1000/72.27*Valu
+ if(Unit=="pc") MilliIn<<-1000/6.022*Valu
+ if(Unit=="bp") MilliIn<<-1000/72*Valu
+ if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
+ if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu;
+ if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
MARKLEN<<- MARKLENNow*1000/2.54/MilliIn;
Str<-paste("{\\unitlength=",ULEN,"%\n",sep="")
cat(Str,file=Wfile,append=TRUE)
@@ -1246,14 +1365,14 @@ Bowdata<- function(...) #17.09.17
PB <- varargin[[2]]
Cut <- 0
D <- 1/2*Norm(PB-PA)
- if (Nargs>=3) {
+ if(Nargs>=3) {
H <- varargin[[3]]*D*0.2
}
else {
H <- D*0.2
}
H <- min(H,D)
- if (Nargs>=4){
+ if(Nargs>=4){
Cut <- varargin[[4]]
}
Ydata <- MakeBowdata(PA,PB,H)
@@ -1268,7 +1387,7 @@ Bowdata<- function(...) #17.09.17
ThetaM <- Op(2,BOWMIDDLE)
BOWSTART <<- PA
BOWEND <<- PB
- if (Cut==0){
+ if(Cut==0){
Pd<- Circledata(c(C,r),Rng)
}
else{
@@ -1290,14 +1409,14 @@ Bowmiddle <- function(...)
M <- BOWMIDDLE
return(M)
}
- if (Nargs==1) {
+ if(Nargs==1) {
Bdata <- varargin[[1]]
A <- Bdata[1,]
Dind <- Dataindex(Bdata)
Dc <- Nrow(Dind)
Tmp <- Dind[Dc,2]
B <- Bdata[Tmp,]
- if (Dc==1) {
+ if(Dc==1) {
Tmp1 <- round(Tmp/2)
}
else {
@@ -1320,7 +1439,7 @@ Bowmiddle <- function(...)
A <- varargin[[1]]; B <- varargin[[2]]
D <- 1/2*Norm(B-A)
H <- 0.2*D;
- if (length(varargin)>=3) {
+ if(length(varargin)>=3) {
Tmp <- varargin[[3]]
H <- Tmp*D*0.2
}
@@ -1353,11 +1472,11 @@ Bowname<- function(...)
Nargs<- Nargs-1
}
}
- if (Nargs==0){
+ if(Nargs==0){
Siki <- varargin[[1]]
P <- Op(1,BOWMIDDLE)
}
- else if (Nargs==1){
+ else if(Nargs==1){
Bdata <- varargin[[1]]
P <- Bowmiddle(Bdata)
}
@@ -1365,7 +1484,7 @@ Bowname<- function(...)
A <- varargin[[1]]; B <- varargin[[2]]
D <- 1/2*Norm(B-A)
Tmp <- varargin[[3]]
- if (is.character(Tmp)){
+ if(is.character(Tmp)){
H <- D*0.2
}
else {
@@ -1390,7 +1509,7 @@ Bownamerot <- function(...)
Eps <- 10^(-6)
Flg <- 1
Tmp <- varargin[[Nargs]]
- if (is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){
+ if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){
Flg <- Tmp
Nargs <- Nargs-1
}
@@ -1404,7 +1523,7 @@ Bownamerot <- function(...)
Nargs<- Nargs-1
}
}
- if (Nargs==0) {
+ if(Nargs==0) {
P <- Op(1,BOWMIDDLE)
A <- BOWSTART
B <- BOWEND
@@ -1422,7 +1541,7 @@ Bownamerot <- function(...)
}
}
}
-# else if (Nargs==2) {
+# else if(Nargs==2) {
# Bdata <- varargin[[1]]
# P <- Bowmiddle(Bdata)
# A <- Bdata[1,]
@@ -1433,7 +1552,7 @@ Bownamerot <- function(...)
# A <- varargin[[1]]; B <- varargin[[2]]
# D <- 1/2*Norm(B-A)
# Tmp <- varargin[[3]]
-# if (mode(Tmp)=="character") {
+# if(mode(Tmp)=="character") {
# H <- 0.2*D; Siki <- Tmp
# }
# else {
@@ -1446,12 +1565,12 @@ Bownamerot <- function(...)
# T <- (Op(3,Ydata)+Op(4,Ydata))/2
# P <- C+R*c(cos(T),sin(T))
# }
- if (A[1]>B[1]+Eps){
+ if(A[1]>B[1]+Eps){
Tmp <- A
A <- B
B <- Tmp
}
- if (Flg>0) {
+ if(Flg>0) {
Tmp <- B-A
}
else{
@@ -1468,9 +1587,9 @@ CalcHeight<-function(Hoko,Moji)
Str<-c(Tmp)
Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="")
Str<-c(Str,Tmp)
- if (H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}")
- if (H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}")
- if (H=="c")
+ if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}")
+ if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}")
+ if(H=="c")
{
Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}")
Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}")
@@ -1486,9 +1605,9 @@ CalcWidth<-function(Hoko,Moji)
{
D<-0;
H<-substring(Hoko,2,2)
- if (H=="e") D<-0
- if (H=="w") D<--1.0
- if (H=="c") D<--0.5
+ if(H=="e") D<-0
+ if(H=="w") D<--1.0
+ if(H=="c") D<--0.5
Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="")
Tmp<-as.character(D)
Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="")
@@ -1576,27 +1695,27 @@ Dataindex<-function(P)
{
# Inf;Inf : Terminator
Ndm<-c()
- if (length(P)==0) return(Ndm)
+ if(length(P)==0) return(Ndm)
N1<-1
Flg<-0
for (J in 1:Nrow(P))
{
- if (P[J,1]==Inf)
+ if(P[J,1]==Inf)
{
Ndm<-Appendrow(Ndm,c(N1,J-1))
N1<-J+1;
- if (P[N1,1]==Inf)
+ if(P[N1,1]==Inf)
{
Flg<-1;
break;
}
}
}
- if (Flg==0)
+ if(Flg==0)
{
Ndm<-Appendrow(Ndm,c(N1,Nrow(P)))
}
- if (class(Ndm)=="numeric")
+ if(class(Ndm)=="numeric")
{
Tmp<-matrix(Ndm,nrow=1)
Ndm<- Tmp
@@ -1612,9 +1731,9 @@ Dashline<- function(...)
Nargs<- length(varargin)
Nall<- Nargs; Sen<- 1 ; Gap<- 1
Tmp<- varargin[[Nall]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){
Tmp1<- varargin[[Nall-1]]
- if (mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){
+ if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){
Sen<- Tmp1; Gap<- Tmp
Nall<- Nall-2
}
@@ -1627,7 +1746,7 @@ Dashline<- function(...)
Gap<- 1000/2.54/MilliIn*Gap
for (N in Looprange(1,Nall)){
Pdata<- varargin[[N]]
- if (Mixtype(Pdata)==1){
+ if(is.numeric(Pdata)==1){
Pdata<- list(Pdata)
}
for (II in 1:length(Pdata)){
@@ -1684,7 +1803,7 @@ Diagcelldata<- function(Tb,Nc,Nr)
Dividegraphics<- function(Pd)
{
- if (length(Pd)==0){
+ if(length(Pd)==0){
return(Pd)
}
DtL<- Flattenlist(Pd)
@@ -1717,17 +1836,17 @@ Dividetable<- function(Tb)
Doscaling<- function(G)
{
GLg<- G
- if (class(GLg)=="numeric")
+ if(class(GLg)=="numeric")
{
- if (LOGX==1) GLg[1]<- log(G[1], base=10)
- if (LOGY==1) GLg[2]<- log(G[2], base=10)
+ if(LOGX==1) GLg[1]<- log(G[1], base=10)
+ if(LOGY==1) GLg[2]<- log(G[2], base=10)
Tmp<-c(SCALEX*GLg[1],SCALEY*GLg[2])
return(Tmp)
}
else
{
- if (LOGX==1) GLg[,1]<- log(G[,1],base=10)
- if (LOGY==1) GLg[,2]<- log(G[,2],base=10)
+ if(LOGX==1) GLg[,1]<- log(G[,1],base=10)
+ if(LOGY==1) GLg[,2]<- log(G[,2],base=10)
Tmp1<-matrix(c(SCALEX,0,0,SCALEY),nrow=2)
Tmp<-GLg %*% Tmp1
return(Tmp)
@@ -1750,30 +1869,30 @@ Dotfilldata<- function(...)
Xmx<- Tmp[1]; Ymx<- Tmp[2]
for (N in seq(Nargs,1,by=-1)){
Tmp<- varargin[[N]]
- if (Mixtype(Tmp)!=1){
+ if(Mixtype(Tmp)!=1){
break
}
}
- if (N<Nargs){
+ if(N<Nargs){
Kosa<- varargin[[N+1]]
}
# Kosa<- min(Kosa,1)
Tmp<- 1/(2*Kosa)
Kankaku<- Tmp*0.100*1000/2.54/MilliIn
NaitenL<- varargin[[1]]
- if (Mixtype(NaitenL)==1){
+ if(Mixtype(NaitenL)==1){
NaitenL<- list(NaitenL)
}
Ns<- 2
StartP<- Op(1,NaitenL)
- if (mode(StartP)=="character"){
+ if(mode(StartP)=="character"){
StartP<- c((Xmn+Xmx)/2,(Ymn+Ymx)/2)
}
else{
StartP<- Doscaling(StartP)
}
Tmp<- varargin[[2]]
- if (Mixtype(Tmp)==1){
+ if(Mixtype(Tmp)==1){
StartP<- Doscaling(Tmp)
Ns<- 3
}
@@ -1792,17 +1911,17 @@ Dotfilldata<- function(...)
PtnL<- list()
for (I in Looprange(1,length(NaitenL))){
Tmp<- Op(I,NaitenL)
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Tmp1<- Naigai(Tmp,Bdy)
PtnL<- Mixjoin(PtnL,list(Tmp1))
}
else{
- if (mode(Tmp)!="character"){
+ if(mode(Tmp)!="character"){
return("Mode Error")
}
Ptn<- c()
for (J in Looprange(1,nchar(Tmp))){
- if (substr(Tmp,J,J)=="i"){
+ if(substr(Tmp,J,J)=="i"){
Ptn<- c(Ptn,1)
}
else{
@@ -1814,7 +1933,7 @@ Dotfilldata<- function(...)
}
Call<- length(Bdy)
Ptn<- c(seq(0, 0, length=Call))
- if (Member(Ptn,PtnL)){
+ if(Member(Ptn,PtnL)){
Wn<- Doscaling(Framedata())
Bdy<- Mixjoin(Bdy,list(Wn))
Tmp<- list()
@@ -1827,7 +1946,7 @@ Dotfilldata<- function(...)
V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180))
Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180))
Tmp<- Op(1,NaitenL)
- if (mode(Tmp)=="numeric" && length(Tmp)==2){
+ if(mode(Tmp)=="numeric" && length(Tmp)==2){
Tmp<- Doscaling(Tmp)
Delta<- Tmp-StartP
K<- trunc(Dotprod(Delta,Vm)/Kankaku)
@@ -1843,10 +1962,10 @@ Dotfilldata<- function(...)
R<- Tmp[2,]
Tmp<- Dotprod(Q-P,V)/Kankaku
K1<- ceiling(Tmp)
- if (abs(K1-Tmp)<Eps) K1=K1+1
+ if(abs(K1-Tmp)<Eps) K1=K1+1
Tmp<- Dotprod(R-P,V)/Kankaku
K2<- floor(Tmp)
- if (abs(Tmp-K2)<Eps) K2=K2-1
+ if(abs(Tmp-K2)<Eps) K2=K2-1
for (K in Looprange(K1,K2)){
Tmp1<- Pointdata(P+K*Kankaku*V)
ShaL<- Mixjoin(ShaL, list(Tmp1))
@@ -1867,10 +1986,10 @@ Dotfilldata<- function(...)
R<- Tmp[2,]
Tmp<- Dotprod(Q-P,V)/Kankaku
K1<- ceiling(Tmp)
- if (abs(K1-Tmp)<Eps) K1<- K1+1
+ if(abs(K1-Tmp)<Eps) K1<- K1+1
Tmp<- Dotprod(R-P,V)/Kankaku
K2<- floor(Tmp)
- if (abs(Tmp-K2)<Eps) K2<- K2-1
+ if(abs(Tmp-K2)<Eps) K2<- K2-1
for (K in Looprange(K1,K2)){
Tmp1<- Pointdata(P+K*Kankaku*V)
ShaL<- Mixjoin(ShaL, list(Tmp1))
@@ -1896,17 +2015,17 @@ Dotfilldata<- function(...)
P<- StartP+I*Kankaku*Vm
Sha<- Makeshasen(PtnL,P,V,Bdy)
Sha<- Dividegraphics(Sha)
- if (length(Sha)>0){
+ if(length(Sha)>0){
for (J in 1:length(Sha)){
Tmp<- Op(J,Sha)
Q<- Tmp[1,]
R<- Tmp[2,]
Tmp<- Dotprod(Q-P,V)/Kankaku
K1<- ceiling(Tmp)
- if (abs(K1-Tmp)<Eps) K1=K1+1
+ if(abs(K1-Tmp)<Eps) K1=K1+1
Tmp<- Dotprod(R-P,V)/Kankaku
K2<- floor(Tmp)
- if (abs(Tmp-K2)<Eps) K2=K2-1
+ if(abs(Tmp-K2)<Eps) K2=K2-1
for (K in Looprange(K1,K2)){
Tmp1<- Pointdata(P+K*Kankaku*V)
ShaL<- Mixjoin(ShaL, list(Tmp1))
@@ -1940,11 +2059,11 @@ Dottedline<- function(...)
I <- I-1
Tmp <- varargin[[I]]
}
- if (I==Nall-1) {
+ if(I==Nall-1) {
Nagasa<-Nagasa*varargin[[Nall]]
Nall <- Nall-1
}
- if (I==Nall-2) {
+ if(I==Nall-2) {
Nagasa <- Nagasa*varargin[[Nall-1]]
Ookisa <- round(Ookisa*varargin[[Nall]])
Nall <- Nall-2
@@ -1952,7 +2071,7 @@ Dottedline<- function(...)
Nagasa <- 1000/2.54/MilliIn*Nagasa
for (N in 1:Nall) {
Pdata <- varargin[[N]]
- if (mode(Pdata)=="numeric") {
+ if(mode(Pdata)=="numeric") {
Pdata <- list(Pdata)
}
for (II in 1:length(Pdata)) {
@@ -1968,12 +2087,12 @@ Dottedline<- function(...)
Lenlist <- c(Lenlist,Len)
}
Lenall <- Lenlist[length(Lenlist)]
- if (Lenall==0) {
+ if(Lenall==0) {
next
}
Naga <- Nagasa
Nten <- round(Lenall/Naga)+1
- if (Nten > 1) {
+ if(Nten > 1) {
Seg <- Lenall/(Nten-1)
}
else {
@@ -1984,7 +2103,7 @@ Dottedline<- function(...)
Hajime <- 1
for (I in Looprange(0,Nten-1)) {
Len <- Seg*I
- if (I>0) {
+ if(I>0) {
J <- Hajime
while( Len>=Lenlist[J]+Eps) {
J <- J+1
@@ -1995,8 +2114,8 @@ Dottedline<- function(...)
(Lenlist[Hajime+1]-Lenlist[Hajime])
P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,])
PPd<-Appendrow(PPd,P)
- if (I==Nten-1) {
- if (Norm(P-Data[1,])<Eps) {
+ if(I==Nten-1) {
+ if(Norm(P-Data[1,])<Eps) {
next
}
}
@@ -2005,14 +2124,14 @@ Dottedline<- function(...)
cat(Str,file=Wfile,append=TRUE)
for (I in Looprange(1,Nrow(PPd))){
P<- Op(I,PPd)
- if (Nrow(PPd)==1){
+ if(Nrow(PPd)==1){
V<- c(1,0)
}
- else if (I==1){
+ else if(I==1){
Tmp<- Op(I+1,PPd)-P
V<- 1/Norm(Tmp)*Tmp
}
- else if (I==Nrow(PPd)){
+ else if(I==Nrow(PPd)){
Tmp<- P-Op(I-1,PPd)
V<- 1/Norm(Tmp)*Tmp
}
@@ -2035,7 +2154,7 @@ Dottedline<- function(...)
Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
cat(Str,file=Wfile,append=TRUE)
cat("\\special{fp}",file=Wfile,append=TRUE)
- if (I%%2==0){
+ if(I%%2==0){
cat("%\n",file=Wfile,append=TRUE)
}
}
@@ -2054,7 +2173,7 @@ Drwline<-function(...)
Nall<-length(varargin)
Thick<-0
Tmp<-varargin[[Nall]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
Thick<-round(Tmp*PenThickInit)
Str<-paste("\\special{pn ", as.character(Thick),"}%\n",sep="")
cat(Str,file=Wfile,append=TRUE)
@@ -2062,8 +2181,8 @@ Drwline<-function(...)
}
for (N in 1:Nall){
Pdata<-varargin[[N]]
- if (length(Pdata)==0) next
- if (mode(Pdata)!="list") Pdata<-list(Pdata)
+ if(length(Pdata)==0) next
+ if(mode(Pdata)!="list") Pdata<-list(Pdata)
while(Mixtype(Pdata)==3){ # 10.07.25
Tmp1<- list()
for(II in Looprange(1,length(Pdata))){
@@ -2085,12 +2204,12 @@ Drwline<-function(...)
Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
cat(Str,file=Wfile,append=TRUE)
Mojisu<-Mojisu+nchar(Str)
- if (Mojisu>80){
+ if(Mojisu>80){
cat("%\n",file=Wfile,append=TRUE)
Mojisu<-0
}
}
- if (Mojisu!=0){
+ if(Mojisu!=0){
cat("%\n",file=Wfile,append=TRUE)
}
cat("\\special{fp}%\n",file=Wfile,append=TRUE)
@@ -2098,7 +2217,7 @@ Drwline<-function(...)
}
}
Str<-"%"
- if (Thick>0){
+ if(Thick>0){
Tmp<-PenThick/PenThickInit
Setpen(Tmp)
}
@@ -2110,22 +2229,22 @@ Drwpt<-function(...)
{ ## Scaling is implemented
varargin<-list(...)
Nargs<-length(varargin)
- if (TenSize>TenSizeInit){
+ if(TenSize>TenSizeInit){
N<- round(6*sqrt(TenSize/TenSizeInit))
}
else{
N<-4
}
Tmp<- varargin[[Nargs]]
- if (mode(Tmp)=="numeric"){
- if (length(Tmp)>1){
+ if(mode(Tmp)=="numeric"){
+ if(length(Tmp)>1){
Kosa<- 1; All<- Nargs
}
else{
Kosa<- Tmp; All<- Nargs-1
}
}
- else if (mode(Tmp)=="list"){
+ else if(mode(Tmp)=="list"){
Kosa<- 1; All<- Nargs
}
CL<-c()
@@ -2139,12 +2258,12 @@ Drwpt<-function(...)
for (II in Looprange(1,All)){
MS<- varargin[[II]]
MS=Flattenlist(MS) #17.10.11
- if (mode(MS)=="numeric"){
+ if(mode(MS)=="numeric"){
MS<- list(MS)
}
for (I in Looprange(1,length(MS))){
P<- MS[[I]]
- if (InWindow(P)!="i") next
+ if(InWindow(P)!="i") next
P<- Doscaling(P)
PL<-c()
for (J in 0:N){
@@ -2160,7 +2279,7 @@ Drwpt<-function(...)
Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
cat(Str,file=Wfile,append=TRUE)
Mojisu<- Mojisu+nchar(Str)
- if (Mojisu>80){
+ if(Mojisu>80){
cat("#\n",file=Wfile,append=TRUE)
}
Mojisu=0
@@ -2180,7 +2299,7 @@ Drwxy<-function(...)
varargin<-list(...)
Nargs <- length(varargin)
Tmp<-grep("arrow", ZIKU)
- if (length(Tmp)>0)
+ if(length(Tmp)>0)
{
Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE)
Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE)
@@ -2204,9 +2323,9 @@ Enclosing<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
P<- varargin[[1]]
- if (Mixtype(P)==2){
+ if(Mixtype(P)==2){
Tmp<- Op(1,P)
- if (mode(Tmp)!="numeric" || length(Tmp)>1){
+ if(mode(Tmp)!="numeric" || length(Tmp)>1){
AnsL<- EnclosingS(...)
AnsL<- Joincrvs(AnsL) # 10.12.04
}
@@ -2234,11 +2353,11 @@ EnclosingS<- function(...)
Flg<- 0
for (I in Looprange(2,Nargs)){
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
+ if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
S<- Tmp
}
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
- if (Flg==0){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(Flg==0){
Eps<- Tmp
Flg=Flg+1
}
@@ -2249,13 +2368,13 @@ EnclosingS<- function(...)
}
F<- Op(1,PdataL); G<- Op(Nall,PdataL)
KL<- IntersectcrvsPp(F,G)
- if (length(KL)==1){
+ if(length(KL)==1){
Tmp<- Op(1,KL)
P<- Op(1,Tmp)
T1<- Op(2,Tmp)
}
- if (length(KL)==0){
- if (Numptcrv(F)>Numptcrv(G)){
+ if(length(KL)==0){
+ if(Numptcrv(F)>Numptcrv(G)){
Tmp<- Nearestpt(F,G)
P<- Op(1,Tmp)
T1=Op(2,Tmp)
@@ -2266,8 +2385,8 @@ EnclosingS<- function(...)
T1<- Op(4,Tmp)
}
}
- if (length(KL)>=2){
- if (length(S)==0){
+ if(length(KL)>=2){
+ if(length(S)==0){
return("No Start Point")
}
Tmp<- Op(1,KL)
@@ -2277,7 +2396,7 @@ EnclosingS<- function(...)
for (I in Looprange(2,length(KL))){
Tmp1<- Op(1,Op(I,KL))
Tmp2<- Norm(Tmp1-S)
- if (Tmp2<Tmp){
+ if(Tmp2<Tmp){
P<- Tmp1
T1<- Op(2,Op(I,KL))
Tmp<- Tmp2
@@ -2288,29 +2407,29 @@ EnclosingS<- function(...)
AnsL<- list()
for (N in Looprange(1,Nall)){
F<- Op(N,PdataL)
- if (N>1) P<- Q
- if (N==Nall){
+ if(N>1) P<- Q
+ if(N==Nall){
Q=S
}
else{
Flg<- 0
G<- Op(N+1,PdataL)
KL<- IntersectcrvsPp(G,F)
- if (length(KL)==1){
+ if(length(KL)==1){
Tmp<- Op(1,KL)
Q<- Op(1,Tmp)
T3<- Op(2,Tmp)
Flg<- 10
}
- if (length(KL)==0) Flg<- 1
- if (length(KL)>=2){ # Maple bug?
+ if(length(KL)==0) Flg<- 1
+ if(length(KL)>=2){ # Maple bug?
Tmp1<- Op(1,Op(1,KL))
Tmp2<- Op(1,Op(2,KL))
Tmp<- Norm(Tmp1-Tmp2)
- if (Tmp<Eps*10) Flg<- 1
+ if(Tmp<Eps*10) Flg<- 1
}
- if (Flg==1){
- if (Numptcrv(F)>Numptcrv(G)){
+ if(Flg==1){
+ if(Numptcrv(F)>Numptcrv(G)){
Tmp<- Nearestpt(F,G)
Q<- Op(1,Tmp)
T3<- Op(4,Tmp)
@@ -2323,15 +2442,15 @@ EnclosingS<- function(...)
Flg<- 10
}
}
- if (Flg<10){
+ if(Flg<10){
T2<- Inf
for (I in Looprange(1,length(KL))){
Dt<- Op(I,KL)
Tmp1<- Op(1,Dt)
Tmp<- Op(3,Dt)
- Tmp2<- Paramoncrv(Tmp1,Tmp,F)
+ Tmp2<- Paramoncurve(Tmp1,Tmp,F)
Tmp3<- Op(2,Dt)
- if (Tmp2>T1+Eps && Tmp2<T2-Eps){
+ if(Tmp2>T1+Eps && Tmp2<T2-Eps){
Q<- Tmp1
T2<- Tmp2
T3<- Tmp3
@@ -2352,13 +2471,13 @@ Endpicture<-function(...)
{
varargin<-list(...)
Nargs<-length(varargin)
- if (Nargs==0)
+ if(Nargs==0)
{
Drwxy()
}
else
{
- if (varargin[[1]]==1) Drwxy()
+ if(varargin[[1]]==1) Drwxy()
}
cat("\\end{picture}}%",file=Wfile,append=TRUE)
# MEMORI<<-MEMORINow*1000/2.54/MilliIn
@@ -2373,7 +2492,7 @@ Execmd<- function(StrL)
StrL<- list(StrL)
}
for (I in Looprange(1,length(StrL))){
- if (!is.na(Op(I,StrL)) && nchar(Op(I,StrL))>0){
+ if(!is.na(Op(I,StrL)) && nchar(Op(I,StrL))>0){
eval(parse(text=Op(I,StrL)))
}
}
@@ -2396,20 +2515,20 @@ Expr<-function(...)
Mojiretu<-paste("$",varargin[[I+2]],"$",sep="")
Hset<-Houkou
Vhoko<-"c"
- if (length(grep("n",Hset))>0)
+ if(length(grep("n",Hset))>0)
{
Vhoko<-"n"; Y<-Y+MEMORI
}
- if (length(grep("s",Hset))>0)
+ if(length(grep("s",Hset))>0)
{
Vhoko<-"s"; Y<-Y-MEMORI
}
Hhoko<-"c"
- if (length(grep("e",Hset))>0)
+ if(length(grep("e",Hset))>0)
{
Hhoko<-"e"; X<-X+MEMORI
}
- if (length(grep("w",Hset))>0)
+ if(length(grep("w",Hset))>0)
{
Hhoko<-"w"; X<-X-MEMORI
}
@@ -2420,34 +2539,34 @@ Expr<-function(...)
while (J<=nchar(Houkou))
{
Tmp<-substring(Houkou,J,J)
- if (length(grep(Tmp,Suu))>0)
+ if(length(grep(Tmp,Suu))>0)
{
- if (Dstr=="") Hk<-substring(Houkou,J-1,J-1)
+ if(Dstr=="") Hk<-substring(Houkou,J-1,J-1)
Dstr<-paste(Dstr,Tmp,sep="")
}
else
{
- if (Dstr!="")
+ if(Dstr!="")
{
Nmbr<-as.numeric(Dstr)
D<-Nmbr*MEMORI
- if (Hk=="n") Y<-Y+D
- if (Hk=="s") Y<-Y-D
- if (Hk=="e") X<-X+D
- if (Hk=="w") X<-X-D
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
Dstr<-""
}
}
J<-J+1
}
- if (Dstr!="")
+ if(Dstr!="")
{
Nmbr<-as.numeric(Dstr)
D<-Nmbr*MEMORI;
- if (Hk=="n") Y<-Y+D
- if (Hk=="s") Y<-Y-D
- if (Hk=="e") X<-X+D
- if (Hk=="w") X<-X-D
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
}
CalcWidth(Hoko,Mojiretu)
CalcHeight(Hoko,Mojiretu)
@@ -2474,12 +2593,12 @@ Exprrot<- function(...)
V<- Doscaling(V)
Tmov<- 0
Tmp<- varargin[[N]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Tmov<- Tmp; N<- N+1
}
Nmov<- 0
Tmp<- varargin[[N]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Nmov<- Tmp; N<- N+1
}
Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26
@@ -2488,7 +2607,7 @@ Exprrot<- function(...)
P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv
Tmp<- acos(V[1]/Norm(V))
Theta<- round(Tmp*180/pi)
- if (V[2]>=0){
+ if(V[2]>=0){
Units<- ""
}
else{
@@ -2508,7 +2627,7 @@ Findcell<- function(...)
TbL<- varargin[[1]]
Ag<- varargin[[2]]
Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- if (mode(Ag)=="character"){
+ if(mode(Ag)=="character"){
Clm<- c()
Rstr<- ""
for (I in Looprange(1,nchar(Ag))){
@@ -2516,7 +2635,7 @@ Findcell<- function(...)
C<- toupper(C)
Tmp<- strsplit(Alpha,C)
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
Tmp1<- nchar(Tmp[1])
Clm<- c(Clm,Tmp1)
}
@@ -2531,7 +2650,7 @@ Findcell<- function(...)
Nrg<- Nrg+Tmp*26^Tmp1
}
Mrg<- eval(parse(text=Rstr))
- if (Nargs>=3){
+ if(Nargs>=3){
Ag<- varargin[[3]]
Clm<- c()
Rstr<- ""
@@ -2539,7 +2658,7 @@ Findcell<- function(...)
C<- substr(Ag,1,1)
C<- toupper(C)
Tmp<- strsplit(Alpha,C)
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
Clm<- c(Clm,Tmp+1)
}
else{
@@ -2561,13 +2680,13 @@ Findcell<- function(...)
Nrg<- varargin[[2]]
Mrg<- varargin[[3]]
}
- if (length(Mrg)==1){
+ if(length(Mrg)==1){
m1<- Mrg; m2<- m1+1
}
else{
m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12
}
- if (length(Nrg)==1){
+ if(length(Nrg)==1){
n1<- Nrg; n2<- n1+1
}
else{
@@ -2594,7 +2713,7 @@ Findcell<- function(...)
Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp)))
VL<- Mixjoin(list(Tmp1),VL,list(Tmp2))
Tmp<- HL[[n1]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
H1<- Tmp[1,1]
}
else{
@@ -2602,7 +2721,7 @@ Findcell<- function(...)
H1<- Tmp1[1,1]
}
Tmp<- HL[[n2]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
H2<- Tmp[1,1]
}
else{
@@ -2610,7 +2729,7 @@ Findcell<- function(...)
H2<- Tmp1[1,1]
}
Tmp<- VL[[m1]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
V1<- Tmp[1,2]
}
else{
@@ -2618,7 +2737,7 @@ Findcell<- function(...)
V1<- Tmp1[1,2]
}
Tmp<- VL[[m2]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
V2<- Tmp[1,2]
}
else{
@@ -2660,50 +2779,50 @@ Fontsize<- function(Ookisa)
{
Str<- "%"
S<- substr(Ookisa,1,1)
- if (S=="n"){
+ if(S=="n"){
Str<- "\\normalsize%"
}
- if (S=="s"){
- if (nchar(Ookisa)==1){
+ if(S=="s"){
+ if(nchar(Ookisa)==1){
Tmp<- "n"
}
else{
Tmp<- substr(Ookisa,2,2)
}
- if (Tmp=="s"){
+ if(Tmp=="s"){
Str<- "\\scriptsize%"
}
else{
Str<- "\\small%"
}
}
- if (S=="f"){
+ if(S=="f"){
Str<- "\\footnotesize%"
}
- if (S=="t"){
+ if(S=="t"){
Str<- "\\tiny%"
}
- if (S=="l"){
+ if(S=="l"){
Str<- "\\large%"
}
- if (S=="L"){
- if (nchar(Ookisa)==1){
+ if(S=="L"){
+ if(nchar(Ookisa)==1){
Tmp<- "a"
}
else{
Tmp<- substr(Ookisa,2,2)
}
- if (Tmp=="a"){
+ if(Tmp=="a"){
Str<- "\\Large%"
}
else{
Str<- "\\LARGE%"
}
}
- if (S=="h"){
+ if(S=="h"){
Str<- "\\huge%"
}
- if (S=="H"){
+ if(S=="H"){
Str<- "\\Huge%"
}
cat(Str,file=Wfile,append=TRUE)
@@ -2723,13 +2842,13 @@ Fracform<- function(...)
X<- as.matrix(X,nrow=Nr)
for (I in Looprange(2,Nargs)){
Tmp<- varargin[[I]]
- if (mode(Tmp)!="numeric"){
+ if(mode(Tmp)!="numeric"){
next
}
- if (Tmp>1){
+ if(Tmp>1){
Nmax<- Tmp
}
- else if (Tmp>0){
+ else if(Tmp>0){
Eps<- Tmp
}
}
@@ -2738,7 +2857,7 @@ Fracform<- function(...)
for (I in Looprange(1,nrow(X))){
for (J in Looprange(1,ncol(X))){
Dt<- X[I,J]
- if (mode(Dt)=="character"){
+ if(mode(Dt)=="character"){
Dt<- eval(parse(text=Dt))
}
R<- 1
@@ -2749,23 +2868,23 @@ Fracform<- function(...)
N<- N+1
M<- round(Dt*N)
R<- abs(Dt-M/N)
- if (R<Rmin){
+ if(R<Rmin){
Rmin<- R
Nr<- N
}
}
- if (N==Nmax){
+ if(N==Nmax){
N<- Nr
M<- round(Dt*N)
}
Tmp<- as.character(M)
- if (N!=1){
+ if(N!=1){
Tmp<- paste(Tmp,"/",as.character(N),sep="")
}
Out[I,J]<- Tmp
}
}
- if (nrow(Out)==1){
+ if(nrow(Out)==1){
Out<- as.character(Out)
}
return(Out)
@@ -2778,7 +2897,7 @@ Framedata<-function(...)
{
varargin<- Flattenlist(list(...))
N<-length(varargin)
- if (N<= 1){
+ if(N<= 1){
H<- 1.0*10^(-4);
PA<-c(XMIN+H,YMIN+H)
PB<-c(XMAX-H,YMIN+H)
@@ -2787,10 +2906,10 @@ Framedata<-function(...)
}
else{
Tmp<-varargin[[N]]
- if (is.numeric(Tmp) && length(Tmp)==1){
+ if(is.numeric(Tmp) && length(Tmp)==1){
Dy<-Tmp; Dx<-Dy
Tmp<-varargin[[N-1]]
- if (is.numeric(Tmp) && length(Tmp)==1){
+ if(is.numeric(Tmp) && length(Tmp)==1){
Dx<-Tmp
}
Tmp<-varargin[[1]]
@@ -2826,31 +2945,31 @@ Hatchdata<- function(...)
for (N in seq(Nargs,1, by=-1))
{
Tmp<- varargin[[N]]
- if (mode(Tmp)=="list")
+ if(mode(Tmp)=="list")
{
break
}
}
- if (N<Nargs)
+ if(N<Nargs)
{
Kakudo<- varargin[[N+1]]
- if (N==Nargs-2)
+ if(N==Nargs-2)
{
Kankaku<- 0.125*varargin[[Nargs]]
}
}
NaitenL<- varargin[[1]]
- if (mode(NaitenL)!="list")
+ if(mode(NaitenL)!="list")
{
NaitenL<- list(NaitenL)
}
Ns<- 2
StartP<- Op(1,NaitenL)
- if (mode(StartP)=="character")
+ if(mode(StartP)=="character")
{
StartP<- c((Xmn+Xmx)/2, (Ymn+Ymx)/2)
}
- if (mode(varargin[[2]])=="numeric")
+ if(mode(varargin[[2]])=="numeric")
{
StartP<- varargin[[2]]
StartP<- Doscaling(StartP)
@@ -2876,7 +2995,7 @@ Hatchdata<- function(...)
for (I in Looprange(1,length(NaitenL)))
{
Tmp<- Op(I, NaitenL)
- if (mode(Tmp)=="numeric")
+ if(mode(Tmp)=="numeric")
{
Tmp1<- Naigai(Tmp,Bdy)
Tmp2<- Mixjoin(PtnL, list(Tmp1))
@@ -2884,14 +3003,14 @@ Hatchdata<- function(...)
}
else
{
- if (mode(Tmp)!="character")
+ if(mode(Tmp)!="character")
{
return("Mode Error")
}
Ptn<-c()
for (J in 1:nchar(Tmp))
{
- if (Op(J,Tmp)=="i")
+ if(Op(J,Tmp)=="i")
{
Ptn<- c(Ptn,1)
}
@@ -2905,7 +3024,7 @@ Hatchdata<- function(...)
}
Call<- length(Bdy)
Ptn<- c(seq(0, 0, length=Call))
- if (Member(Ptn,PtnL))
+ if(Member(Ptn,PtnL))
{
Wn<- Doscaling(Framedata())
Tmp<- Mixjoin(Bdy,list(Wn))
@@ -2922,7 +3041,7 @@ Hatchdata<- function(...)
V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180))
Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180))
Tmp<- Op(1,NaitenL)
- if (mode(Tmp)=="numeric" && length(Tmp)==2)
+ if(mode(Tmp)=="numeric" && length(Tmp)==2)
{
Tmp<- Doscaling(Tmp)
Delta<- Tmp-StartP
@@ -2991,11 +3110,11 @@ Htickmark<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
ArgsL<- varargin
- if (mode(ArgsL[[1]])=="character"){
+ if(mode(ArgsL[[1]])=="character"){
Str<- ArgsL[[1]]
Tmp<- strsplit(Str,"m")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
I<- nchar(Tmp[1])+1
}
else{
@@ -3003,7 +3122,7 @@ Htickmark<- function(...)
}
Tmp<- strsplit(Str,"n")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
J<- nchar(Tmp[1])+1
}
else{
@@ -3011,16 +3130,16 @@ Htickmark<- function(...)
}
Tmp<- strsplit(Str,"r")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
K=nchar(Tmp[1])+1
}
else{
K<- 0
}
- if (K>0){
+ if(K>0){
S<- substr(Str,K+1,nchar(Str))
R<- as.numeric(S)
- if (is.na(R)){
+ if(is.na(R)){
R<- 1
}
}
@@ -3028,10 +3147,10 @@ Htickmark<- function(...)
R<- 1
K<- nchar(Str)+1
}
- if (J>0){
+ if(J>0){
S<- substr(Str,J+1,K-1)
Dn<- as.numeric(S)
- if (is.na(Dn)){
+ if(is.na(Dn)){
Dn<- 1
}
}
@@ -3041,20 +3160,20 @@ Htickmark<- function(...)
}
S<- substr(Str,I+1,J-1)
Dm<- as.numeric(S)
- if (is.na(Dm)){
+ if(is.na(Dm)){
Dm<- 1
}
ArgsL<- list()
for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
}
for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
@@ -3064,18 +3183,18 @@ Htickmark<- function(...)
Memori<- list()
for (N in 1:length(ArgsL)){
Dt<- ArgsL[[N]]
- if (mode(Dt)=="numeric" && length(Dt)>1){
- if (length(Memori)>0){
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(Dt[1],Dt[2])
next
}
- if (mode(Dt)=="character"){
+ if(mode(Dt)=="character"){
Memori<- Mixjoin(Memori,Dt)
}
else{
- if (length(Memori)>0){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(Dt,GENTEN[2])
@@ -3095,14 +3214,14 @@ Htickmark<- function(...)
Tmp2<- Unscaling(c(X,Y-MARKLEN))
Fd<- Listplot(c(Tmp1,Tmp2))
Drwline(Fd)
- if (Ndt==3){
+ if(Ndt==3){
Tmp<-Unscaling(c(X,Y-MARKLEN))
Expr(Tmp,"s",Moji)
}
- if (Ndt==4){
+ if(Ndt==4){
Houkou<- Op(3,Dt)
Tmp<-grep("s",Houkou)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Tmp<-Unscaling(c(X,Y-MARKLEN))
Expr(Tmp,Houkou,Moji)
}
@@ -3139,17 +3258,17 @@ Intersectcrvs<-function(...)
Nargs<-length(varargin)
Eps<-10^(-4)
Tmp<-varargin[[Nargs]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1)
+ if(mode(Tmp)=="numeric" && length(Tmp)==1)
{
Eps<-Tmp
}
G1<-varargin[[1]]
- if (mode(G1)=="numeric")
+ if(mode(G1)=="numeric")
{
G1<-list(G1)
}
G2<-varargin[[2]]
- if (mode(G2)=="numeric")
+ if(mode(G2)=="numeric")
{
G2<-list(G2)
}
@@ -3178,20 +3297,20 @@ IntersectcrvsPp<-function(...)
Nargs<-length(varargin)
G1<-varargin[[1]]; G2<-varargin[[2]]
Eps<- 10.0^(-4)
- if (Nargs>2) Eps<-varargin[[3]]
+ if(Nargs>2) Eps<-varargin[[3]]
SqEps<- 10.0^(-10)
Eps2<- 0.1
- if (Nargs>3) Eps2<-varargin[[4]]
+ if(Nargs>3) Eps2<-varargin[[4]]
Data1<-G1
Data2<-G2
- if (Nrow(Data1)==Nrow(Data2))
+ if(Nrow(Data1)==Nrow(Data2))
{
Tmp<-seq(Nrow(Data2),1, by=-1)
Tmp1<-Data2[Tmp,]
Eps0<-10^(-6)
Tmp2<-Norm(Data1-Data2)
Tmp3<-Norm(Data1-Tmp1)
- if (Tmp2<Eps0||Tmp3<Eps0)
+ if(Tmp2<Eps0||Tmp3<Eps0)
{
KL<-list()
return(KL)
@@ -3207,9 +3326,9 @@ IntersectcrvsPp<-function(...)
{
P<-Data2[J,]; Q<-Data2[J+1,]
Tmp<-Koutenseg(A,B,P,Q,Eps,Eps2)
- if (mode(Tmp)=="list")
+ if(mode(Tmp)=="list")
{
- if (Tmp[[3]]==0)
+ if(Tmp[[3]]==0)
{
Tmp1<-list(Tmp[[1]],Tmp[[2]],I,J)
KL1<-append(KL1,list(Tmp1))
@@ -3223,7 +3342,7 @@ IntersectcrvsPp<-function(...)
}
}
KL<-list()
- if (length(KL1)>0)
+ if(length(KL1)>0)
{
Tmp<-KL1[[1]]
P<-Tmp[[1]]
@@ -3240,15 +3359,15 @@ IntersectcrvsPp<-function(...)
Flg<-0
for (K in 1:length(KL))
{
- if (1>length(KL)) break
+ if(1>length(KL)) break
Tmp<-KL[[K]]
- if (Norm(P-Tmp[[1]])^2<SqEps)
+ if(Norm(P-Tmp[[1]])^2<SqEps)
{
Flg<-1
break
}
}
- if (Flg==0)
+ if(Flg==0)
{
Tmp<-KL1[[N]]
T<-Tmp[[2]]
@@ -3266,13 +3385,13 @@ IntersectcrvsPp<-function(...)
for (K in Looprange(1,length(KL)))
{
Tmp<-KL[[K]]
- if (Norm(P-Tmp[[1]])^2<SqEps)
+ if(Norm(P-Tmp[[1]])^2<SqEps)
{
Flg<-1
break
}
}
- if (Flg==0)
+ if(Flg==0)
{
Tmp<-KL2[[N]]
T<-Tmp[[2]]
@@ -3295,9 +3414,9 @@ Invdashline<- function(...)
Nargs<- length(varargin)
Nall<- Nargs; Sen<- 1 ; Gap<- 1
Tmp<- varargin[[Nall]]
- if (is.numeric(Tmp) && length(Tmp)==1 && Tmp>0){ # 13.12.20
+ if(is.numeric(Tmp) && length(Tmp)==1 && Tmp>0){ # 13.12.20
Tmp1<- varargin[[Nall-1]]
- if (is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20
+ if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20
Sen<- Tmp1; Gap<- Tmp
Nall<- Nall-2
}
@@ -3329,7 +3448,7 @@ InWindow<-function(PA)
Eps<-10.0^(-6);
if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20
X<-PA[1]; Y<-PA[2];
- if (X>XMIN-Eps && X<XMAX+Eps && Y>YMIN-Eps && Y<YMAX+Eps)
+ if(X>XMIN-Eps && X<XMAX+Eps && Y>YMIN-Eps && Y<YMAX+Eps)
Rx<-"i"
else
Rx<-"o"
@@ -3347,12 +3466,12 @@ Joincrvs<- function(...)
Nall<- length(varargin)
Eps<- 10^(-4)
Tmp<- varargin[[Nall]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
Eps<- Tmp
Nall<- Nall-1
}
QdL<- Flattenlist(varargin[1:Nall]) # 11.06.25
- if (length(QdL)==0){
+ if(length(QdL)==0){
PtL<-c()
return(PtL)
}
@@ -3365,17 +3484,17 @@ Joincrvs<- function(...)
Q<- Ptstart(Qd)
R<- Ptend(Qd)
MN<- min(Norm(P-Q),Norm(P-R),Norm(S-Q),Norm(S-R))
- if (MN==Norm(P-R)){
+ if(MN==Norm(P-R)){
Qd<- Invert(Qd)
}
- else if (MN==Norm(S-Q)){
+ else if(MN==Norm(S-Q)){
PtL=Invert(PtL)
}
- else if (MN==Norm(S-R)){
+ else if(MN==Norm(S-R)){
PtL<- Invert(PtL)
Qd<- Invert(Qd)
}
- if (MN>Eps){
+ if(MN>Eps){
PtL<- Appendrow(PtL,Qd)
}
else{
@@ -3396,7 +3515,7 @@ Joingraphics<- function(...)
N<- length(Ls)
Tp<- Ls[[N]]
Listflg<- 0
- if ( is.character(Tp)){
+ if( is.character(Tp)){
Tmp<- toupper(substr(Tp,1,1))
if(Tmp=="L"){
Listflg<- 1
@@ -3429,19 +3548,19 @@ Kouten<- function(PA,V,P,Q)
P1<- P[1]; P2<- P[2]
U1<- Q[1]-P1; U2<- Q[2]-P2
Tmp<- Norm(P-Q)*Norm(V)
- if (Tmp==0)
+ if(Tmp==0)
{
Out<- list(Inf,-Inf)
return(Out)
}
D<- U1*V2-U2*V1
- if (abs(D)/Tmp<Eps)
+ if(abs(D)/Tmp<Eps)
{
Out<- list(Inf,-Inf)
return(Out)
}
S<- ((-A2+P2)*V1+(A1-P1)*V2)/D
- if (S>1+Eps || S<Eps)
+ if(S>1+Eps || S<Eps)
{
Out<-list(Inf,-Inf)
return(Out)
@@ -3464,10 +3583,10 @@ KoutenList<- function(PA,V,Bdy)
for (K in Looprange(1, Nrow(KL)-1))
{
P<- Op(K,KL); Q<- Op(K+1,KL)
- if (P!="/" && Q!="/")
+ if(P!="/" && Q!="/")
{
Tmp<- Kouten(PA,V,P,Q);
- if (Tmp[[1]]!=Inf)
+ if(Tmp[[1]]!=Inf)
{
Ten<- append(Tmp,N)
Flg<- 0
@@ -3476,7 +3595,7 @@ KoutenList<- function(PA,V,Bdy)
while (Flg==0 && I<=NN)
{
Tmp<- Op(I,TenL)
- if (Op(1,Ten)<Op(1,Tmp)-Eps)
+ if(Op(1,Ten)<Op(1,Tmp)-Eps)
{
Tmp1<- TenL[Looprange(1,I-1)]
Tmp2<- TenL[Looprange(I,length(TenL))]
@@ -3484,9 +3603,9 @@ KoutenList<- function(PA,V,Bdy)
Flg<-1
}
else
- if (Op(1,Ten)<Op(1,Tmp)+Eps)
+ if(Op(1,Ten)<Op(1,Tmp)+Eps)
{
- if (Op(4,Ten)!=Op(4,Tmp))
+ if(Op(4,Ten)!=Op(4,Tmp))
{
Tmp1<- TenL[Looprange(1,I-1)]
Tmp2<- TenL[Looprange(I,length(TenL))]
@@ -3494,7 +3613,7 @@ KoutenList<- function(PA,V,Bdy)
Flg<-1
}
else
- if (Op(3,Ten)!=Op(3,Tmp))
+ if(Op(3,Ten)!=Op(3,Tmp))
{
Tmp1<- TenL[Looprange(I,I-1)]
Tmp2<- TenL[Looprange(I+1,length(TenL))]
@@ -3504,7 +3623,7 @@ KoutenList<- function(PA,V,Bdy)
}
I<- I+1
}
- if (Flg==0)
+ if(Flg==0)
{
TenL<- Mixjoin(TenL,list(Ten))
}
@@ -3525,19 +3644,19 @@ Koutenseg<-function(...)
Eps0 <- 10^(-4)
A<-varargin[[1]]; V<-varargin[[2]]-A
Sv2 <- V[1]^2+V[2]^2
- if (Sv2<10^(-6))
+ if(Sv2<10^(-6))
{
Out<-Inf
return(Out)
}
P<-varargin[[3]]-A; Q<-varargin[[4]]-A
Eps <- 10.0^(-3)
- if (Nargs>=5)
+ if(Nargs>=5)
{
Eps<-varargin[[5]]
}
Eps2 <- 0.2
- if (Nargs>=6)
+ if(Nargs>=6)
{
Eps2<-varargin[[6]]
}
@@ -3548,22 +3667,22 @@ Koutenseg<-function(...)
Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2
m1 <- -Eps; M1 <- 1+Eps
m2 <- -Eps; M2 <- Eps
- if (max(P1,Q1)<m1 || min(P1,Q1)>M1)
+ if(max(P1,Q1)<m1 || min(P1,Q1)>M1)
{
Out<-Inf
return(Out)
}
- if (max(P2,Q2)<m2 || min(P2,Q2)>M2)
+ if(max(P2,Q2)<m2 || min(P2,Q2)>M2)
{
Out<-Inf
return(Out)
}
- if (P2*Q2<0)
+ if(P2*Q2<0)
{
T<- P1-(Q1-P1)/(Q2-P2)*P2
- if (T>m1 && T<M1)
+ if(T>m1 && T<M1)
{
- if (T > -Eps0 && T<1+Eps0)
+ if(T > -Eps0 && T<1+Eps0)
{
Tmp1<-A+T*V
Tmp2<-min(max(T,0),1)
@@ -3577,9 +3696,9 @@ Koutenseg<-function(...)
}
return(Out)
}
- if (P1<m1 || P1>M1 || P2<m2 || P2>M2)
+ if(P1<m1 || P1>M1 || P2<m2 || P2>M2)
{
- if (Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
+ if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
{
Out<-Inf
return(Out)
@@ -3594,23 +3713,23 @@ Koutenseg<-function(...)
Out<-list(Tmp,T,1)
return(Out)
}
- if (P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0)
+ if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0)
{
T<- P1
Tmp<- A+T*V
Out<- list(Tmp, T, 0)
return(Out)
}
- if (Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2<Eps0)
+ if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2<Eps0)
{
T<- Q1
Tmp<-A+T*V
Out<- list(Tmp,T,0)
return(Out)
}
- if (P1<m1 || P1>M1 || P2<m2 || P2>M2)
+ if(P1<m1 || P1>M1 || P2<m2 || P2>M2)
{
- if (Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
+ if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
{
Out<-Inf
return(Out)
@@ -3620,14 +3739,14 @@ Koutenseg<-function(...)
Out<-list(Tmp,T,1)
return(Out)
}
- if (Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
+ if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
{
T<-min(max(P1,0),1)
Tmp<-A+T*V
Out<-list(Tmp,T,1)
return(Out)
}
- if (abs(P2)<abs(Q2))
+ if(abs(P2)<abs(Q2))
{
T<-min(max(P1,0),1)
}
@@ -3650,7 +3769,7 @@ Kukeiwake<- function(PL)
Tmp<-matrix(c(NW,SW,SE,NE,NW),nrow=2)
Sikaku<- t(Tmp)
Kt<- IntersectcrvsPp(PL,Sikaku)
- if (length(Kt)!=2)
+ if(length(Kt)!=2)
{
print("not two points")
return(c())
@@ -3663,55 +3782,55 @@ Kukeiwake<- function(PL)
Pt2<- Op(1,Tmp)
N2<- trunc(Op(2,Tmp))
M2<- Op(3,Tmp)
- T1<- ParamonCurve(Pt1,M1,Sikaku)
- T2<- ParamonCurve(Pt2,M2,Sikaku)
+ T1<- Paramoncurve(Pt1,M1,Sikaku) #18.02.06
+ T2<- Paramoncurve(Pt2,M2,Sikaku)
QL<c()
- if (Norm(Pt1-Op(N1+1,PL))>Eps)
+ if(Norm(Pt1-Op(N1+1,PL))>Eps)
{
QL<-Pt1
}
Tmp<-Appendrow(QL,PL[(N1+1):N2,])
QL<- Tmp
- if (Norm(Pt2-Op(N2,PL))>Eps)
+ if(Norm(Pt2-Op(N2,PL))>Eps)
{
Tmp<-Appendrow(QL,Pt2)
QL<- Tmp
}
HidariL<- QL
Ms<- M2+1; Me<- M1
- if (T1<T2+Eps) Me<- M1+4
+ if(T1<T2+Eps) Me<- M1+4
for (M in Looprange(Ms,Me))
{
Tmp<- Op(Nrow(HidariL),HidariL)
P<-Op(((M-1) %% 4)+1,Sikaku)
- if (Norm(Tmp-P)>Eps)
+ if(Norm(Tmp-P)>Eps)
{
Tmp<-Append(HidariL,P)
HidariL<-Tmp
}
}
Tmp<- Op(Nrow(HidariL),HidariL)
- if (Norm(Tmp-Pt1)>Eps)
+ if(Norm(Tmp-Pt1)>Eps)
{
Tmp<-Append(HidariL,Pt1)
HidariL<-Tmp
}
MigiL<- QL
Ms<- M2; Me<- M1+1
- if (T1>T2-Eps) Me<- Me-4
+ if(T1>T2-Eps) Me<- Me-4
for (Mm in Looprange(Me,Ms))
{
M<- Me+Ms-Mm
Tmp<- Op(Nrow(MigiL),MigiL)
P<- Op(((M-1) %% 4)+1,Sikaku)
- if (Norm(Tmp-P)>Eps)
+ if(Norm(Tmp-P)>Eps)
{
Tmp<-Appendrow(MigiL,P)
MigiL<-Tmp
}
}
Tmp<- Op(Nrow(MigiL),MigiL)
- if (Norm(Tmp-Pt1)>Eps)
+ if(Norm(Tmp-Pt1)>Eps)
{
Tmp<-Appendrow(MigiL,Pt1)
MigiL<-Tmp
@@ -3731,11 +3850,11 @@ Kyoukai<- function(...)
DataL<-list()
for (I in 1:Nargs){
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
DataL<- Mixjoin(DataL,list(list(Tmp)))
}
- if (mode(Tmp)=="list"){
- if (mode(Tmp[[1]])!="list"){
+ if(mode(Tmp)=="list"){
+ if(mode(Tmp[[1]])!="list"){
DataL<- Mixjoin(DataL, list(Tmp))
}
else{
@@ -3750,11 +3869,11 @@ Kyoukai<- function(...)
for (I in 1:N){
Data<- Op(I, DataL)
Tmp<- Op(length(Data),Data)
- if (mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
+ if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
Rg<-Tmp ; Nd<-length(Data)-1
}
else{
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Rg<- Tmp ; Nd<-length(Data)-1
}
else{
@@ -3763,22 +3882,22 @@ Kyoukai<- function(...)
}
for (J in Looprange(1,Nd)){
Tmp<- Op(J,Data)
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Rg<- Tmp
next
}
Points<- Tmp
P1<- Ptstart(Points)
P2<- Ptend(Points)
- if (J==1){
+ if(J==1){
PL<- Points
Pfirst<- P1
Plast<- P2
- if (Nd>=2){
+ if(Nd>=2){
Tmp<- Data[[2]]
P<- Ptstart(Tmp)
Q<- Ptend(Tmp)
- if (Norm(P2-P)>Eps && Norm(P2-Q)>Eps){
+ if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){
Tmp< Nrow(PL)
PL<-PL[Tmp:1,]
Pfirst<- Ptstart(PL)
@@ -3787,11 +3906,11 @@ Kyoukai<- function(...)
}
}
else{
- if (Norm(P1-Plast)<Eps){
+ if(Norm(P1-Plast)<Eps){
Stp<-1; Ks<-2; Ke=Nrow(Points)
}
else{
- if (Norm(P2-Plast)<Eps) {
+ if(Norm(P2-Plast)<Eps) {
Stp<- -1; Ks<-Nrow(Points)-1; Ke=1
}
else{
@@ -3810,45 +3929,45 @@ Kyoukai<- function(...)
Plast<- Op(Ke,Points)
}
}
- if (Norm(Pfirst-Plast)>Eps){
+ if(Norm(Pfirst-Plast)>Eps){
Np<- Nrow(PL)
- if (Rg=="c"){
+ if(Rg=="c"){
Tmp<- Appendrow(PL,Pfirst)
PL<- Tmp
}
- else if (Rg=="s"){
+ else if(Rg=="s"){
Tmp<- c(PL[1:Np,2],YMIN)
Y<- min(Tmp)-1
P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y)
Tmp<- Appendrow(PL,P,Q,Pfirst)
PL<- Tmp
}
- else if (Rg=="n"){
+ else if(Rg=="n"){
Tmp<- c(PL[1:Np,2],YMAX)
Y<-max(Tmp)+1
P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y)
Tmp<- Appendrow(PL,P,Q,Pfirst)
PL<- Tmp
}
- else if (Rg=="w"){
+ else if(Rg=="w"){
Tmp<- c(PL[1:Np,1],XMIN)
X<- min(Tmp)-1
P<- c(X,Plast[2]); Q<- c(X,Pfirst[2])
Tmp<- Appendrow(PL,P,Q,Pfirst)
PL<- Tmp
}
- else if (Rg=="e"){
+ else if(Rg=="e"){
Tmp<- c(PL[1:Np,1],XMAX)
X<- max(Tmp)+1
P<- c(X,Plast[2]); Q<- c(X,Pfirst[2])
Tmp<- Appendrow(PL,P,Q,Pfirst)
PL<- Tmp
}
- else if (mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){
+ else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){
Tmp<- Kukeiwake(PL)
Tmp1<- Op(1,Tmp)
Tmp2<- Naigai(Rg,list(Tmp1))
- if (Tmp2==c(1)){
+ if(Tmp2==c(1)){
PL<-Op(1,Tmp)
}
else{
@@ -3860,7 +3979,7 @@ Kyoukai<- function(...)
for (J in 2:Nrow(PL)){
P<- Op(J,PL)
Q<- Op(Nrow(Tmp),Tmp)
- if (Norm(P-Q)>Eps){
+ if(Norm(P-Q)>Eps){
Tmp1<-Appendrow(Tmp,P)
Tmp<-Tmp1
}
@@ -3868,10 +3987,10 @@ Kyoukai<- function(...)
PL<-Tmp
PLall<-Mixjoin(PLall,list(PL))
}
- if (length(PLall)==1 && Sflg==0){
+ if(length(PLall)==1 && Sflg==0){
Tmp<- Op(1,PLall)
# Tmp<- Op(1,Tmp)
- if (Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){
+ if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){
Tmp1<- Appendrow(Tmp,Ptstart(Tmp))
PLall<- list(Tmp1)
}
@@ -3896,20 +4015,20 @@ Letter<-function(...)
Mojiretu<-varargin[[I+2]]
Hset<-Houkou
Vhoko<-"c"
- if (length(grep("n",Hset))>0)
+ if(length(grep("n",Hset))>0)
{
Vhoko<-"n"; Y<-Y+MEMORI
}
- if (length(grep("s",Hset))>0)
+ if(length(grep("s",Hset))>0)
{
Vhoko<-"s"; Y<-Y-MEMORI
}
Hhoko<-"c"
- if (length(grep("e",Hset))>0)
+ if(length(grep("e",Hset))>0)
{
Hhoko<-"e"; X<-X+MEMORI
}
- if (length(grep("w",Hset))>0)
+ if(length(grep("w",Hset))>0)
{
Hhoko<-"w"; X<-X-MEMORI
}
@@ -3920,34 +4039,34 @@ Letter<-function(...)
while (J<=nchar(Houkou))
{
Tmp<-substring(Houkou,J,J)
- if (length(grep(Tmp,SuuL))>0)
+ if(length(grep(Tmp,SuuL))>0)
{
- if (Dstr=="") Hk<-substring(Houkou,J-1,J-1)
+ if(Dstr=="") Hk<-substring(Houkou,J-1,J-1)
Dstr<-paste(Dstr,Tmp,sep="")
}
else
{
- if (Dstr!="")
+ if(Dstr!="")
{
Nmbr<-as.numeric(Dstr)
D<-Nmbr*MEMORI
- if (Hk=="n") Y<-Y+D
- if (Hk=="s") Y<-Y-D
- if (Hk=="e") X<-X+D
- if (Hk=="w") X<-X-D
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
Dstr<-""
}
}
J<-J+1
}
- if (Dstr!="")
+ if(Dstr!="")
{
Nmbr<-as.numeric(Dstr)
D<-Nmbr*MEMORI;
- if (Hk=="n") Y<-Y+D
- if (Hk=="s") Y<-Y-D
- if (Hk=="e") X<-X+D
- if (Hk=="w") X<-X-D
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
}
CalcWidth(Hoko,Mojiretu)
CalcHeight(Hoko,Mojiretu)
@@ -3974,12 +4093,12 @@ Letterrot<- function(...)
V<- Doscaling(V)
Tmov<- 0
Tmp<- varargin[[N]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Tmov<- Tmp; N<- N+1
}
Nmov<- 0
Tmp<- varargin[[N]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Nmov<- Tmp; N<- N+1
}
Mojiretu<- Assign(varargin[[N]]) #2017.11.26
@@ -3988,7 +4107,7 @@ Letterrot<- function(...)
P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv
Tmp<- acos(V[1]/Norm(V))
Theta<- round(Tmp*180/pi)
- if (V[2]>=0){
+ if(V[2]>=0){
Units<- ""
}
else{
@@ -4007,9 +4126,9 @@ Lineplot<-function(...)
varargin <- list(...)
Nargs<-length(varargin)
A<-varargin[[1]]
- if (is.numeric(A)) {
+ if(is.numeric(A)) {
Tmp<-length(A)
- if (Tmp>3) {
+ if(Tmp>3) {
B <- A[(Tmp/2+1):Tmp]
A <- A[1:(Tmp/2)]
Is <- 2
@@ -4033,10 +4152,10 @@ Lineplot<-function(...)
)
}
V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here
- if (Semi=="") {
+ if(Semi=="") {
Out<- Listplot(c(A-V,A+V))
}
- else if (Semi=="+") {
+ else if(Semi=="+") {
Out<- Listplot(c(A,A+V))
}
else {
@@ -4054,9 +4173,9 @@ Listplot<-function(...)
for (I in 1:length(varargin))
{
Data<-varargin[[I]];
- if (mode(Data)=="numeric")
+ if(mode(Data)=="numeric")
{
- if (class(Data)=="numeric")
+ if(class(Data)=="numeric")
{
Tmp<-matrix(Data,nrow=2);
Tmp<-t(Tmp);
@@ -4088,7 +4207,7 @@ MakeBowdata <- function(PA,PB,H)
R <- (H^2+D^2)/(2*H)
A1 <- PA[1]; A2<-PA[2]
B1 <- PB[1]; B2<-PB[2]
- if (abs(A2-B2)>Eps){
+ if(abs(A2-B2)>Eps){
# x <- poly(0,"X")
# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)
# Eq1 <- (A1-x)^2+(A2-y)^2-R^2
@@ -4112,18 +4231,18 @@ MakeBowdata <- function(PA,PB,H)
}
VA <- PA-PC
VB <- PB-PC
- if (VA[1]*VB[2]-VA[2]*VB[1]<0) {
+ if(VA[1]*VB[2]-VA[2]*VB[1]<0) {
PC <- PC2
}
AngA <- acos((PA[1]-PC[1])/R)
- if (PA[2]-PC[2]<0){
+ if(PA[2]-PC[2]<0){
AngA <- -AngA
}
AngB <- acos((PB[1]-PC[1])/R)
- if (PB[2]-PC[2]<0){
+ if(PB[2]-PC[2]<0){
AngB <- -AngB
}
- if (AngA>AngB) {
+ if(AngA>AngB) {
AngB <- AngB+2*pi
}
Out <- list(PC,R,AngA,AngB)
@@ -4135,11 +4254,11 @@ MakeBowdata <- function(PA,PB,H)
MakeCurves<-function(...){ ## Scaling is implemented
varargin<-list(...)
Figdata<-varargin[[1]]
- if (class(Figdata)=="numeric"){
+ if(class(Figdata)=="numeric"){
Figdata<-matrix(Figdata,nrow=1)
}
Ptout<-1
- if (length(varargin)>=2) Ptout<-varargin[[2]]
+ if(length(varargin)>=2) Ptout<-varargin[[2]]
Eps<-10.0^(-6)
IndM<-Dataindex(Figdata)
Atos<-c()
@@ -4147,12 +4266,12 @@ MakeCurves<-function(...){ ## Scaling is implemented
Tmp<-IndM[Nd,]
Motos<-Figdata[Tmp[1]:Tmp[2],]
All<-Nrow(Motos)
- if (Nrow(Motos)==1){
- if (InWindow(Motos)=="o"){
+ if(Nrow(Motos)==1){
+ if(InWindow(Motos)=="o"){
next
}
Tmp1<- as.numeric(Motos)
- if (Ptout==1){
+ if(Ptout==1){
Drwpt(Tmp1)
}
else{
@@ -4166,20 +4285,20 @@ MakeCurves<-function(...){ ## Scaling is implemented
P<- Op(I-1,Motos)
Q<- Op(I,Motos)
Snbn<-MeetWindow(P,Q)
- if (length(Snbn)==0){
- if (length(Crv)>0){
+ if(length(Snbn)==0){
+ if(length(Crv)>0){
Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
Crv<-c()
}
}
else{
if(Norm(Snbn[1,]-Snbn[2,])<Eps){ next} # naosi 101202
- if (length(Crv)==0){
+ if(length(Crv)==0){
Crv<-Snbn
}
else{
Tmp<-Op(Nrow(Crv),Crv)
- if (Norm(Tmp-Op(1,Snbn))<Eps){
+ if(Norm(Tmp-Op(1,Snbn))<Eps){
Crv<-Appendrow(Crv,Op(2,Snbn))
}
else{
@@ -4189,13 +4308,13 @@ MakeCurves<-function(...){ ## Scaling is implemented
}
}
}
- if (Nrow(Crv)>=2)
+ if(Nrow(Crv)>=2)
{
Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
}
}
Outdata<-Atos[2:Nrow(Atos),]
- if (class(Outdata)=="numeric")
+ if(class(Outdata)=="numeric")
{
Outdata<-matrix(Outdata,nrow=1)
}
@@ -4220,13 +4339,13 @@ Makehasen<- function(Figdata,Sen,Gap,Ptn)
Lenlist<- c(Lenlist,Len)
}
Lenall<- Lenlist[Dtall]
- if (Lenall==0){
+ if(Lenall==0){
next
}
Kari<- (Sen+Gap)*0.1
Naga<- Sen*0.1
Tobi<- Gap*0.1
- if (Norm(Data[1,]-Data[Dtall,])<Eps){
+ if(Norm(Data[1,]-Data[Dtall,])<Eps){
Nsen<- max(ceiling(Lenall/Kari),3)
SegUnit<- Lenall/Nsen
Naga<- SegUnit*Sen/(Sen+Gap)
@@ -4234,7 +4353,7 @@ Makehasen<- function(Figdata,Sen,Gap,Ptn)
SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
}
else{
- if (Ptn==0){
+ if(Ptn==0){
Nsen<- max(ceiling((Lenall+Tobi)/Kari),3)
SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap)
Naga<- SegUnit*Sen/(Sen+Gap)
@@ -4255,7 +4374,7 @@ Makehasen<- function(Figdata,Sen,Gap,Ptn)
Len<- SegList[I]
J<- Owari
while (Len>=Lenlist[J]-Eps){
- if (J==Dtall){
+ if(J==Dtall){
break
}
J<- J+1
@@ -4263,7 +4382,7 @@ Makehasen<- function(Figdata,Sen,Gap,Ptn)
Hajime<- J-1
J<- Hajime
while (Len+Naga>Lenlist[J]-Eps){
- if (J==Dtall){
+ if(J==Dtall){
break
}
J<- J+1
@@ -4295,7 +4414,7 @@ Makehasen<- function(Figdata,Sen,Gap,Ptn)
cat(Str1,file=Wfile,append=TRUE)
cat(Str2,file=Wfile,append=TRUE)
Mojisu<- Mojisu+nchar(Str1)+nchar(Str2)
- if (Mojisu>80){
+ if(Mojisu>80){
cat("%\n",file=Wfile,append=TRUE)
Mojisu<- 0
}
@@ -4311,8 +4430,8 @@ Makeliststr<- function(L)
Out="list("
for (I in 1:length(L)){
Dt<- L[[I]]
- if (mode(Dt)=="numeric"){
- if (length(Dt)==1){
+ if(mode(Dt)=="numeric"){
+ if(length(Dt)==1){
Dts<- as.character(Dt)
}
else{
@@ -4320,11 +4439,11 @@ Makeliststr<- function(L)
for (J in Looprange(1,Nrow(Dt))){
for (K in 1:ncol(Dt)){
Dts<- paste(Dts,as.character(Dt[J,K]),sep="")
- if (K< ncol(Dt)){
+ if(K< ncol(Dt)){
Dts<- paste(Dts,",",sep="")
}
}
- if (J<Nrow(Dt)){
+ if(J<Nrow(Dt)){
Dts<- paste(Dts,";",sep="")
}
else{
@@ -4333,14 +4452,14 @@ Makeliststr<- function(L)
}
}
}
- if (mode(Dt)=="character"){
+ if(mode(Dt)=="character"){
Dts<- paste(Prime(),Dt,Prime(),sep="")
}
if(mode(Dt)=="list"){
Dts<- Makeliststr(Dt)
}
Out<- paste(Out,Dts,sep="")
- if (I<length(L)){
+ if(I<length(L)){
Out<- paste(Out,",")
}
else{
@@ -4369,10 +4488,10 @@ Makeshasen<- function(PtnL,PA,V,Bdy)
NC<- Op(4,TenP)
Tmp<- (Op(NC,Ptn)+1) %% 2
Ptn[NC]<- Tmp
- if (Op(1,TenQ)-Ts>Eps){
- if (Member(Ptn,PtnL)){
- if (abs(Te-Ts)>Eps){
- if (Nrow(GL)>0){
+ if(Op(1,TenQ)-Ts>Eps){
+ if(Member(Ptn,PtnL)){
+ if(abs(Te-Ts)>Eps){
+ if(Nrow(GL)>0){
Tmp<- Mixjoin(Out, list(GL))
Out<- Tmp
}
@@ -4386,7 +4505,7 @@ Makeshasen<- function(PtnL,PA,V,Bdy)
}
}
}
- if (Nrow(GL)>0){
+ if(Nrow(GL)>0){
Tmp<- Mixjoin(Out, list(GL))
Out<- Tmp
}
@@ -4400,7 +4519,7 @@ Mawarikomi<- function(...)
varargin<- list(...)
haba<- "10cm"
Nargs<- length(varargin)
- if (Nargs>0){
+ if(Nargs>0){
haba<- varargin[[1]]
}
cat("\\begin{mawarikomi}%\n",file="",append=TRUE)
@@ -4415,7 +4534,7 @@ Mawarikomi<- function(...)
MeetWindow<-function(PA,PB)
{
- if (InWindow(PA)=="i" && InWindow(PB)=="i")
+ if(InWindow(PA)=="i" && InWindow(PB)=="i")
{
R<-Appendrow(PA,PB)
return(R)
@@ -4427,33 +4546,33 @@ MeetWindow<-function(PA,PB)
}
Eps<-10.0^(-6);
Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1);
- if (PA[1]!=PB[1])
+ if(PA[1]!=PB[1])
{
Txm<-(XMIN-PA[1])/(PB[1]-PA[1]);
TxM<-(XMAX-PA[1])/(PB[1]-PA[1]);
}
- if (PA[2]!=PB[2])
+ if(PA[2]!=PB[2])
{
Tym<-(YMIN-PA[2])/(PB[2]-PA[2]);
TyM<-(YMAX-PA[2])/(PB[2]-PA[2]);
}
Tmp<-Horner(2,Txm);
- if (Tmp<YMIN-Eps || Tmp>YMAX+Eps)
+ if(Tmp<YMIN-Eps || Tmp>YMAX+Eps)
{
Txm<-(-1);
}
Tmp<-Horner(2,TxM);
- if (Tmp<YMIN-Eps || Tmp>YMAX+Eps)
+ if(Tmp<YMIN-Eps || Tmp>YMAX+Eps)
{
TxM<-(-1)
}
Tmp<-Horner(1,Tym);
- if (Tmp<XMIN-Eps || Tmp>XMAX+Eps)
+ if(Tmp<XMIN-Eps || Tmp>XMAX+Eps)
{
Tym<--1
}
Tmp<-Horner(1,TyM);
- if (Tmp<XMIN-Eps || Tmp>XMAX+Eps)
+ if(Tmp<XMIN-Eps || Tmp>XMAX+Eps)
{
TyM<--1
}
@@ -4462,15 +4581,15 @@ MeetWindow<-function(PA,PB)
for (I in 1:length(Tans))
{
Tmp1<-Tans[I];
- if (Tmp1>-Eps && Tmp1<1+Eps)
+ if(Tmp1>-Eps && Tmp1<1+Eps)
{
- if (length(Tmp)==0)
+ if(length(Tmp)==0)
{
Tmp<-c(Tmp1);
}
else
{
- if (abs(Tmp[length(Tmp)]-Tmp1)>Eps)
+ if(abs(Tmp[length(Tmp)]-Tmp1)>Eps)
{
Tmp<-c(Tmp,Tmp1)
}
@@ -4478,15 +4597,15 @@ MeetWindow<-function(PA,PB)
}
}
Tans<-Tmp;
- if (length(Tans)==0)
+ if(length(Tans)==0)
{
R<-c();
return(R);
}
- if (length(Tans)==1)
+ if(length(Tans)==1)
{
Ten1<-Horner(1:2,Tans[1]);
- if (InWindow(PA)=="i")
+ if(InWindow(PA)=="i")
{
R<-Appendrow(PA,Ten1)
return(R)
@@ -4515,12 +4634,12 @@ Mixjoin<-function(...)
for (I in 1:Nargs)
{
Tmp<-varargin[[I]]
- if (length(Tmp)==0) next
- if (Mixtype(Tmp)==1)
+ if(length(Tmp)==0) next
+ if(Mixtype(Tmp)==1)
{
Tmp<-list(Tmp)
}
- if (length(M)==0){
+ if(length(M)==0){
M <- Tmp
}
else{
@@ -4533,10 +4652,10 @@ Mixjoin<-function(...)
#################################
Mixlength<- function(PL){
- if (length(PL)==0){
+ if(length(PL)==0){
return(0)
}
- if (Mixtype(PL)==1){
+ if(Mixtype(PL)==1){
Out<- Nrow(PL)
}
else{
@@ -4549,11 +4668,11 @@ Mixlength<- function(PL){
Mixtype<- function(D)
{
- if (mode(D)!="list") return(1)
+ if(mode(D)!="list") return(1)
for (I in 1:length(D))
{
Tmp<- D[[I]]
- if (mode(Tmp)=="list") return(3)
+ if(mode(Tmp)=="list") return(3)
}
return(2)
}
@@ -4570,7 +4689,7 @@ Naigai<- function(A,Bdy)
{
Ten<- Op(K,KL)
T<- Op(1,Ten); NC<- Op(4,Ten)
- if (T<0)
+ if(T<0)
{
Tmp<- (Ptn[NC]+1) %% 2
Ptn[NC]<- Tmp
@@ -4585,11 +4704,11 @@ Nearestpt<- function(...){
varargin<- list(...)
Nargs<- length(varargin)
PL1<- varargin[[1]]
- if (!is.matrix(PL1)){
+ if(!is.matrix(PL1)){
Tmp<- matrix(PL1);
PL1<- t(Tmp)
}
- if (Nrow(PL1)==1) Flg=0
+ if(Nrow(PL1)==1) Flg=0
else Flg=1
Eps<- 10.0^(-6)
PL<- varargin[[2]]
@@ -4605,25 +4724,25 @@ Nearestpt<- function(...){
V1<- B1-A1; V2<-B2-A2
X1<- PA[1]; X2<-PA[2]
Tmp<-V2^2+V1^2
- if (abs(Tmp)<Eps) next
+ if(abs(Tmp)<Eps) next
T<- (-A2*V2-V1*A1+V1*X1+X2*V2)/Tmp
- if (T< -Eps){
+ if(T< -Eps){
P<- c(A1,A2)
}else{
- if (T>1+Eps){
+ if(T>1+Eps){
P<- c(B1,B2)
}else{
P<- c(A1+T*V1,A2+T*V2)
}
}
S<- Norm(P-PA)
- if (S<Sm-Eps){
- Tmp<- Paramoncrv(P,I,PL)
+ if(S<Sm-Eps){
+ Tmp<- Paramoncurve(P,I,PL)
Pm<- P; Im<- Tmp; Sm<- S
}
}
- if (Sm<Op(5,Ans)) Ans<- list(PA,N,Pm,Im,Sm)
- if (Flg==0){
+ if(Sm<Op(5,Ans)) Ans<- list(PA,N,Pm,Im,Sm)
+ if(Flg==0){
Ans<- Ans[3:5]
}
}
@@ -4661,8 +4780,8 @@ Length<- function(Data){
Op<-function(N,Data)
{
C <- c()
- if (length(Data)==0) return(C)
- if (mode(Data)=="list"){
+ if(length(Data)==0) return(C)
+ if(mode(Data)=="list"){
if(class(Data)=="data.frame"){ # 10.02.23
C<- Data[N,]
}
@@ -4671,8 +4790,8 @@ Op<-function(N,Data)
}
return(C)
}
- if (mode(Data)=="character"){
- if (length(Data)==1){
+ if(mode(Data)=="character"){
+ if(length(Data)==1){
C<- substring(Data,N,N)
}
else{
@@ -4680,10 +4799,10 @@ Op<-function(N,Data)
}
return(C)
}
- if (mode(Data)=="numeric"){
- if (class(Data)=="matrix"){
+ if(mode(Data)=="numeric"){
+ if(class(Data)=="matrix"){
Din<- Dataindex(Data)
- if (nrow(Din)==1){
+ if(nrow(Din)==1){
C<- Data[N,]
}
else{
@@ -4748,7 +4867,7 @@ Openpar<- function(...)
Nargs<- length(varargin)
Tmp<- varargin[[1]]
Tmp1<- substr(Tmp,1,1)
- if (Tmp1=="\\"){
+ if(Tmp1=="\\"){
Namestr<- Tmp
N<- 2
}
@@ -4757,7 +4876,7 @@ Openpar<- function(...)
N<- 1
}
Habastr<- varargin[[N]]
- if (Nargs>N){
+ if(Nargs>N){
Posstr<- paste("[",varargin[[N+1]],"]",sep="")
}
else{
@@ -4789,11 +4908,11 @@ Ovalbox<- function(...)
NDflg<- 0
for (I in Looprange(4,Nargs)){
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
R<- Tmp
}
else{
- if (substr(Tmp,1,1)=="-"){
+ if(substr(Tmp,1,1)=="-"){
NDflg<- 1
Tmp1<- substr(Tmp,2,nchar(Tmp))
Cmdstr<- chartr("*","G",Tmp1)
@@ -4809,7 +4928,7 @@ Ovalbox<- function(...)
G<- Ovaldata(c(0,-H/2),W/2,H/2,R)
Openphr("\\ketpictmp")
Beginpicture("1cm")
- if (NDflg==0){
+ if(NDflg==0){
Drwline(G)
}
else{
@@ -4830,7 +4949,7 @@ Ovaldata<- function(...) #17.09.11
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==1){
+ if(Nargs==1){
Eps<- 1.0*10^(-4)
C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2)
Dx<- XMAX-C(1)-Eps
@@ -4844,7 +4963,7 @@ Ovaldata<- function(...) #17.09.11
N<- 4
}
Rc<- 0.2
- if (N<=Nargs){ #15.11.15
+ if(N<=Nargs){ #15.11.15
Rc<- varargin[[N]]*Rc #15.11.15
}
Out<- c()
@@ -4869,12 +4988,12 @@ Paramark<- function(...)
PB<- varargin[[2]]
PC<- varargin[[3]]
R<- 0.5
- if (Nargs>=4){
+ if(Nargs>=4){
R<- varargin[[4]]*R
}
U<- R*(PA-PB)/Norm(PA-PB)
V<- R*(PC-PB)/Norm(PC-PB)
- if (Crossprod(PA-PB,PC-PB)!=0){
+ if(Crossprod(PA-PB,PC-PB)!=0){
P<- Listplot(c(PB+U,PB+U+V,PB+V))
}
else{
@@ -4884,41 +5003,32 @@ Paramark<- function(...)
###########################################
-Paramoncrv<-function(...)
-{
+Paramoncurve<-function(...){
varargin<-list(...)
Nargs<-length(varargin)
Eps<-10^(-8)
P<-varargin[[1]]
Gdata<-varargin[[Nargs]]
- if (Nrow(P)>1)
- {
+ if(Nrow(P)>1){
Tmp<-P; P<-Gdata; Gdata<-Tmp
}
- if (Nargs==2)
- {
+ if(Nargs==2){
Tmp<-Nearestpt(P,Gdata)
Out<-Tmp[[2]]
return(Out)
}
N<-varargin[[2]]
PtL<-Gdata
- if (N==Nrow(PtL))
- {
- Out<-N
- }
- else
- {
- Pa<-Ptcrv(N,PtL)
- Pb<-Ptcrv(N+1,PtL)
- V<-Pb-Pa
- W<-P-Pa
- D2<-Norm(V)^2
- if (D2<Eps) return(0)
- S<-Dotprod(V,W)/D2
- S<-min(max(S,0),1)
- Out=N+S
- }
+ N=min(N,Length(PtL)-1) #18.02.11from
+ Pa<-Ptcrv(N,PtL)
+ Pb<-Ptcrv(N+1,PtL)
+ V<-Pb-Pa
+ W<-P-Pa
+ D2<-Norm(V)^2
+ if(D2<Eps) return(0)
+ S<-Dotprod(V,W)/D2
+ S<-min(max(S,0),1)
+ Out=N+S #18.02.11upto
return(Out)
}
@@ -4941,7 +5051,7 @@ Paramplot<- function(...)
Tmp<- varargin[[I]]
Tmp<- strsplit(Tmp,"=")
K<- Tmp[[1]]
- Tmp<-K[1]
+ Tmp<- K[1]
Lhs<- substring(Tmp,1,1)
Tmp1<- K[2]
Str<-paste(Lhs,"=",Tmp1,sep="")
@@ -4949,7 +5059,7 @@ Paramplot<- function(...)
}
Tmp<- strsplit(Rgstr,"=")
K<-Tmp[[1]]
- if (length(K)>1)
+ if(length(K)>1)
{
Vname<- K[1]
Tmp1<- K[2]
@@ -4962,7 +5072,7 @@ Paramplot<- function(...)
}
T1<- Rng[1]; T2<- Rng[2]
Dt<- (T2-T1)/N #17.09.22
- if (Fnflg==0)
+ if(Fnflg==0)
{
Str<- gsub(Vname,"t",Fnstr)
}
@@ -4972,7 +5082,7 @@ Paramplot<- function(...)
return(P)
}
P<-c()
- if (length(E)>0)
+ if(length(E)>0)
{
E<-sort(E)
E<E[length(E):1]
@@ -4981,12 +5091,13 @@ Paramplot<- function(...)
Tmp<- sort(E)
E<- E[length(Tmp):1]
Ke<- 1
- for (t in seq(T1, T2, by=Dt))
- {
+# for (t in seq(T1, T2+Eps, by=Dt)){#18.02.05
+ for(jj in 1:(N+1)){
+ t=T1+(jj-1)*Dt
Pa<- c()
- if (t-E[Ke]< Eps)
+ if(t-E[Ke]< Eps)
{
- if (Fnflg==0)
+ if(Fnflg==0)
{
Tmp<-eval(parse(text=Str))
Pa<- Tmp
@@ -4995,16 +5106,16 @@ Paramplot<- function(...)
{
}
}
- if (abs(t-E[Ke])<=Eps)
+ if(abs(t-E[Ke])<=Eps)
{
- if (Nrow(P)>0 && Op(Nrow(P),P)!=c(Inf,Inf))
+ if(Nrow(P)>0 && Op(Nrow(P),P)!=c(Inf,Inf))
{
Pa<- c(Inf,Inf)
}
}
- if (t-E[Ke]>Eps)
+ if(t-E[Ke]>Eps)
{
- if (Fnflg==0)
+ if(Fnflg==0)
{
Tmp<- eval(parse(text=Str))
Pa<- Tmp
@@ -5014,16 +5125,16 @@ Paramplot<- function(...)
}
Ke<-Ke+1
}
- if (length(Pa)>0)
+ if(length(Pa)>0)
{
- if (Pa[1]==Inf)
+ if(Pa[1]==Inf)
{
Tmp<-Appendrow(P,Pa)
P<-Tmp
}
else
{
- if (Nrow(P)==0)
+ if(Nrow(P)==0)
{
Tmp<- Appendrow(P,Pa)
P<-Tmp
@@ -5031,14 +5142,14 @@ Paramplot<- function(...)
else
{
Tmp<- Op(Nrow(P),P)
- if (Tmp[1]==Inf)
+ if(Tmp[1]==Inf)
{
Tmp<- Appendrow(P,Pa)
P<- Tmp
}
else
{
- if (Norm(Tmp-Pa)<D)
+ if(Norm(Tmp-Pa)<D)
{
Tmp<-Appendrow(P,Pa)
P<-Tmp
@@ -5055,7 +5166,7 @@ Paramplot<- function(...)
}
Tmp<- Nrow(P)
Tmp1<- Op(Tmp,P)
- if (Tmp1[1]==Inf)
+ if(Tmp1[1]==Inf)
{
P<- P[1:(Tmp-1),]
}
@@ -5067,13 +5178,13 @@ Paramplot<- function(...)
Partcrv<- function(A,B,PkL)
{
Eps<- 10.0^(-3)
- if (mode(A)=="numeric" && length(A)==1){
- if (A>B+Eps){
+ if(mode(A)=="numeric" && length(A)==1){
+ if(A>B+Eps){
Npt<- Numptcrv(PkL)
Out1<- Partcrv(A,Npt,PkL)
Out2<- Partcrv(1,B,PkL)
Tmp<- Ptstart(PkL)-Ptend(PkL)
- if (Norm(Tmp)<Eps){
+ if(Norm(Tmp)<Eps){
Ans<- Joincrvs(Out1,Out2)
}
else{
@@ -5084,12 +5195,12 @@ Partcrv<- function(A,B,PkL)
Is<- ceiling(A)
Ie<- floor(B)
PL<- c()
- if (A<Is-Eps){
+ if(A<Is-Eps){
P<- (Is-A)*PkL[Is-1,]+(1-Is+A)*PkL[Is,]
PL<- c(P)
}
PL<- Appendrow(PL, PkL[Looprange(Is,Ie),])
- if (B>Ie+Eps){
+ if(B>Ie+Eps){
P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,]
PL<- Appendrow(PL,P)
}
@@ -5122,8 +5233,8 @@ Partframe<- function(Tb,St,Ed)
Tmp1<- Ptstart(Gat[[Ed[1]]])
Tmp2<- Ptstart(Gay[[Ed[2]]])
Pe<- c(Tmp1[1],Tmp2[2])
- Pars<- Paramoncrv(Ps,Gw)
- Pare<- Paramoncrv(Pe,Gw)
+ Pars<- Paramoncurve(Ps,Gw)
+ Pare<- Paramoncurve(Pe,Gw)
if(Pars<Pare){
Out<- Partcrv(Pars,Pare,Gw)
}
@@ -5148,7 +5259,7 @@ Plotdata<- function(...)
Rgstr<- varargin[[Is]]; Is<- Is+1
Tmp<- strsplit(Rgstr,"=")
K<-Tmp[[1]]
- if (length(K)>1){
+ if(length(K)>1){
Vname<- K[1]
Tmp1<- K[2]
Rng<- eval(parse(text=Tmp1))
@@ -5168,7 +5279,7 @@ Plotdata<- function(...)
K<- Tmp[[1]]
Tmp1<- K[2]
Tmp2<- grep(Vname,Tmp1,fixed=TRUE) ## 10.12.04
- if (length(Tmp2)==0){
+ if(length(Tmp2)==0){
Str<-paste(Lhs,"=",Tmp1,sep="")
eval(parse(text=Str))
}
@@ -5178,7 +5289,7 @@ Plotdata<- function(...)
}
X1<- Rng[1]; X2<- Rng[2]
dx<- (X2-X1)/N # 17.09.22
- if (Fnflg==0){
+ if(Fnflg==0){
Str<- gsub(Vname,"x",Fnstr,fixed=TRUE)
}
if(abs(dx)<Eps){ # Scilab 16.12.13
@@ -5188,7 +5299,7 @@ Plotdata<- function(...)
}
Exfun<- gsub(Vname,"x",Exfun,fixed=TRUE)
P<-c()
- if (length(E)>0){
+ if(length(E)>0){
E<-sort(E)
E<E[length(E):1]
}
@@ -5197,46 +5308,46 @@ Plotdata<- function(...)
E<- E[length(Tmp):1]
Ke<- 1
for (x in seq(X1,X2,by=dx)){
- if (nchar(Exfun)>0){
+ if(nchar(Exfun)>0){
Tmp<-eval(parse(text=Exfun))
- if (abs(Tmp)<Eps){
+ if(abs(Tmp)<Eps){
P<- Appendrow(P,c(Inf,inf))
next
}
}
Pa<- c()
- if (x-E[Ke]< -Eps){ ## 10.12.04
+ if(x-E[Ke]< -Eps){ ## 10.12.04
Tmp<-eval(parse(text=Str))
Pa<- c(x,Tmp)
}
- if (abs(x-E[Ke])<=Eps){
- if (Nrow(P)>0 && P[Nrow(P),]!=c(Inf,Inf)){
+ if(abs(x-E[Ke])<=Eps){
+ if(Nrow(P)>0 && P[Nrow(P),]!=c(Inf,Inf)){
Pa<- c(Inf,Inf)
}
}
- if (x-E[Ke]>Eps){
+ if(x-E[Ke]>Eps){
Tmp<- eval(parse(text=Str))
Pa<- c(x,Tmp)
Ke<-Ke+1
}
- if (length(Pa)>0){
- if (Pa[1]==Inf){
+ if(length(Pa)>0){
+ if(Pa[1]==Inf){
Tmp<-Appendrow(P,Pa)
P<-Tmp
}
else{
- if (Nrow(P)==0){
+ if(Nrow(P)==0){
Tmp<- Appendrow(P,Pa)
P<-Tmp
}
else{
Tmp<- P[Nrow(P),]
- if (Tmp[1]==Inf){
+ if(Tmp[1]==Inf){
Tmp<- Appendrow(P,Pa)
P<- Tmp
}
else{
- if (Norm(Tmp-Pa)<D){
+ if(Norm(Tmp-Pa)<D){
Tmp<-Appendrow(P,Pa)
P<-Tmp
}
@@ -5251,7 +5362,7 @@ Plotdata<- function(...)
}
Tmp<- Nrow(P)
Tmp1<-P[Tmp,]
- if (Tmp1[1]==Inf)
+ if(Tmp1[1]==Inf)
{
P<- P[1:(Tmp-1),]
}
@@ -5260,20 +5371,20 @@ Plotdata<- function(...)
######################################
-Pointoncrv<-function(...)
+Pointoncurve<-function(...)
{
varargin<-list(...)
Eps<-10^(-4)
T<-varargin[[1]]
Gdata<-varargin[[2]]
- if (Nrow(T)>1)
+ if(Nrow(T)>1)
{
Tmp<-T; T<-Gdata; Gdata<-Tmp
}
PtL<-Gdata
N<-trunc(T+Eps);
S<-max(T-N,0);
- if (N==Nrow(PtL))
+ if(N==Nrow(PtL))
{
Out<-PtL[N,]
}
@@ -5313,7 +5424,7 @@ Pointdata<-function(...)
}
}
} # to here
- if (length(PL)==1)
+ if(length(PL)==1)
{
PL<-PL[[1]]
}
@@ -5325,7 +5436,7 @@ Pointdata<-function(...)
Prime<- function(...)
{
varargin<- list(...)
- if (length(varargin)==0){
+ if(length(varargin)==0){
Out="'"
}
else{
@@ -5351,7 +5462,11 @@ Ptcrv<-function(N,Fig)
Ptend<-function(Fig)
{
- return(Fig[Nrow(Fig),])
+ if(Length(Fig)>0){ #18.02.09
+ return(Op(Length(Fig),Fig))
+ }else{
+ return(c())
+ }
}
#########################################
@@ -5359,7 +5474,7 @@ Ptend<-function(Fig)
Ptne<-function(...)
{
varargin<- list(...)
- if (length(varargin)==0){
+ if(length(varargin)==0){
Out<- c(XMAX,YMAX)
}
else{
@@ -5376,7 +5491,7 @@ Ptne<-function(...)
Ptnw<-function(...)
{
varargin<- list(...)
- if (length(varargin)==0){
+ if(length(varargin)==0){
Out<- c(XMIN,YMAX)
}
else{
@@ -5393,7 +5508,7 @@ Ptnw<-function(...)
Ptse<-function(...)
{
varargin<- list(...)
- if (length(varargin)==0){
+ if(length(varargin)==0){
Out<- c(XMAX,YMIN)
}
else{
@@ -5409,7 +5524,11 @@ Ptse<-function(...)
Ptstart<-function(Fig)
{
- return(Fig[1,])
+ if(Length(Fig)>0){ #18.02.09
+ return(Op(1,Fig))
+ }else{
+ return(c())
+ }
}
#########################################
@@ -5417,7 +5536,7 @@ Ptstart<-function(Fig)
Ptsw<-function(...)
{
varargin<- list(...)
- if (length(varargin)==0){
+ if(length(varargin)==0){
Out<- c(XMIN,YMAX)
}
else{
@@ -5437,13 +5556,13 @@ Putcell<- function(...)
Nargs<- length(varargin)
TbL<- varargin[[1]]
Str<- varargin[[Nargs]]
- if (mode(Str)=="numeric"){
+ if(mode(Str)=="numeric"){
Str<- as.character(Str)
}
Pos<- varargin[[Nargs-1]]
Nrg<- varargin[[2]]
- if (mode(Nrg)=="character"){
- if (Nargs==4){
+ if(mode(Nrg)=="character"){
+ if(Nargs==4){
Cell<- Findcell(TbL,Nrg)
}
else{
@@ -5458,45 +5577,45 @@ Putcell<- function(...)
Pt<- Cell[[1]]; Dr<- "c"
Posh<- substr(Pos,1,1)
Post<- substr(Pos,2,nchar(Pos))
- if (toupper(Posh)=="R"){
+ if(toupper(Posh)=="R"){
Pt<- Pt+c(Cell[[2]],0)
- if (nchar(Post)==0){
+ if(nchar(Post)==0){
Dr<- "w1"
}
else{
Dr<- paste("w",Post,sep="")
}
}
- if (toupper(Posh)=="L"){
+ if(toupper(Posh)=="L"){
Pt=Pt-c(Cell[[2]],0)
- if (nchar(Post)==0){
+ if(nchar(Post)==0){
Dr<- "e1"
}
else{
Dr<- paste("e",Post,sep="")
}
}
- if (toupper(Posh)=="U"){
+ if(toupper(Posh)=="U"){
Pt<- Pt+c(0,Cell[[3]])
- if (nchar(Post)==0){
+ if(nchar(Post)==0){
Dr<- "s1"
}
else{
Dr<- paste("s",Post,sep="")
}
}
- if (toupper(Posh)=="D"){
+ if(toupper(Posh)=="D"){
Pt<- Pt-c(0,Cell[[3]])
- if (nchar(Post)==0){
+ if(nchar(Post)==0){
Dr<- "n1"
}
else{
Dr<- paste("n",Post,sep="")
}
}
- if (toupper(Posh)=="B"){
+ if(toupper(Posh)=="B"){
Pt<- Pt-c(0,Cell[[3]])
- if (nchar(Post)==0){
+ if(nchar(Post)==0){
Dr<- "n1"
}
else{
@@ -5514,11 +5633,11 @@ PutcoL<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
TbL<- varargin[[1]]
- if (mode(TbL)!="list"){
+ if(mode(TbL)!="list"){
return("Tabledata missing")
}
Ag<- varargin[[2]]
- if (mode(Ag)=="numeric"){
+ if(mode(Ag)=="numeric"){
CoL<- Ag
}
else{
@@ -5529,7 +5648,7 @@ PutcoL<- function(...)
C<- toupper(C)
Tmp<- strsplit(Alpha,C)
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
Tmp1<- nchar(Tmp[1])
Clm<- c(Clm,Tmp1)
}
@@ -5546,11 +5665,11 @@ PutcoL<- function(...)
K<- 1
Dpos<- varargin[[3]]
for (I in Looprange(4,Nargs)){
- if (I-3>Nc){
+ if(I-3>Nc){
break
}
Dt<- varargin[[I]]
- if (mode(Dt)!="list"){
+ if(mode(Dt)!="list"){
Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02
K<- K+1
}
@@ -5561,10 +5680,10 @@ PutcoL<- function(...)
Pos<- Dpos
for (J in Looprange(1,N-1)){
Tmp<- Dt[[J]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Rrng<- c(K,K+Tmp)
}
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Pos<- Tmp
}
}
@@ -5584,11 +5703,11 @@ PutcoLexpr<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
TbL<- varargin[[1]]
- if (mode(TbL)!="list"){
+ if(mode(TbL)!="list"){
return("Tabledata missing")
}
Ag<- varargin[[2]]
- if (mode(Ag)=="numeric"){
+ if(mode(Ag)=="numeric"){
CoL<- Ag
}
else{
@@ -5599,7 +5718,7 @@ PutcoLexpr<- function(...)
C<- toupper(C)
Tmp<- strsplit(Alpha,C)
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
Tmp1<- nchar(Tmp[1])
Clm<- c(Clm,Tmp1)
}
@@ -5616,11 +5735,11 @@ PutcoLexpr<- function(...)
K<- 1
Dpos<- varargin[[3]]
for (I in Looprange(4,Nargs)){
- if (I-3>Nc){
+ if(I-3>Nc){
break
}
Dt<- varargin[[I]]
- if (mode(Dt)!="list"){
+ if(mode(Dt)!="list"){
Dt<- paste("$",Dt,"$",sep="")
Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02
K<- K+1
@@ -5632,10 +5751,10 @@ PutcoLexpr<- function(...)
Pos<- Dpos
for (J in Looprange(1,N-1)){
Tmp<- Dt[[J]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Rrng<- c(K,K+Tmp)
}
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Pos<- Tmp
}
}
@@ -5661,10 +5780,10 @@ PutcoLstr<- function(...)
Pos<- varargin[[3]]
Str<- varargin[[4]]
Sep<- ""
- if (Nargs>4){
+ if(Nargs>4){
Sep<- varargin[[5]]
}
- if (nchar(Sep)==0){
+ if(nchar(Sep)==0){
for (I in Looprange(1,nchar(Str))){
Tmp<- substr(Str,I,I)
Putcell(Tb,Nr,I,Pos,Tmp)
@@ -5675,7 +5794,7 @@ PutcoLstr<- function(...)
K<- 1
for (I in Looprange(1,length(Str))){
Tmp<- substr(Str,I,I)
- if (Tmp==Sep){
+ if(Tmp==Sep){
Putcell(Tb,Nr,K,Pos,Ltr)
K<- K+1
Ltr<- ""
@@ -5684,7 +5803,7 @@ PutcoLstr<- function(...)
Ltr<- paste(Ltr,Tmp,sep="")
}
}
- if (nchar(Ltr)>0){
+ if(nchar(Ltr)>0){
Putcell(Tb,Nr,K,Pos,Ltr)
}
}
@@ -5697,7 +5816,7 @@ Putrow<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
TbL<- varargin[[1]]
- if (mode(TbL)!="list"){
+ if(mode(TbL)!="list"){
return("Tabledata missing")
}
Row<- varargin[[2]]
@@ -5705,11 +5824,11 @@ Putrow<- function(...)
K<- 1
Dpos<- varargin[[3]]
for (I in Looprange(4,Nargs)){
- if (I-3>Nr){
+ if(I-3>Nr){
break;
}
Dt<- varargin[[I]]
- if (mode(Dt)!="list"){
+ if(mode(Dt)!="list"){
Putcell(TbL,K,Row,Dpos,Dt) # 110308
K<- K+1
}
@@ -5720,10 +5839,10 @@ Putrow<- function(...)
Pos<- Dpos
for (J in Looprange(1,N-1)){
Tmp<- Dt[[J]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Crng<- c(K,K+Tmp)
}
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Pos<- Tmp
}
}
@@ -5738,7 +5857,7 @@ Putrowexpr<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
TbL<- varargin[[1]]
- if (mode(TbL)!="list"){
+ if(mode(TbL)!="list"){
return("Tabledata missing")
}
Row<- varargin[[2]]
@@ -5746,11 +5865,11 @@ Putrowexpr<- function(...)
K<- 1
Dpos<- varargin[[3]]
for (I in Looprange(4,Nargs)){
- if (I-3>Nr){
+ if(I-3>Nr){
break;
}
Dt<- varargin[[I]]
- if (mode(Dt)!="list"){
+ if(mode(Dt)!="list"){
Dt<- paste("$",Dt,"$",sep="")
Putcell(TbL,K,Row,Dpos,Dt) #110308
K<- K+1
@@ -5762,10 +5881,10 @@ Putrowexpr<- function(...)
Pos<- Dpos
for (J in Looprange(1,N-1)){
Tmp<- Dt[[J]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Crng<- c(K,K+Tmp)
}
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
Pos<- Tmp
}
}
@@ -5786,10 +5905,10 @@ Putrowstr<- function(...)
Pos<- varargin[[3]]
Str<- varargin[[4]]
Sep<- ""
- if (Nargs>4){
+ if(Nargs>4){
Sep<- varargin[[5]]
}
- if (nchar(Sep)==0){
+ if(nchar(Sep)==0){
for (I in Looprange(1,nchar(Str))){
Tmp<- substr(Str,I,I)
Putcell(Tb,I,Nr,Pos,Tmp)
@@ -5800,7 +5919,7 @@ Putrowstr<- function(...)
K<- 1
for (I in Looprange(1,length(Str))){
Tmp<- substr(Str,I,I)
- if (Tmp==Sep){
+ if(Tmp==Sep){
Putcell(Tb,K,Nr,Pos,Ltr)
K<- K+1
Ltr<- ""
@@ -5809,7 +5928,7 @@ Putrowstr<- function(...)
Ltr<- paste(Ltr,Tmp,sep="")
}
}
- if (nchar(Ltr)>0){
+ if(nchar(Ltr)>0){
Putcell(Tb,K,Nr,Pos,Ltr)
}
}
@@ -5911,10 +6030,10 @@ Readtextdata<- function(...)
Nargs<- length(varargin)
Fname<- varargin[[1]]
Tmp<- readLines(Fname,n=1)
- if (length(grep("\t",Tmp))>0){
+ if(length(grep("\t",Tmp))>0){
Sep<- "\t"
}
- else if (length(grep(",",Tmp))>0){
+ else if(length(grep(",",Tmp))>0){
Sep<- ","
}
else{
@@ -5932,7 +6051,7 @@ Readtextdata<- function(...)
Flg<- 0
for (I in Looprange(2,Nargs)){
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
if (Flg==0){
Hajime<- Tmp
Flg<- 1
@@ -5947,7 +6066,7 @@ Readtextdata<- function(...)
}
Tmp<- Hajime+c(R-1,C-1)
Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2]))
- if (Cna){
+ if(Cna){
Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE)
}
else{
@@ -5955,16 +6074,16 @@ Readtextdata<- function(...)
Nv<- c(1:ncol(Df))
colnames(Df)<- Nv
}
- if (Rna){
+ if(Rna){
rownames(Df)<-Df[,1]
Hajime<- Hajime+c(0,1)
}
- if (Mat){
+ if(Mat){
M<- as.matrix(Df)
Tmp1<- min(Owari[1],nrow(M))
Tmp2<- min(Owari[2],ncol(M))
Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2])
- if (Num){
+ if(Num){
Tmp1<- as.numeric(Out)
Out<- matrix(Tmp1,nrow=nrow(Out))
}
@@ -5974,7 +6093,7 @@ Readtextdata<- function(...)
Tmp2<- min(Owari[2],ncol(Df))
Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2]
}
- if (D!=-Inf){ # 11.01.20 v2
+ if(D!=-Inf){ # 11.01.20 v2
Tmp<- ncol(Out) # 11.01.07
Tmp1<- rep(Inf,Tmp)
Out[Out[,1]<=D,]<- Tmp1 # 11.01.07
@@ -5990,15 +6109,15 @@ Reflectdata<- function(...)
Nargs<- length(varargin)
Eps<- 10^(-8)
ML<- varargin[[1]]
- if (Mixtype(ML)==1){
+ if(Mixtype(ML)==1){
ML<- list(ML)
}
- if (Nargs==1){
+ if(Nargs==1){
PtA<- c(0,0); PtB<- PtA
}
else{
Pts<- varargin[[2]]
- if (length(Pts)==2){
+ if(length(Pts)==2){
PtA<- Pts; PtB<- PtA
}
else{
@@ -6018,12 +6137,12 @@ Reflectdata<- function(...)
}
X1<- Tmp[1]
Y1<- Tmp[2]
- if (X1==Inf){
+ if(X1==Inf){
X2<- X1
Y2<- Y1
}
else{
- if (Norm(PtA-PtB)<Eps){
+ if(Norm(PtA-PtB)<Eps){
X2<- 2*PtA[1]-X1
Y2<- 2*PtA[2]-Y1
}
@@ -6042,7 +6161,7 @@ Reflectdata<- function(...)
}
OutL<- Mixjoin(OutL,list(Out))
}
- if (length(OutL)==1){
+ if(length(OutL)==1){
OutL<- Op(1,OutL)
}
return(OutL)
@@ -6091,22 +6210,24 @@ WriteOutData<- function(...){
Gdata=varargin[[N+1]]
Gdata=Flattenlist(Gdata)
if(!is.list(Gdata)){Gdata=list(Gdata)}
- for(K in seq(1,length(Gdata))){
+ for(K in Looprange(1,length(Gdata))){
GL=Dividegraphics(Gdata[[K]])
- for(J in seq(1,length(GL))){
+# for(J in seq(1,length(GL))){
+ for(J in Looprange(1,length(GL))){
cat("start//","\n",sep="",file=Fname,append=TRUE)
Str=""
Iend=Numptcrv(GL[[J]])
- for(II in seq(1,Iend)){
+# for(II in seq(1,Iend)){
+ for(II in Looprange(1,Iend)){
Pt=Ptcrv(II,GL[[J]])
if(nchar(Str)>0){
Str=paste(Str,",",sep="")
}
if(length(Pt)<3){
- Str=paste(Str,sprintf("[%5.4f,%5.4f]",Pt[1],Pt[2]),sep="")
+ Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="")
}
else{
- Str=paste(Str,sprintf("[%5.4f,%5.4f,%5.4f]",Pt[1],Pt[2],Pt[3]),sep="")
+ Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="")
}
if(nchar(Str)>80){
cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE)
@@ -6252,12 +6373,12 @@ Rotatedata<- function(..., deg=FALSE)
Nargs<- length(varargin)
Eps<- 10^(-8)
ML<- varargin[[1]]
- if (Mixtype(ML)==1){
+ if(Mixtype(ML)==1){
ML<- list(ML)
}
Theta<- varargin[[2]]
- if (deg) Theta<- Theta*pi/180 # 10.12.07
- if (Nargs==2){
+ if(deg) Theta<- Theta*pi/180 # 10.12.07
+ if(Nargs==2){
Pt<- c(0,0)
}
else{
@@ -6277,7 +6398,7 @@ Rotatedata<- function(..., deg=FALSE)
}
X1<- Tmp[1]
Y1<- Tmp[2]
- if (X1==Inf){
+ if(X1==Inf){
X2<- X1
Y2<- Y1
}
@@ -6292,7 +6413,7 @@ Rotatedata<- function(..., deg=FALSE)
}
OutL<- Mixjoin(OutL,list(Out))
}
- if (length(OutL)==1){
+ if(length(OutL)==1){
OutL<- Op(1,OutL)
}
return(OutL)
@@ -6306,12 +6427,12 @@ Scaledata<- function(...)
Nargs<- length(varargin)
Eps<- 10^(-8)
ML<- varargin[[1]]
- if (Mixtype(ML)==1){
+ if(Mixtype(ML)==1){
ML<- list(ML)
}
A<- varargin[[2]]
B<- varargin[[3]]
- if (Nargs==3){
+ if(Nargs==3){
Pt<- c(0,0)
}
else{
@@ -6330,7 +6451,7 @@ Scaledata<- function(...)
}
X1<- Tmp[1]
Y1<- Tmp[2]
- if (X1==Inf){
+ if(X1==Inf){
X2<- X1
Y2<-Y1
}
@@ -6342,7 +6463,7 @@ Scaledata<- function(...)
}
OutL<- Mixjoin(OutL,list(Out))
}
- if (length(OutL)==1){
+ if(length(OutL)==1){
OutL<- Op(1,OutL)
}
return(OutL)
@@ -6354,7 +6475,7 @@ Setarrow<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0){
+ if(Nargs==0){
Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="")
Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="")
return(Str)
@@ -6362,21 +6483,21 @@ Setarrow<- function(...)
Flg<- 0
for (I in 1:Nargs){
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Flg<- Flg+1
- if (Flg==1) YaSize<<-Tmp
- if (Flg==2){
- if (Tmp<5){
+ if(Flg==1) YaSize<<-Tmp
+ if(Flg==2){
+ if(Tmp<5){
YaAngle<<- 18*Tmp
}
else{
YaAngle<<- Tmp
}
}
- if (Flg==3) YaPosition<<- Tmp
- if (Flg==4) YaThick<<- Tmp
+ if(Flg==3) YaPosition<<- Tmp
+ if(Flg==4) YaThick<<- Tmp
}
- if (mode(Tmp)=="character"){
+ if(mode(Tmp)=="character"){
YaStyle<<- Tmp
}
}
@@ -6388,8 +6509,8 @@ Setax<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0){
- if (ZIKU=="line"){
+ if(Nargs==0){
+ if(ZIKU=="line"){
Tmp<- ","
}
else{
@@ -6402,7 +6523,7 @@ Setax<- function(...)
ArgL<- c()
Is<- 1
Tmp<- varargin[[1]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
Is<- varargin[[1]]
ArgL<- c()
for (I in Looprange(1,Is-1)){
@@ -6413,12 +6534,12 @@ Setax<- function(...)
}
}
else{
- if (Nargs==1){
+ if(Nargs==1){
ArgL<- c(varargin[[1]])
}
else{
Tmp<- varargin[[2]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
ARROWSIZE<<-Tmp
ArgL<- c(varargin[[1]])
for (I in Looprange(3,Nargs)){
@@ -6437,41 +6558,41 @@ Setax<- function(...)
ArgL<- c(ArgL,"")
}
Zk<- ArgL[1]
- if (nchar(Zk)>0){
+ if(nchar(Zk)>0){
ZL<-substr(Zk,2,nchar(Zk))
Zk<-substr(Zk,1,1)
- if (nchar(ZL)>0){
+ if(nchar(ZL)>0){
ARROWSIZE<<- as.numeric(ZL)
}
}
Xn<- ArgL[2]; Xp<- ArgL[3]
Yn<- ArgL[4]; Yp<- ArgL[5]
Genn<- ArgL[6]; Genp<- ArgL[7]
- if (nchar(Zk)>0){
+ if(nchar(Zk)>0){
C<- Zk
- if (C=="a"){
+ if(C=="a"){
ZIKU<<- "arrow"
}
else{
ZIKU<<- "line"
}
}
- if (nchar(Xn)>0){
+ if(nchar(Xn)>0){
XNAME<<- paste("$",Xn,"$",sep="")
}
- if (nchar(Xp)>0){
+ if(nchar(Xp)>0){
XPOS<<- Xp
}
- if (nchar(Yn)>0){
+ if(nchar(Yn)>0){
YNAME<<- paste("$",Yn,"$",sep="")
}
- if (nchar(Yp)>0){
+ if(nchar(Yp)>0){
YPOS<<-Yp
}
- if (nchar(Genn)>0){
+ if(nchar(Genn)>0){
ONAME<<- Genn
}
- if (nchar(Genp)>0){
+ if(nchar(Genp)>0){
OPOS<<- Genp
}
Out<- "";
@@ -6515,7 +6636,7 @@ Setmarklen<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0){
+ if(Nargs==0){
Tmp<- MARKLENNow/MARKLENInit
Tmp=round(Tmp*100)/100
return(Tmp)
@@ -6531,7 +6652,7 @@ Setorigin<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0){
+ if(Nargs==0){
return(GENTEN)
}
Pt<- varargin[[1]]
@@ -6544,25 +6665,25 @@ Setscaling<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0)
+ if(Nargs==0)
{
return(c(SCALEY,LOGX,LOGY))
}
for (I in 1:Nargs)
{
Tmp<- varargin[[I]]
- if (mode(Tmp)=="numeric")
+ if(mode(Tmp)=="numeric")
{
SCALEY<<- Tmp
}
- if (mode(Tmp)=="character")
+ if(mode(Tmp)=="character")
{
- if (Tmp=="l")
+ if(Tmp=="l")
{
LOGX<<- 0
LOGY<<- 1
}
- else if (Tmp=="ll")
+ else if(Tmp=="ll")
{
LOGX<<- 1
LOGY<<- 1
@@ -6592,7 +6713,7 @@ Setpt<- function(...)
{
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0)
+ if(Nargs==0)
{
Tmp<- TenSize/TenSizeInit
Tmp<- round(Tmp*100)/100
@@ -6607,7 +6728,7 @@ Setpt<- function(...)
Setunitlen<-function(...)
{
varargin<-list(...)
- if (length(varargin)==0){
+ if(length(varargin)==0){
return(ULEN)
}
Ul=varargin[[1]]
@@ -6616,7 +6737,7 @@ Setunitlen<-function(...)
Sym<-".0123456789 +-*/"
SL<-Sym
OL<-"+-*/"
- if (nchar(Ul)>0){
+ if(nchar(Ul)>0){
ULEN<<-Ul
}
Is<-1
@@ -6624,8 +6745,8 @@ Setunitlen<-function(...)
Ucode<-ULEN
for (I in 1:nchar(Ucode)){
C<-substring(Ucode,I,I)
- if (length(grep(C,SL))>0){
- if (length(grep(C,OL))>0){
+ if(length(grep(C,SL))>0){
+ if(length(grep(C,OL))>0){
Tmp<-substring(Ucode,Is,I-1)
Str<-paste(VL,Tmp,C,sep="")
VL<-Str
@@ -6642,15 +6763,15 @@ Setunitlen<-function(...)
Valu<-eval(parse(text=VL))
Str<-as.character(Valu)
ULEN<<-paste(Str,Unit,sep="");
- if (Unit=="cm") MilliIn<<-1000/2.54*Valu
- if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10
- if (Unit=="in") MilliIn<<-1000*Valu
- if (Unit=="pt") MilliIn<<-1000/72.27*Valu
- if (Unit=="pc") MilliIn<<-1000/6.022*Valu
- if (Unit=="bp") MilliIn<<-1000/72*Valu
- if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
- if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu
- if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
+ if(Unit=="cm") MilliIn<<-1000/2.54*Valu
+ if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10
+ if(Unit=="in") MilliIn<<-1000*Valu
+ if(Unit=="pt") MilliIn<<-1000/72.27*Valu
+ if(Unit=="pc") MilliIn<<-1000/6.022*Valu
+ if(Unit=="bp") MilliIn<<-1000/72*Valu
+ if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
+ if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu
+ if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
MARKLEN<<-MARKLENNow*1000/2.54/MilliIn
MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17
}
@@ -6662,11 +6783,11 @@ Setwindow<-function(...)
{
varargin<-list(...)
Nargs<-length(varargin)
- if (Nargs==0){
+ if(Nargs==0){
Out<-c(XMIN,XMAX,YMIN,YMAX)
return(Out)
}
- if (Nargs==1){
+ if(Nargs==1){
Dt<- varargin[[1]]
if(is.list(Dt) && !is.data.frame(Dt)){
Tmp<- as.data.frame(Dt)
@@ -6682,13 +6803,13 @@ Setwindow<-function(...)
Str<- paste(Str,")",sep="")
print(Str)
}
- if (Nargs==2){
+ if(Nargs==2){
RgX<-varargin[[1]]
RgY<-varargin[[2]]
XMIN<<-RgX[1]; XMAX<<-RgX[2]
YMIN<<-RgY[1]; YMAX<<-RgY[2]
}
- if (Nargs==4){
+ if(Nargs==4){
XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]]
YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]]
}
@@ -6754,7 +6875,7 @@ Shade<- function(...)
Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
cat(Str,file=Wfile,append=TRUE)
Mojisu<- Mojisu+nchar(Str)
- if (Mojisu>80){
+ if(Mojisu>80){
cat("%\n",file=Wfile,append=TRUE)
Mojisu<- 0
}
@@ -6777,35 +6898,35 @@ Shade<- function(...)
Nargs<- length(varargin)
Iroflg<- 0
Kosa<- 1
- if (Nargs>1){
+ if(Nargs>1){
Iro<- varargin[[Nargs]]
- if (mode(Iro)=="character"){
+ if(mode(Iro)=="character"){
Iroflg<- 1
- if (length(grep(Iro,"{"))>0)
+ if(length(grep(Iro,"{"))>0)
Str<- paste("{\\color",Iro,sep="")
else
Str<- paste("{\\color{",Iro,"}",sep="")
}
else{
- if (length(Iro)==1)
+ if(length(Iro)==1)
Kosa<- Iro
else{
Iroflg<- 1
- if (length(Iro)==4)
+ if(length(Iro)==4)
Str<- paste("{\\color[cmyk]{",sep="")
else
- if (length(Iro)==3)
+ if(length(Iro)==3)
Str<- paste("{\\color[rgb]{",sep="")
for (J in Looprange(1,length(Iro))){
Str<- paste(Str,as.character(Iro[J]),sep="")
- if (J<length(Iro))
+ if(J<length(Iro))
Str<- paste(Str,",",sep="")
}
Str<- paste(Str,"}",sep="")
}
}
- if (Iroflg==1){
- if (Wfile=="default")
+ if(Iroflg==1){
+ if(Wfile=="default")
cat(Str,"%\n",file="",append=TRUE,sep="")
else
cat(Str,"%\n",file=Wfile,append=TRUE,sep="")
@@ -6821,13 +6942,13 @@ Shade<- function(...)
X<- as.character(round(MilliIn*P[1]))
Y<- as.character(-round(MilliIn*P[2]))
Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
- if (Wfile=="default")
+ if(Wfile=="default")
cat(Str,file="",append=TRUE,sep="")
else
cat(Str,file=Wfile,append=TRUE,sep="")
Mojisu<- Mojisu+nchar(Str)
- if (Mojisu>80){
- if (Wfile=="default")
+ if(Mojisu>80){
+ if(Wfile=="default")
cat("%\n",file="",append=TRUE,sep="")
else
cat("%\n",file=Wfile,append=TRUE,sep="")
@@ -6836,7 +6957,7 @@ Shade<- function(...)
}
Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
Str2<- paste("\\special{ip}%\n",sep="")
- if (Wfile=="default"){
+ if(Wfile=="default"){
cat(Str1,file="",append=TRUE,sep="")
cat(Str2,file="",append=TRUE,sep="")
}
@@ -6845,8 +6966,8 @@ Shade<- function(...)
cat(Str2,file=Wfile,append=TRUE,sep="")
}
}
- if (Iroflg==1){
- if (Wfile=="default")
+ if(Iroflg==1){
+ if(Wfile=="default")
cat("}%\n",file="",append=TRUE,sep="")
else
cat("}%\n",file=Wfile,append=TRUE,sep="")
@@ -6862,18 +6983,18 @@ Splinedata<- function(...)
Nargs<- length(varargin)
Eps<- 10^(-3)
PL<- varargin[[1]]
- if (mode(PL)=="character"){
+ if(mode(PL)=="character"){
Fname<- PL
PL<- Readtextdata(Fname)
}
else{
PL<- as.matrix(PL)
- if (Nrow(PL)==1){
+ if(Nrow(PL)==1){
PL<- matrix(PL, nrow=length(PL)/2)
PL<- t(PL)
}
}
- if (ncol(PL)==3){
+ if(ncol(PL)==3){
Flg3<- 1
}
else{
@@ -6884,13 +7005,13 @@ Splinedata<- function(...)
C<- c()
for (I in Looprange(2,Nargs)){
Tmp<- varargin[[I]]
- if (mode(Tmp)!="character") next
- if (length(grep("=",Tmp,fixed=TRUE))>0){
+ if(mode(Tmp)!="character") next
+ if(length(grep("=",Tmp,fixed=TRUE))>0){
eval(parse(text=Tmp))
}
else{
Tmp1<- substr(Tmp,1,1)
- if (toupper(Tmp1)=="C"){
+ if(toupper(Tmp1)=="C"){
C<- 1:length(PLL)
}
}
@@ -6900,7 +7021,7 @@ Splinedata<- function(...)
K<- C[J]
Cflg[K]<- 1
}
- if (length(N)>1){
+ if(length(N)>1){
Nj<- as.numeric(N)
}
else{
@@ -6917,8 +7038,8 @@ Splinedata<- function(...)
OutL<- list()
for(J in 1:length(PLL)){
PL<- PLL[[J]]
- if (Cflg[J]==1){
- if (Norm(PL[1,]-PL[Nrow(PL),])>Eps){
+ if(Cflg[J]==1){
+ if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){
PL<-Appendrow(PL,PL[1,])
Nj[J]=round(N/MxP*nrow(PL))
}
@@ -6929,21 +7050,21 @@ Splinedata<- function(...)
Tn<- 1:Nrow(PL)
Xn<- PL[,1]
Yn<- PL[,2]
- if (Flg3==1) Zn<- PL[,3]
- if (Cflg[J]==0){
+ if(Flg3==1) Zn<- PL[,3]
+ if(Cflg[J]==0){
Dxn<- spline(Tn,Xn,n=Nj[J])
Dyn<- spline(Tn,Yn,n=Nj[J])
- if (Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J])
+ if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J])
}
else{
Dxn<- spline(Tn,Xn,method="periodic")
Dyn<- spline(Tn,Yn,method="periodic")
- if (Flg3==1) Dzn<- spline(Tn,Zn,method="periodic")
+ if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic")
}
Tmp1<- Dxn$y
Tmp2<- Dyn$y
Tmp3<-c()
- if (Flg3==1) Tmp3<- Dzn$y
+ if(Flg3==1) Tmp3<- Dzn$y
Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1))
OutL<- c(OutL,list(Out))
}
@@ -6976,7 +7097,7 @@ Tabledata<- function(...){
Tmp[1]<- S
SvL<- c(SvL,list(Tmp))
}
- if (Hsize>S){
+ if(Hsize>S){
SvL<- c(SvL,list(Hsize))
}
Hsize<- Op(1,SvL[[length(SvL)]])
@@ -6989,16 +7110,16 @@ Tabledata<- function(...){
Tmp[1]<- S
ShL<- c(ShL,list(Tmp))
}
- if (Vsize>S){
+ if(Vsize>S){
ShL<- c(ShL,list(Vsize))
}
Vsize<- Op(1,ShL[[length(ShL)]])
Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0
- if (length(Domain)>2){
+ if(length(Domain)>2){
Marw<- Domain[3]
Mare<- Domain[4]
}
- if (length(Domain)>4){
+ if(length(Domain)>4){
Marn<- Domain[5]
Mars<- Domain[6]
}
@@ -7010,7 +7131,7 @@ Tabledata<- function(...){
for (I in Looprange(1,length(SvL))){
Data<- SvL[[I]]
X<- Data[1]
- if (length(Data)==1){
+ if(length(Data)==1){
Y1<- 0
Y2<- Vsize
G<- Listplot(c(X,Y1),c(X,Y2))
@@ -7036,7 +7157,7 @@ Tabledata<- function(...){
for (I in Looprange(1,length(ShL))){
Data<- ShL[[I]]
Y<- Vsize-Data[1]
- if (length(Data)==1){
+ if(length(Data)==1){
X1<- 0
X2<- Hsize
G<- Listplot(c(X1,Y),c(X2,Y))
@@ -7079,25 +7200,25 @@ Tabledata<- function(...){
Texcom<- function(Meirei)
{
- if (Meirei=="\\thinlines"){
+ if(Meirei=="\\thinlines"){
Setpen(1);
return();
}
- if (Meirei=="\\thicklines"){
+ if(Meirei=="\\thicklines"){
Setpen(2);
return()
}
- if (Meirei=="\\Thicklines"){
+ if(Meirei=="\\Thicklines"){
Setpen(3);
return()
}
- if (length(Meirei)==0){ # 09.12.07
+ if(length(Meirei)==0){ # 09.12.07
Tmp<- c()
}
else{
Tmp<- grep("newline",Meirei)
}
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
cat("\n",file=Wfile,append=TRUE);
}
else{
@@ -7110,7 +7231,7 @@ Texcom<- function(Meirei)
###############################################
Texctr<- function(N){
- if (is.numeric(N)){
+ if(is.numeric(N)){
Alpha<- "abcdefghijklmnopqrstuvwxyz"
Out<- paste("ketpicctr",substr(Alpha,N,N),sep="")
}
@@ -7209,28 +7330,28 @@ Texletter<- function(...)
for (I in seq(1,Nargs,by=3)){
P<- varargin[[I]]
X<- P[1]
- if (mode(X)=="numeric"){
+ if(mode(X)=="numeric"){
X<- as.character(X)
}
Y<- P[2]
- if (mode(Y)=="numeric"){
+ if(mode(Y)=="numeric"){
Y<- as.character(Y)
}
Houkou<- varargin[[I+1]]
Mojiretu<- varargin[[I+2]]
Hset<- Houkou
Vhoko<- "c"
- if (length(grep("n",Hset))>0){
+ if(length(grep("n",Hset))>0){
Vhoko<- "n"
}
- if (length(grep("s",Hset))>0){
+ if(length(grep("s",Hset))>0){
Vhoko<- "s"
}
Hhoko<- "c";
- if (length(grep("e",Hset))>0){
+ if(length(grep("e",Hset))>0){
Hhoko<- "e"
}
- if (length(grep("w",Hset))>0){
+ if(length(grep("w",Hset))>0){
Hhoko<- "w"
}
Hoko<- paste(Vhoko,Hhoko,sep="")
@@ -7250,13 +7371,13 @@ Texnewcmd<- function(...)
Nargs<- length(varargin)
Str<- varargin[[1]]
S<- paste("\\newcommand{",Str,"}",sep="")
- if (Nargs>1){
+ if(Nargs>1){
Tmp<- as.character(varargin[[2]])
S<- paste(S,"[",Tmp,"]",sep="")
}
- if (Nargs>2){
+ if(Nargs>2){
Tmp<- varargin[[3]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Tmp<- as.character(Tmp)
}
S<- paste(S,"[",Tmp,"]",sep="")
@@ -7269,7 +7390,7 @@ Texnewcmd<- function(...)
Texnewctr<- function(N)
{
- if (mode(N)=="character"){
+ if(mode(N)=="character"){
Str<- paste("\\newcounter{",N,"}",sep="")
Texcom(Str)
}
@@ -7288,13 +7409,13 @@ Texrenewcmd<- function(...)
Nargs<- length(varargin)
Str<- varargin[[1]]
S<- paste("\\renewcommand{",Str,"}",sep="")
- if (Nargs>1){
+ if(Nargs>1){
Tmp<- as.character(varargin[[2]])
S<- paste(S,"[",Tmp,"]",sep="")
}
- if (Nargs>2){
+ if(Nargs>2){
Tmp<- varargin[[3]]
- if (mode(Tmp)=="numeric"){
+ if(mode(Tmp)=="numeric"){
Tmp<- as.character(Tmp)
}
S<- paste(S,"[",Tmp,"]",sep="")
@@ -7316,35 +7437,35 @@ Texsetctr<- function(Nctr,Opstr)
Paflg<- 0
for (I in Looprange(1,nchar(Opstr))){
Tmp<- substring(Opstr,I,I)
- if (Tmp=="("){
+ if(Tmp=="("){
Paflg<- 1
- if (nchar(Va)>0){
+ if(nchar(Va)>0){
Evflg<- 1
Va<- paste(Va,Tmp,sep="")
}
next
}
- if (Tmp==")"){
+ if(Tmp==")"){
Paflg<- 0
- if (Evflg>0){
+ if(Evflg>0){
Va<- paste(Va,Tmp,sep="")
}
next
}
- if (Paflg>0){
+ if(Paflg>0){
Va<- paste(Va,Tmp,sep="")
next
}
- if (length(grep(Tmp,OperL))==0){
+ if(length(grep(Tmp,OperL))==0){
Va<- paste(Va,Tmp,sep="")
}
else{
- if (Evflg>0){
+ if(Evflg>0){
Tmp1<- eval(parse(text=Va))
Va<- paste("\\value{",Tmp1,"}",sep="")
Evflg<- 0
}
- if (Oper==""){
+ if(Oper==""){
if(nchar(Va)>0){
Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="")
Texcom(Str)
@@ -7412,10 +7533,10 @@ Tonumeric <- function(...)
Data<- varargin[[1]]
Sp<- c(1,1)
Ep<- c(Inf,Inf)
- if (Nargs>1){
+ if(Nargs>1){
Sp<- varargin[[2]]
}
- if (Nargs>2){
+ if(Nargs>2){
Ep<- varargin[[3]]
}
Nrs<- Sp[1]
@@ -7429,27 +7550,27 @@ Tonumeric <- function(...)
for (I in 1:nrow(Out)){
for (J in 1:ncol(Out)){
Tmp<- Out[I,J]
- if (!is.na(Tmp)){
+ if(!is.na(Tmp)){
Sp<- c(I,J)
break;
}
}
- if (length(Sp)>0) break
+ if(length(Sp)>0) break
}
- if (length(Sp)==0){
+ if(length(Sp)==0){
return("Numeric data not found")
}
Ep<- c(nrow(Out),ncol(Out))
for (I in Sp[1]:nrow(Out)){
Tmp<- Out[I,Sp[2]]
- if (is.na(Tmp)){
+ if(is.na(Tmp)){
Ep[1]<- I-1
break
}
}
for (J in Sp[2]:ncol(Out)){
Tmp<- Out[Sp[1],J]
- if (is.na(Tmp)){
+ if(is.na(Tmp)){
Ep[2]<- J-1
break
}
@@ -7466,16 +7587,16 @@ Translatedata<- function(...)
Nargs<- length(varargin)
Eps<- 10^(-8)
ML<- varargin[[1]]
- if (Mixtype(ML)==1){
+ if(Mixtype(ML)==1){
ML<- list(ML)
}
Tmp=varargin[[2]]
- if (mode(Tmp)=="numeric" && length(Tmp)>1){
+ if(mode(Tmp)=="numeric" && length(Tmp)>1){
A<- Tmp[1]; B<- Tmp[2]
}
else{
A<- Tmp
- if (Nargs>=3){
+ if(Nargs>=3){
B<- varargin[[3]]
}
else{
@@ -7495,7 +7616,7 @@ Translatedata<- function(...)
}
X1<- Tmp[1]
Y1<- Tmp[2]
- if (X1==Inf){
+ if(X1==Inf){
X2<- X1
Y2<-Y1
}
@@ -7507,7 +7628,7 @@ Translatedata<- function(...)
}
OutL<- Mixjoin(OutL,list(Out))
}
- if (length(OutL)==1){
+ if(length(OutL)==1){
OutL<- Op(1,OutL)
}
return(OutL)
@@ -7518,19 +7639,19 @@ Translatedata<- function(...)
Unscaling<- function(G)
{
GLg<- G
- if (class(GLg)=="numeric"){
+ if(class(GLg)=="numeric"){
GLg<-c(G[1]/SCALEX, G[2]/SCALEY)
Tmp<-GLg
- if (LOGX==1) Tmp[1]<- 10^(GLg[1])
- if (LOGY==1) Tmp[2]<- 10^(GLg[2])
+ if(LOGX==1) Tmp[1]<- 10^(GLg[1])
+ if(LOGY==1) Tmp[2]<- 10^(GLg[2])
return(Tmp)
}
else{
Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2)
GLg<-G %*% Tmp1
Tmp<-GLg
- if (LOGX==1) Tmp[,1]<- 10^(G[,1])
- if (LOGY==1) Tmp[,2]<- 10^(G[,2])
+ if(LOGX==1) Tmp[,1]<- 10^(G[,1])
+ if(LOGY==1) Tmp[,2]<- 10^(G[,2])
return(Tmp)
}
}
@@ -7542,11 +7663,11 @@ Vtickmark<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
ArgsL<- varargin
- if (mode(ArgsL[[1]])=="character"){
+ if(mode(ArgsL[[1]])=="character"){
Str<- ArgsL[[1]]
Tmp<- strsplit(Str,"m")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
I<- nchar(Tmp[1])+1
}
else{
@@ -7554,7 +7675,7 @@ Vtickmark<- function(...)
}
Tmp<- strsplit(Str,"n")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
J<- nchar(Tmp[1])+1
}
else{
@@ -7562,16 +7683,16 @@ Vtickmark<- function(...)
}
Tmp<- strsplit(Str,"r")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
K=nchar(Tmp[1])+1
}
else{
K<- 0
}
- if (K>0){
+ if(K>0){
S<- substr(Str,K+1,nchar(Str))
R<- as.numeric(S)
- if (is.na(R)){
+ if(is.na(R)){
R<- 1
}
}
@@ -7579,10 +7700,10 @@ Vtickmark<- function(...)
R<- 1
K<- nchar(Str)+1
}
- if (J>0){
+ if(J>0){
S<- substr(Str,J+1,K-1)
Dn<- as.numeric(S)
- if (is.na(Dn)){
+ if(is.na(Dn)){
Dn<- 1
}
}
@@ -7592,20 +7713,20 @@ Vtickmark<- function(...)
}
S<- substr(Str,I+1,J-1)
Dm<- as.numeric(S)
- if (is.na(Dm)){
+ if(is.na(Dm)){
Dm<- 1
}
ArgsL<- list()
for (I in 1:floor((YMAX-GENTEN[2])/Dm)){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
}
for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
@@ -7615,18 +7736,18 @@ Vtickmark<- function(...)
Memori<- list()
for (N in 1:length(ArgsL)){
Dt<- ArgsL[[N]]
- if (mode(Dt)=="numeric" && length(Dt)>1){
- if (length(Memori)>0){
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(Dt[1],Dt[2])
next
}
- if (mode(Dt)=="character"){
+ if(mode(Dt)=="character"){
Memori<- Mixjoin(Memori,Dt)
}
else{
- if (length(Memori)>0){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(GENTEN[1],Dt)
@@ -7646,14 +7767,14 @@ Vtickmark<- function(...)
Tmp2<- Unscaling(c(X-MARKLEN,Y))
Fd<- Listplot(c(Tmp1,Tmp2))
Drwline(Fd)
- if (Ndt==3){
+ if(Ndt==3){
Tmp<-Unscaling(c(X-MARKLEN,Y))
Expr(Tmp,"w",Moji)
}
- if (Ndt==4){
+ if(Ndt==4){
Houkou<- Op(3,Dt)
Tmp<-grep("w",Houkou)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Tmp<-Unscaling(c(X-MARKLEN,Y))
Expr(Tmp,Houkou,Moji)
}
@@ -7684,21 +7805,21 @@ Windisp<-function(...){
Tmp2<- c(XMAX,GENTEN[2])
Tmp3<- Listplot(Tmp1,Tmp2)
Tmp<- MakeCurves(Tmp3,0)
- if (Datalength(Tmp)>0){
+ if(Datalength(Tmp)>0){
lines(Tmp[,1],Tmp[,2],col="green")
}
Tmp1<- c(GENTEN[1],YMAX)
Tmp2<- c(GENTEN[1],YMIN)
Tmp3<- Listplot(Tmp1,Tmp2)
Tmp<- MakeCurves(Tmp3,0)
- if (Datalength(Tmp)>0){
+ if(Datalength(Tmp)>0){
lines(Tmp[,1],Tmp[,2],col="green")
}
Tmp<-Doscaling(Framedata())
lines(Tmp[,1],Tmp[,2])
for (I in Looprange(1,Nargs)){
Pdata<-varargin[[I]]
- if (mode(Pdata)=="numeric"){
+ if(mode(Pdata)=="numeric"){
Pdata<-list(Pdata)
}
while(Mixtype(Pdata)==3){ # 10.02.23
@@ -7714,7 +7835,7 @@ Windisp<-function(...){
Ndm<-Dataindex(P)
for (J in Looprange(1,Nrow(Ndm))){
Q<-P[Ndm[J,1]:Ndm[J,2],]
- if (Nrow(Q)==1){
+ if(Nrow(Q)==1){
Tmp<-seq(1,Ncol(Q),by=2)
for (K in Tmp){
Pt<-Q[K:(K+1)]
@@ -7754,14 +7875,14 @@ WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ #
Tmp2<- c(XMAX,GENTEN[2])
Tmp3<- Listplot(Tmp1,Tmp2)
Tmp<- MakeCurves(Tmp3,0)
- if (Datalength(Tmp)>0){
+ if(Datalength(Tmp)>0){
lines(Tmp[,1],Tmp[,2],col="green")
}
Tmp1<- c(GENTEN[1],YMAX)
Tmp2<- c(GENTEN[1],YMIN)
Tmp3<- Listplot(Tmp1,Tmp2)
Tmp<- MakeCurves(Tmp3,0)
- if (Datalength(Tmp)>0){
+ if(Datalength(Tmp)>0){
lines(Tmp[,1],Tmp[,2],col="green")
}
Tmp<-Doscaling(Framedata())
@@ -7791,7 +7912,7 @@ WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ #
Ndm<-Dataindex(P)
for (J in Looprange(1,Nrow(Ndm))){
Q<-P[Ndm[J,1]:Ndm[J,2],]
- if (Nrow(Q)==1){
+ if(Nrow(Q)==1){
Tmp<-seq(1,Ncol(Q),by=2)
for (K in Tmp){
Pt<-Q[K:(K+1)]
@@ -7847,13 +7968,13 @@ CameraCurve<- function(Curve){
for (I in Looprange(1,Nrow(Curve))){
P<- Curve[I,]
x<- P[1]; y<- P[2]; z<- P[3]
- if (x!=Inf){
+ if(x!=Inf){
Tmp<- Perspt(P)
- if (I==1){
+ if(I==1){
AnsL<- rbind(c(),Tmp)
}else{
Tmp1<- AnsL[Nrow(AnsL),]
- if (Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){
+ if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){
AnsL<- rbind(AnsL,Tmp)
}
}
@@ -7867,11 +7988,11 @@ CameraCurve<- function(Curve){
######################################
-Cancoordpara<- function(P){ # 13.10.06
+Cancoordpara<- function(P){ # 18.02.15
Xz<- P[1]
Yz<- P[2]
Zz<- P[3]
- X<- Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA)
+ X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA)
Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA)
Z<- Yz*sin(THETA)+Zz*cos(THETA)
Out<- c(X,Y,Z)
@@ -7953,12 +8074,12 @@ Facesdata<- function(...){
FL<- varargin[[1]]
PT<- varargin[[length(varargin)]]
Tmp<-grep("para",PT,fixed=TRUE)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Ptype<- 1
}else{
Ptype<- -1
}
- if (Nargs==2){
+ if(Nargs==2){
CLadd<- list()
}else{
CLadd<- varargin[[2]]
@@ -7966,10 +8087,10 @@ Facesdata<- function(...){
NohiddenL<- list()
HiddenL<- list()
Eps<- 10^(-4)
- if (length(CLadd)>0){
- if (mode(CLadd)=="numeric"){
+ if(length(CLadd)>0){
+ if(mode(CLadd)=="numeric"){
C<- list()
- if (Nrow(CLadd)>1){
+ if(Nrow(CLadd)>1){
for (I in Looprange(1,Nrow(CLadd))){
C<- c(C,list(CLadd[I,]))
}
@@ -7981,12 +8102,12 @@ Facesdata<- function(...){
}
}
CrvL<- list(C)
- }else if (mode(CLadd[[1]])=="numeric"){
+ }else if(mode(CLadd[[1]])=="numeric"){
CrvL<- list()
for (J in Looprange(1,length(CL))){
Ctmp<- CLadd[[J]]
C<- list()
- if (Nrow(Ctmp)>1){
+ if(Nrow(Ctmp)>1){
for (I in Looprange(1,Nrow(Ctmp))){
C<- c(C,list(Ctmp[I,]))
}
@@ -8018,7 +8139,7 @@ Facesdata<- function(...){
}
FaceL<- Out[[2]]
Tmp<- grep("raw",PT,fixed=TRUE)
- if (length(Tmp)==0){
+ if(length(Tmp)==0){
for (Nf in Looprange(1,length(FaceL))){
Face<- FaceL[[Nf]]
Menkakusi2(Face,Nf,Ptype)
@@ -8026,7 +8147,7 @@ Facesdata<- function(...){
}
for (I in Looprange(1,length(VELNO))){
Edge<- Op(1,VELNO[[I]])
- if (Norm(Edge[[1]]-Edge[[2]])>Eps){
+ if(Norm(Edge[[1]]-Edge[[2]])>Eps){
NohiddenL<- c(NohiddenL,list(Spaceline(Edge)))
}
}
@@ -8074,7 +8195,7 @@ PhHiddenData<- function(){
PHHIDDENDATA
}
-##############################
+########## Old Fullform ( Check the case of Polygon )####################
Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL)
Out<- list(Op(1,FdL))
@@ -8082,23 +8203,23 @@ Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL)
for (Jrg in Looprange(1,N)){
Tmp<- Stripblanks(Op(Jrg,FdL))
Tmp1<- grep("=c(",Tmp,fixed=TRUE)
- if (length(Tmp1)>0){
+ if(length(Tmp1)>0){
break
}
}
Urg<- Stripblanks(Op(Jrg,FdL))
StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]]
- Uname<-StrV[1]
+ Uname<- StrV[1]
Vrg<- Stripblanks(Op(Jrg+1,FdL))
StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]]
Vname<- StrV[1]
- if (Jrg==2){
+ if(Jrg==2){
Tmp<- Stripblanks(Op(1,FdL))
StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
Zf<- StrV[2]
Tmp<- list(Uname,Vname,Zf,Urg,Vrg)
Out<- c(Out,Tmp)
- }else if (Jrg==4){
+ }else if(Jrg==4){
Tmp<- Stripblanks(Op(1,FdL))
StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
Zf<- StrV[2]
@@ -8131,13 +8252,13 @@ Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL)
BdyL<- c()
for (I in Looprange(Jrg+2,Mixlength(FdL))){
Tmp<- Op(I,FdL)
- if (mode(Tmp)=="character"){
- if (length(Tmp)==0){
+ if(mode(Tmp)=="character"){
+ if(length(Tmp)==0){
Tmp<- " "
}
DrwS<- Tmp
}
- if (mode(Tmp)=="numeric" && Ncol(Tmp)>1){
+ if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){
BdyL<- Tmp
}
}
@@ -8161,19 +8282,19 @@ Invparapt<- function(...){
Fk<- varargin[[length(varargin)]]
NFk<- Numptcrv(Fk)
Tmp<- varargin[[1]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1){ # debug
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){ # debug
Ph<- Tmp
Fh<- varargin[[2]]
}else{
Fh<- Projpara(Fk)
- if (NFk>2){
+ if(NFk>2){
Tmp1<- Nearestpt(Tmp,Fh)
Ph<- Tmp1[[2]]
}else{
Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh)
V1<- Tmp-Ah; V2<- Bh-Ah
Tmp1<- Crossprod(V1,V2)
- if (abs(Tmp1)>Eps){
+ if(abs(Tmp1)>Eps){
print("Not on the line")
return(c())
}else{
@@ -8181,10 +8302,10 @@ Invparapt<- function(...){
}
}
}
- if (NFk>2){
+ if(NFk>2){
N<- trunc(Ph)
S0<- Ph-N
- if (Ph>Numptcrv(Fh)-Eps){
+ if(Ph>Numptcrv(Fh)-Eps){
Out<- list(Ptend(Fk),Numptcrv(Fh))
return(Out)
}
@@ -8210,19 +8331,19 @@ Invperspt<- function(...){
Fk<- varargin[[length(varargin)]]
NFk<- Numptcrv(Fk)
Tmp<- varargin[[1]]
- if (mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
Ph<- varargin[[1]]
Fh<- varargin[[2]]
}else{
Fh<- Projpers(Fk)
- if (NFk>2){
+ if(NFk>2){
Tmp1<- Nearestpt(Tmp,Fh)
Ph<- Tmp1[[2]]
}else{
Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh)
V1<- Tmp-Ah; V2<- Bh-Ah
Tmp1<- Crossprod(V1,V2)
- if (abs(Tmp1)>Eps){
+ if(abs(Tmp1)>Eps){
print("Not on the line")
Out<- c()
return(Out)
@@ -8231,10 +8352,10 @@ Invperspt<- function(...){
}
}
}
- if (NFk>2){
+ if(NFk>2){
N<- trunc(Ph)
S0<- Ph-N
- if (Ph>Numptcrv(Fh)-Eps){
+ if(Ph>Numptcrv(Fh)-Eps){
Out<- list(Ptend(Fk),Numptcrv(Fh))
return(Out)
}
@@ -8254,9 +8375,9 @@ Invperspt<- function(...){
Cp<- Crossprod(Vp,AB)
Nmr<- Crossprod(Va,Vp)
Mx<- max(abs(Cp))
- if (abs(Cp[1])==Mx){
+ if(abs(Cp[1])==Mx){
T2<- Nmr[1]/Cp[1]
- }else if (abs(Cp[2])==Mx){
+ }else if(abs(Cp[2])==Mx){
T2<- Nmr[2]/Cp[2]
}else{
T2<- Nmr[3]/Cp[3]
@@ -8280,26 +8401,26 @@ Kukannozoku<- function(Jokyo,KukanL){
Flg<- 0
for (I in Looprange(1,N)){
Ku<- KukanL[I,]
- if (Flg==0){
- if (Ku[2]<T1){
+ if(Flg==0){
+ if(Ku[2]<T1){
Res<- rbind(Res,Ku)
}else{
Flg<- 1
- if (Ku[1]<T1-Eps){
+ if(Ku[1]<T1-Eps){
Tmp<- c(Ku[1],T1)
Res<- rbind(Res,Tmp)
}
- if (Ku[2]>T2+Eps){
+ if(Ku[2]>T2+Eps){
Tmp<- c(T2,Ku[2])
Res<- rbind(Res,Tmp)
}
}
- }else if (Flg==1){
- if (Ku[2]<T2){
+ }else if(Flg==1){
+ if(Ku[2]<T2){
next
}else{
Flg<- 2
- if (Ku[1]<T2-Eps){
+ if(Ku[1]<T2-Eps){
Ku<- c(T2,Ku[2])
}
Res<- rbind(Res,Ku)
@@ -8341,14 +8462,14 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
P2<- Tmp[,1:2]
KC<- IntersectcrvsPp(P1,P2,Eps)
- if (Mixlength(KC)>0){
+ if(Mixlength(KC)>0){
for (J in 1:Mixlength(KC)){
P<- Op(1,Op(J,KC))
Tmp<- Op(2,Op(J,KC))
- if (Tmp<1+Eps && Ns==1){
+ if(Tmp<1+Eps && Ns==1){
next
}
- if (Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
+ if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
next
}
N1<- Ns
@@ -8357,7 +8478,7 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
Za<- Plt2[N1,3]
Pb<- Plt2[N1+1,1:2]
Zb<- Plt2[N1+1,3]
- if (Norm(Pa-Pb)<Eps){
+ if(Norm(Pa-Pb)<Eps){
next
}
T1<- Norm(Pa-P)/Norm(Pa-Pb)
@@ -8367,13 +8488,13 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
Za<- Tmp[N2,3]
Pb<- Tmp[N2+1,1:2]
Zb<- Tmp[N2+1,3]
- if ((Norm(Pa-Pb)<Eps)){
+ if((Norm(Pa-Pb)<Eps)){
next
}
T2<- Norm(Pa-P)/Norm(Pa-Pb)
Z2<- (1-T2)*Za+T2*Zb
- if (Z1<Z2-Eps2){
- if (Nrow(ClipL)==0){
+ if(Z1<Z2-Eps2){
+ if(Nrow(ClipL)==0){
Tmp<- 1
}else{
Tmp1<- ClipL[,1]-P[1]
@@ -8381,7 +8502,7 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
Tmp3<- Tmp1^2+Tmp2^2
Tmp<- min(Tmp3)
}
- if (Tmp>Eps^2){
+ if(Tmp>Eps^2){
Tmp1<- P1[2,]-P1[1,]
Tmp2<- Pb-Pa
Tmp3<- Dotprod(Tmp1,Tmp2)
@@ -8397,7 +8518,7 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
Te<- Nrow(Plt2)
KukanL<- rbind(c(),c(1.0,Te))
P1<- PhL
- if (Nrow(ClipL)>0){
+ if(Nrow(ClipL)>0){
for (I in 1:Nrow(ClipL)){
P<- ClipL[I,1:2]
NN<- ClipL[I,3]
@@ -8405,22 +8526,22 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
R<- ClipL[I,5]
Flg<- 0
for (J in NN:1){
- Q<- Pointoncrv(J,P1)
- if (Norm(P-Q)<R){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){
next
}
Flg<- 1
break
}
- if (Flg==0){
+ if(Flg==0){
T1<- 1
}else{
T1<- J; T2<- T
H<- T2-T1
for (N in 1:10){
H<- H*0.5
- Q<- Pointoncrv(T1+H,P1)
- if (Norm(P-Q)<R){
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){
T2<- T2-H
}else{
T1<- T1+H
@@ -8430,22 +8551,22 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
Ku<- c(T1)
Flg<- 0
for (J in Looprange(NN+1,Te)){
- Q<- Pointoncrv(J,P1)
- if (Norm(P-Q)<R){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){
next
}
Flg<- 1
break
}
- if (Flg==0){
+ if(Flg==0){
T2<- Te
}else{
T1<- T; T2<- J
H<- T2-T1
for (N in 1:10){
H<- H*0.5
- Q<- Pointoncrv(T1+H,P1)
- if (Norm(P-Q)<R){
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){
T1<- T1+H
}else{
T2<- T2-H
@@ -8461,16 +8582,16 @@ Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
T1<- KukanL[I,1]; N1<- trunc(T1)
T2<- KukanL[I,2]; N2<- trunc(T2)
PtL<- list()
- if (T1-N1<1-Eps){
- Tmp<- Pointoncrv(T1,P1)
+ if(T1-N1<1-Eps){
+ Tmp<- Pointoncurve(T1,P1)
PtL<- list(Tmp)
}
for (J in Looprange(N1+1,N2)){
- Tmp<- Pointoncrv(J,P1)
+ Tmp<- Pointoncurve(J,P1)
PtL<- c(PtL,list(Tmp))
}
- if (T2-N2>Eps){
- Tmp<- Pointoncrv(T2,P1)
+ if(T2-N2>Eps){
+ Tmp<- Pointoncurve(T2,P1)
PtL<- c(PtL,list(Tmp))
}
Res<- c(Res,list(Listplot(PtL)))
@@ -8506,14 +8627,14 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
P2<- Tmp[,1:2]
KC<- IntersectcrvsPp(P1,P2,Eps)
- if (Mixlength(KC)>0){
+ if(Mixlength(KC)>0){
for (J in Looprange(1,Mixlength(KC))){#
P<- Op(1,Op(J,KC))
Tmp<- Op(2,Op(J,KC))
- if (Tmp<(1+Eps) && Ns==1){
+ if(Tmp<(1+Eps) && Ns==1){
next
}
- if (Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
+ if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
next
}
N1<- Ns
@@ -8522,13 +8643,13 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Za<- Plt2[N1,3]
Pb<- Plt2[N1+1,1:2]
Zb<- Plt2[N1+1,3]
- if (Norm(Pa-Pb)<Eps){
+ if(Norm(Pa-Pb)<Eps){
next
}
T1<- Norm(Pa-P)/Norm(Pa-Pb)#norm(Pa-P)/norm(Pa-Pb)
Pka<- Cancoordpers(c(Pa[1],Pa[2],Za))
Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb))
- if (T1>1-Eps){
+ if(T1>1-Eps){
Pk<- Pkb
}else{
Tmp1<- Listplot(c(Pa,Pb))
@@ -8542,13 +8663,13 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Za<- Tmp[N2,3]
Pb<- Tmp[N2+1,1:2]
Zb<- Tmp[N2+1,3]
- if (Norm(Pa-Pb)<Eps){
+ if(Norm(Pa-Pb)<Eps){
next
}
T2<- Norm(Pa-P)/Norm(Pa-Pb)
Pka<- Cancoordpers(c(Pa[1],Pa[2],Za))
Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb))
- if (T2>(1-Eps)){
+ if(T2>(1-Eps)){
Pk<- Pkb
}else{
Tmp1<- Listplot(c(Pa,Pb))
@@ -8557,8 +8678,8 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Pk<- Op(1,Tmp)
}
Z2<- Zperspt(Pk)
- if (Z1<(Z2-Eps2)){
- if (length(ClipL)==0){
+ if(Z1<(Z2-Eps2)){
+ if(length(ClipL)==0){
Tmp<- 1
}else{
Tmp1<- ClipL[,1]-P[1]
@@ -8566,7 +8687,7 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Tmp3<- Tmp1^2+Tmp2^2
Tmp<- min(Tmp3)
}
- if (Tmp>Eps^2){
+ if(Tmp>Eps^2){
Tmp1<- P1[2,]-P1[1,]
Tmp2<- Pb-Pa
Tmp3<- Dotprod(Tmp1,Tmp2)
@@ -8582,7 +8703,7 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Te<- Nrow(Plt2)
KukanL<- rbind(c(),c(1.0,Te))
P1<- PhL
- if (Nrow(ClipL)>0){
+ if(Nrow(ClipL)>0){
for (I in Looprange(1,Nrow(ClipL))){
P<- ClipL[I,1:2]
NN<- ClipL[I,3]
@@ -8590,22 +8711,22 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
R<- ClipL[I,5] #added 10.08.17
Flg<- 0
for (J in NN:1){
- Q<- Pointoncrv(J,P1)
- if (Norm(P-Q)<R){#(norm(P-Q)<R)
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){#(norm(P-Q)<R)
next
}
Flg<- 1
break
}
- if (Flg==0){
+ if(Flg==0){
T1<- 1
}else{
T1<- J; T2<- T
H<- T2-T1
for (N in 1:10){
H<- H*0.5
- Q<- Pointoncrv(T1+H,P1)
- if (Norm(P-Q)<R){ # norm(P-Q)<R
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){ # norm(P-Q)<R
T2<- T2-H
}else{
T1<- T1+H
@@ -8615,22 +8736,22 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
Ku<- c(T1)#Ku<- [T1]
Flg<- 0
for (J in Looprange(NN+1,Te)){
- Q<- Pointoncrv(J,P1)
- if (Norm(P-Q)<R){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){
next#continue
}
Flg<- 1
break
}
- if (Flg==0){
+ if(Flg==0){
T2<- Te
}else{
T1<- T; T2<- J
H<- T2-T1
for (N in 1:10){
H<- H*0.5
- Q<- Pointoncrv(T1+H,P1)
- if (Norm(P-Q)<R){
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){
T1<- T1+H
}else{
T2<- T2-H
@@ -8646,16 +8767,16 @@ Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
T1<- KukanL[I,1]; N1<- trunc(T1)
T2<- KukanL[I,2]; N2<- trunc(T2)
PtL<- list()#[]
- if (T1-N1<1-Eps){
- Tmp<- Pointoncrv(T1,P1)
+ if(T1-N1<1-Eps){
+ Tmp<- Pointoncurve(T1,P1)
PtL<- list(Tmp)#100816c(PtL,list(Tmp)) PtL<- MixS(Tmp)
}
for (J in Looprange(N1+1,N2)){
- Tmp<- Pointoncrv(J,P1)
+ Tmp<- Pointoncurve(J,P1)
PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp)
}
- if (T2-N2>Eps){
- Tmp<- Pointoncrv(T2,P1)
+ if(T2-N2>Eps){
+ Tmp<- Pointoncurve(T2,P1)
PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp)
}
Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL))
@@ -8674,7 +8795,7 @@ MakeveLfaceL<- function(VfL){
Eps<- 10^(-4)
Tmp<- VfL[[length(VfL)]]
Tmp1<- Tmp[[1]]
- if (mode(Tmp1)=="numeric"){
+ if(mode(Tmp1)=="numeric"){
FvL<- list(VfL)
}else{
FvL<- VfL
@@ -8683,7 +8804,7 @@ MakeveLfaceL<- function(VfL){
for (Nn in Looprange(1,length(FvL))){
Tmp<- FvL[[Nn]]
VL<- Tmp[[1]]
- if (length(VL)>0){
+ if(length(VL)>0){
FnL<- Tmp[[2]]
FaceL<- list()
for (I in Looprange(1,length(FnL))){
@@ -8710,7 +8831,7 @@ MakeveLfaceL<- function(VfL){
Tmp1<- Tmp[[1]]
Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]])
Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]])
- if (Tmp2<Eps || Tmp3<Eps){#(
+ if(Tmp2<Eps || Tmp3<Eps){#(
Tmp<- EL[[K]]
Tmp1<- Tmp[[1]]
Tmp2<- c(Tmp[[2]],length(FL))
@@ -8719,7 +8840,7 @@ MakeveLfaceL<- function(VfL){
break
}
}
- if (Flg==0){
+ if(Flg==0){
Ntmp<- length(EL)
EL[[Ntmp+1]]<- list(Edge,c(length(FL)),Ntmp+1)
}
@@ -8740,14 +8861,14 @@ Menkakusi2<- function(Face,Nf,Ptype){
Eps<- 10^(-4)
Tmp1<- Face[[1]]-Face[[2]]
Tmp2<- Face[[3]]-Face[[2]]
- if (Norm(Tmp1)<Eps || Norm(Tmp2)<Eps){
+ if(Norm(Tmp1)<Eps || Norm(Tmp2)<Eps){
return()
}
Vec<- 1/Norm(Tmp1)/Norm(Tmp2)*Crossprod(Tmp1,Tmp2)
- if (Norm(Vec)<Eps){
+ if(Norm(Vec)<Eps){
return()
}
- if (Ptype== -1){
+ if(Ptype== -1){
W<- EyePoint
Tmp<- Dotprod(Vec,W-Face[[1]])
}else{
@@ -8755,13 +8876,13 @@ Menkakusi2<- function(Face,Nf,Ptype){
W<- 100*W
Tmp<- Dotprod(Vec,W-Face[[1]])
}
- if (abs(Tmp)<Eps){
+ if(abs(Tmp)<Eps){
return()
}
- if (Tmp<-Eps){
+ if(Tmp<-Eps){
Vec<- -Vec
}
- if (Ptype==-1){
+ if(Ptype==-1){
G1<- Projpers(Spaceline(Face))
}else{
G1<- Projpara(Spaceline(Face))
@@ -8779,31 +8900,31 @@ Menkakusi2<- function(Face,Nf,Ptype){
Edge<- Tmp[[1]]
Ne<- Tmp[[2]]
NNe<- Tmp[[3]]
- if (Member(Nf,Ne)){
+ if(Member(Nf,Ne)){
Out1L<- c(Out1L, list(list(Edge,Ne,NNe)))
next
}
- if (Ptype==-1){
+ if(Ptype==-1){
PtA<- Perspt(Edge[[1]])
PtB<- Perspt(Edge[[2]])
}else{
PtA<- Parapt(Edge[[1]])
PtB<- Parapt(Edge[[2]])
}
- if (Norm(PtA-PtB)<Eps){
+ if(Norm(PtA-PtB)<Eps){
next
}
Bdy<- list(G1)
V<- PtB-PtA
TenL<- KoutenList(PtA,V,Bdy)
Nten<- length(TenL)
- if (Nten==0){ # debug 10.08.17
+ if(Nten==0){ # debug 10.08.17
Out1L<- c(Out1L,list(list(Edge,Ne,NNe)))
next
}
Te<- 0
Pe3<- Edge[[1]]
- if (Ptype==-1){
+ if(Ptype==-1){
Tmp1<- Perspt(Pe3)
Tmp<- Invperspt(Tmp1,Spaceline(Face))
}else{
@@ -8816,11 +8937,11 @@ Menkakusi2<- function(Face,Nf,Ptype){
TenP<- TenL[[I]]
Ts<- TenP[[1]]
P<- TenP[[2]]
- if (Ts< -Eps){
+ if(Ts< -Eps){
next
}
Eline<- Spaceline(Edge)
- if (Ptype==-1){
+ if(Ptype==-1){
Tmp<- Invperspt(P,Eline)
Tmp1<- Invperspt(P,Spaceline(Face))
}else{
@@ -8828,17 +8949,17 @@ Menkakusi2<- function(Face,Nf,Ptype){
Tmp1<- Invparapt(P,Spaceline(Face))
}
P3<- Tmp[[1]]; Q3<- Tmp1[[1]]
- if (Ts>1-Eps){# // P3, Q3 are necessary
+ if(Ts>1-Eps){# // P3, Q3 are necessary
Flg<- I
break
}
- if (abs(Te-Ts)>Eps0){
- if ((I%%2)==1){
+ if(abs(Te-Ts)>Eps0){
+ if((I%%2)==1){
Out1<- c(Out1,list(list(Pe3,P3)))
}else{
- if (length(Qe3)==0){
+ if(length(Qe3)==0){
Tmp<- Op(2,TenL[[I-1]])
- if (Ptype==-1){
+ if(Ptype==-1){
Tmp1<- Invperspt(Tmp,Spaceline(Face))
}else{
Tmp1<- Invparapt(Tmp,Spaceline(Face))
@@ -8846,12 +8967,12 @@ Menkakusi2<- function(Face,Nf,Ptype){
Qe3<- Tmp1[[1]]
}
PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3)
- if (Ptype==-1){
+ if(Ptype==-1){
Z1<- Zperspt(PM); Z2<- Zperspt(QM)
}else{
Z1<- Zparapt(PM); Z2<- Zparapt(QM)
}
- if (Z1>Z2){
+ if(Z1>Z2){
Out1<- c(Out1, list(list(Pe3,P3)))
}else{
Out2<- c(Out2, list(list(Pe3,P3)))
@@ -8860,21 +8981,21 @@ Menkakusi2<- function(Face,Nf,Ptype){
}
Te<- Ts; Pe3<- P3; Qe3<- Q3
}
- if (Flg==0){
- if (Norm(Pe3-Edge[[2]])>Eps0){
+ if(Flg==0){
+ if(Norm(Pe3-Edge[[2]])>Eps0){
Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
}
}else{
- if ((Flg%%2)==1){
+ if((Flg%%2)==1){
Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
}else{
PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3)
- if (Ptype==-1){
+ if(Ptype==-1){
Z1<- Zperspt(PM); Z2<- Zperspt(QM)
}else{
Z1<- Zparapt(PM); Z2<- Zparapt(QM)
}
- if (Z1>Z2){
+ if(Z1>Z2){
Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
}else{
Out2<- c(Out2, list(list(Pe3,Edge[[2]])))
@@ -8883,10 +9004,10 @@ Menkakusi2<- function(Face,Nf,Ptype){
}
for (I in Looprange(1,length(Out1))){
Tmp<- Out1[[I]]
- if (I==1){
+ if(I==1){
SeL<- Tmp
}else{
- if (Norm(SeL[[2]]-Tmp[[1]])<Eps0){
+ if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){
SeL[[2]]<- Tmp[[2]]
}else{
Out1L<- c(Out1L, list(list(SeL,Ne,NNe)))
@@ -8894,15 +9015,15 @@ Menkakusi2<- function(Face,Nf,Ptype){
}
}
}
- if (length(Out1)>0){
+ if(length(Out1)>0){
Out1L<- c(Out1L, list(list(SeL,Ne,NNe)))
}
for (I in Looprange(1,length(Out2))){
Tmp<- Out2[[I]]
- if (I==1){
+ if(I==1){
SeL<- Tmp
}else{
- if (Norm(SeL[[2]]-Tmp[[1]])<Eps0){
+ if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){
SeL[[2]]<- Tmp[[2]]
}else{
Out2L<- c(Out2L, list(list(SeL,Ne,NNe)))
@@ -8910,7 +9031,7 @@ Menkakusi2<- function(Face,Nf,Ptype){
}
}
}
- if (length(Out2)>0){
+ if(length(Out2)>0){
Out2L<- c(Out2L, list(list(SeL,Ne,NNe)))
}
}
@@ -8920,29 +9041,34 @@ Menkakusi2<- function(Face,Nf,Ptype){
###################################
-Parapt<- function(P){
- x<- P[1]
- y<- P[2]
- z<- P[3]
- Xz<- -x*sin(PHI)+y*cos(PHI)
- Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA)
- Out<- c(Xz,Yz)
+Parapt<- function(Plist){ # 18.02.19 changed (for point list)
+ if(!is.list(Plist)){Plist=list(Plist)}
+ Out=list()
+ for(jj in 1:length(Plist)){
+ P=Op(jj,Plist)
+ x<- P[1]
+ y<- P[2]
+ z<- P[3]
+ Xz<- -x*sin(PHI)+y*cos(PHI)
+ Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA)
+ Out<- c(Out,list(c(Xz,Yz)))
+ }
+ if(length(Out)==1){Out=Op(1,Out)}
return(Out)
}
###################################
-#100815
Partcrv3<- function(T1,T2,Fk){
- Eps=10^(-4)
+ Eps0=10^(-4)
#// Tmp=Mixop(1,Fk)
#// new part from
- if (T1>(T2+Eps)){
+ if(T1>(T2+Eps0)){
Npt<- Nrow(Fk)
Out1<- Partcrv3(T1,Npt,Fk)
Out2<- Partcrv3(1,T2,Fk)
Tmp<- Fk[1,]-Fk[Npt,]
- if (Norm(Tmp)<Eps){
+ if(Norm(Tmp)<Eps0){
PL<- Joincrvs(Out1,Out2)
}else{
PL<- list(Out1,Out2)
@@ -8950,57 +9076,25 @@ Partcrv3<- function(T1,T2,Fk){
rownames(PL)<- 1:Nrow(PL)
return(PL)
}
-# // to here
- Is<- ceiling(T1)
- Ie<- floor(T2)
- PL<- c()
- if (T1<Is-Eps){
- P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,]
- PL<- rbind(c(0), P)
- }
- PL<- rbind(PL,Fk[Is:Ie,])
- if (T2>(Ie+Eps)){
- P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,]
- PL<- rbind(PL,P)
- }
- rownames(PL)<- 1:Nrow(PL)
- return(PL)
-}
-
-###################################
-
-#100815
-Partcrv3<- function(T1,T2,Fk){
- Eps=10^(-4)
-#// Tmp=Mixop(1,Fk)
-#// new part from
- if (T1>(T2+Eps)){
- Npt<- Nrow(Fk)
- Out1<- Partcrv3(T1,Npt,Fk)
- Out2<- Partcrv3(1,T2,Fk)
- Tmp<- Fk[1,]-Fk[Npt,]
- if (Norm(Tmp)<Eps){
- PL<- Joincrvs(Out1,Out2)
- }else{
- PL<- list(Out1,Out2)
+ if(floor(T1)==floor(T2)){ #18.02.26from
+ Tmp=floor(T1)
+ p1=Op(Tmp,Fk); p2=Op(Tmp+1,Fk)
+ PL=c(p1+(T1-Tmp)*(p2-p1))
+ PL=Appendrow(PL, p1+(T2-Tmp)*(p2-p1)) #18.02.26upto
+ }else{
+ Is<- ceiling(T1)
+ Ie<- floor(T2)
+ PL<- c()
+ if(T1<Is-Eps0){
+ P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,]
+ PL<- Appendrow(PL, P) #18.02.10(bug)
+ }
+ PL<- Appendrow(PL,Fk[Is:Ie,])
+ if(T2>(Ie+Eps0)){
+ P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,]
+ PL<- Appendrow(PL,P)
}
- rownames(PL)<- 1:Nrow(PL)
- return(PL)
- }
-# // to here
- Is<- ceiling(T1)
- Ie<- floor(T2)
- PL<- c()
- if (T1<Is-Eps){
- P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,]
- PL<- rbind(c(0), P)
- }
- PL<- rbind(PL,Fk[Is:Ie,])
- if (T2>(Ie+Eps)){
- P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,]
- PL<- rbind(PL,P)
}
- rownames(PL)<- 1:Nrow(PL)
return(PL)
}
@@ -9037,7 +9131,7 @@ Phcutdata<- function(VL,FaceL,PlaneD){
Face<- Op(I,FaceL)
for (J in Looprange(1,length(Face))){
Nj<- J+1
- if (J==length(Face)){
+ if(J==length(Face)){
Nj<- 1
}
N1<- Face[J]; N2<- Face[Nj]
@@ -9046,12 +9140,12 @@ Phcutdata<- function(VL,FaceL,PlaneD){
for (K in Looprange(1,Mixlength(EL))){
Tmp1<- Op(K,EL)
Tmp2<- Tmp1[2:1]
- if (all(Tmp==Tmp1) || all(Tmp==Tmp2)){
+ if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){
Flg<- 1
break
}
}
- if (Flg==0){
+ if(Flg==0){
EL<- c(EL,list(Tmp))
}
}
@@ -9063,15 +9157,15 @@ Phcutdata<- function(VL,FaceL,PlaneD){
Tmp2<- Op(Tmp[2],VL)
Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2)))
}
- if (Mixtype(PlaneD)!=1){
+ if(Mixtype(PlaneD)!=1){
V1<- Op(1,PlaneD)
Tmp<- Op(2,PlaneD)
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3]
}else{
d<- Tmp
}
- }else if (mode(PlaneD)=="numeric"){
+ }else if(mode(PlaneD)=="numeric"){
V1<- PlaneD[1:3]
d<- PlaneD[4]
}else{
@@ -9092,7 +9186,7 @@ Phcutdata<- function(VL,FaceL,PlaneD){
Tmp3<- eval(parse(text=PlaneD))+d
V1<- c(Tmp1,Tmp2,Tmp3)
}
- if (all(V1==c(0,0,0))){
+ if(all(V1==c(0,0,0))){
return(Out0)
}
V3<- c(1,0,0)
@@ -9106,24 +9200,24 @@ Phcutdata<- function(VL,FaceL,PlaneD){
Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,]
P<- list(Tmp1,Tmp2-Tmp1)
Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1])
- if (abs(Tmp[[2]]) < Eps){
+ if(abs(Tmp[[2]]) < Eps){
Tmp<- c()
}else{
Tmp1<- Tmp[[2]]
Tmp2<- x0-Tmp[[1]]
Tmp<- c(Tmp2/Tmp1)
}
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Tmp<- Tmp[1]
- if (Tmp>-Eps && Tmp<(1+Eps)){
+ if(Tmp>-Eps && Tmp<(1+Eps)){
Tmp3<- P[[1]]+Tmp*P[[2]]
Tmp3<- Rotate3pt(Tmp3,V3,V1)
- if (Tmp<Eps){
+ if(Tmp<Eps){
Tmp1<- Op(I,EL)
Tmp1<- Tmp1[1]
Tmp4<- list(c(Tmp1,Tmp1),Tmp3)
}else{
- if (Tmp>1-Eps){
+ if(Tmp>1-Eps){
Tmp1<- Op(I,EL)
Tmp1<- Tmp1[2]
Tmp4<- list(c(Tmp1,Tmp1),Tmp3)
@@ -9135,18 +9229,18 @@ Phcutdata<- function(VL,FaceL,PlaneD){
for (J in Looprange(1,Mixlength(PtL))){
Tmp<- Op(J,PtL)
Tmp<- Op(2,Tmp)
- if (Norm(Tmp3-Tmp)<Eps){
+ if(Norm(Tmp3-Tmp)<Eps){
Flg<- 1
break
}
}
- if (Flg==0){
+ if(Flg==0){
PtL<- c(PtL,list(Tmp4))
}
}
}
}
- if (Mixlength(PtL)==0){
+ if(Mixlength(PtL)==0){
return(Out0)
}
PL<- list(Op(1,PtL))
@@ -9161,7 +9255,7 @@ Phcutdata<- function(VL,FaceL,PlaneD){
Flg<- 0
for (K in Looprange(1,Mixlength(FaceL))){
Tmp3<- Op(K,FaceL);
- if (Member(Tmp1[1],Tmp3) &&
+ if(Member(Tmp1[1],Tmp3) &&
Member(Tmp1[2],Tmp3) &&
Member(Tmp2[1],Tmp3) &&
Member(Tmp2[2],Tmp3)){
@@ -9169,7 +9263,7 @@ Phcutdata<- function(VL,FaceL,PlaneD){
break
}
}
- if (Flg==1){
+ if(Flg==1){
break
}
}
@@ -9178,7 +9272,7 @@ Phcutdata<- function(VL,FaceL,PlaneD){
Tmp1<- QL[Looprange(1,J-1)]
Tmp2<- QL[Looprange(J+1,Mixlength(QL))]
QL<- c(Tmp1,Tmp2)
- if (Mixlength(QL)==0){
+ if(Mixlength(QL)==0){
break
}
}
@@ -9207,14 +9301,14 @@ Phcutoffdata<- function(...){
PlaneD<- varargin[[3]]
Sgnstr<- varargin[[4]]
Fugou<- 1
- if (Sgnstr=="-" || Sgnstr=="n"){
+ if(Sgnstr=="-" || Sgnstr=="n"){
Fugou<- -1
}
Out0<- Phcutdata(VL,FaceL,PlaneD)
PtL<- PHCUTPOINTL
PHVERTEXL<<- VL
PHFACEL<<- FaceL
- if (length(PtL)==0){
+ if(length(PtL)==0){
Out2<- Out0
return(Out2)
}
@@ -9224,7 +9318,7 @@ Phcutoffdata<- function(...){
Tmp<- Op(I,PtL)
Tmp3<- Op(1,Tmp)
Tmp1<- Tmp3[[1]]; Tmp2<- Tmp3[[2]] # debugged 10.08.14
- if (Tmp1!=Tmp2){
+ if(Tmp1!=Tmp2){
VL<- c(VL,list(Op(2,Tmp)))
N1<- N1+1
Tmp1<- N1
@@ -9233,15 +9327,15 @@ Phcutoffdata<- function(...){
PtL[[I]]<- list(Op(1,Tmp),Tmp1)
}
OutfL<- list(Face)
- if (Mixtype(PlaneD)!=1){
+ if(Mixtype(PlaneD)!=1){
V1<- Op(1,PlaneD)
Tmp<- Op(2,PlaneD)
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3]
}else{
d<- Tmp
}
- }else if (mode(PlaneD)=="numeric"){
+ }else if(mode(PlaneD)=="numeric"){
V1<- PlaneD[1:3]
d<- PlaneD[4]
}else{
@@ -9267,7 +9361,7 @@ Phcutoffdata<- function(...){
TmpL<- list()
for (J in Looprange(1,length(Face))){
N1<- Face[J]
- if (J==length(Face)){
+ if(J==length(Face)){
N2<- Face[1]
}else{
N2<- Face[J+1]
@@ -9275,28 +9369,28 @@ Phcutoffdata<- function(...){
for (K in Looprange(1,Mixlength(PtL))){
Pd<- Op(K,PtL)
Tmp<- Op(1,Pd)
- if (Tmp[1]==Tmp[2]){
- if (Tmp[1]==N1){
+ if(Tmp[1]==Tmp[2]){
+ if(Tmp[1]==N1){
TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd))))
}
}else{
- if (all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){
+ if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){
TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd))))
}
}
}
}
- if (Mixlength(TmpL)<2){
+ if(Mixlength(TmpL)<2){
Flg<- 0
for (J in Looprange(1,length(Face))){
Tmp<- Op(Face[J],VL)
Tmp1<- Fugou*(Dotprod(V1,Tmp)-d)
- if (Tmp1< -Eps){
+ if(Tmp1< -Eps){
Flg<- 1
break
}
}
- if (Flg==0){
+ if(Flg==0){
OutfL<- c(OutfL,list(Face))
}
next
@@ -9309,23 +9403,23 @@ Phcutoffdata<- function(...){
JJ<- 0
while (!all(Tmp==Op(2,Qd))){
JJ<- JJ+1
- if (JJ>20){
+ if(JJ>20){
print("bug")
return()
}
Tmp1<- Tmp[2]
- if (Outf1[length(Outf1)]!=Tmp1){
+ if(Outf1[length(Outf1)]!=Tmp1){
Outf1<- c(Outf1,Tmp1)
}
Tmp<- c(Face[Nf])
Nf<- Nf+1
- if (Nf>length(Face)){
+ if(Nf>length(Face)){
Nf<- 1
}
Tmp<- c(Tmp,Face[Nf])
}
Tmp1<- Op(3,Qd)
- if (Outf1[length(Outf1)]!=Tmp1){
+ if(Outf1[length(Outf1)]!=Tmp1){
Outf1<- c(Outf1,Tmp1)
}
Outf2<- c(Op(3,Pd))
@@ -9334,47 +9428,47 @@ Phcutoffdata<- function(...){
JJ<- 0
while (!all(Tmp==Op(2,Qd))){
JJ<- JJ+1
- if (JJ>20){
+ if(JJ>20){
print("bug")
return()
}
Tmp1<- Tmp[1]
- if (Outf2[length(Outf2)]!=Tmp1){
+ if(Outf2[length(Outf2)]!=Tmp1){
Outf2<- c(Outf2,Tmp1)
}
Tmp<- c(Face[Nf])
Nf<- Nf-1
- if (Nf<1){
+ if(Nf<1){
Nf<- length(Face)
}
Tmp<- c(Face[Nf],Tmp)
}
Tmp1<- Op(3,Qd)
- if (Outf2[length(Outf2)]!=Tmp1){
+ if(Outf2[length(Outf2)]!=Tmp1){
Outf2<- c(Outf2,Tmp1)
}
- if (length(Outf1)<3 || length(Outf2)<3){
+ if(length(Outf1)<3 || length(Outf2)<3){
Face<- Outf1
- if (length(Outf1)<length(Outf2)){
+ if(length(Outf1)<length(Outf2)){
Face<- Outf2
}
Flg<- 0
for (J in Looprange(1,length(Face))){
Tmp<- Op(Face(J),VL)
Tmp1<- Fugou*(Dotprod(V1,Tmp)-d)
- if (Tmp1<-Eps){
+ if(Tmp1<-Eps){
Flg<- 1
break
}
}
- if (Flg==0){
+ if(Flg==0){
OutfL<- c(OutfL,list(Face))
}
}else{
Tmp<- Op(Outf1[2],VL)
Tmp1<- Outf1
Tmp2<- Fugou*(Dotprod(V1,Tmp)-d)
- if (Tmp2<0){
+ if(Tmp2<0){
Tmp1<- Outf2
}
OutfL<- c(OutfL,list(Tmp1))
@@ -9421,21 +9515,21 @@ Projpers<- function(...){
varargin<- list(...)
Nargs<- length(varargin)
Flg<- 0
- if (Nargs==1 && Mixtype(varargin[[1]])==1){
+ if(Nargs==1 && Mixtype(varargin[[1]])==1){
Flg<- 1
}
CL<- list()
for (N in Looprange(1,Nargs)){
Crv<- varargin[[N]]
- if (Mixtype(Crv)==1){
+ if(Mixtype(Crv)==1){
Tmp<- CameraCurve(Crv)
CL<- c(CL,list(Tmp))
}else{
- if (Mixtype(Crv)==3){
+ if(Mixtype(Crv)==3){
ObjL<- list()
for (I in Looprange(1,Mixlength(Crv))){
Tmp1<- Op(I,Crv)
- if (Mixtype(Tmp1)==1){
+ if(Mixtype(Tmp1)==1){
ObjL<- c(ObjL,list(Tmp1))
}else{
ObjL<- c(ObjL,Tmp1)
@@ -9449,7 +9543,7 @@ Projpers<- function(...){
}
}
}
- if (Mixlength(CL)==1 && Flg==1){
+ if(Mixlength(CL)==1 && Flg==1){
CL<- Op(1,CL)
}
return(CL)
@@ -9475,33 +9569,22 @@ ProjcoordCurve<- function(Curve){
#################################
-ProjCurve<- function(Curve){
- Eps<- 10^(-6)
- AnsL<- c()
- SP<- sin(PHI); CP<- cos(PHI)
- ST<- sin(THETA); CT<- cos(THETA)
- for (I in Looprange(1,Nrow(Curve)) ){
- P<- Curve[I,]
- x<- P[1]; y<- P[2]; z<- P[3]
- if (x!=Inf){
- Xz<- -x*SP+y*CP
- Yz<- -x*CP*CT-y*SP*CT+z*ST
- Tmp<- c(Xz,Yz)
- if (I==1){
- AnsL<- c(Tmp)
- }
- else{
- Tmp1<- AnsL[(length(AnsL)-1):length(AnsL)]
- if (Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){
- AnsL<- c(AnsL,Tmp)
- }
- }
- }
- else{
- AnsL<- c(AnsL,c(Inf,Inf))
+ProjCurve<- function(Curve){ # 2018.02.26 rewritten
+ AnsL= c()
+ SP=sin(PHI); CP=cos(PHI)
+ ST=sin(THETA); CT=cos(THETA)
+ for(I in Looprange(1,Length(Curve)) ){
+ P=Op(I,Curve)
+ x=P[1]; y=P[2]; z=P[3]
+ if(x!=Inf){
+ Xz=-x*SP+y*CP
+ Yz= -x*CP*CT-y*SP*CT+z*ST
+ AnsL=Appendrow(AnsL,c(Xz,Yz))
+ Tmp= c(Xz,Yz)
+ }else{
+ AnsL=Appendrow(AnsL,c(Inf,Inf))
}
}
- AnsL<- matrix(AnsL,ncol=2,byrow=TRUE)
return(AnsL)
}
@@ -9511,22 +9594,22 @@ Projpara<- function(...){
varargin<-list(...)
Nargs<- length(varargin)
Flg<- 0
- if (Nargs==1 && Mixtype(varargin[[1]])==1){
+ if((Nargs==1)&&(is.numeric(varargin[[1]]))){
Flg<- 1
}
CL<- list()
for (N in Looprange(1,Nargs)){
Crv<- varargin[[N]]
- if (Mixtype(Crv)==1){
+ if(is.numeric(Crv)){
Tmp<- ProjCurve(Crv)
CL<- c(CL,list(Tmp))
}
else{
- if (Mixtype(Crv)==3){
+ if(is.list(Crv)){
ObjL<- list()
for (I in Looprange(1,Mixlength(Crv))){
Tmp1<- Op(I,Crv)
- if (Mixtype(Tmp1)==1){
+ if(is.numeric(Tmp1)){
ObjL<- c(ObjL,list(Tmp1))
}
else{
@@ -9535,13 +9618,13 @@ Projpara<- function(...){
}
Crv<- ObjL
}
- for (J in Looprange(1,Mixlength(Crv))){
+ for (J in Looprange(1,length(Crv))){
Tmp<- ProjCurve(Op(J,Crv))
CL<- c(CL,list(Tmp))
}
}
}
- if (Mixlength(CL)==1 && Flg==1){
+ if((length(CL)==1)&&(Flg==1)){
CL<- Op(1,CL)
}
return(CL)
@@ -9554,21 +9637,21 @@ Projpers<- function(...){
varargin<- list(...)
Nargs<- length(varargin)
Flg<- 0
- if (Nargs==1 && Mixtype(varargin[[1]])==1){
+ if(Nargs==1 && Mixtype(varargin[[1]])==1){
Flg<- 1
}
CL<- list()
for (N in Looprange(1,Nargs)){
Crv<- varargin[[N]]
- if (Mixtype(Crv)==1){
+ if(Mixtype(Crv)==1){
Tmp<- CameraCurve(Crv)
CL<- c(CL,list(Tmp))
}else{
- if (Mixtype(Crv)==3){
+ if(Mixtype(Crv)==3){
ObjL<- list()
for (I in Looprange(1,Mixlength(Crv))){
Tmp1<- Op(I,Crv)
- if (Mixtype(Tmp1)==1){
+ if(Mixtype(Tmp1)==1){
ObjL<- c(ObjL,list(Tmp1))
}else{
ObjL<- c(ObjL,Tmp1)
@@ -9582,7 +9665,7 @@ Projpers<- function(...){
}
}
}
- if (Mixlength(CL)==1 && Flg==1){
+ if(Mixlength(CL)==1 && Flg==1){
CL<- Op(1,CL)
}
return(CL)
@@ -9600,12 +9683,12 @@ Rotate3data<- function(...){
W1<- varargin[[2]]
W2<- varargin[[3]]
C<- c(0,0,0)
- if (Nargs>=4){
+ if(Nargs>=4){
C<- varargin[[4]]
}
- if (Mixtype(Pd3)==1){
+ if(Mixtype(Pd3)==1){
Pd3<- list(Pd3)
- } else if (Mixtype(Pd3)==3){
+ } else if(Mixtype(Pd3)==3){
Tmp<- list()
for (I in Looprange(1,Mixlength(Pd3))){
Tmp<- c(Tmp,Op(I,Pd3))
@@ -9629,7 +9712,7 @@ Rotate3data<- function(...){
rownames(Ans)<- 1:Nrow(Ans) #10.08.16
Out<- c(Out,list(Ans))
}
- if (Mixlength(Out)==1){
+ if(Mixlength(Out)==1){
Out<- Op(1,Out)
}
return(Out)
@@ -9645,14 +9728,14 @@ Rotate3pt<- function(...){
W1<- varargin[[2]]
W2<- varargin[[3]]
C<- c(0,0,0)
- if (Nargs>=4){
+ if(Nargs>=4){
C<- varargin[[4]]
}
- if (mode(W2)=="numeric" && length(W2)==1){
+ if(mode(W2)=="numeric" && length(W2)==1){
Ct<- cos(W2)
St<- sin(W2)
V3<- 1/Norm(W1)*W1
- if (V3[1]==0){
+ if(V3[1]==0){
Tmp<- c(1,0,0)
}else{
Tmp<- c(0,1,0)
@@ -9668,7 +9751,7 @@ Rotate3pt<- function(...){
Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2],
W1[3]*W2[1]-W1[1]*W2[3],
W1[1]*W2[2]-W1[2]*W2[1])
- if (Norm(Tmp)<Eps){
+ if(Norm(Tmp)<Eps){
Ans<- P
return(Ans)
}
@@ -9683,14 +9766,14 @@ Rotate3pt<- function(...){
Ct<- Ns/Norm(W2)
St<- sqrt(1-Ct^2)
}
- if (Norm(Tmp)<Eps){
+ if(Norm(Tmp)<Eps){
Ans<- P
return(Ans)
}
V1x<- V1[1]; V1y<- V1[2]; V1z<- V1[3]
V2x<- V2[1]; V2y<- V2[2]; V2z<- V2[3]
V3x<- V3[1]; V3y<- V3[2]; V3z<- V3[3]
- if (Mixtype(P)!=1){
+ if(Mixtype(P)!=1){
PtL<- P
}else{
PtL<- list(P)
@@ -9698,7 +9781,7 @@ Rotate3pt<- function(...){
Ans<- list()
for (N in Looprange(1,Mixlength(PtL))){
P<- Op(N,PtL)
- if (P[1]==Inf){
+ if(P[1]==Inf){
Ans<- c(Ans,list(c(Inf,Inf,Inf)))
next
}
@@ -9717,7 +9800,7 @@ Rotate3pt<- function(...){
Z<- Tmp1+Tmp2+Tmp3
Ans<- c(Ans,list(C+c(X,Y,Z)))
}
- if (Mixlength(Ans)==1){
+ if(Mixlength(Ans)==1){
Ans<- Op(1,Ans)
}
return(Ans)
@@ -9729,7 +9812,7 @@ Setangle<- function(...){
Eps<- 10^(-6)
varargin<-list(...)
Nargs<-length(varargin)
- if (Nargs==0) {
+ if(Nargs==0) {
}
else if(Nargs==1){
V<- varargin[[1]]
@@ -9757,7 +9840,7 @@ Setangle<- function(...){
Setpers<- function(...){
varargin<- list(...)
Nargs<- length(varargin)
- if (Nargs==0){
+ if(Nargs==0){
}
else{
FocusPoint<<- varargin[[1]]
@@ -9815,13 +9898,13 @@ Sf3data<- function(...){
Tmp<- eval(parse(text=Tmp))
Vmin<- Tmp[1]; Vmax<- Tmp[2]
Ndu<- 25 ; Ndv<- 25; Np<- c(50,50)
- if (Nargs>=3){
+ if(Nargs>=3){
Ndu<- varargin[[2]]
Ndv<- varargin[[3]]
}
- if (Nargs>=4){
+ if(Nargs>=4){
Np<- varargin[[4]]
- if (mode(Np)=="numeric" && length(Np)==1){
+ if(mode(Np)=="numeric" && length(Np)==1){
Np<- c(Np,Np)
}
}
@@ -9869,11 +9952,11 @@ Skeletonparadata<- function(...){
ObjL<- Flattenlist(varargin[[1]])
Plt3L<- Flattenlist(varargin[[2]])
R<- 0.075*1000/2.54/MilliIn
- if (Nargs>2){
+ if(Nargs>2){
R<- R*varargin[[3]]
}
Eps2<- 0.05
- if (Nargs>3){
+ if(Nargs>3){
Eps2<- varargin[[4]]
}
Obj2L<- list()
@@ -9898,11 +9981,11 @@ Skeletonpara3data<- function(...){
ObjL<- Flattenlist(varargin[[1]])
Plt3L<- Flattenlist(varargin[[2]])
R<- 0.075*1000/2.54/MilliIn
- if (Nargs>2){
+ if(Nargs>2){
R=R*varargin[[3]]
}
Eps2<- 0.05
- if (Nargs>3){
+ if(Nargs>3){
Eps2<- varargin[[4]]
}
Plt2L<- list()
@@ -9941,11 +10024,11 @@ Skeletonpersdata<- function(...){
ObjL<- Flattenlist(varargin[[1]])
Plt3L<- Flattenlist(varargin[[2]])
R<- 0.075*1000/2.54/MilliIn
- if (Nargs>2){
+ if(Nargs>2){
R<- R*varargin[[3]]
}
Eps2<- 0.05
- if (Nargs>3){
+ if(Nargs>3){
Eps2<- varargin[[4]]
}
Obj2L<- list()
@@ -9971,11 +10054,11 @@ Skeletonpers3data<- function(...){
ObjL<- Flattenlist(varargin[[1]])
Plt3L<- Flattenlist(varargin[[2]])
R<- 0.075*1000/2.54/MilliIn
- if (Nargs>2){
+ if(Nargs>2){
R<- R*varargin[[3]]
}
Eps2<- 0.05
- if (Nargs>3){
+ if(Nargs>3){
Eps2<- varargin[[4]]
}
Plt2L<- list()
@@ -10026,7 +10109,7 @@ Spacecurve<- function(...){
}
StrV<- strsplit(Rgstr,"=",fixed=TRUE)
StrV<- StrV[[1]]
- if (length(StrV)>1){
+ if(length(StrV)>1){
Vname<- StrV[1]
Rng<- eval(parse(text=StrV[2]))
}
@@ -10049,30 +10132,30 @@ Spacecurve<- function(...){
E<- c(E,Inf)
E<- sort(E,decreasing=FALSE)
Ke<- 1
- t<- T1
- while(t<T2+Eps){
+ for(jj in 1:(N+1)){
+ t=T1+(jj-1)*Dt
Pa<- c()
- if (t-E[Ke]< Eps){
+ if(t-E[Ke]< Eps){
Pa<- eval(parse(text=Str))
}
- if (abs(t-E[Ke])<=Eps){
- if (length(P)>0 && P[Nrow(P),1]!=Inf){
+ if(abs(t-E[Ke])<=Eps){
+ if(length(P)>0 && P[Nrow(P),1]!=Inf){
Pa<- c(Inf,Inf,Inf)
}
}
- if (t-E[Ke]>Eps){
+ if(t-E[Ke]>Eps){
Pa<- eval(parse(text=Str))
Ke<- Ke+1
}
- if (length(Pa)>0){
- if (Pa[1]==Inf){
+ if(length(Pa)>0){
+ if(Pa[1]==Inf){
P<- rbind(P,Pa)
- }else if (length(P)==0){
+ }else if(length(P)==0){
P<- rbind(c(),c(Pa))
}
else{
Tmp<- P[Nrow(P),]
- if (Tmp[1]==Inf){
+ if(Tmp[1]==Inf){
P<- rbind(P,Pa)
}
else if( Norm(Tmp-Pa)<D){
@@ -10084,7 +10167,6 @@ Spacecurve<- function(...){
}
}
}
- t<- t+Dt
}
rownames(P)<- 1:Nrow(P) # 10.08.16
return(P)
@@ -10097,7 +10179,7 @@ Spaceline<- function(...){
Z<- c()
for(I in 1:length(varargin)){
Data<- varargin[[I]]
- if (Mixtype(Data)==1){
+ if(Mixtype(Data)==1){
J<- 1
while (J<=Ncol(Data)){
Tmp<- Data[J:(J+2)]
@@ -10194,11 +10276,11 @@ Xyzaxparaname<- function(...){
Eps<- 10.0^(-6)
Dr<- 0.19*1000/2.54/MilliIn
Tmp<- varargin[[Nargs]]
- if (Nargs>1 && is.numeric(Tmp)){
+ if(Nargs>1 && is.numeric(Tmp)){
Dr<- Dr*Tmp
Nargs<- Nargs-1
}
- if (mode(varargin[[1]])=="character"){
+ if(mode(varargin[[1]])=="character"){
Xname<- "x"
Yname<- "y"
Zname<- "z"
@@ -10235,14 +10317,14 @@ Xyzaxparaname<- function(...){
}else{
Data<- varargin[[1]]
Xname<- "x"; Yname<- "y"; Zname<- "z"
- if (Nargs>1){
- if (varargin[[2]]!=""){
+ if(Nargs>1){
+ if(varargin[[2]]!=""){
Xname<- varargin[[2]]
}
- if (varargin[[3]]!=""){
+ if(varargin[[3]]!=""){
Yname<- varargin[[3]]
}
- if (varargin[[4]]!=""){
+ if(varargin[[4]]!=""){
Zname<- varargin[[4]]
}
}
@@ -10257,19 +10339,19 @@ Xyzaxparaname<- function(...){
}
Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh)
Kekka<- list()
- if (R>Eps){
+ if(R>Eps){
Ch<- Qh+Dr/R*(Qh-Ph)
Kekka<- c(Kekka,list(Pointdata(Ch)))
Expr(Ch,"c",Xname)
}
Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh)
- if (R>Eps){
+ if(R>Eps){
Ch<- Qh+Dr/R*(Qh-Ph)
Kekka<- c(Kekka,list(Pointdata(Ch)))
Expr(Ch,"c",Yname)
}
Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh)
- if (R>Eps){
+ if(R>Eps){
Ch<- Qh+Dr/R*(Qh-Ph)
Kekka<- c(Kekka,list(Pointdata(Ch)))
Expr(Ch,"c",Zname)
@@ -10285,11 +10367,11 @@ Xyzaxpersname<- function(...){
Nargs<- length(varargin)
Dr<- 0.19*1000/2.54/MilliIn
Tmp<- varargin[[Nargs]]
- if (Nargs>1 && mode(Tmp)=="numeric"){
+ if(Nargs>1 && mode(Tmp)=="numeric"){
Dr<- Dr*Tmp
Nargs<- Nargs-1
}
- if (mode(varargin[[1]])=="character"){
+ if(mode(varargin[[1]])=="character"){
Xname<- "x"
Yname<- "y"
Zname<- "z"
@@ -10326,14 +10408,14 @@ Xyzaxpersname<- function(...){
}else{
Data<- varargin[[1]]
Xname<- "x"; Yname<- "y"; Zname<- "z"
- if (Nargs>1){
- if (varargin[[2]]!=""){
+ if(Nargs>1){
+ if(varargin[[2]]!=""){
Xname<- varargin[[2]]
}
- if (varargin[[3]]!=""){
+ if(varargin[[3]]!=""){
Yname<- varargin[[3]]
}
- if (varargin[[4]]!=""){
+ if(varargin[[4]]!=""){
Zname<- varargin[[4]]
}
}
@@ -10350,7 +10432,7 @@ Xyzaxpersname<- function(...){
Qh<- Perspt(Qx)
R<- Norm(Ph-Qh)
Kekka<- list()
- if (R>Eps){
+ if(R>Eps){
Ch<- Qh+Dr/R*(Qh-Ph)
Kekka<- c(Kekka,list(Pointdata(Ch)))
Expr(Ch,"c",Xname)
@@ -10358,7 +10440,7 @@ Xyzaxpersname<- function(...){
Ph<- Perspt(Py)
Qh<- Perspt(Qy)
R<- Norm(Ph-Qh)
- if (R>Eps){
+ if(R>Eps){
Ch<- Qh+Dr/R*(Qh-Ph)
Kekka<- c(Kekka,list(Pointdata(Ch)))
Expr(Ch,"c",Yname)
@@ -10366,7 +10448,7 @@ Xyzaxpersname<- function(...){
Ph<- Perspt(Pz)
Qh<- Perspt(Qz)
R<- Norm(Ph-Qh)
- if (R>Eps){
+ if(R>Eps){
Ch<- Qh+Dr/R*(Qh-Ph)
Kekka<- c(Kekka,list(Pointdata(Ch)))
Expr(Ch,"c",Zname)
@@ -10423,11 +10505,11 @@ Htickmarklower<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
ArgsL<- varargin
- if (mode(ArgsL[[1]])=="character"){
+ if(mode(ArgsL[[1]])=="character"){
Str<- ArgsL[[1]]
Tmp<- strsplit(Str,"m")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
I<- nchar(Tmp[1])+1
}
else{
@@ -10435,7 +10517,7 @@ Htickmarklower<- function(...)
}
Tmp<- strsplit(Str,"n")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
J<- nchar(Tmp[1])+1
}
else{
@@ -10443,16 +10525,16 @@ Htickmarklower<- function(...)
}
Tmp<- strsplit(Str,"r")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
K=nchar(Tmp[1])+1
}
else{
K<- 0
}
- if (K>0){
+ if(K>0){
S<- substr(Str,K+1,nchar(Str))
R<- as.numeric(S)
- if (is.na(R)){
+ if(is.na(R)){
R<- 1
}
}
@@ -10460,10 +10542,10 @@ Htickmarklower<- function(...)
R<- 1
K<- nchar(Str)+1
}
- if (J>0){
+ if(J>0){
S<- substr(Str,J+1,K-1)
Dn<- as.numeric(S)
- if (is.na(Dn)){
+ if(is.na(Dn)){
Dn<- 1
}
}
@@ -10473,20 +10555,20 @@ Htickmarklower<- function(...)
}
S<- substr(Str,I+1,J-1)
Dm<- as.numeric(S)
- if (is.na(Dm)){
+ if(is.na(Dm)){
Dm<- 1
}
ArgsL<- list()
for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
}
for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
@@ -10496,18 +10578,18 @@ Htickmarklower<- function(...)
Memori<- list()
for (N in 1:length(ArgsL)){
Dt<- ArgsL[[N]]
- if (mode(Dt)=="numeric" && length(Dt)>1){
- if (length(Memori)>0){
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(Dt)
next
}
- if (mode(Dt)=="character"){
+ if(mode(Dt)=="character"){
Memori<- Mixjoin(Memori,Dt)
}
else{
- if (length(Memori)>0){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(Dt,GENTEN[2])
@@ -10527,14 +10609,14 @@ Htickmarklower<- function(...)
Tmp2<- Unscaling(c(X,Y-2*MARKLEN))
Fd<- Listplot(c(Tmp1,Tmp2))
Drwline(Fd)
- if (Ndt==3){
+ if(Ndt==3){
Tmp<-Unscaling(c(X,Y-2*MARKLEN))
Expr(Tmp,"s",Moji)
}
- if (Ndt==4){
+ if(Ndt==4){
Houkou<- Op(3,Dt)
Tmp<-grep("s",Houkou)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Tmp<-Unscaling(c(X,Y-2*MARKLEN))
Expr(Tmp,Houkou,Moji)
}
@@ -10552,11 +10634,11 @@ Vtickmarkleft<- function(...)
varargin<- list(...)
Nargs<- length(varargin)
ArgsL<- varargin
- if (mode(ArgsL[[1]])=="character"){
+ if(mode(ArgsL[[1]])=="character"){
Str<- ArgsL[[1]]
Tmp<- strsplit(Str,"m")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
I<- nchar(Tmp[1])+1
}
else{
@@ -10564,7 +10646,7 @@ Vtickmarkleft<- function(...)
}
Tmp<- strsplit(Str,"n")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
J<- nchar(Tmp[1])+1
}
else{
@@ -10572,16 +10654,16 @@ Vtickmarkleft<- function(...)
}
Tmp<- strsplit(Str,"r")
Tmp<- Tmp[[1]]
- if (length(Tmp)>1){
+ if(length(Tmp)>1){
K=nchar(Tmp[1])+1
}
else{
K<- 0
}
- if (K>0){
+ if(K>0){
S<- substr(Str,K+1,nchar(Str))
R<- as.numeric(S)
- if (is.na(R)){
+ if(is.na(R)){
R<- 1
}
}
@@ -10589,10 +10671,10 @@ Vtickmarkleft<- function(...)
R<- 1
K<- nchar(Str)+1
}
- if (J>0){
+ if(J>0){
S<- substr(Str,J+1,K-1)
Dn<- as.numeric(S)
- if (is.na(Dn)){
+ if(is.na(Dn)){
Dn<- 1
}
}
@@ -10602,20 +10684,20 @@ Vtickmarkleft<- function(...)
}
S<- substr(Str,I+1,J-1)
Dm<- as.numeric(S)
- if (is.na(Dm)){
+ if(is.na(Dm)){
Dm<- 1
}
ArgsL<- list()
for (I in 1:floor((YMAX-GENTEN[2])/Dm)){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
}
for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){
ArgsL<- Mixjoin(ArgsL,I*Dm)
- if (I-floor(I/Dn)*Dn==0){
+ if(I-floor(I/Dn)*Dn==0){
Str<- as.character(I*Dm*R)
ArgsL<- Mixjoin(ArgsL,Str)
}
@@ -10625,18 +10707,18 @@ Vtickmarkleft<- function(...)
Memori<- list()
for (N in 1:length(ArgsL)){
Dt<- ArgsL[[N]]
- if (mode(Dt)=="numeric" && length(Dt)>1){
- if (length(Memori)>0){
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(Dt)
next
}
- if (mode(Dt)=="character"){
+ if(mode(Dt)=="character"){
Memori<- Mixjoin(Memori,Dt)
}
else{
- if (length(Memori)>0){
+ if(length(Memori)>0){
MemoriList<- Mixjoin(MemoriList,list(Memori))
}
Memori<- list(GENTEN[1],Dt)
@@ -10656,14 +10738,14 @@ Vtickmarkleft<- function(...)
Tmp2<- Unscaling(c(X-2*MARKLEN,Y))
Fd<- Listplot(c(Tmp1,Tmp2))
Drwline(Fd)
- if (Ndt==3){
+ if(Ndt==3){
Tmp<-Unscaling(c(X-2*MARKLEN,Y))
Expr(Tmp,"w",Moji)
}
- if (Ndt==4){
+ if(Ndt==4){
Houkou<- Op(3,Dt)
Tmp<-grep("w",Houkou)
- if (length(Tmp)>0){
+ if(length(Tmp)>0){
Tmp<-Unscaling(c(X-2*MARKLEN,Y))
Expr(Tmp,Houkou,Moji)
}
@@ -10704,7 +10786,7 @@ VtickLV<- function(...)
Insertcom<- function(CmdM,Npos,Str)
{
- if (is.matrix(CmdM)){
+ if(is.matrix(CmdM)){
Cmd<- CmdM
}
else{
@@ -10716,7 +10798,7 @@ Insertcom<- function(CmdM,Npos,Str)
Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),]
Out<- c(Out,Tmp)
Out<- matrix(Out)
- if (!is.matrix(CmdM)){
+ if(!is.matrix(CmdM)){
C<- paste(CmdM,"<<- Out")
eval(parse(text=C))
}
@@ -10725,7 +10807,7 @@ Insertcom<- function(CmdM,Npos,Str)
Replacecom<- function(CmdM,Npos,Str)
{
- if (is.matrix(CmdM)){
+ if(is.matrix(CmdM)){
Cmd<- CmdM
}
else{
@@ -10737,7 +10819,7 @@ Replacecom<- function(CmdM,Npos,Str)
Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),]
Out<- c(Out,Tmp)
Out<- matrix(Out)
- if (!is.matrix(CmdM)){
+ if(!is.matrix(CmdM)){
C<- paste(CmdM,"<<- Out")
eval(parse(text=C))
}
@@ -10746,7 +10828,7 @@ Replacecom<- function(CmdM,Npos,Str)
Deletecom<- function(CmdM,Npos)
{
- if (is.matrix(CmdM)){
+ if(is.matrix(CmdM)){
Cmd<- CmdM
}
else{
@@ -10757,7 +10839,7 @@ Deletecom<- function(CmdM,Npos)
Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),]
Out<- c(Out,Tmp)
Out<- matrix(Out)
- if (!is.matrix(CmdM)){
+ if(!is.matrix(CmdM)){
C<- paste(CmdM,"<<- Out")
eval(parse(text=C))
}
@@ -10773,7 +10855,7 @@ Maketexfile<- function(commands="",texfile="")
Formatting<- function(X,D=2,N=2)
{
- if (D>0){
+ if(D>0){
Xs <- format(X,digits=D,nsmall=N)
}
else{
@@ -10983,7 +11065,7 @@ Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...)
Counts <- Temp$counts
Density <- Temp$density
Mids <- Temp$mids
- if (!freq){
+ if(!freq){
Data<- Density
}
else{
@@ -11107,7 +11189,7 @@ Drwhistplot<- function(datav,var,size,freq=TRUE,
Infostr<- paste(var,"$info",sep="")
Brkstr<- paste(Infostr,"$breaks",sep="")
Midstr<- paste(Infostr,"$mids",sep="")
- if (!freq){
+ if(!freq){
Digits<- ",2,2"
Denstr<- paste(Infostr,"$density",sep="")
}
@@ -11116,7 +11198,7 @@ Drwhistplot<- function(datav,var,size,freq=TRUE,
Denstr<- paste(Infostr,"$counts",sep="")
}
- if (fpplot) Prefp<- "" else Prefp<- "#"
+ if(fpplot) Prefp<- "" else Prefp<- "#"
Exstr<- c(
"","",
paste("Beginpicture(","'",unit,"')",sep=""),
@@ -11223,7 +11305,7 @@ Connectseg<- function(...){
varargin=list(...)
Nargs=length(varargin)
Pdata=varargin[[1]]
- Eps=10^(-5)
+ Eps=10^(-4)
if(Nargs>=2){
Eps=varargin[[2]]
}
@@ -11236,18 +11318,20 @@ Connectseg<- function(...){
}
Pdata=tmp1
}
- PlotL=Pdata[1]
- VI=2:length(Pdata)
+ PlotL=list(Op(1,Pdata))
+ VI=Looprange(2,length(Pdata))
while(length(VI)>0){
- Qd=PlotL[[length(PlotL)]]
- Ah=Qd[1,]; Ao=Qd[nrow(Qd),]
+ Qd=Op(Length(PlotL),PlotL)
+ Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd)
Flg=0
for(J in 1:length(VI)){
- Tmp1=Pdata[[VI[J]]]
- P=Tmp1[1,]; Q=Tmp1[nrow(Tmp1),]
+ Tmp1=Op(VI[J],Pdata)
+ P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1)
if(Norm(P-Ao)<Eps){
- Tmp=Tmp1[2:nrow(Tmp1),]
- Qd=Appendrow(Qd,Tmp)
+ Tmp=Tmp1[Looprange(2,Length(Tmp1)),]
+ if(Length(Tmp)>0){
+ Qd=Appendrow(Qd,Tmp)
+ }
PlotL[[length(PlotL)]]=Qd
VI=VI[-J]
Flg=1
@@ -11303,16 +11387,16 @@ Makevaltable<- function(MS){
Tmp=gsub(Xname,"x",Fstr)
Fstr=gsub(Yname,"y",Tmp)
Tmp=grep(Xname,Fstr)
- if(Tmp==0){
+ if(length(Tmp)==0){
Fstr=paste(Fstr,'+0*x',sep="")
}
Mdv=50
Ndv=50
if(Nargs>=4){
Tmp=Op(4,MS)
- if(nrow(Tmp)>1){
- Mdv=Tmp[1,1]
- Ndv=Tmp[1,2]
+ if(Length(Tmp)>1){ #18.02.09
+ Mdv=Op(1,Tmp)
+ Ndv=Op(2,Tmp)
}else{
Mdv=Tmp
if(Nargs==4){
@@ -11333,17 +11417,17 @@ Makevaltable<- function(MS){
Dy=(Y2-Y1)/Ndv
Xval=c()
Tmp=X1
- while(Tmp<X2+Eps){
+ for(ii in 1:(Mdv+1)){
+ Tmp=X1+(ii-1)*Dx
Xval=c(Xval,Tmp)
- Tmp=Tmp+Dx
- }
+ }
Yval=c()
Tmp=Y1
- while(Tmp<Y2+Eps){
+ for(jj in 1:(Ndv+1)){
+ Tmp=Y1+(jj-1)*Dy
Yval=c(Yval,Tmp)
- Tmp=Tmp+Dy
}
- Zval=matrix(nrow=Mdv+1,ncol=Ndv+1)
+ Zval=matrix(nrow=Ndv+1,ncol=Mdv+1)
I=1
for(y in Yval){
J=1
@@ -11358,7 +11442,7 @@ Makevaltable<- function(MS){
Implicitplot<- function(...){
varargin=list(...)
- Eps=10^(-4)
+ Eps0=10^(-4)
Nargs=length(varargin)
Fstr=varargin[[1]]
if(is.list(Fstr)){
@@ -11366,11 +11450,12 @@ Implicitplot<- function(...){
Tmp=Makevaltable(MS)
Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]]
}else if(is.character(Fstr)){
- MS=list()
- for(I in 1:Nargs){
- MS=c(MS,varargin[I])
- }
- Tmp=Makevaltable(MS)
+# MS=list()
+# for(I in 1:Nargs){
+# MS=c(MS,varargin[I])
+# }
+# Tmp=Makevaltable(MS)
+ Tmp=Makevaltable(varargin) #18.02.24
Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]]
}else{
Zval=varargin[[1]]
@@ -11388,28 +11473,28 @@ Implicitplot<- function(...){
VL=c(c1,c2,c3,c4,c1)
QL=c()
for(K in 1:4){
- if(abs(VL[K])<=Eps){
+ if(abs(VL[K])<=Eps0){
QL=Appendrow(QL,PL[K,])
- }else if(VL[K]>Eps){
- if(VL[K+1]< -Eps){
+ }else if(VL[K]>Eps0){
+ if(VL[K+1]< -Eps0){
Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,])
QL=Appendrow(QL,Tmp)
}
}else{
- if(VL[K+1]>Eps){
+ if(VL[K+1]>Eps0){
Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,])
QL=Appendrow(QL,Tmp)
}
}
}
- if(length(QL)==4){
+ if(Length(QL)==2){
Out=Appendrow(Out,c(Inf,Inf))
Out=Appendrow(Out,QL)
}
}
}
Out=Out[2:nrow(Out),]
- if(length(Out)>0){
+ if(Length(Out)>0){
Out=Connectseg(Out)
}else{
Out=c()
@@ -12130,14 +12215,14 @@ Symb3data<- function(Moji,Size,Kaiten,NV,Pos){
############## New Intersect 18.02.01 #############
Intersectline<- function(p1,v1,p2,v2){
- Eps=10^(-5)
+ Eps0=10^(-5)
tmp=Dotprod(v1,v2)
tmp1=c(tmp,Norm(v1)^2)
tmp2=c(-Norm(v2)^2,-tmp)
tmp3=c(Dotprod(p2-p1,v2),Dotprod(p2-p1,v1))
d=Crossprod(tmp1,tmp2)
tmp=abs(Crossprod(v1,v2))
- if(tmp>Eps){
+ if(tmp>Eps0){
dt=Crossprod(tmp3,tmp2)
ds=Crossprod(tmp1,tmp3)
t=dt/d
@@ -12154,20 +12239,20 @@ Intersectline<- function(p1,v1,p2,v2){
Intersectseg<- function(...){
varargin=list(...)
Nargs=length(varargin)
- Eps=10^(-4)
+ Eps0=10^(-4)
Eps1=0.01
seg1=varargin[[1]]
seg2=varargin[[2]]
if(Nargs>2){Eps1=varargin[[3]]}
p1=Op(1,seg1); q1=Op(2,seg1)
p2=Op(1,seg2); q2=Op(2,seg2)
- if((Norm(q1-p1)<Eps)||(Norm(q2-p2)<Eps)){
+ if((Norm(q1-p1)<Eps0)||(Norm(q2-p2)<Eps0)){
out=list(-1)
}else{
tmp=Intersectline(p1,q1-p1,p2,q2-p2)
if(length(Op(1,tmp))>1){
pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp)
- if((t*(t-1)<Eps)&&(s*(s-1)<Eps)){
+ if((t*(t-1)<Eps0)&&(s*(s-1)<Eps0)){
out=list(0,pt,t,s)
}else{
t=min(max(t,0),1)
@@ -12176,25 +12261,25 @@ Intersectseg<- function(...){
tmp1=c(Op(2,q2-p2),-Op(1,q2-p2))
tmp=Intersectline(p1,tmp1,p2,q2-p2)
if(length(Op(1,tmp))>1){
- if(Op(3,tmp)*(Op(3,tmp)-1)<Eps){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
tmp3=c(tmp3,Norm(Op(1,tmp)-p1))
}
}
tmp=Intersectline(q1,tmp1,p2,q2-p2)
if(length(Op(1,tmp))>1){
- if(Op(3,tmp)*(Op(3,tmp)-1)<Eps){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
tmp3=c(tmp3,Norm(Op(1,tmp)-q1))
}
}
tmp1=c(Op(2,q1-p1),-Op(1,q1-p1))
tmp=Intersectline(p2,tmp1,p1,q1-p1);
if(length(Op(1,tmp))>1){
- if(Op(3,tmp)*(Op(3,tmp)-1)<Eps){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
tmp3=c(tmp3,Norm(Op(1,tmp)-p2))
}
}
if(length(Op(1,tmp))>1){
- if(Op(3,tmp)*(Op(3,tmp)-1)<Eps){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
tmp3=c(tmp3,Norm(Op(1,tmp)-q2))
}
}
@@ -12206,22 +12291,21 @@ Intersectseg<- function(...){
n=c(tmp1[2],-tmp1[1])/Norm(tmp1)
pts=list()
tmp=Intersectline(p1,n,p2,q2-p2)
- if(tmp[[3]]*(tmp[[3]]-1)<Eps){
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2
pts=c(pts,list(list(tmp1,0,tmp[[3]])))
}
tmp=Intersectline(q1,n,p2,q2-p2)
- if(tmp[[3]]*(tmp[[3]]-1)<Eps){
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2
pts=c(pts,list(list(tmp1,1,tmp[[3]])))
}
tmp=Intersectline(p2,n,p1,q1-p1)
- if(tmp[[3]]*(tmp[[3]]-1)<Eps){
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1
pts=c(pts,list(list(tmp1,tmp[[3]],0)))
}
- tmp=Intersectline(q2,n,p1,q1-p1)
- if(tmp[[3]]*(tmp[[3]]-1)<Eps){
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1
pts=c(pts,list(list(tmp1,tmp[[3]],2)))
}
@@ -12256,12 +12340,12 @@ Osplineseg<- function(...){
Nargs=length(varargin)
Eps=10^(-2)
Eps0=10^(-6)
- list=varargin[[1]]
+ Ptlist=varargin[[1]]
Numstr="Num=20"
if(Nargs>1){
Numstr=varargin[[2]]
}
- p0=Op(1,list); p1=Op(2,list); p2=Op(3,list); p3=Op(4,list)
+ p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist)
tmp=Norm(p2-p0)*Norm(p3-p1)
tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2)
cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp
@@ -12283,7 +12367,7 @@ Intersectpartseg<- function(...){
Eps2=varargin[[6]]
Dist=10*Eps2
if(Nargs>6){Dist=varargin[[7]]}
- Eps=10^(-4)
+ Eps0=10^(-4)
out=list()
seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1))
seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2))
@@ -12292,11 +12376,11 @@ Intersectpartseg<- function(...){
snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2))
tmp=Intersectseg(seg1,seg2,Eps1)
dst=Op(1,tmp)
- if(dst<Eps){
+ if(dst<Eps0){
out=list(Op(2,tmp),ii+Op(3,tmp),jj+Op(4,tmp),dst,snang)
}else{
if(dst<Eps2){
- if((Length(crv1)==2)||(Norm(Op(2,seg1)-Op(1,seg1))>Dist-Eps)){
+ if((Length(crv1)==2)||(Norm(Op(2,seg1)-Op(1,seg1))>Dist-Eps0)){
os1=seg1
}else{
p1=Op(1,seg1); p2=Op(2,seg1)
@@ -12317,7 +12401,7 @@ Intersectpartseg<- function(...){
}
os1=Osplineseg(list(p0,p1,p2,p3))
}
- if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps)){
+ if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){
os2=seg2
}else{
p1=Op(1,seg2); p2=Op(2,seg2)
@@ -12340,17 +12424,17 @@ Intersectpartseg<- function(...){
}
tmp2=list()
for(kk in Looprange(1,Length(os1)-1)){
- for(II in Looprange(1,Length(os2)-1)){
+ for(ll in Looprange(1,Length(os2)-1)){
seg1=Listplot(Op(kk,os1),Op(kk+1,os1))
- seg2=Listplot(Op(II,os2),Op(II+1,os2))
+ seg2=Listplot(Op(ll,os2),Op(ll+1,os2))
tmp=Intersectseg(seg1,seg2,Eps1)
- if(Op(1,tmp)<Eps1){
- if(Op(1,tmp)<dst+Eps){
+ if((Op(1,tmp)<Eps1)&&(length(tmp)>1)){ #18.02.05
+ if(Op(1,tmp)<dst+Eps0){
dst=Op(1,tmp)
tmp3=list()
for( nn in Looprange(1,length(tmp2))){
if(Op(1,tmp2[[nn]])<dst){
- tmp3=c(tmp3,list(tmp2[[n]]))
+ tmp3=c(tmp3,list(tmp2[[nn]]))
}
}
tmp2=c(tmp3,list(list(dst,Op(2,tmp))))
@@ -12370,7 +12454,7 @@ Intersectpartseg<- function(...){
tmp=c(Op(2,p2-p1),-Op(1,p2-p1))
tmp=Intersectline(Op(1,out),tmp,p1,p2-p1)
tmp=min(max(Op(3,tmp),0),1)
- out=list(tmp1,ii+tmp)
+ out=c(out,list(ii+tmp))
p1=Op(jj,crv2); p2=Op(jj+1,crv2)
tmp=c(Op(2,p2-p1),-Op(1,p2-p1))
tmp=Intersectline(Op(1,out),tmp,p1,p2-p1)
@@ -12383,39 +12467,75 @@ Intersectpartseg<- function(...){
}
Collectnear<- function(ptdL,Eps2){
- Eps=10^(-4);
gL=list(Op(1,ptdL))
- rL=ptdL[2:(length(ptdL))]
- flg=0
+ rL=ptdL[Looprange(2,length(ptdL))] #18.02.07
for( ii in Looprange(1,length(ptdL)-1)){
- if(flg==0){
- numL=c()
- for(jj in Looprange(1,length(rL))){
- tmp1=100
- for(kk in Looprange(1,length(gL))){
- tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]]))
- if(tmp<tmp1){tmp1=tmp}
+ numL=c()
+ for(jj in Looprange(1,length(rL))){
+ tmp1=100
+ for(kk in Looprange(1,length(gL))){
+ tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]]))
+ if(tmp<tmp1){tmp1=tmp}
+ }
+ if(tmp1<Eps2){numL=c(numL,jj)}
+ }
+ if(length(numL)==0){
+ break
+ }else{
+ gL=c(gL,rL[numL]) #18.02.05
+ tmp=setdiff(1:(length(rL)),numL)
+ rL=rL[tmp]
+ }
+ }
+ return(list(gL,rL))
+}
+
+Groupnearpt<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Eps=varargin[[Nargs]]
+ plist=varargin[[1]]
+ qlist=varargin[[2]]
+ if(!is.list(qlist)){
+ qlist=plist
+ plist=list()
+ }
+ if(length(qlist)==0){
+ return(plist)
+ }
+ pt=qlist[[1]]
+ qlist=qlist[Looprange(2,length(qlist))]
+ if(length(plist)==0){
+ plist=list(matrix(pt,nrow=1))
+ }else{
+ flg=0
+ for(ii in Looprange(1,length(plist))){
+ gL=plist[[ii]]
+ for(jj in Looprange(1,Length(gL))){
+ if(Norm(Op(jj,gL)-pt)<Eps){
+ flg=1
+ break
}
- if(tmp1<Eps2){numL=c(numL,jj)}
}
- if(length(numL)==0){
- flg=1
- }else{
- gL=c(gL,rm[numL])
- tmp=setdiff(1:(length(rL)),numL)
- rL=rL[tmp]
+ if(flg==1){
+ plist[[ii]]=Appendrow(gL,pt)
+ break
}
}
+ if(flg==0){
+ plist=c(plist,list(matrix(pt,nrow=1)))
+ }
}
- return(list(gL,rL))
+ out=Groupnearpt(plist,qlist,Eps)
+ return(out)
}
IntersectcurvesPp<- function(...){
varargin=list(...)
Nargs=length(varargin)
- Eps=10^(-4)
+ Eps0=10^(-4)
Eps1=0.01
- Eps2=0.1
+ Eps2=0.05
Dist=10*Eps2
if(Nargs>2){Eps1=varargin[[3]]}
if(Nargs>3){Eps2=varargin[[4]]}
@@ -12424,7 +12544,7 @@ IntersectcurvesPp<- function(...){
crv1=matrix(Op(1,tmp1),nrow=1)
for(ii in Looprange(2,Length(tmp1))){
tmp=Op(Length(crv1),crv1)
- if(Norm(tmp-Op(ii,tmp1))>Eps){
+ if(Norm(tmp-Op(ii,tmp1))>Eps0){
crv1=Appendrow(crv1,Op(ii,tmp1))
}
}
@@ -12432,7 +12552,7 @@ IntersectcurvesPp<- function(...){
crv2=matrix(Op(1,tmp2),nrow=1)
for(ii in Looprange(2,Length(tmp2))){
tmp=Op(Length(crv2),crv2)
- if(Norm(tmp-Op(ii,tmp2))>Eps){
+ if(Norm(tmp-Op(ii,tmp2))>Eps0){
crv2=Appendrow(crv2,Op(ii,tmp2))
}
}
@@ -12456,7 +12576,7 @@ IntersectcurvesPp<- function(...){
}
for(jj in loopL){
tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist)
- if(length(tmp)>0){
+ if(length(tmp)>1){ #18.02.05
if(length(out)==0){
out=list(tmp)
}else{
@@ -12475,16 +12595,13 @@ IntersectcurvesPp<- function(...){
tmp2=out
out=list()
tmp1=tmp2
- flg=0
for(ii in Looprange(1,length(tmp2))){
- if(flg==0){
- tmp=Collectnear(tmp1,Eps2)
- out=c(out,list(Op(1,tmp)))
- if(length(Op(2,tmp))==0){
- flg=1
- }else{
- tmp1=Op(2,tmp)
- }
+ tmp=Collectnear(tmp1,Eps2)
+ out=c(out,list(Op(1,tmp)))
+ if(length(Op(2,tmp))==0){
+ break
+ }else{
+ tmp1=Op(2,tmp)
}
}
for(ii in Looprange(1,length(out))){
@@ -12497,18 +12614,14 @@ IntersectcurvesPp<- function(...){
tmp=c(tmp,Op(4,tmp1[[jj]]))
}
dst=min(tmp)
- tmp=list()
- for(jj in Looprange(1,length(tmp1))){
- if(Op(4,tmp1[[jj]])<dst+Eps){
- tmp=c(tmp,list(tmp1[[jj]]))
- }
- }
- tmp1=tmp
tmp=c()
for(jj in Looprange(1,length(tmp1))){
- tmp=c(tmp,Op(1,tmp1[[jj]]))
+ if(Op(4,tmp1[[jj]])<dst+Eps0){
+ tmp=c(tmp,Op(1,tmp1[[jj]]))
+ }
}
- tmp=sum(tmp)/length(tmp1);
+ tmp=matrix(tmp,ncol=2,byrow=TRUE)
+ tmp=c(sum(tmp[,1]),sum(tmp[,2]))/Length(tmp)
tmp2=list(tmp)
tmp=Nearestpt(Op(1,tmp2),crv1)
tmp2=c(tmp2,list(Op(2,tmp)))
@@ -12522,10 +12635,10 @@ IntersectcurvesPp<- function(...){
}
Intersectcurves<- function(...){
- tmp=IntersectcurvesPp(...)
+ dtL=IntersectcurvesPp(...)
out=list()
- for(ii in Looprange(1,length(tmp))){
- out=c(out,list(Op(1,tmp[[ii]])))
+ for(jj in Looprange(1,length(dtL))){
+ out=c(out,list(Op(1,dtL[[jj]])))
}
return(out)
}
@@ -12538,7 +12651,7 @@ Enclosing2<- function(...){
varargin=list(...)
Nargs=length(varargin)
plist=varargin[[1]]
- Eps=10^(-5)
+ Eps0=10^(-5)
Eps1=0.01
Eps2=0.1
Start=c()
@@ -12559,7 +12672,7 @@ Enclosing2<- function(...){
Fdata=plist[[1]]
tmp1=Op(1,Fdata)
tmp2=Op(Length(Fdata),Fdata)
- if(Norm(tmp1-tmp2)<Eps){
+ if(Norm(tmp1-tmp2)<Eps0){
AnsL=Fdata
}else{
AnsL=Appendrow(Fdata,tmp1)
@@ -12582,14 +12695,14 @@ Enclosing2<- function(...){
if(length(KL)==1){
tmp=Op(1,KL)
tst=Op(2,tmp)
- Start=Pointoncrv(tst,Fdata)
+ Start=crv(tst,Fdata)
}
if(length(KL)>1){
KL=Quicksort(KL,2)
if(length(Start)==0){
tmp=Op(1,KL)
tst=Op(2,tmp)
- Start=Pointoncrv(tst,Fdata)
+ Start=Pointoncurve(tst,Fdata)
}else{
tmp=c()
for(ii in Looprange(1,length(KL))){
@@ -12605,7 +12718,7 @@ Enclosing2<- function(...){
}
tmp=Op(1,tmp1)
tst=Op(2,tmp)
- Start=Pointoncrv(tst,Fdata)
+ Start=Pointoncurve(tst,Fdata)
}
}
}
@@ -12631,7 +12744,7 @@ Enclosing2<- function(...){
tmp=Op(1,KL)
t2=Op(2,tmp)
ss=Op(3,tmp)
- if(abs(t2-t1)<Eps){
+ if(abs(t2-t1)<Eps0){
if(length(KL)>1){
tmp=Op(2,KL)
t2=Op(2,tmp)
@@ -12658,3 +12771,1643 @@ Enclosing2<- function(...){
}
############## end of Enclosing2 #############
+
+############## start of surface drawing #############
+
+Fullformfunc<- function(FdL){
+ ADDPOINT<<- list() #18.02.19
+ Out=list(Op(1,FdL))
+ N=length(FdL)
+ for(Jrg in Looprange(1,N)){
+ Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE)
+ if(length(Tmp)>0){
+ break
+ }
+ }
+ Urg=Stripblanks(Op(Jrg,FdL))
+ Tmp=strsplit(Urg,"=",fixed=TRUE)
+ UNAME<<- Tmp[[1]][1]
+ URNG<<- eval(parse(text=Tmp[[1]][2]))
+ Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",",
+ sprintf("%6.7f",URNG[2]),")",sep="")
+ Vrg=Stripblanks(Op(Jrg+1,FdL))
+ Tmp=strsplit(Vrg,"=",fixed=TRUE)
+ VNAME<<- Tmp[[1]][1]
+ VRNG<<- eval(parse(text=Tmp[[1]][2]))
+ Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",",
+ sprintf("%6.7f",VRNG[2]),")",sep="")
+ if(Jrg==2){
+ Xf=UNAME
+ Yf=VNAME
+ Tmp=Stripblanks(Op(1,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Zf=Tmp[[1]][2]
+ Tmp=list(UNAME,VNAME,Zf,Urg,Vrg)
+ Out=c(Out,Tmp)
+ }else if(Jrg==4){
+ Tmp=Stripblanks(Op(1,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Zf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(2,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Xname=Tmp[[1]][1]
+ Xf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(3,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Yname=Tmp[[1]][1]
+ Yf=Tmp[[1]][2]
+ Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE)
+ Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE)
+ Tmp=list(Xf,Yf,Zf,Urg,Vrg)
+ Out=c(Out,Tmp)
+ }else{
+ Tmp=Stripblanks(Op(2,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Xf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(3,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Yf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(4,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Zf=Tmp[[1]][2]
+ Tmp=list(Xf,Yf,Zf,Urg,Vrg)
+ Out=c(Out,Tmp)
+ }
+ tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='')
+ eval(parse(text=tmp))
+ tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='')
+ eval(parse(text=tmp))
+ tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='')
+ eval(parse(text=tmp))
+ tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='')
+ tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='')
+ eval(parse(text=tmp))
+ XYZstr<<- c(Xf,Yf,Zf)
+ DRWS<<- "enws"
+ BdyL=list()
+ for(I in Looprange(Jrg+2,length(FdL))){
+ Tmp=Op(I,FdL)
+ if(is.character(Tmp)){
+ if(nchar(Tmp)==0){
+ Tmp=" "
+ }
+ DRWS<<- list(Tmp)
+ }
+ if((is.numeric(Tmp))&&(Length(Tmp)>1)){
+ BdyL=list(Tmp)
+ }
+ }
+ BDYL<<- BdyL
+ Tmp=c(DRWS,BDYL)
+ Out=c(Out,Tmp)
+ return(Out)
+}
+
+Addpoints<- function(ptlist){
+ ADDPOINT<<- ptlist
+}
+
+Makexybdy<- function(Np){
+ Eps0=10^(-4)
+ Xystr=XYZstr[1:2]
+ Umin=URNG[1]; Umax=URNG[2]
+ Vmin=VRNG[1]; Vmax=VRNG[2]
+ Cflg=0
+ EhL=list()
+ Tmp=grep("e",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ Tmp=grep("n",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Cflg>0){
+ Tmp1=Op(length(EhL),EhL)
+ Tmp=Joincrvs(Tmp1,Tmp)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ EhL=c(Tmp1,Tmp)
+ }else{
+ Cflg=0
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ }
+ Tmp=grep("w",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Cflg>0){
+ Tmp1=Op(length(EhL),EhL)
+ Tmp=Joincrvs(Tmp1,Tmp)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ EhL=c(Tmp1,list(Tmp))
+ }else{
+ Cflg=0
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ }
+ Tmp=grep("s",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Cflg>0){
+ Tmp1=Op(length(EhL),EhL)
+ Tmp=Joincrvs(Tmp1,Tmp)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ }
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ EhL=c(Tmp1,list(Tmp))
+ }else{
+ Cflg=0
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ }
+ return(EhL)
+}
+
+Partitionseg<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fig=varargin[[1]]
+ GL=varargin[[2]]; N=3
+ if(!is.list(GL)){GL=list(GL)} #18.02.21
+ Eps0=10^(-4)
+ Eps=0.01
+ if(Nargs>2){
+ Eps=varargin[[3]]
+ }
+ Eps2=0.1
+ if(Nargs>3){
+ Eps2=varargin[[4]]
+ }
+ if(Nargs>4){
+ Ns=varargin[[5]]
+ if(Ns>0){#18.02.21from
+ Other=Op(Ns,OTHERPARTITION)
+ }else{
+ Other=c()
+ }#18.02.21upto
+ }else{
+ Ns=1
+ Other=c()
+ }
+ Npt=Length(Fig)
+ ParL=c(1,Npt,Other)
+ for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21
+ G=Op(N,GL)
+ KouL=IntersectcurvesPp(Fig,G,Eps,Eps2)
+ Tmp1=c(); Tmp2=c()
+ for(jj in Looprange(1,length(KouL))){
+ tmp=Op(2,KouL[[jj]])
+ if((tmp>1+Eps0)&&(tmp<Npt-Eps0)){
+ Tmp1=c(Tmp1,tmp)
+ }
+ tmp=Op(3,KouL[[jj]])
+ if((tmp>1+Eps0)&&(tmp<Length(G)-Eps0)){
+ Tmp2=c(Tmp2,tmp)
+ }
+ }
+ ParL=c(ParL,Tmp1)
+ if((Ns>0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21
+ tmp=OTHERPARTITION[[N]]
+ OTHERPARTITION[[N]]<<- c(tmp,Tmp2)
+ }
+ }
+ tmp1=sort(ParL)
+ ParL=c()
+ tmp2=-1
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=Op(jj,tmp1)
+ if(abs(tmp-tmp2)>Eps){
+ ParL=c(ParL,tmp)
+ tmp2=tmp
+ }
+ }
+ return(ParL)
+}
+
+Evlptablepara<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Tmp=varargin[[1]]
+ Mdv=50
+ Ndv=50
+ if(Nargs>=2){
+ Tmp=varargin[[2]]
+ if(is.list(Tmp)){Tmp=Op(1,Tmp)}
+ if(length(Tmp)>1){
+ Mdv=Tmp[1]
+ Ndv=Tmp[2]
+ }else{
+ Mdv=Tmp
+ if(Nargs==2){
+ Ndv=Mdv
+ }else{
+ Tmp1=varargin[[3]]
+ if((is.numeric(Tmp1)) && (length(Tmp1)==1)){
+ Ndv=Tmp1
+ }else{
+ Ndv=Mdv
+ }
+ }
+ }
+ }
+ U1=URNG[1]; U2=URNG[2]
+ V1=VRNG[1]; V2=VRNG[2]
+ Du=(U2-U1)/(Mdv)
+ Dv=(V2-V1)/(Ndv)
+ sph=sprintf("%7.7f",sin(PHI))
+ cph=sprintf("%7.7f",cos(PHI))
+ sth=sprintf("%7.7f",sin(THETA))
+ cth=sprintf("%7.7f",cos(THETA))
+ xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="")
+ tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="")
+ ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="")
+ dxu=Diff(xstr,UNAME)
+ dxv=Diff(xstr,VNAME)
+ dyu=Diff(ystr,UNAME)
+ dyv=Diff(ystr,VNAME)
+ I=1
+ Zval=c()
+ for(jj in 1:(Ndv+1)){
+ v=V1+(jj-1)*Dv
+ ZuL=c()
+ for(ii in 1:(Mdv+1)){
+ u=U1+(ii-1)*Du
+ tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="")
+ tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="")
+ Dxu=Funvalue(dxu,tmp1,tmp2)
+ Dxv=Funvalue(dxv,tmp1,tmp2)
+ Dyu=Funvalue(dyu,tmp1,tmp2)
+ Dyv=Funvalue(dyv,tmp1,tmp2)
+ Tmp=Dxu*Dyv-Dxv*Dyu
+ ZuL=c(ZuL,Tmp)
+ }
+ Zval=Appendrow(Zval,ZuL)
+ }
+ Yval=c()
+ for(jj in 1:(Ndv+1)){
+ v=V1+(jj-1)*Dv
+ Yval=c(Yval,v)
+ }
+ Xval=c()
+ for(ii in 1:(Mdv+1)){
+ u=U1+(ii-1)*Du
+ Xval=c(Xval,u)
+ }
+ return(list(Zval,Xval,Yval))
+}
+
+Dropnumlistcrv<- function(QdL,Eps){
+ Eps0=10^(-4)
+ if(!is.list(QdL)){
+ PdL=list(QdL)
+ }else{
+ PdL=QdL
+ }
+ OutL=list()
+ for(I in Looprange(1,length(PdL))){
+ Pd=Op(I,PdL)
+ PtL=c(1)
+ P=Op(1,Pd)
+ for(K in Looprange(2,Length(Pd)-1)){
+ if(Norm(P-Op(K,Pd))>Eps){
+ PtL=c(PtL,K)
+ P=Op(K,Pd)
+ }
+ }
+ K=Length(Pd)
+ if(Norm(P-Op(K,Pd))>Eps){ #18.02.12 eps
+ PtL=c(PtL,K)
+ }
+ if(length(PtL)==1){
+ PtL=c()
+ }
+ OutL=c(OutL,list(PtL))
+ }
+ return(OutL)
+}
+
+Cuspsplitpara<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin);
+ Gdxy=varargin[[1]]
+ if(!is.list(Gdxy)){
+ Gdxy=list(Gdxy)
+ }
+ Eps0=10^(-4)
+ Eps=0.01
+ if(Nargs>2){Eps=varargin[[2]]}
+ N=2
+ CUSPSPLITPT<<- list()
+ OutkL=list()
+ for(Ng in Looprange(1,length(Gdxy))){
+ PtxyL=Op(Ng,Gdxy)
+ PtkL=c()
+ PthL=c()
+ for(I in Looprange(1,Length(PtxyL))){
+ Tmp=Op(I,PtxyL)
+ Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="")
+ eval(parse(text=Tmp1))
+ Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="")
+ eval(parse(text=Tmp1))
+ Tmp2=c(eval(parse(text=XYZstr[1])))
+ Tmp2=c(Tmp2,eval(parse(text=XYZstr[2])))
+ Tmp2=c(Tmp2,eval(parse(text=XYZstr[3])))
+ Tmp3=Parapt(Tmp2)
+ if(I==1){
+ PtkL=matrix(Tmp2,nrow=1)
+ PthL=matrix(Tmp3,nrow=1)
+ }else{
+ Tmp4=Op(Length(PthL),PthL)
+ if(Norm(Tmp3-Tmp4)>Eps0){
+ PtkL=Appendrow(PtkL,Tmp2)
+ PthL=Appendrow(PthL,Tmp3)
+ }
+ }
+ }
+ if(Length(PthL)==0){
+ return(list())
+ }
+ Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL)
+ Cflg=0
+ if(Norm(Ps-Pe)<Eps){Cflg=1}
+ CuspL=c()
+ Cva=cos(10*pi/180)
+ for(I in Looprange(1,Length(PthL)-1)){
+ if(Length(PthL)==2){break}
+ Tmp=Op(I,PthL)
+ if(I==1){
+ if(Cflg==0){next}
+ Tmp1=Op(Length(PthL)-1,PthL)
+ }else{
+ Tmp1=Op(I-1,PthL)
+ }
+ Tmp2=Op(I+1,PthL)
+ V1=Tmp-Tmp1
+ V2=Tmp2-Tmp
+ Tmp3=Dotprod(V1,V2)/(Norm(V1)*Norm(V2))
+ Cuspflg=0
+ if(Tmp3<Cva){
+ P=Op(I,PthL)
+ Kaku=acos(Tmp3)*180/pi
+ if(Crossprod(V1,V2)<0){
+ Kaku=-Kaku
+ }
+ Cuspflg=0
+ for(J in Looprange(I+1,Length(PthL)-1)){
+ if(abs(Kaku)>90){
+ Cuspflg=1
+ break
+ }
+ Q=Op(J,PthL)
+ if(Norm(P-Q)>Eps){
+ break
+ }
+ V1=Q-Op(J-1,PthL)
+ V2=Op(J+1,PthL)-Q
+ Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2))
+ Tmp=acos(Tmp3)*180/pi
+ if(Crossprod(V1,V2)<0){
+ Tmp=-Tmp
+ }
+ Kaku=Kaku+Tmp
+ }
+ if(Cuspflg==1){
+ Tmp=trunc((I+J)*0.5)
+ I=J
+ if(length(CuspL)==0){
+ CuspL=c(Tmp)
+ }else{
+ CuspL=c(CuspL,Tmp)
+ }
+ }
+ }
+ }
+ if(Cflg==0){
+ CuspL=c(1,CuspL,Length(PthL))
+ }else if(length(CuspL)==0){
+ CuspL=c(1,Length(PthL))
+ }else if(Op(1,CuspL)==1){
+ CuspL=c(CuspL,Length(PthL))
+ }else{
+ Tmp=Op(1,CuspL)
+ Tmp1=PthL[Tmp:Length(PthL),]
+ Tmp2=PthL[2:Tmp,]
+ PthL=Appendrow(Tmp1,Tmp2)
+ Tmp1=PtkL[Tmp:Length(PthL),]
+ Tmp2=PtkL[2:Tmp,]
+ PtkL=Appendrow(Tmp1,Tmp2)
+ CuspL=CuspL-Tmp+1
+ CuspL=c(CuspL,Length(PthL))
+ }
+ if(length(CuspL)==2){
+ Tmp4=PthL[Length(PthL),]
+ if(Length(PtkL)>=2){
+ CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4))
+ OutkL=c(OutkL,list(PtkL))
+ }
+ next
+ }
+ Outk=list()
+ Is=1
+ for(I in Looprange(1,length(CuspL)-1)){
+ Tmp1=CuspL[Is]; Tmp2=CuspL[I+1]
+ Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL)
+ if(Norm(Tmp3-Tmp4)>Eps){
+ Tmpk=PtkL[Tmp1:Tmp2,]
+ Outk=c(Outk,list(Tmpk))
+ CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4))
+ Is=I+1
+ }
+ }
+ OutkL=c(OutkL,Outk)
+ }
+ Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps*0.5)
+ Tmp=list()
+ for(I in Looprange(1,length(OutkL))){
+ Tmp2=Op(I,OutkL)
+ Tmp3=Op(I,Tmp1)
+ Tmp4=c()
+ for(J in Looprange(1,Length(Tmp3))){
+ Tmp5=Op(Tmp3[J],Tmp2)
+ Tmp4=Appendrow(Tmp4,Tmp5)
+ }
+ if(Length(Tmp4)>0){
+ Tmp=c(Tmp,list(Tmp4))
+ }
+ }
+ return(Tmp)
+}
+
+PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps,Eps2){
+ Eps0=10^(-4)
+ Out=c()
+ Vec=1/Norm(Vec)*Vec
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ Tmp=paste("Eqfun<- function(U,V){",sep='')
+ if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){
+ Vstr=sprintf("%6.6f",Vec)
+ Pstr=sprintf("%6.6f",PtA)
+ Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='')
+ Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='')
+ }else{
+ Tmp=paste(Tmp,"Xfunc(U,V)}",sep='')
+ }
+ eval(parse(text=Tmp))
+ Dx=(URNG[2]-URNG[1])/Np[1]
+ Dy=(VRNG[2]-VRNG[1])/Np[2]
+ for(J in Looprange(1,Np[2])){ #####
+ Vval1=VRNG[1]+(J-1)*Dy
+ Vval2=VRNG[1]+J*Dy
+ for(I in Looprange(1,Np[1])){ #####
+ Uval1=URNG[1]+(I-1)*Dx
+ Uval2=URNG[1]+I*Dx
+ Eval11=Eqfun(Uval1,Vval1)
+ Eval12=Eqfun(Uval1,Vval2)
+ Eval21=Eqfun(Uval2,Vval1)
+ Eval22=Eqfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ P1=Op(K,PL); P2=Op(K+1,PL)
+ M1=Op(K,VL); M2=Op(K+1,VL)
+ if(abs(M1)<Eps0){
+ QL=Appendrow(QL,P1)
+ next
+ }
+ if(abs(M2)<Eps0){
+# QL=Appendrow(QL,P2)
+ next
+ }
+ if((M1> 0) && (M2> 0)){
+ next
+ }
+ if((M1< 0) && (M2< 0)){
+ next
+ }
+ Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
+ QL=Appendrow(QL,Tmp)
+ }
+ if(Length(QL)==2){
+ Puv1=Op(1,QL); Puv2=Op(2,QL)
+ Tmp1=Op(1,Puv1)
+ Tmp2=Op(2,Puv1)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P1=c(Xv,Yv,Zv)
+ Tmp1=Op(1,Puv2)
+ Tmp2=Op(2,Puv2)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P2=c(Xv,Yv,Zv)
+ V1=Vec[1]; V2=Vec[2]; V3=Vec[3]
+ if(abs(V1)>Eps0){
+ M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3]
+ M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3]
+ }else if(abs(V2)>Eps0){
+ M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3]
+ M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3]
+ }else{
+ M1=PtA[2]-P1[2]
+ M2=PtA[2]-P2[2]
+ }
+ if(M1*M2>= 0){
+ if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
+ next
+ }
+ if(M1==0){
+ Pt=P1; Ptuv=Puv1
+ }else{
+ Pt=P2; Ptuv=Puv2
+ }
+ }else{
+ Pt=1/(M1-M2)*(-M2*P1+M1*P2)
+ Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2)
+ }
+ if(is.character(Uveq)){
+ Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='')
+ Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='')
+ Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE)
+ Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE)
+ Tmp=eval(parse(text=Tmp))
+ if(Tmp< -Eps0){
+ next
+ }
+ }
+ Tmp1=Crossprod(Pt-PtA,Vec)
+ if(Norm(Tmp1)<Eps){ #18.02.19
+ if(Zparapt(Pt)>Zparapt(PtA)+Eps2){
+ return(list(1,Pt,Zparapt(Pt),Zparapt(PtA)))
+ }else{
+ Out=Appendrow(Out,Pt)
+ }
+ }
+ }
+ }
+ }
+ if(Length(Out)==0){
+ return(list(0,c()))
+ }
+ return(c(list(0,Out)))
+}
+
+Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps,Eps2){
+ Eps0=10^(-4)
+ Fh=Projpara(Fk)
+ P1=Ptstart(Fh)
+ P2=Ptend(Fh)
+ Csp=CUSPPT
+ if(!is.list(Csp)){Csp=list(Csp)}
+ Cspflg=1
+ for(I in Looprange(1,length(Csp))){
+ Tmp=Op(I,Csp)
+ if(Norm(Tmp-P1)<Eps0){
+ if(Cspflg==1){Cspflg=2}
+ if(Cspflg==3){Cspflg=6}
+ next
+ }
+ if(Norm(Tmp-P2)<Eps0){
+ if(Cspflg==1){Cspflg=3}
+ if(Cspflg==2){Cspflg=6}
+ next
+ }
+ }
+ PaL=c()
+ tmp2=-1
+ for(jj in Looprange(1,length(Par)-1)){
+ tmp1=Op(jj,Par)
+ if(abs(tmp1-tmp2)>Eps2){
+ PaL=c(PaL,tmp1)
+ tmp2=tmp1
+ }
+ }
+ tmp1=PaL[length(PaL)] #18.02.26from
+ tmp2=Par[length(Par)]
+ if(abs(tmp1-tmp2)<Eps2){
+ PaL[length(PaL)]=tmp2
+ }else{
+ PaL=c(PaL,tmp2)
+ } #18.02.26upto
+ SeL=c()
+ for(N in Looprange(1,length(PaL)-1)){
+ S=(PaL[N]+PaL[N+1])/2
+ Tmp=Invparapt(S,Fh,Fk)
+ PtA=Op(1,Tmp)
+ PtAp=Parapt(PtA)
+ Vec=c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA))
+ Flg=PthiddenQ(PtA,Vec,Uveq,Np,Eps,Eps2)
+ if(Flg[[1]]==0){
+ SeL=c(SeL,N)
+ }
+ }
+ FigL=list()
+ FigkL=list()
+ for(I in Looprange(1,length(SeL))){
+ Tmp1=Pointoncurve(PaL[SeL[I]],Fh)
+ Tmp2=Pointoncurve(PaL[SeL[I]+1],Fh)
+ if(I==1){
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ if(Member(SeL[I]-1,SeL)){
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ FigL=c(FigL,list(Partcrv(SP,SQ,Fh)))
+ Tmp3=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp3)
+ Tmp3=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp3)
+ Tmp4=Partcrv3(TP,TQ,Fk)
+ FigkL=c(FigkL,list(Tmp4))
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }
+ }
+ }
+ if(length(SeL)>0){
+ if(Norm(P-Q)>Eps0){ #18.02.14
+ FigL=c(FigL,list(Partcrv(P,Q,Fh)))
+ Tmp3=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp3)
+ Tmp3=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp3)
+ FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk)))
+ }else{
+ FigL=c(FigL,list(Fh))
+ FigkL=c(FigkL,list(Fk))
+ }
+ }
+ Tmp=c()
+ for(I in Looprange(1,length(PaL)-1)){
+ if(!Member(I,SeL)){
+ Tmp=c(Tmp,I)
+ }
+ }
+ SeL=Tmp
+ HIDDENDATA<<- list()
+ for(I in Looprange(1,length(SeL))){
+ Tmp=PaL[SeL[I]]
+ Tmp1=Pointoncurve(Tmp,Fh)
+ Tmp=PaL[SeL[I]+1]
+ Tmp2=Pointoncurve(Tmp,Fh)
+ if(I==1){
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ if(Member(SeL[I]-1,SeL)){
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ Tmp=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp)
+ Tmp=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp)
+ HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk)))
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }
+ }
+ }
+ if(length(SeL)>0){
+ if(Norm(P-Q)>Eps0){ #18.02.14
+ Tmp=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp)
+ Tmp=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp)
+ HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk)))
+ }else{
+ HIDDENDATA<<- c(HIDDENDATA,list(Fk))
+ }
+ }
+ return(FigkL)
+}
+
+Borderparadata<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ FkL=varargin[[1]]
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(2,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Umin=URNG[1]; Umax=URNG[2]
+ Vmin=VRNG[1]; Vmax=VRNG[2]
+ EkL=list()
+ Tmp=grep("e",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]),sep="")
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ Tmp=grep("n",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]),sep="")
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ Tmp=grep("w",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]))
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ Tmp=grep("s",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]))
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ if(length(EkL)>0){
+ FkL=c(FkL,EkL)
+ }
+ Fall=Projpara(FkL)
+ if(is.numeric(Fall)){
+ Fall=list(Fall)
+ }
+ Fbdxy=Makexybdy(Np)
+ BORDERPT<<- list()
+ Tmp1=list()
+ for(I in Looprange(1,length(Fall))){
+ Tmp1=c(Tmp1,list(c()))
+ }
+ OTHERPARTITION<<- Tmp1
+ FsL=list()
+ BORDERHIDDENDATA<<- list()
+ starttime=proc.time()
+ for(I in Looprange(1,length(FkL))){
+ Tmp=Op(I,FkL)
+ Tmp=Projpara(Tmp)
+ Par=Partitionseg(Tmp,Fall,Eps,Eps2,I)
+ Tmp1=Op(I,FkL)
+ Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps,Eps2)
+ if(length(HIDDENDATA)>0){
+ BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA)
+ }
+ if(length(Tmp)>0){
+ FsL=c(FsL,Tmp)
+ }
+ Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='')
+ Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ }
+ return(FsL)
+}
+
+Sfbdparadata<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fd=varargin[[1]]
+ FdL=Fullformfunc(Fd)
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(2,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ starttime=proc.time()
+ tmp=Evlptablepara(Np)
+ Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]]
+ Out3=Implicitplot(Zval,Xval,Yval)
+ tmp3=list()
+ for(jj in Looprange(1,length(Out3))){
+ tmp1=Op(jj,Out3)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ Nlist=Dropnumlistcrv(tmp2,Eps)
+ Nlist=Nlist[[1]]
+ tmp=c()
+ for(kk in Looprange(1,length(Nlist))){
+ tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18
+ }
+ if(Length(tmp)>0){
+ tmp3=c(tmp3,list(tmp))
+ }
+ }
+ Out3=tmp3
+ IMPLICITDATA<<- Out3
+ Tmp=proc.time()-starttime
+ print(paste('ImplicitData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep=''))
+ starttime=proc.time()
+ Out4=Cuspsplitpara(Out3,Eps)
+ CUSPDATA<<- Out4
+ CUSPPT<<- CUSPSPLITPT
+ Tmp=proc.time()-starttime
+ print(paste('CuspData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep=''))
+ Out5=Borderparadata(Out4,Np,Eps,Eps2)
+ return(Out5)
+}
+
+Meetpoints<- function(PtA,PtB,Uveq,Np,Eps){
+ Eps0=10^(-4)
+ Vec=PtB-PtA
+ if(Norm(Vec)<Eps0){return(list())} #18.02.24
+ Out=list()
+ Vec=1/Norm(Vec)*Vec
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ Tmp=paste("Eqfun<- function(U,V){",sep='')
+ if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){
+ Vstr=sprintf("%6.6f",Vec)
+ Pstr=sprintf("%6.6f",PtA)
+ Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='')
+ Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='')
+ }else{
+ Tmp=paste(Tmp,"Xfunc(U,V)}",sep='')
+ }
+ eval(parse(text=Tmp))
+ Dx=(URNG[2]-URNG[1])/Np[1]
+ Dy=(VRNG[2]-VRNG[1])/Np[2]
+ for(J in Looprange(1,Np[2])){ #####
+ Vval1=VRNG[1]+(J-1)*Dy
+ Vval2=VRNG[1]+J*Dy
+ for(I in Looprange(1,Np[1])){ #####
+ Uval1=URNG[1]+(I-1)*Dx
+ Uval2=URNG[1]+I*Dx
+ Eval11=Eqfun(Uval1,Vval1)
+ Eval12=Eqfun(Uval1,Vval2)
+ Eval21=Eqfun(Uval2,Vval1)
+ Eval22=Eqfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ P1=Op(K,PL); P2=Op(K+1,PL)
+ M1=Op(K,VL); M2=Op(K+1,VL)
+ if(abs(M1)<Eps0){
+ QL=Appendrow(QL,P1)
+ next
+ }
+ if(abs(M2)<Eps0){
+# QL=Appendrow(QL,P2)
+ next
+ }
+ if((M1> 0) && (M2> 0)){
+ next
+ }
+ if((M1< 0) && (M2< 0)){
+ next
+ }
+ Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
+ QL=Appendrow(QL,Tmp)
+ }
+ if(Length(QL)==2){
+ Puv1=Op(1,QL); Puv2=Op(2,QL)
+ Tmp1=Op(1,Puv1)
+ Tmp2=Op(2,Puv1)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P1=c(Xv,Yv,Zv)
+ Tmp1=Op(1,Puv2)
+ Tmp2=Op(2,Puv2)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P2=c(Xv,Yv,Zv)
+ V1=Vec[1]; V2=Vec[2]; V3=Vec[3]
+ if(abs(V1)>Eps0){
+ M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3]
+ M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3]
+ }else if(abs(V2)>Eps0){
+ M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3]
+ M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3]
+ }else{
+ M1=PtA[2]-P1[2]
+ M2=PtA[2]-P2[2]
+ }
+ if(M1*M2>= 0){ #18.02.21
+ if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
+ next
+ }
+ if(M1==0){
+ Pt=P1; Ptuv=Puv1
+ }else{
+ Pt=P2; Ptuv=Puv2
+ }
+ }else{
+ Pt=1/(M1-M2)*(-M2*P1+M1*P2)
+ Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2)
+ }
+ if(is.character(Uveq)){
+ Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='')
+ Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='')
+ Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE)
+ Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE)
+ Tmp=eval(parse(text=Tmp))
+ if(Tmp< -Eps0){
+ next
+ }
+ }
+ Tmp1=Crossprod(Pt-PtA,Vec)
+ if(Norm(Tmp1)<Eps){ #18.02.19
+ Tmp1=Dotprod(Pt-PtA,Vec) #18.02.21
+ if((Tmp1>-Eps0)&&(Tmp1<Norm(PtB-PtA)+Eps0)){
+ Out=c(Out,list(Pt))
+ }
+ }
+ }
+ }
+ }
+ tmp1=Groupnearpt(Out,Eps)
+ Out=list()
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=Op(jj,tmp1)
+ tmp=c(sum(tmp[,1]),sum(tmp[,2]),sum(tmp[,3]))/Length(tmp)
+ Out=c(Out,list(tmp))
+ }
+ return(Out)
+}
+
+Clipindomain<- function(ObjL,FigL){
+ Eps0=10^(-4)
+ Eps1=0.01
+ Eps2=0.05
+ Bdy=Kyoukai(FigL)
+ if(length(Bdy)>=2){
+ Fbdy=Joincrvs(FigL)
+ }else{
+ Fbdy=Op(1,FigL)
+ }
+ if(!is.list(ObjL)){
+ ObjL=list(ObjL)
+ }
+ if(!is.list(FigL)){
+ FigL=list(FigL)
+ }
+ OutL=list()
+ for(Nobj in Looprange(1,length(ObjL))){
+ Obj=Op(Nobj,ObjL)
+ ParL=c(1,Length(Obj))
+ Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2)
+ for(J in Looprange(1,length(Tmp))){
+ Tmp1=Op(J,Tmp)
+ ParL=c(ParL,Op(2,Tmp1))
+ }
+ ParL=sort(ParL)
+ Tmp=c(1)
+ for(I in Looprange(1,length(ParL))){
+ Tmp1=Op(length(Tmp),Tmp)
+ Tmp2=ParL[I]
+ if(Tmp2-Tmp1>Eps0){
+ Tmp=c(Tmp,Tmp2)
+ }
+ }
+ ParL=Tmp
+ Tmp1=Op(length(ParL),ParL)
+ Tmp2=Length(Obj)
+ if(abs(Tmp1-Tmp2)<Eps){
+ ParL=c(ParL[Looprange(1,length(ParL)-1)],Tmp2)
+ }
+ Fig=list()
+ for(N in Looprange(1,length(ParL)-1)){
+ Tmp=(ParL[N]+ParL[N+1])*0.5
+ Tmp=Pointoncurve(Tmp,Obj)
+ Tmp=Naigai(Tmp,Bdy)
+ Tmp1=sum(Tmp)%%2
+ if(Tmp1==0){
+ next
+ }
+ Fig=c(Fig,list(Partcrv(ParL[N],ParL[N+1],Obj)))
+ }
+ OutL=c(OutL,Fig)
+ }
+ return(OutL)
+}
+
+Crvsfparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Sepflg=0
+ Tmp=varargin[[Nargs]]
+ if((is.numeric(Tmp))&&(Tmp<=0)){
+ Sepflg=1
+ Nargs=Nargs-1
+ }
+ Fk=varargin[[1]]
+ if(!is.list(Fk)){
+ FkL=list(Fk)
+ }else{
+ FkL=Fk
+ }
+ Fbdy=Projpara(varargin[[2]])
+ Fd=varargin[[3]];
+ Fullformfunc(Fd) #18.02.17
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Out=list()
+ CRVSFHIDDENDATA<<- list()
+ for(Nn in Looprange(1,length(FkL))){
+ Fk=Op(Nn,FkL)
+ Tmp=Projpara(Fk)
+ Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0)
+ if(Sepflg==0){
+ for(I in Looprange(1,Length(Fk)-1)){
+ Pa=Op(I,Fk)
+ Pb=Op(I+1,Fk)
+ PtL=Meetpoints(Pa,Pb,1,Np,Eps)
+ for(J in Looprange(1,Length(PtL))){
+ Tmp=Op(J,PtL)
+ Tmp=Parapt(Tmp)
+ Tmp1=Paramoncurve(Tmp,I,Projpara(Fk))
+ Tmp2=min(abs(Par-Tmp1))
+ if(Tmp2*Norm(Parapt(Pb-Pa))>Eps) {
+ Par=c(Par,Tmp1)
+ }
+ }
+ Par=sort(Par)
+ }
+ }
+ for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from
+ tmp=Parapt(Op(jj,ADDPOINT))
+ tmp=Nearestpt(tmp,Projpara(Fk))
+ if(tmp[[3]]<Eps){
+ Par=c(Par,tmp[[2]])
+ }
+ } #18.02.19upto
+ tmp1=sort(Par)
+ Par=c()
+ tmp2=-1
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=Op(jj,tmp1)
+ if(abs(tmp-tmp2)>Eps){
+ Par=c(Par,tmp)
+ tmp2=tmp
+ }
+ }
+ Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2)
+ Out=c(Out,Tmp1)
+ CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA)
+ Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='')
+ Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ }
+ return(Out)
+}
+
+Crv3onsfparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fk=varargin[[1]]
+ if(!is.list(Fk)){
+ FkL=list(Fk)
+ }else{
+ FkL=Fk
+ }
+ Fbdy=Projpara(varargin[[2]])
+ Fd=varargin[[3]]
+ Fullformfunc(Fd) #18.02.17
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Out=list()
+ CRVONSFHIDDENDATA<<- list()
+ for(Nn in Looprange(1,length(FkL))){
+ Fk=Op(Nn,FkL)
+ Tmp=Projpara(Fk)
+ Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0)
+ for(jj in Looprange(1,length(ADDPOINT))){
+ tmp=Parapt(Op(jj,ADDPOINT))
+ tmp=Nearestpt(tmp,Projpara(Fk))
+ if(tmp[[3]]<Eps){
+ Par=c(Par,tmp[[2]])
+ }
+ }
+ Par=sort(Par)
+ Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2)
+ Out=c(Out,Tmp1)
+ CRVONSFHIDDENDATA<<- c(CRVONSFHIDDENDATA,HIDDENDATA)
+ Tmp=paste('Crvonsfdata',formatC(Nn,width=2,flag="0"),'/',sep='')
+ Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ }
+ return(Out)
+}
+
+Crvonsfparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fuv=varargin[[1]]
+ Fbdy3=varargin[[2]]
+ Fd=varargin[[3]]
+ Fullformfunc(Fd)
+ if(!is.list(Fuv)){
+ Fuv=list(Fuv)
+ }
+ FkL=list()
+ for(jj in Looprange(1,length(Fuv))){
+ tmp1=Op(jj,Fuv)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ FkL=c(FkL,list(tmp2))
+ }
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2)
+ return(Out)
+}
+
+Wireparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fbdy3=varargin[[1]]
+ Fd=varargin[[2]]
+ FdL=Fullformfunc(Fd)
+ DuL=varargin[[3]]
+ DvL=varargin[[4]]
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(5,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ if(is.numeric(DuL)){
+ tmp1=DuL
+ DuL=list()
+ for(jj in Looprange(1,tmp1)){
+ tmp=jj*(URNG[2]-URNG[1])/(tmp1+1)
+ DuL=c(DuL,list(tmp))
+ }
+ }
+ if(is.numeric(DvL)){
+ tmp1=DvL
+ DvL=list()
+ for(jj in Looprange(1,tmp1)){
+ tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1)
+ DvL=c(DvL,list(tmp))
+ }
+ }
+ Fuv=list()
+ for(jj in Looprange(1,length(DuL))){
+ tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="")
+ tmp2=paste("N=",as.character(Np[2]),sep="")
+ tmp1=Paramplot(tmp1,Op(6,FdL),tmp2)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,tmp)
+ }
+ Fuv=c(Fuv,list(tmp2))
+ }
+ FkL=list()
+ for(jj in Looprange(1,length(Fuv))){
+ tmp1=Op(jj,Fuv)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ FkL=c(FkL,list(tmp2))
+ }
+ Tmp1=proc.time()-starttime
+ cat(UNAME,"direction started","\n")
+ Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2)
+ WIREHIDDENDATA<<- CRVONSFHIDDENDATA
+ Fuv=list()
+ for(jj in Looprange(1,length(DvL))){
+ tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="")
+ tmp2=paste("N=",as.character(Np[2]),sep="")
+ tmp1=Paramplot(tmp1,Op(5,FdL),tmp2)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,tmp)
+ }
+ Fuv=c(Fuv,list(tmp2))
+ }
+ FkL=list()
+ for(jj in Looprange(1,length(Fuv))){
+ tmp1=Op(jj,Fuv)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ FkL=c(FkL,list(tmp2))
+ }
+ cat(VNAME,"direction started","\n")
+ Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2)
+ WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA)
+ Out=c(Out1,Out2)
+ return(Out)
+}
+
+Intersectcrvsf<- function(...){
+ # bdyeq is the equation of boundary f(x,y,z) =0
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ crv=varargin[[1]]
+ Fd=varargin[[2]]
+ Fullformfunc(Fd)
+ bdyflg=0
+ bdyeq=varargin[[Nargs]]
+ if(is.character(bdyeq)){
+ Nargs=Nargs-1
+ bdyflg=1
+ tmp=strsplit(bdyeq,"=",fixed=TRUE)
+ tmp=tmp[[1]]
+ if(length(tmp)>1){
+ bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="")
+ }
+ tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="")
+ eval(parse(text=tmp))
+ }
+ Eps0=10^(-4)
+ Np=c(50,50)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(3,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ PtL=list()
+ for(I in Looprange(1,Length(crv)-1)){
+ Pa=Op(I,crv)
+ Pb=Op(I+1,crv)
+ if(bdyflg==0){
+ tmp=Meetpoints(Pa,Pb,1,Np,Eps)
+ }else{
+ M1=bdyeq(Pa); M2=bdyeq(Pb)
+ if(M1*M2>= 0){ #18.02.21
+ if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
+ next
+ }
+ if(M1==0){
+ tmp=list(Pa)
+ }else{
+ tmp=list(Pb)
+ }
+ }else{
+ while(Norm(Pb-Pa)>Eps0){
+ if(bdyeq(Pa)==0){
+ tmp=list(Pa)
+ break
+ }
+ if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){
+ Pa=(Pa+Pb)/2
+ }else{
+ Pb=(Pa+Pb)/2
+ }
+ }
+ tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb))
+ }
+ }
+ PtL=c(PtL,tmp)
+ }
+ Tmp=paste('Intersectcrvsf obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ return(PtL)
+}
+
+Sfcutparadata<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ CutD=varargin[[1]]
+ Fbdy3=varargin[[2]]
+ Fd=varargin[[3]]
+ FdL=Fullformfunc(Fd)
+ Np=c(50,50)
+ Eps0=10^(-4)
+ Eps=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ Tmp=varargin[[jj]]
+ if((length(Tmp)>1)||(Tmp>1)){
+ Np=Tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps=Tmp}
+ if(ctr==2){Eps2=Tmp}
+ }
+ }
+ starttime=proc.time()
+ Tmp=strsplit(CutD,'=')
+ Tmp=Tmp[[1]]
+ if(length(Tmp)==1){
+ Eq=CutD
+ }else{
+ Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="")
+ }
+ Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE)
+ Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE)
+ Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE)
+ Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="") ########
+ eval(parse(text=Tmp))
+ Du=(URNG[2]-URNG[1])/Np[1]
+ Dv=(VRNG[2]-VRNG[1])/Np[2]
+ Out=list();Out2=list()
+ for(J in Looprange(1,Np[2])){ #####
+ Vval1=VRNG[1]+(J-1)*Dv
+ Vval2=VRNG[1]+J*Dv
+ for(I in Looprange(1,Np[1])){ #####
+ Uval1=URNG[1]+(I-1)*Du
+ Uval2=URNG[1]+I*Du
+ Eval11=Eqfun(Uval1,Vval1)
+ Eval12=Eqfun(Uval1,Vval2)
+ Eval21=Eqfun(Uval2,Vval1)
+ Eval22=Eqfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ P1=Op(K,PL); P2=Op(K+1,PL)
+ M1=Op(K,VL); M2=Op(K+1,VL)
+ if(abs(M1)<Eps0){
+ QL=Appendrow(QL,P1)
+ next
+ }
+ if(abs(M2)<Eps0){
+# QL=Appendrow(QL,P2)
+ next
+ }
+ if((M1> 0) && (M2> 0)){
+ next
+ }
+ if((M1< 0) && (M2< 0)){
+ next
+ }
+ Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
+ QL=Appendrow(QL,Tmp)
+ }
+ if(Length(QL)==2){
+ q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2]
+ if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){
+ if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){
+ Out2=c(Out2,list(QL))
+ }else{
+ Out=c(Out,list(QL))
+ }
+ next
+ }
+ if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){
+ if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){
+ Out2=c(Out2,list(QL))
+ }else{
+ Out=c(Out,list(QL))
+ }
+ next
+ }
+ Out=c(Out,list(QL))
+ }
+ }
+ }
+ while(length(Out2)>0){
+ tmp1=Out2[[1]]
+ Out=c(Out,list(tmp1))
+ Out2=Out2[-1]
+ rmv=c()
+ for(jj in Looprange(1,length(Out2))){
+ tmp2=Out2[[jj]]
+ diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,])
+ diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,])
+ if((diff1<Eps0)||(diff2<Eps0)){
+ rmv=c(rmv,jj)
+ next
+ }
+ }
+ Out2=Out2[-rmv]
+ }
+ Out=Connectseg(Out,Eps)
+ Tmp1=Out
+ Out=list()
+ for(ii in Looprange(1,length(Tmp1))){
+ Tmp2=Op(ii,Tmp1)
+ Tmp3=c()
+ for(jj in Looprange(1,Length(Tmp2))){
+ Tmp=Op(jj,Tmp2)
+ Tmp=XYZfunc(Tmp[1],Tmp[2])
+ if(Length(Tmp3)>0){
+ if(Norm(Op(Length(Tmp3),Tmp3)-Tmp)<Eps){next}
+ }
+ Tmp3=Appendrow(Tmp3,Tmp)
+ }
+ Out=c(Out,list(Tmp3))
+ }
+ Out=Crv3onsfparadata(Out,Fbdy3,Fd,Np,Eps,Eps2)
+ return(Out)
+}
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r
index 37033948..37033948 100644
--- a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r
new file mode 100644
index 00000000..dc54682b
--- /dev/null
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r
@@ -0,0 +1,14614 @@
+# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
+#
+#This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>
+
+
+#########################################
+
+ThisVersion<- "KeTpic for R v5_2_4(20180327)"
+
+print(ThisVersion)
+
+# 20180402
+# Implicitplot greatly changed
+# 20180327
+# Kyoukai debugged
+# 20180317
+# IntersectcurvesPp changed and debugged
+# Intersectpartseg changed (Eps00 )
+# Collectsameseg added, Collectnear commented out
+# 20180306
+# PthiddenQ,Meetpoints,Sfcutparadata changed (to avoid duplications )
+# Sfbdparadata changed ( for near points in Implicitdata )
+# Envelopedata, Evlpfun added
+# 20180305
+# (for surface drwaings ) Eps => Eps1
+# 2018.02.27
+# Nohiddenpara2,Crvsfparadara debugged (Eps=>Eps0)
+# 2018.02.26
+# Sfcutparadata changed
+# Partcrv3 debugged
+# Projcurve rewritten
+# Nohiddenparadata debugged
+# PthiddenQ debugged
+# 2018.02.24
+# Sfcutdata added ( for functions )
+# Meetpoints debugged (case Norm(PtB-PtA)<Eps0)
+# 2018.02.23
+# Makevaltable2 added ( for functions )
+# 2018.02.23
+# Crvonsfparadata,Crv3onsfparadata added
+# Wireparadata added
+# 2018.02.22
+# PthiddenQ,Nohiddenpara2 changed (Eps2)
+# 2018.02.21
+# PthiddenQ,Meetpoints debugged
+# Crvsfparadata debugged (OTHERPARTITION)
+# Partitionseg debugged (for non-list) and changed (Ns=0)
+# Intersectcrvsf added
+# 2018.02.19
+# Groupnearpt added
+# Collectnear debugged
+# Meetpoints,PthiddenQ debugged and changed (Groupnearpt used )
+# Parapt changed (for point list )
+# Partitionseg changed (remove close value )
+# Fullformfunc changed (Initialization of ADDPOINT)
+# Addpoints added
+# 2018.02.18
+# Projpara debugged ( for empty data, Mix replace )
+# WriteOutData debugged (for emply data )
+# Sfbdparadata,Cuspparadata debugged
+# Meetpoints replaced
+# 2018.02.17
+# PthiddenQ replaced
+# 2018.02.15
+# Cancoordpara debugged (X=-... )
+# 2018.02.14
+# Paramoncrv,Pointoncrv renamed to ...curve
+# 2018.02.12
+# Nohiddenpara2 debugged ( CUSPPT should be a list )
+# Dropnumlistcrv changed (Eps)
+# 2018.02.11
+# Paramocrv debugged ( case N=Length(PtL) )
+# Sfbdparadata, Borderparadata, Makexybdy, Partitionseg,
+# Evlptablepara, Fullformfunc, Dropnumlistcrv, Cuspsplitpara,
+# PthiddenQ, Nohiddenpara2 added
+# Crvsfparadata, Meetpoints, Clipdomain added
+# 2018.02.10
+# Partcrv3 debugged
+# 2018.02.09
+# Ptstart,Ptend changed ( for the case fig is empty)
+# Norm changed (Dotprod used )
+# 2018.02.07
+# Collectnear debugged (Looprange )
+# Intersectcurves debugged (sum)
+# 2018.02.06
+# Kukeiiwake debugged ( ParamonCurve -> Paramoncrv )
+# 2018.02.05
+# Dotprod changed ( crossprod not used )
+# Intersectpartseg changed ( case of length of result =1)
+# 2018.02.04
+# Diff added ( func, withvar, (varnamevalue1,... ))
+# Funvalue added ( for an expression )
+# 2018.02.02
+# Enclosing2 changed ( for distant curves, startpt option removed )
+# 2018.02.01
+# Intersectline,Intersectseg,...,Intersectcuves added
+# Quicksort added
+# Enclosing2 added (incomplete)
+# 2018.01.29
+# Length added
+# 2017.12.24
+# Objpolyhedron added
+# 2017.12.23
+# Objsymb, symb3data added
+# Objrecs, Objpolygon debugged
+# Objthicksurf added
+# 2017.12.22
+# Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added
+# Crossprod added
+# Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added
+# Spacecurve debugged
+# 2017.12.17
+# Setunitlen debugged ( MEMORI )
+# 2017.12.13
+# ReadOutData debugged
+# 2017.12.11
+# Enclosing debugged ( appendrow -> Appendrow )
+# 2017.11.29
+# Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included )
+# 2017.11.27
+# Anglemark changed ( Scilab 16.12.29)
+# Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13)
+# Enclosing changed ( Scilab 16.10.09)
+# Arrowhead,Arrowline changed ( Scilab 15.06.11)
+# Definecolor added ( Scilab 15.05.04)
+# 2017.11.26
+# Exprrot, Letterrot debugged ( `)
+# 2017.11.24
+# Deqplot debugged (Looprange)
+# 2017.11.20
+# InWindow debugged (for length=1)
+# 2017.10.28
+# Openfile changed (Creator)
+# 2017.10.23
+# ReadOutData greatly changed
+# 2017.10.11
+# Drwpt debugged (Flattenlist )
+# 2017.10.08
+# Bezier debugged ( Num )
+# 2017.10.07
+# ReadOutData debugged ( for null data )
+# 2017.10.06
+# Deqdata, Deqplot added
+# Connectseg remade(bug)
+# 2017.09.30
+# Bezierpt, Bezier added
+# 2017.09.29
+# Ptcrv debugged
+# 2017.09.28
+# Openfile changed
+# 2017.09.24
+# Circledata debugged
+# Kyoukai changed (Eps)
+# Shade updated
+# 2017.09.22
+# Setcolor changed
+# Plotdata,Paramplot,Spacecurve changed (N-1 -> N)
+# 2017.09.21
+# Shade changed (Sci 17.01.09)
+# 2017.09.17
+# Ovaldata,Assignadd changed
+# Dist added
+# Cicledata changed
+# Bowdata debugged (Circledata,etc)
+
+# 2015.11.05
+# WriteOutData changed
+
+# 2015.10.29
+# WriteOutData changed ( endmark //// )
+
+# 2015.10.24
+# ReadOutData changed ( in case of listlength=1 )
+
+# 2014.12.23
+# ReadOutData added
+
+# 2014.12.17
+# WriteOutData added
+
+# 2014.0905
+# Unscaling debugged MARKLENI => MARKLEN
+# 2014.03.31
+# PhHiddenData added
+# 2014.03.30
+# Facesdata changed ( for Hiddendata )
+# 2014.03.23
+# MARKLEN separated, Rotate3data debugged
+
+# 2013.12.19
+# Openfile, Closefile, Bowname, Bownamerot
+
+# 2013.11.13
+# Arrowhead, Arrowheaddata
+
+# 2013.08.07
+# Cancoordpara added
+
+# 2013.08.07
+# Integrate added
+
+# 2013.05.20
+# Openfile changed
+
+# 2013.05.03
+# Tabledata, Pointdata changed
+# Dividetable, Partframe added
+
+# 2013.02.10
+# Ketinit added
+
+# 2012.01.07
+# Arrowline, Arrowhead ( Cut implemented )
+
+# 2011.12.18
+# Framedata ( compliant for list )
+
+# 2011.12.12
+# Skeletonparadata... ( Flattellist used)
+
+# 2011.11.27
+# drwboxframe
+
+# 2011.11.07
+# metacommands added
+
+# 2011.11.02
+# Joingraphics ( for list structure )
+
+# 2011.08.24
+# Setcolor ( c(1,0,0,0.5) etc )
+# Rotate3data ( Point is available )
+
+# 2011.07.19
+# Drwline, Letter, Expr
+# Drwboxplot( etc ) min,max => outliners
+# Drwline ( unfinished in the case of "integer" )
+
+# 2011.06.25
+# joincrvs debugged
+
+# synchro with ketpict2e
+
+# 2011.06.01
+# Bowdata debugged
+
+#2011.05.28
+# Ratiocmyk, Setcolor ( new )
+
+#2011.04.28
+# Htickmark, Vtickmark debugged
+
+#2011.03.08
+# Drwboxframe debugged
+# Putrow, Putrowexpr debugged (Dpos )
+
+#2011.03.02
+# Tabledata ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged
+# Texcom changed ( // => backslash )
+
+#2011.01.07
+# Dividegraphics, Splinedat are changed significantly
+# Readtextdata is changed
+
+#2011.01.04
+# Derivative, Integrate are added
+
+#2010.12.07
+# Translatedata, Scaledata, Reflectdata changed ( efficient for vector )
+# Rotatedata changed ( deg : logical )
+# HIstplotdata, Drwhistplot ( type => freq , fpplot (added) )
+
+# 2010.12.04
+# WindispT changed ( tickmark )
+# Lineplot changed ( mag=> length )
+# Plotdata debugged ( 'E=fun', 'D=')
+# Enclosing changed (return PD)
+
+# 2010.12.02
+# WindispT changed
+# Makecurves debugged
+
+# 2010.11.27
+# Pointdata changed ( efficient for matrix and data.frame )
+# WindispT
+# Setwindow ( decide from data )
+# Assign debugged ( strsplit => gsub(fixed=T))
+
+# 2010.11.20
+# Flattenlist, WindispT
+# Splinedata changed( efficient for data.frame )
+
+#2010.08.19 ( Maybe not finished )
+# Stripblanks
+# Fullformfunc, Sf3data
+
+#2010.08.17
+# Phparadata, Phpersdata, Phspersdata, Phsparadata
+# Facesdata, MakeveLfaceL, Menkakusi2
+# Rotate3data
+# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata
+# Embed
+
+#2010.08.16
+# Spacecurve changed
+# CameracoordCurve, Partcrv3, Projpers, CameraCurve,
+# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt
+
+# 2010.08.15
+# Phcutoffdata added
+
+# 2010.08.13
+# Phcutdata, Spacecurve debugged
+# Setangle changed
+
+# 2010.08.09
+# Spacecurve
+# Rotate3data, Rotate3pt
+# Phcutdata
+
+# 2010.08.08
+# Implementing 3d
+# Initangle, Setangle, Setpers, SetstereoL, SetstereoR
+# Mixlength
+# Spaceline, Projpara, ProjCurve, Parapt
+# Xyzax3data, Xyzaxparaname
+# Cancoordpers, Invparapt, ProjcoordCurve
+# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki
+
+# 2010.07.25
+# Rotatedata changed
+# Drwline changed (list of list)
+
+# 2010.04.09
+# Stat package added
+
+# 2010.04.02
+# Putcolexpr, Putrowexpr
+
+# 2010.04.02
+
+# Windisp, Op changed
+# Execmd added
+# Texnewcmd, Texrenewcmd, Texend,
+# Texctr, Texnewctr, Texsetctr
+# Kyoukai debugged
+
+# 2010.01.20
+# Partcrv, Makeshasen : debugged
+
+# 2010.01.23
+# Ovaldata, Ovalbox added
+
+# 2010.01.27
+# Readtextdata changed
+# Putrow, PutcoL debugged ( Putcol is OK)
+
+# 2010.01.31
+# Writetextdata added
+
+# 2010.02.12
+# Texvalctr, Texthectr added
+
+# 2010.02.22
+# Execmd changed
+
+# 2010.02.23
+# Op, Windisp changed
+
+# 2010.02.24
+# Execmd changed
+
+# 2010.03.07
+# Dotfilldata (Kosa>1)
+
+# 2010.03.21
+# Mixjoin
+# Koutenlist (bug)
+
+
+# 2010.03.24
+# Arrowhead ( bug in the case of "l" )
+
+# 2010.03.28
+# Tabledata
+# Diagcelldata ( New )
+
+# 2010.03.30
+# Tabledata
+
+###########################################
+
+XMIN<- -5
+XMAX<- 5
+YMIN<- -5 ; YMAX<- 5
+ZIKU<- "line"
+ARROWSIZE<- 1
+XNAME<- "$x$"
+XPOS<- "e"
+YNAME<- "$y$"
+YPOS<- "n"
+ONAME<- "O"
+OPOS<- "sw"
+ULEN<- "1cm"
+MilliIn<- 1/2.54*1000
+PenThick<- round(MilliIn*0.02)
+PenThickInit<- PenThick
+TenSizeInit<<- 0.02*2 #17.10.07
+TenSize<- TenSizeInit
+Wfile<-""
+MEMORI<- 0.05
+MEMORIInit<- MEMORI
+MEMORINow<- MEMORI
+MARKLEN<- 0.05
+MARKLENInit<- MARKLEN
+MARKLENNow<- MARKLEN
+GENTEN<- c(0,0)
+YaSize<- 1
+YaAngle<- 18
+YaPosition<- 1
+YaThick<- 1
+YaStyle<- "tf"
+PHI<- 30*pi/180
+THETA<- 60*pi/180
+FocusPoint<- c(0,0,0)
+EyePoint<- c(5,5,5)
+ASSIGNLIST<- list("`","'")
+
+SCALEX<- 1
+SCALEY<- 1
+LOGX<- 0
+LOGY<- 0
+
+TEXFORLEVEL<- 0
+TEXFORLAST<- list()
+
+#######################
+
+Ketinit<- function(){
+XMIN<<- -5
+XMAX<<- 5
+YMIN<<- -5 ; YMAX<<- 5
+ZIKU<<- "line"
+ARROWSIZE<<- 1
+XNAME<<- "$x$"
+XPOS<<- "e"
+YNAME<<- "$y$"
+YPOS<<- "n"
+ONAME<<- "O"
+OPOS<<- "sw"
+ULEN<<- "1cm"
+MilliIn<<- 1/2.54*1000
+PenThick<<- round(MilliIn*0.02)
+PenThickInit<<- PenThick
+TenSizeInit<<- 0.02*2 #17.10.07
+TenSize<<- TenSizeInit
+Wfile<<-""
+MEMORI<<- 0.05
+MEMORIInit<<- MEMORI
+MEMORINow<<- MEMORI
+MARKLEN<<- 0.05
+MARKLENInit<<- MARKLEN
+MARKLENNow<<- MARKLEN
+GENTEN<<- c(0,0)
+YaSize<<- 1
+YaAngle<<- 18
+YaPosition<<- 1
+YaThick<<- 1
+YaStyle<<- "tf"
+PHI<<- 30*pi/180
+THETA<<- 60*pi/180
+FocusPoint<<- c(0,0,0)
+EyePoint<<- c(5,5,5)
+ASSIGNLIST<<- list("`","'")
+
+SCALEX<<- 1
+SCALEY<<- 1
+LOGX<<- 0
+LOGY<<- 0
+
+TEXFORLEVEL<<- 0
+TEXFORLAST<<- list()
+}
+
+#-------------------------------------------------------
+
+Appendrow<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Out<-c()
+ Nc<- 0
+ for (I in 1:Nargs)
+ {
+ Dt<- varargin[[I]]
+ Nc<- max(Nc,Ncol(Dt))
+ if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt))
+ Out<- c(Out,Dt)
+ }
+ if(Nc>0)
+ {
+ Out<-matrix(Out, nrow=Nc)
+ Out<-t(Out)
+ }
+ else
+ {
+ Out<-c()
+ }
+ return(Out)
+}
+
+Datalength<-function(Data)
+{
+ if(length(Data)==0) return(0)
+ if(mode(Data)=="numeric") return(Nrow(Data))
+ if(mode(Data)=="character") return(nchar(Data))
+ if(mode(Data)=="list") return(length(Data))
+}
+
+Crossprod<- function (a,b){ # 17.12.22
+ if(length(a)==3){
+ Tmp1=a[2]*b[3]-a[3]*b[2]
+ Tmp2=a[3]*b[1]-a[1]*b[3]
+ Tmp3=a[1]*b[2]-a[2]*b[1]
+ Out=c(Tmp1,Tmp2,Tmp3)
+ }else{
+ Out=a[1]*b[2]-a[2]*b[1]
+ }
+ return(Out)
+}
+
+Dotprod<-function(a,b){ # 18.02.05
+ nn=min(length(a),length(b))
+ out=0
+ for(jj in Looprange(1,nn)){
+ out=out+a[jj]*b[jj]
+ }
+ return(out)
+}
+
+Dist<- function(...) # 17.09.17
+{
+ varargin<- list(...)
+ a=varargin[[1]]
+ if(length(varargin)==1){
+ tmp=sqrt(Dotprod(a,a))
+ return(as.vector(tmp))
+ }
+ else{
+ b=varargin[[2]]
+ tmp=sqrt(Dotprod(b-a,b-a))
+ retun(as.vector(tmp))
+ }
+}
+
+Member<-function(A,L)
+{
+ N<-length(L);
+ if(length(N)==0) return(FALSE)
+ for (I in 1:N)
+ {
+ if(class(L)=="list")
+ {
+ Tmp<-L[[I]]
+ }
+ else
+ {
+ Tmp<-L[I]
+ }
+ if(mode(A)=="numeric")
+ {
+ if(Norm(A-Tmp)==0) return(TRUE)
+ }
+ else
+ {
+ if(A==Tmp) return(TRUE)
+ }
+ }
+ return(FALSE)
+}
+
+Norm<-function(V)
+{
+ Tmp=Dotprod(V,V) #18.02.09
+# Tmp<-as.vector(V);
+# Tmp<-crossprod(Tmp,Tmp)
+ Tmp<-sqrt(Tmp)
+# as.numeric(Tmp)
+}
+
+Ncol<-function(P)
+{
+ if(class(P)=="matrix") return(ncol(P))
+ else return(length(P))
+}
+
+Nrow<-function(P)
+{
+ if(length(P)==0) return(0)
+ if(class(P)=="matrix") return(nrow(P))
+ else return(1)
+}
+
+Looprange<- function(a,b)
+{
+if(a<=b) return(a:b)
+return(c())
+}
+
+Stripblanks<- function(Ch){
+ Tmp<- gsub(" ","",Ch,fixed=TRUE)
+ return(Tmp)
+}
+
+Quicksort<- function(seqL,key){ #18.02.01
+ if(length(seqL)<2){
+ out=seqL
+ }else{
+ tmp1=Op(1,seqL)
+ tmp2=Op(2,seqL)
+ if(Op(key,tmp1)>=Op(key,tmp2)){
+ pivot = tmp1
+ }else{
+ pivot=tmp2
+ }
+ left = list()
+ right = list()
+ for(ii in 1:length(seqL)){
+ tmp=Op(ii,seqL)
+ if(Op(key,tmp)< Op(key,pivot)){
+ left=c(left,list(tmp))
+ }else{
+ right=c(right,list(tmp))
+ }
+ }
+ left = Quicksort(left,key)
+ right = Quicksort(right,key)
+ out=c(left,right)
+ }
+ return(out)
+}
+
+Derivative<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Fstr<- varargin[[1]]
+ Vstr<- varargin[[2]]
+ NvaL<- length(Vstr)
+ Flg<- 0
+ if(Nargs>=3){
+ VaL<- varargin[[3]]
+ Flg<- 1
+ }
+ Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="")
+ for(J in Looprange(2,NvaL)){
+ Str<- paste(Str,",'",Vstr[J],"'",sep="")
+ }
+ Str<- paste(Str,")",sep="")
+ if(NvaL<=3){
+ Str<- paste(Str,",func=TRUE)",sep="")
+ }
+ else{
+ Str<- paste(Str,")",sep="")
+ }
+ f<- eval(parse(text=Str))
+ if(Flg==1){
+ if(NvaL<=3){
+ if(NvaL==1){V<- f(VaL[1])}
+ if(NvaL==2){V<- f(VaL[1],VaL[2])}
+ if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])}
+ }
+ else{
+ for(J in 1:NvaL){
+ Tmp<- paste(Vstr[J],'<-',as.character(VaL[J]))
+ eval(parse(text=Tmp))
+ }
+ V<- eval(f)
+ }
+ Out<- attr(V,'gradient')
+ Out<- Out[1,]
+ }
+ else{
+ Out<- f
+ }
+ return(Out)
+}
+
+Diff<- function(...){ #18.02.04
+ varargin=list(...)
+ Nargs=length(varargin)
+ fun=varargin[[1]]
+ withvar=varargin[[2]]
+ tmp=paste("f<- expression(",fun,")",sep="")
+ eval(parse(text=tmp))
+ nn=nchar(withvar)
+ for(jj in Looprange(1,nn)){
+ tmp=substring(withvar,jj,jj)
+ f=D(f,tmp)
+ }
+ var=c()
+ val=""
+ for(jj in Looprange(3,Nargs)){
+ tmp=strsplit(varargin[[jj]],"=")
+ var=c(var,tmp[[1]][1])
+ val=paste(val,tmp[[1]][2],",",sep="")
+ }
+ if(Length(val)>1){
+ val=substring(val,1,Length(val)-1)
+ f=deriv(f,var,func=TRUE)
+ tmp=paste("out=f(",val,")",sep="")
+ out=eval(parse(text=tmp))
+ return(out[1])
+ }else{
+ return(f)
+ }
+}
+
+Funvalue<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ df=varargin[[1]]
+ var=c()
+ val=""
+ for(jj in Looprange(2,Nargs)){
+ tmp=strsplit(varargin[[jj]],"=")
+ var=c(var,tmp[[1]][1])
+ val=paste(val,tmp[[1]][2],",",sep="")
+ }
+ val=substring(val,1,Length(val)-1)
+ dfun=deriv(df,var,func=TRUE)
+ tmp=paste("out=dfun(",val,")",sep="")
+ eval(parse(text=tmp))
+ return(out[1])
+}
+
+Integrate<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Fstr<- varargin[[1]]
+ Vstr<- varargin[[2]]
+ IntvL<- varargin[[3]]
+ Str<- 'Tmpfun<- function('
+ Str<- paste(Str,Vstr,'){',sep='')
+ Str<- paste(Str,Fstr,'}',sep='')
+ eval(parse(text=Str))
+ Tmpfunv<- function(x){sapply(x,Tmpfun)}
+ Out<- 0
+ for (J in 1:(length(IntvL)-1)){
+ Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1])
+ Out<- Out+Tmp[[1]]
+ }
+ return(Out)
+}
+
+#--------------------------------------
+
+#########################
+
+Anglemark<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10^(-3)
+ PA<- varargin[[1]]
+ PB<- varargin[[2]]
+ PC=varargin[[3]]
+ r <- 0.5
+ if(Nargs>=4){
+ r<- varargin[[4]]*r
+ }
+ Out=c()
+ if(r>min(Norm(PA-PB),Norm(PC-PB))){
+ return(Out)
+ }
+ Cir<- Circledata(c(PB,r)) #17.11.29
+ Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB))
+ P1<- Op(2,Op(1,Tmp))
+ Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB))
+ P2<- Op(2,Op(1,Tmp))
+ if(abs(P1-P2)<Eps){
+ Out<-c()
+ return(Out)
+ }
+ if(P1<P2-Eps){
+ Out<- Partcrv(P1,P2,Cir)
+ }
+ else{
+ Tmp<- Numptcrv(Cir)
+ Tmp1<- Partcrv(P1,Tmp,Cir)
+ Tmp2<- Partcrv(1,P2,Cir)
+ Out<- Joincrvs(Tmp1,Tmp2)
+ }
+}
+
+##############################################
+
+Arrowdata<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ P<- varargin[[1]]
+ Q<- varargin[[2]]
+ R<- Q
+ Futosa<- YaThick
+ Ookisa<- YaSize
+ Thickness<- 1
+ Hiraki<- YaAngle
+ Yapos<- YaPosition
+ Position<- 1
+ Str<- YaStyle
+ Flg<- 0
+ for (I in Looprange(3,Nargs)){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric"){
+ if(length(Tmp)>1){
+ R<- Tmp
+ }
+ else{
+ if(Flg==0){
+ Ookisa<- Ookisa*Tmp
+ }
+ if(Flg==1){
+ if(Tmp<5){
+ Hiraki<- Tmp*Hiraki
+ }
+ else{
+ Hiraki<- Tmp
+ }
+ }
+ if(Flg==2){
+ R<- P+Tmp*(Q-P)
+ }
+ else{
+ R<- P+Yapos*(Q-P)
+ }
+ if(Flg==3){
+ Futosa<- Tmp
+ }
+ Flg<- Flg+1
+ }
+ }
+ if(mode(Tmp)=="character"){
+ Tmp<- grep("=", Tmp)
+ if(length(Tmp)>0){
+ eval(parse(text=Tmp))
+ Futosa<- Futosa*Thickness
+ R<- P+Position*(Q-P)
+ }
+ else{
+ Str<- Tmp
+ }
+ }
+ }
+ Tmp1<- Listplot(c(P,Q))
+ Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str)
+ Out<- Joingraphics(Tmp1,Tmp2)
+}
+
+######################################
+
+# 2013.11.13 No Intersect debugged
+
+Arrowhead<-function(...)
+{ ## Scaling is implemented
+ ## 12.01.08 Kirikomi
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ P<-varargin[[1]]
+ Houkou<-varargin[[2]]
+ Ookisa<-0.2*YaSize
+ Hiraki<-YaAngle
+ Futosa<-0.5*YaThick
+ Cut<- 0
+ Str<-YaStyle
+ Flg<- 0
+ for (I in Looprange(3,Nargs)){
+ Tmp<-varargin[[I]]
+ if(is.character(Tmp)){
+ Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from
+ if(length(Equal)>0){
+ Tmp1<- strsplit(Tmp,"=",fixed=TRUE)
+ Tmp2<- Tmp1[[1]]
+ if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){
+ Tmp<- paste("Cut=",Tmp2[2],sep="")
+ eval(parse(text=Tmp))
+ }
+ }else{
+ Str<- Tmp
+ } # 12.01.07 until
+ }
+ if(is.numeric(Tmp) && length(Tmp)==1){
+ if(Flg==0) Ookisa<-Ookisa*Tmp
+ if(Flg==1){
+ if(Tmp<5) Hiraki<-Tmp*Hiraki
+ else Hiraki<-Tmp
+ }
+ if(Flg==2) Futosa<-Tmp
+ Flg<-Flg+1
+ }
+ }
+ Ookisa<-1000/2.54/MilliIn*Ookisa
+ Theta<-Hiraki*pi/180
+ if(Nrow(Houkou)>1){
+ P<- Doscaling(P)
+ Houkou<- Doscaling(Houkou)
+ Tmp<-Nearestpt(P,Houkou)
+ A<-Tmp[[1]]
+ I<-floor(Tmp[[2]])
+ G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29
+ Flg<- 0 # 13.11.13
+ JL<-seq(I,1,by=-1)
+ for (J in JL){
+ B<-Ptcrv(J,Houkou)
+ Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G)
+ if(length(Tmp)>0){
+ Flg<- 1
+ break
+ }
+ A<-B
+ }
+ if(Flg==0){ # 13.11.13
+ print("Arrowhead may be too large (no intersect)")
+ return(P)
+ }
+ Houkou<-P-Op(1,Tmp[[1]])
+ Houkou<- Unscaling(Houkou)
+ P<- Unscaling(P)
+ }
+ P<- Doscaling(P)
+ Houkou<- Doscaling(Houkou)
+ Ev<--1/Norm(Houkou)*Houkou
+ Nv<-c(-Ev[2],Ev[1])
+ if(length(grep("c",Str))>0){
+ P<-P-0.5*Ookisa*cos(Theta)*Ev
+ }
+ if(length(grep("b",Str))>0){
+ P<-P-Ookisa*cos(Theta)*Ev
+ }
+ A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv
+ B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv
+ if(length(grep("l",Str))>0){
+ Tmp<-Listplot(list(A,P,B))
+ Tmp1<- Unscaling(Tmp)
+ Drwline(Tmp1,Futosa)
+ }
+ else{
+ C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07
+ Tmp<- Listplot(list(A,P,B,C,A)) # 12.01.07
+ Tmp1<- Unscaling(Tmp)
+ Shade(Tmp1)
+ Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20
+ Tmp1=Unscaling(Tmp)
+ Drwline(Tmp1,0.1) # 15.06.11, 15.06.14
+ }
+}
+
+############################################
+
+# 2013.11.13 No intersect debugged
+
+Arrowheaddata<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ P<- varargin[[1]]
+ Houkou<- varargin[[2]]
+ Ookisa<- 0.2*YaSize
+ Hiraki<- YaAngle
+ Futosa<- 0
+ Thickness<- 1
+ Str<- YaStyle
+ Flg<- 0
+ for (I in Looprange(3,Nargs)){
+ Tmp<-varargin[[I]]
+ if(mode(Tmp)=="character"){
+ Tmp1<-grep("=",Tmp)
+ if(length(Tmp1)>0){
+ eval(parse(text=Tmp))
+ Futosa<- Thickness
+ }
+ else{
+ Str<- Tmp
+ }
+ }
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(Flg==0) Ookisa<-Ookisa*Tmp
+ if(Flg==1){
+ if(Tmp<5) Hiraki<-Tmp*Hiraki
+ else Hiraki<-Tmp
+ }
+ if(Flg==2) Futosa<-Tmp
+ Flg<-Flg+1
+ }
+ }
+ Theta<- Hiraki*pi/180
+ if(Nrow(Houkou)>1){
+ P<- Doscaling(P)
+ Houkou<- Doscaling(Houkou)
+ Tmp<-Nearestpt(P,Houkou)
+ A<-Tmp[[1]]
+ I<-floor(Tmp[[2]])
+ G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29
+ Flg<- 0 # 13.11.13
+ JL<-seq(I,1,by=-1)
+ for (J in JL){
+ B<- Ptcrv(J,Houkou)
+ Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G)
+ if(length(Tmp)>0){
+ Flg<- 1
+ break
+ }
+ A<-B
+ }
+ if(Flg==0){ # 13.11.13
+ print("Arrowhead may be too large (no intersect)")
+ return(P)
+ }
+ Houkou<-P-Op(1,Tmp[[1]])
+ Houkou<- Unscaling(Houkou)
+ P<- Unscaling(P)
+ }
+ P<- Doscaling(P)
+ Houkou<- Doscaling(Houkou)
+ Ev<- -1/Norm(Houkou)*Houkou
+ Nv<- c(-Ev[2],Ev[1])
+ if(length(grep("c",Str))>0){
+ P<-P-0.5*Ookisa*cos(Theta)*Ev
+ }
+ if(length(grep("b",Str))>0){
+ P<-P-Ookisa*cos(Theta)*Ev
+ }
+ A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv
+ B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv
+ Tmp<- Listplot(A,P,B)
+ Out<- Unscaling(Tmp)
+ return(Out)
+}
+
+##########################################
+
+Arrowline<- function(...)
+{ # 12.01.07 kirikomi
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ P<- varargin[[1]]
+ Q<- varargin[[2]]
+ Futosa<- YaThick
+ Ookisa<- YaSize
+ Hiraki<- YaAngle
+ Yapos<- YaPosition
+ Cutstr<- "Cut=0"
+ Str<- YaStyle
+ Flg<- 0
+ for (I in Looprange(3,Nargs)){
+ Tmp<- varargin[[I]]
+ if(is.character(Tmp)){
+ Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from
+ if(length(Equal)>0){
+ Tmp1<- strsplit(Tmp,"=")
+ Tmp2<- Tmp1[[1]]
+ if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){
+ Tmp<- paste("Cut=", Tmp2[2],sep="")
+ Cutstr<- Tmp
+ }
+ }
+ else{
+ Str<- Tmp
+ } # 12.01.07 until
+ }
+ if(is.numeric(Tmp) && length(Tmp)==1){
+ if(Flg==0) Ookisa<- Ookisa*Tmp
+ if(Flg==1){
+ if(Tmp<5) Hiraki<- Tmp*Hiraki
+ else Hiraki<- Tmp
+ }
+ if(Flg==2) Yapos<- Tmp
+ if(Flg==3) Futosa<- Tmp
+ Flg<- Flg+1
+ }
+ }
+ R<- P+Yapos*(Q-P)
+ Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24
+ Drwline(Listplot(c(P,Tmp)),Futosa)
+ Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str)
+}
+
+#########################################
+
+Assign<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0){
+ ASSIGNLIST<<- list("`",Prime())
+ Out<- ASSIGNLIST
+ return()
+# return("Assign reset done");
+ }
+ L<- list("`","'")
+ if(Nargs%%2==0){
+ L<- Mixjoin(L,varargin)
+ ASSIGNLIST<<- L
+ Out<- L
+ return()
+# return("Assign set done");
+ }
+ if(Nargs==1){
+ Fnstr<- varargin[[1]]
+ if(nchar(Fnstr)==0){ # case of ""
+ L<- ASSIGNLIST
+ Out<- c()
+ for (I in seq(1,length(L),by=2)){
+ Tmp1<- L[[I]]
+ Tmp2<- L[[I+1]]
+ if(length(Tmp2)==1){
+ Tmp3<- as.character(Tmp2)
+ }
+ else{
+ if(mode(Tmp2)=="character"){
+ Tmp3<- Tmp2
+ }
+ else if(mode(Tmp2)=="list"){
+ Tmp3<- makeliststr(Tmp2)
+ }
+ else if(mode(Tmp2)=="numeric"){
+ Tmp3<- "c("
+ for (J in Looprange(1,length(Tmp2))){
+ Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="")
+ if(J<length(Tmp2)){
+ Tmp3<- paste(Tmp3,",",sep="")
+ }
+ }
+ Tmp3<- paste(Tmp3,")",sep="")
+ if(class(Tmp2)=="matrix"){
+ Nr<- as.character(nrow(Tmp2))
+ Tmp3<- paste("matrix(",Tmp3,"nrow=",Nr,")",sep="")
+ }
+ }
+ }
+ Tmp<- paste(Tmp1,"=",Tmp3,sep="")
+ Out<- c(Out,Tmp)
+ }
+ return(Out);
+ }
+ if(substr(Fnstr,1,1)=="?"){
+ Fnstr<- substr(Fnstr,2,nchar(Fnstr))
+ for (I in seq(1,length(ASSIGNLIST),by=2)){
+ Tmp<- ASSIGNLIST[[I]]
+ if(Tmp==Fnstr){
+ Out<- Mixjoin(list(I),ASSIGNLIST[I+1])
+ return(Out)
+ }
+ }
+ Out<- "Not found"
+ return(Out);
+ }
+ L<- ASSIGNLIST
+ }
+ else{
+ if(mode(varargin[[2]])=="numeric"){
+ Fnstr<- varargin[[Nargs]]
+ for (I in Looprange(1,Nargs-1)){
+ L[[I]]=varargin[[I]]
+ }
+ }
+ else{
+ Fnstr<- varargin[[1]]
+ for (I in Looprange(2,Nargs)){
+ L[[I-1]]<- varargin[[I]]
+ }
+ }
+ }
+ for (I in seq(1,length(L),by=2)){
+ Vname<- L[[I]]
+ Val<- L[[I+1]]
+ if(mode(Val)=="numeric"){
+ if(Nrow(Val)==1){
+ for (K in Looprange(1,length(Val))){
+ Tmp<- paste(Vname,"[", as.character(K),"]",sep="")
+ if(mode(Val[K])=="numeric"){
+ Tmp1<- paste("(",as.character(Val[K]),")",sep="")
+ }
+ else{
+ Tmp1<- Val[K]
+ }
+ Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE)
+ }
+ }
+ else{
+ for (J in Looprange(1,Nrow(Val))){
+ for (K in Looprange(1,Ncol(Val))){
+ Tmp<- paste(Vname,"(",as.character(J),",",as.character(K),")",sep="")
+ if(mode(Val[J,K])=="numeric"){
+ Tmp1<- paste("(",as.character(Val[J,K]),")",sep="")
+ }
+ else{
+ Tmp1<- Val[J,K]
+ }
+ Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE)
+ }
+ }
+ }
+ if(length(Val)==1){
+ Rep<- as.character(Val)
+ }
+ else{
+ Rep<-""
+ if(class(Val)=="matrix"){
+ Rep<- "matrix("
+ }
+ Rep<- paste(Rep,"c(",sep="")
+ for (J in Looprange(1,length(Val))){
+ Rep<- paste(Rep,as.character(Val[J]),sep="")
+ if(J<length(Val)){
+ Rep<- paste(Rep,",",sep="")
+ }
+ else{
+ Rep<- paste(Rep,")",sep="")
+ }
+ }
+ if(class(Val)=="matrix"){
+ Rep<- paste(Rep,",nrow=",as.character(nrow(Val)),")",sep="")
+ }
+ }
+ Tmp1<- paste("(",Rep,")",sep="")
+ }
+ if(mode(Val)=="character"){
+ Tmp1<- Val
+ }
+ if(mode(Val)=="list"){
+ Tmp1<- Makeliststr(Val)
+ }
+ Fnstr<- gsub(Vname,Tmp1,Fnstr,fixed=TRUE) # 10.11.20
+ }
+ return(Fnstr)
+}
+
+#########################################
+
+Assignadd<- function(...)
+{
+ varargin<- list(...)
+ L<- ASSIGNLIST
+ L<- Mixjoin(L,varargin)
+ ASSIGNLIST<<- L
+# return("assign add done"); #17.09.17
+}
+
+#########################################
+
+Assignrep<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ L<- ASSIGNLIST
+ for (I in seq(1,Nargs,by=2)){
+ Vname<- varargin[[I]]
+ Val<- varargin[[I+1]]
+ Tmp1<- paste("?",Vname,sep="")
+ Tmp<- Assign(Tmp)
+ if(mode(Tmp)=="character"){
+ next
+ }
+ I<- Tmp[[1]]
+ L<- Mixjoin(L,list(Val))
+ }
+ ASSIGNLIST<<- L
+}
+
+#########################################
+
+ Assignset<- function(...)
+{
+ Assign(...)
+}
+
+#########################################
+
+Beginpicture<-function(ul)
+{ ## Scaling is implemented
+ Tmp<- Doscaling(c(XMIN,YMIN))
+ Xm<- Tmp[1]
+ Ym<- Tmp[2]
+ Tmp<- Doscaling(c(XMAX,YMAX))
+ XM<- Tmp[1]
+ YM<- Tmp[2]
+ Dx<- XM-Xm
+ Dy<- YM-Ym
+ Sym<-".0123456789 +-*/"
+ SL<-Sym
+ OL<-"+-*/"
+ if(ul!=""){
+ ULEN<<-ul;
+ }
+ Is<-1;
+ VL<-"";
+ Ucode<-ULEN
+ for (I in Looprange(1,nchar(Ucode))){
+ C<-substring(Ucode,I,I);
+ if(length(grep(C,SL))>0){
+ if(length(grep(C,OL))>0){
+ Tmp<-substring(Ucode,Is,I-1);
+ Str<-paste(VL,Tmp,C,sep="")
+ VL<-Str
+ Is<-I+1;
+ }
+ }
+ else{
+ Unit<-substring(Ucode,I,I+1)
+ Str<-substring(Ucode,Is,I-1)
+ VL<-paste(VL,Str,sep="")
+ break;
+ }
+ }
+ Valu<-eval(parse(text=VL))
+ Str<-as.character(Valu);
+ ULEN<<- paste(Str,Unit,sep="")
+ if(Unit=="cm") MilliIn<<-1000/2.54*Valu
+ if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10
+ if(Unit=="in") MilliIn<<-1000*Valu
+ if(Unit=="pt") MilliIn<<-1000/72.27*Valu
+ if(Unit=="pc") MilliIn<<-1000/6.022*Valu
+ if(Unit=="bp") MilliIn<<-1000/72*Valu
+ if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
+ if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu;
+ if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
+ MARKLEN<<- MARKLENNow*1000/2.54/MilliIn;
+ Str<-paste("{\\unitlength=",ULEN,"%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("\\begin{picture}%\n",file=Wfile,append=TRUE)
+ Str<-"("
+ Tmp<-as.character(round(Dx,digits=6))
+ Str<-paste(Str,Tmp,",",sep="")
+ Tmp<-as.character(round(Dy,digits=6))
+ Str<-paste(Str,Tmp,")(",sep="")
+ Tmp<-as.character(round(Xm,digits=6))
+ Str<-paste(Str,Tmp,",",sep="")
+ Tmp<-as.character(round(Ym,digits=6))
+ Str<-paste(Str,Tmp,")%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+}
+
+#################################################
+
+Bowdata<- function(...) #17.09.17
+{
+ varargin <- list(...)
+ Nargs <- length(varargin)
+ PA <- varargin[[1]]
+ PB <- varargin[[2]]
+ Cut <- 0
+ D <- 1/2*Norm(PB-PA)
+ if(Nargs>=3) {
+ H <- varargin[[3]]*D*0.2
+ }
+ else {
+ H <- D*0.2
+ }
+ H <- min(H,D)
+ if(Nargs>=4){
+ Cut <- varargin[[4]]
+ }
+ Ydata <- MakeBowdata(PA,PB,H)
+ C <- Op(1,Ydata)
+ r <- Op(2,Ydata)
+ R1 <- Op(3,Ydata)
+ R2 <- Op(4,Ydata)
+ Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="")
+ Theta <- (R1+R2)*0.5
+ BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta)
+ M <- Op(1,BOWMIDDLE)
+ ThetaM <- Op(2,BOWMIDDLE)
+ BOWSTART <<- PA
+ BOWEND <<- PB
+ if(Cut==0){
+ Pd<- Circledata(c(C,r),Rng)
+ }
+ else{
+ Alpha <- R1; Beta <- ThetaM-Cut/(2*r)
+ Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="")
+ Pd <- Circledata(c(C,r),Rng)
+ Alpha <- ThetaM+Cut/(2*r); Beta <- R2
+ Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="")
+ Tmp <- Circledata(c(C,r),Rng)
+ Pd <- Appendrow(Pd,c(Inf,Inf),Tmp)
+ }
+}
+
+Bowmiddle <- function(...)
+{
+ varargin <- list(...)
+ Nargs <- length(varargin)
+ if( Nargs==0) {
+ M <- BOWMIDDLE
+ return(M)
+ }
+ if(Nargs==1) {
+ Bdata <- varargin[[1]]
+ A <- Bdata[1,]
+ Dind <- Dataindex(Bdata)
+ Dc <- Nrow(Dind)
+ Tmp <- Dind[Dc,2]
+ B <- Bdata[Tmp,]
+ if(Dc==1) {
+ Tmp1 <- round(Tmp/2)
+ }
+ else {
+ Tmp1 <- Dind[1,2]
+ }
+ D <- Bdata[Tmp1,]
+ B <- B-A
+ D <- D-A
+ Tmp1 <- B[1]*D[2]-D[1]*B[2]
+ Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2
+ Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2
+ C <- c(Tmp2,Tmp3)/Tmp1+A
+ R <- Norm(C-A)
+ B <- B+A
+ V <- (A+B)/2-C
+ V <- V/Norm(V)
+ M <- C+R*V
+ }
+ else {
+ A <- varargin[[1]]; B <- varargin[[2]]
+ D <- 1/2*Norm(B-A)
+ H <- 0.2*D;
+ if(length(varargin)>=3) {
+ Tmp <- varargin[[3]]
+ H <- Tmp*D*0.2
+ }
+ H <- min(H,D)
+ Ydata <- MakeBowdata(A,B,H)
+ C <- Op(1,Ydata)
+ R <- Op(2,Ydata)
+ T <- (Op(3,Ydata)+Op(4,Ydata))/2
+ P <- C+R*c(cos(T),sin(T))
+ #M <- list(P,T)
+ M <- P
+ }
+ return(M)
+}
+
+##########################
+# 13.12.19 small movement supported
+
+Bowname<- function(...)
+{
+ varargin <- list(...)
+ Nargs <- length(varargin)
+ Siki <- varargin[[Nargs]]
+ Nargs<- Nargs-1
+ Dr<- "c"
+ if(Nargs>=1){
+ Tmp<- varargin[[Nargs]]
+ if(is.character(Tmp)){
+ Dr<- Tmp
+ Nargs<- Nargs-1
+ }
+ }
+ if(Nargs==0){
+ Siki <- varargin[[1]]
+ P <- Op(1,BOWMIDDLE)
+ }
+ else if(Nargs==1){
+ Bdata <- varargin[[1]]
+ P <- Bowmiddle(Bdata)
+ }
+ else{
+ A <- varargin[[1]]; B <- varargin[[2]]
+ D <- 1/2*Norm(B-A)
+ Tmp <- varargin[[3]]
+ if(is.character(Tmp)){
+ H <- D*0.2
+ }
+ else {
+ H <- Tmp*D*0.2
+ }
+ H <- min(H,D)
+ Ydata <- MakeBowdata(A,B,H)
+ Tmp <- Bowmiddle(Ydata)
+ P <- Op(1,Tmp)
+ }
+ Expr(P,Dr,Siki)
+}
+
+##########################
+# 13.12.19 small movement supported
+# A,B, ... no longer supported
+
+Bownamerot <- function(...)
+{
+ varargin <- list(...)
+ Nargs <- length(varargin)
+ Eps <- 10^(-6)
+ Flg <- 1
+ Tmp <- varargin[[Nargs]]
+ if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){
+ Flg <- Tmp
+ Nargs <- Nargs-1
+ }
+ Siki <- varargin[[Nargs]]
+ Nargs<- Nargs-1
+ Dr<- "c"
+ if(Nargs>=1){
+ Tmp<- varargin[[Nargs]]
+ if(is.character(Tmp)){
+ Dr<- Tmp
+ Nargs<- Nargs-1
+ }
+ }
+ if(Nargs==0) {
+ P <- Op(1,BOWMIDDLE)
+ A <- BOWSTART
+ B <- BOWEND
+ }
+ else{
+ Bdata<- varargin[[1]]
+ P<- Bowmiddle(Bdata)
+ A=Bdata[1,]
+ B=Bdata[nrow(Bdata),]
+ Tm<- 0; Tv<- 0
+ if(Nargs>1){
+ Tm<- varargin[[2]]
+ if(Nargs>2){
+ Tv<- varargin[[3]]
+ }
+ }
+ }
+# else if(Nargs==2) {
+# Bdata <- varargin[[1]]
+# P <- Bowmiddle(Bdata)
+# A <- Bdata[1,]
+# B <- Bdata[Nrow(Bdata),]
+# Siki <- varargin[[2]]
+# }
+# else {
+# A <- varargin[[1]]; B <- varargin[[2]]
+# D <- 1/2*Norm(B-A)
+# Tmp <- varargin[[3]]
+# if(mode(Tmp)=="character") {
+# H <- 0.2*D; Siki <- Tmp
+# }
+# else {
+# H <- Tmp*D*0.2; Siki <- varargin[[4]]
+# }
+# H <- min(H,D)
+# Ydata <- MakeBowdata(A,B,H)
+# C <- Op(1,Ydata)
+# R <- Op(2,Ydata)
+# T <- (Op(3,Ydata)+Op(4,Ydata))/2
+# P <- C+R*c(cos(T),sin(T))
+# }
+ if(A[1]>B[1]+Eps){
+ Tmp <- A
+ A <- B
+ B <- Tmp
+ }
+ if(Flg>0) {
+ Tmp <- B-A
+ }
+ else{
+ Tmp <- A-B
+ }
+ Exprrot(P,Tmp,Tm,Tv,Siki)
+}
+
+CalcHeight<-function(Hoko,Moji)
+{
+ D<-0
+ H<-substring(Hoko,1,1)
+ Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="")
+ Str<-c(Tmp)
+ Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="")
+ Str<-c(Str,Tmp)
+ if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}")
+ if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}")
+ if(H=="c")
+ {
+ Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}")
+ Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}")
+ Str<-c(Str,"\\addtolength{\\Height}{\\Depth}")
+ }
+ for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+}
+
+#########################
+
+CalcWidth<-function(Hoko,Moji)
+{
+ D<-0;
+ H<-substring(Hoko,2,2)
+ if(H=="e") D<-0
+ if(H=="w") D<--1.0
+ if(H=="c") D<--0.5
+ Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="")
+ Tmp<-as.character(D)
+ Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="")
+ cat(Str1,file=Wfile,append=TRUE)
+ cat(Str2,file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+}
+
+#########################
+# 17.09.17
+# 17.09.24
+
+Circledata<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Cr<- varargin[[1]]
+ C=Cr[1:2]
+ if(length(Cr)==4){
+ ra=Norm(C-Cr[3:4])
+ Nop=2
+ }
+ else{
+ ra=Cr[3]
+ Nop=2
+ }
+ R=c(0,2*pi)
+ N=50
+ for (I in Looprange(Nop,Nargs)){
+ Tmp<- varargin[[I]]
+ if(is.character(Tmp)){
+ Tmp1=regexpr("=",Tmp) #17.09.24from
+ Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp))
+ Tmp1=substring(Tmp,1,Tmp1)
+ Tmp1=gsub("NUM", "N", toupper(Tmp1))
+ Tmp1=gsub("RNG", "R", Tmp1)
+ Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24until
+ eval(parse(text=Tmp))
+ }
+ }
+ Dt<- (R[2]-R[1])/N
+ T <- seq(R[1],R[2],by=Dt)
+ X <- C[1]+ra*cos(T)
+ Y <- C[2]+ra*sin(T)
+ XY<- c(X,Y)
+ P<- matrix(XY,ncol=2)
+ return(P)
+}
+
+#########################
+# 13.12.19
+
+Closefile<-function(...)
+{
+ varargin<- list(...)
+ if(length(varargin)>=1){
+ Pa<- varargin[[1]]
+ if(is.character(Pa)){
+ if(Pa=="1") Endpicture(1)
+ if(Pa=="0") Endpicture(0)
+ }
+ }
+ Wfile<<-""
+}
+
+#########################
+
+Closepar<- function()
+{
+ S<- "%\n\\end{minipage}"
+ cat(S,file=Wfile,append=TRUE)
+ Closephr()
+}
+
+
+####################################
+
+Closephr<- function()
+{
+ cat("%\n}%\n",file=Wfile,append=TRUE)
+}
+
+#####################################
+
+Dataindex<-function(P)
+{
+ # Inf;Inf : Terminator
+ Ndm<-c()
+ if(length(P)==0) return(Ndm)
+ N1<-1
+ Flg<-0
+ for (J in 1:Nrow(P))
+ {
+ if(P[J,1]==Inf)
+ {
+ Ndm<-Appendrow(Ndm,c(N1,J-1))
+ N1<-J+1;
+ if(P[N1,1]==Inf)
+ {
+ Flg<-1;
+ break;
+ }
+ }
+ }
+ if(Flg==0)
+ {
+ Ndm<-Appendrow(Ndm,c(N1,Nrow(P)))
+ }
+ if(class(Ndm)=="numeric")
+ {
+ Tmp<-matrix(Ndm,nrow=1)
+ Ndm<- Tmp
+ }
+ return(Ndm)
+}
+
+################################
+
+Dashline<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Nall<- Nargs; Sen<- 1 ; Gap<- 1
+ Tmp<- varargin[[Nall]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){
+ Tmp1<- varargin[[Nall-1]]
+ if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){
+ Sen<- Tmp1; Gap<- Tmp
+ Nall<- Nall-2
+ }
+ else{
+ Sen<- Tmp; Gap<- Sen
+ Nall<- Nall-1
+ }
+ }
+ Sen<- 1000/2.54/MilliIn*Sen
+ Gap<- 1000/2.54/MilliIn*Gap
+ for (N in Looprange(1,Nall)){
+ Pdata<- varargin[[N]]
+ if(is.numeric(Pdata)==1){
+ Pdata<- list(Pdata)
+ }
+ for (II in 1:length(Pdata)){
+ Figdata<- Op(II,Pdata)
+ Makehasen(Figdata,Sen,Gap,0)
+ }
+ }
+}
+
+##############################################
+# 17.11.27
+
+Definecolor<- function(Name,Data){
+ Tmp1=length(Data)
+ if((Tmp1<3) || (Tmp1>4)){
+ cat("Size of data should be 3 or 4.")
+ return()
+ }
+ if(Tmp1==4){
+ Tp="cmyk"
+ }else{
+ Tp="rgb"
+ }
+ Tmp=""
+ for(J in 1:Tmp1){
+ Tmp=paste(Tmp, as.character(Data[J]),sep="")
+ if(J<Tmp1){
+ Tmp=paste(Tmp,",",sep="")
+ }
+ }
+ Tmp=paste("\\definecolor{",Name,"}{",Tp,"}{",Tmp,"}",sep="")
+ Texcom(Tmp)
+}
+
+##############################################
+
+Diagcelldata<- function(Tb,Nc,Nr)
+{
+ Tmp<- Findcell(Tb,Nc,Nr)
+ C<- Tmp[[1]]
+ Dx<- Tmp[[2]]
+ Dy<- Tmp[[3]]
+ Pne<- C+c(Dx,Dy)
+ Pnw<- C+c(-Dx,Dy)
+ Psw<- C+c(-Dx,-Dy)
+ Pse<- C+c(Dx,-Dy)
+ Tmp1<- Listplot(Pnw,Pse)
+ Tmp2<- Listplot(Pne,Psw)
+ list(Tmp1,Tmp2)
+}
+
+##############################################
+# 11.01.07
+
+Dividegraphics<- function(Pd)
+{
+ if(length(Pd)==0){
+ return(Pd)
+ }
+ DtL<- Flattenlist(Pd)
+ OutL<- list()
+ for (J in 1:length(DtL)){
+ Dt<- as.matrix(DtL[[J]])
+ Ndm<- Dataindex(Dt)
+ for (I in Looprange(1,Nrow(Ndm))){
+ Fd<- Dt[Ndm[I,1]:Ndm[I,2],]
+ OutL<- c(OutL,list(Fd))
+ }
+ }
+ return(OutL)
+}
+
+##############################################
+# 13.05.03
+
+Dividetable<- function(Tb)
+{
+ G<- Tb[[1]]
+ Gw<- G[[1]]
+ Gt<- G[Tb[[2]]]
+ Gy<- G[Tb[[3]]]
+ list(Gw,Gt,Gy)
+}
+
+################################################
+
+Doscaling<- function(G)
+{
+ GLg<- G
+ if(class(GLg)=="numeric")
+ {
+ if(LOGX==1) GLg[1]<- log(G[1], base=10)
+ if(LOGY==1) GLg[2]<- log(G[2], base=10)
+ Tmp<-c(SCALEX*GLg[1],SCALEY*GLg[2])
+ return(Tmp)
+ }
+ else
+ {
+ if(LOGX==1) GLg[,1]<- log(G[,1],base=10)
+ if(LOGY==1) GLg[,2]<- log(G[,2],base=10)
+ Tmp1<-matrix(c(SCALEX,0,0,SCALEY),nrow=2)
+ Tmp<-GLg %*% Tmp1
+ return(Tmp)
+ }
+}
+
+########################################
+
+Dotfilldata<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ ShaL<- list()
+ Eps<- 0.01
+ Kakudo<- 45
+ Kosa<- 0.5
+ Tmp<- Doscaling(c(XMIN,YMIN))
+ Xmn<- Tmp[1]; Ymn<- Tmp[2]
+ Tmp<- Doscaling(c(XMAX,YMAX))
+ Xmx<- Tmp[1]; Ymx<- Tmp[2]
+ for (N in seq(Nargs,1,by=-1)){
+ Tmp<- varargin[[N]]
+ if(Mixtype(Tmp)!=1){
+ break
+ }
+ }
+ if(N<Nargs){
+ Kosa<- varargin[[N+1]]
+ }
+# Kosa<- min(Kosa,1)
+ Tmp<- 1/(2*Kosa)
+ Kankaku<- Tmp*0.100*1000/2.54/MilliIn
+ NaitenL<- varargin[[1]]
+ if(Mixtype(NaitenL)==1){
+ NaitenL<- list(NaitenL)
+ }
+ Ns<- 2
+ StartP<- Op(1,NaitenL)
+ if(mode(StartP)=="character"){
+ StartP<- c((Xmn+Xmx)/2,(Ymn+Ymx)/2)
+ }
+ else{
+ StartP<- Doscaling(StartP)
+ }
+ Tmp<- varargin[[2]]
+ if(Mixtype(Tmp)==1){
+ StartP<- Doscaling(Tmp)
+ Ns<- 3
+ }
+ Tmp<- list()
+ for (I in Looprange(Ns,N)){
+ Tmp<- Mixjoin(Tmp,list(varargin[[I]]))
+ }
+ Bdy<- Kyoukai(Tmp)
+ Bdys<-list()
+ for (I in 1:length(Bdy)){
+ Tmp1<- Bdy[[I]]
+ Tmp2<- Doscaling(Tmp1)
+ Bdys<- Mixjoin(Bdys,list(Tmp2))
+ }
+ Bdy<- Bdys
+ PtnL<- list()
+ for (I in Looprange(1,length(NaitenL))){
+ Tmp<- Op(I,NaitenL)
+ if(mode(Tmp)=="numeric"){
+ Tmp1<- Naigai(Tmp,Bdy)
+ PtnL<- Mixjoin(PtnL,list(Tmp1))
+ }
+ else{
+ if(mode(Tmp)!="character"){
+ return("Mode Error")
+ }
+ Ptn<- c()
+ for (J in Looprange(1,nchar(Tmp))){
+ if(substr(Tmp,J,J)=="i"){
+ Ptn<- c(Ptn,1)
+ }
+ else{
+ Ptn<- c(Ptn,0)
+ }
+ }
+ PtnL<- Mixjoin(PtnL,list(Ptn))
+ }
+ }
+ Call<- length(Bdy)
+ Ptn<- c(seq(0, 0, length=Call))
+ if(Member(Ptn,PtnL)){
+ Wn<- Doscaling(Framedata())
+ Bdy<- Mixjoin(Bdy,list(Wn))
+ Tmp<- list()
+ for (I in Looprange(1,length(PtnL))){
+ Tmp1<- c(Op(I,PtnL),1)
+ Tmp<- Mixjoin(Tmp,list(Tmp1))
+ }
+ PtnL<- Tmp
+ }
+ V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180))
+ Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180))
+ Tmp<- Op(1,NaitenL)
+ if(mode(Tmp)=="numeric" && length(Tmp)==2){
+ Tmp<- Doscaling(Tmp)
+ Delta<- Tmp-StartP
+ K<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ PA<- StartP+K*Kankaku*Vm
+ P<- PA
+ Sha<- Makeshasen(PtnL,P,V,Bdy)
+ Sha<- Dividegraphics(Sha)
+ I<- 1
+ while (length(Sha)>0){
+ for (J in Looprange(1,length(Sha))){
+ Tmp<- Op(J,Sha)
+ Q<- Tmp[1,]
+ R<- Tmp[2,]
+ Tmp<- Dotprod(Q-P,V)/Kankaku
+ K1<- ceiling(Tmp)
+ if(abs(K1-Tmp)<Eps) K1=K1+1
+ Tmp<- Dotprod(R-P,V)/Kankaku
+ K2<- floor(Tmp)
+ if(abs(Tmp-K2)<Eps) K2=K2-1
+ for (K in Looprange(K1,K2)){
+ Tmp1<- Pointdata(P+K*Kankaku*V)
+ ShaL<- Mixjoin(ShaL, list(Tmp1))
+ }
+ }
+ P<- PA+I*Kankaku*Vm
+ Sha<- Makeshasen(PtnL,P,V,Bdy)
+ Sha<- Dividegraphics(Sha)
+ I<- I+1
+ }
+ P<- PA-Kankaku*Vm
+ Sha<- Makeshasen(PtnL,P,V,Bdy)
+ I<- 2
+ while (length(Sha)>0){
+ for (J in 1:length(Sha)){
+ Tmp<- Op(J,Sha)
+ Q<- Tmp[1,]
+ R<- Tmp[2,]
+ Tmp<- Dotprod(Q-P,V)/Kankaku
+ K1<- ceiling(Tmp)
+ if(abs(K1-Tmp)<Eps) K1<- K1+1
+ Tmp<- Dotprod(R-P,V)/Kankaku
+ K2<- floor(Tmp)
+ if(abs(Tmp-K2)<Eps) K2<- K2-1
+ for (K in Looprange(K1,K2)){
+ Tmp1<- Pointdata(P+K*Kankaku*V)
+ ShaL<- Mixjoin(ShaL, list(Tmp1))
+ }
+ }
+ P<- PA-I*Kankaku*Vm
+ Sha<- Makeshasen(PtnL,P,V,Bdy)
+ I<- I+1
+ }
+ }
+ else{
+ Delta<- c(Xmn,Ymn)-StartP
+ K1<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ Delta<- c(Xmx,Ymn)-StartP
+ K2<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ Delta<- c(Xmx,Ymx)-StartP
+ K3<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ Delta<- c(Xmn,Ymx)-StartP
+ K4<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ IM<- max(K1,K2,K3,K4)
+ Im<- min(K1,K2,K3,K4)
+ for (I in Im:IM){
+ P<- StartP+I*Kankaku*Vm
+ Sha<- Makeshasen(PtnL,P,V,Bdy)
+ Sha<- Dividegraphics(Sha)
+ if(length(Sha)>0){
+ for (J in 1:length(Sha)){
+ Tmp<- Op(J,Sha)
+ Q<- Tmp[1,]
+ R<- Tmp[2,]
+ Tmp<- Dotprod(Q-P,V)/Kankaku
+ K1<- ceiling(Tmp)
+ if(abs(K1-Tmp)<Eps) K1=K1+1
+ Tmp<- Dotprod(R-P,V)/Kankaku
+ K2<- floor(Tmp)
+ if(abs(Tmp-K2)<Eps) K2=K2-1
+ for (K in Looprange(K1,K2)){
+ Tmp1<- Pointdata(P+K*Kankaku*V)
+ ShaL<- Mixjoin(ShaL, list(Tmp1))
+ }
+ }
+ }
+ }
+ }
+ ShaLs<-list()
+ for (I in Looprange(1,length(ShaL)))
+ {
+ Tmp<- ShaL[[I]]
+ Tmp1<- Unscaling(Tmp)
+ ShaLs<- Mixjoin(ShaLs,Tmp1)
+ }
+ ShaL<- ShaLs
+ return(ShaL)
+}
+
+#############################################
+
+Dottedline<- function(...)
+{
+ varargin <- list(...)
+ Nall <- length(varargin)
+ Nagasa <- 0.1
+ Ookisa <- PenThick
+ I <- Nall
+ Tmp <- varargin[[I]]
+ while (mode(Tmp)=="numeric" && length(Tmp)==1 ) {
+ I <- I-1
+ Tmp <- varargin[[I]]
+ }
+ if(I==Nall-1) {
+ Nagasa<-Nagasa*varargin[[Nall]]
+ Nall <- Nall-1
+ }
+ if(I==Nall-2) {
+ Nagasa <- Nagasa*varargin[[Nall-1]]
+ Ookisa <- round(Ookisa*varargin[[Nall]])
+ Nall <- Nall-2
+ }
+ Nagasa <- 1000/2.54/MilliIn*Nagasa
+ for (N in 1:Nall) {
+ Pdata <- varargin[[N]]
+ if(mode(Pdata)=="numeric") {
+ Pdata <- list(Pdata)
+ }
+ for (II in 1:length(Pdata)) {
+ Clist <- MakeCurves(Op(II,Pdata))
+ DinM <- Dataindex(Clist)
+ for (n in Looprange(1,Nrow(DinM))) {
+ Tmp <- DinM[n,]
+ Data <- Clist[Tmp[1]:Tmp[2],]
+ Len <- 0
+ Lenlist <- c(0)
+ for (I in Looprange(2,Nrow(Data))) {
+ Len <- Len+Norm(Data[I,]-Data[I-1,])
+ Lenlist <- c(Lenlist,Len)
+ }
+ Lenall <- Lenlist[length(Lenlist)]
+ if(Lenall==0) {
+ next
+ }
+ Naga <- Nagasa
+ Nten <- round(Lenall/Naga)+1
+ if(Nten > 1) {
+ Seg <- Lenall/(Nten-1)
+ }
+ else {
+ Seg <- Lenall
+ }
+ Eps <- 10^(-6)*Seg
+ PPd<-c()
+ Hajime <- 1
+ for (I in Looprange(0,Nten-1)) {
+ Len <- Seg*I
+ if(I>0) {
+ J <- Hajime
+ while( Len>=Lenlist[J]+Eps) {
+ J <- J+1
+ }
+ Hajime <- J-1
+ }
+ T <- (Len-Lenlist[Hajime])/
+ (Lenlist[Hajime+1]-Lenlist[Hajime])
+ P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,])
+ PPd<-Appendrow(PPd,P)
+ if(I==Nten-1) {
+ if(Norm(P-Data[1,])<Eps) {
+ next
+ }
+ }
+ }
+ Str<-paste("\\special{pn ", as.character(Ookisa),"}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ for (I in Looprange(1,Nrow(PPd))){
+ P<- Op(I,PPd)
+ if(Nrow(PPd)==1){
+ V<- c(1,0)
+ }
+ else if(I==1){
+ Tmp<- Op(I+1,PPd)-P
+ V<- 1/Norm(Tmp)*Tmp
+ }
+ else if(I==Nrow(PPd)){
+ Tmp<- P-Op(I-1,PPd)
+ V<- 1/Norm(Tmp)*Tmp
+ }
+ else{
+ Tmp1<- Op(I+1,PPd)-P
+ Tmp2<- P-Op(I-1,PPd)
+ Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2
+ V<- 1/Norm(Tmp3)*Tmp3
+ }
+ Tmp<- round(MilliIn*P[1]-1/2*Ookisa*V[1])
+ X<- as.character(Tmp)
+ Tmp<- -round(MilliIn*P[2]-1/2*Ookisa*V[2])
+ Y<- as.character(Tmp)
+ Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Tmp<- round(MilliIn*P[1]+1/2*Ookisa*V[1])
+ X<- as.character(Tmp)
+ Tmp<- -round(MilliIn*P[2]+1/2*Ookisa*V[2])
+ Y<- as.character(Tmp)
+ Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("\\special{fp}",file=Wfile,append=TRUE)
+ if(I%%2==0){
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+ }
+ }
+ }
+ }
+ Tmp<-PenThick/PenThickInit
+ Setpen(Tmp);
+}
+
+###########################################
+
+Drwline<-function(...)
+{
+ varargin<-list(...)
+ Nall<-length(varargin)
+ Thick<-0
+ Tmp<-varargin[[Nall]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ Thick<-round(Tmp*PenThickInit)
+ Str<-paste("\\special{pn ", as.character(Thick),"}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Nall<-Nall-1
+ }
+ for (N in 1:Nall){
+ Pdata<-varargin[[N]]
+ if(length(Pdata)==0) next
+ if(mode(Pdata)!="list") Pdata<-list(Pdata)
+ while(Mixtype(Pdata)==3){ # 10.07.25
+ Tmp1<- list()
+ for(II in Looprange(1,length(Pdata))){
+ Tmp1<- Mixjoin(Tmp1,Pdata[[II]])
+ }
+ Pdata<- Tmp1
+ } # 10.07.25
+ for (II in Looprange(1,length(Pdata))){
+ Clist<-MakeCurves(Pdata[[II]])
+ DinM<-Dataindex(Clist)
+ for (n in Looprange(1,Nrow(DinM))){
+ Tmp<-DinM[n,]
+ Data<-Clist[Tmp[1]:Tmp[2],]
+ Mojisu<-0
+ for (I in Looprange(1,Nrow(Data))){
+ Tmp<-Data[I,]
+ X<- sprintf("%5.0f",MilliIn*Tmp[1]) # 11.07.19
+ Y<- sprintf("%5.0f",-MilliIn*Tmp[2]) # 11.07.19
+ Str<-paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<-Mojisu+nchar(Str)
+ if(Mojisu>80){
+ cat("%\n",file=Wfile,append=TRUE)
+ Mojisu<-0
+ }
+ }
+ if(Mojisu!=0){
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+ cat("\\special{fp}%\n",file=Wfile,append=TRUE)
+ }
+ }
+ }
+ Str<-"%"
+ if(Thick>0){
+ Tmp<-PenThick/PenThickInit
+ Setpen(Tmp)
+ }
+}
+
+###########################################
+
+Drwpt<-function(...)
+{ ## Scaling is implemented
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ if(TenSize>TenSizeInit){
+ N<- round(6*sqrt(TenSize/TenSizeInit))
+ }
+ else{
+ N<-4
+ }
+ Tmp<- varargin[[Nargs]]
+ if(mode(Tmp)=="numeric"){
+ if(length(Tmp)>1){
+ Kosa<- 1; All<- Nargs
+ }
+ else{
+ Kosa<- Tmp; All<- Nargs-1
+ }
+ }
+ else if(mode(Tmp)=="list"){
+ Kosa<- 1; All<- Nargs
+ }
+ CL<-c()
+ for (J in 0:N){
+ Tmp<- TenSize*0.5*1000/2.54/MilliIn
+ Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N))
+ CL<- append(CL,Tmp)
+ }
+ CL<- matrix(CL,nrow=2)
+ CL<- t(CL)
+ for (II in Looprange(1,All)){
+ MS<- varargin[[II]]
+ MS=Flattenlist(MS) #17.10.11
+ if(mode(MS)=="numeric"){
+ MS<- list(MS)
+ }
+ for (I in Looprange(1,length(MS))){
+ P<- MS[[I]]
+ if(InWindow(P)!="i") next
+ P<- Doscaling(P)
+ PL<-c()
+ for (J in 0:N){
+ PL<- c(PL,P+CL[J+1,])
+ }
+ PL<-matrix(PL,nrow=2)
+ PL<-t(PL)
+ Mojisu<-0
+ for (J in 1:Nrow(PL)){
+ Q<- PL[J,]
+ X<- as.character(round(MilliIn*Q[1]))
+ Y<- as.character(-round(MilliIn*Q[2]))
+ Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ if(Mojisu>80){
+ cat("#\n",file=Wfile,append=TRUE)
+ }
+ Mojisu=0
+ }
+ Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
+ Str2<- "\\special{fp}%\n"
+ cat(Str1,file=Wfile,append=TRUE)
+ cat(Str2,file=Wfile,append=TRUE)
+ }
+ }
+}
+
+######################################################
+
+Drwxy<-function(...)
+{
+ varargin<-list(...)
+ Nargs <- length(varargin)
+ Tmp<-grep("arrow", ZIKU)
+ if(length(Tmp)>0)
+ {
+ Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE)
+ Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE)
+ }
+ else
+ {
+ Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2])))
+ Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX)))
+ }
+ Letter(c(XMAX,GENTEN[2]),XPOS,XNAME)
+ Letter(c(GENTEN[1],YMAX),YPOS,YNAME)
+ Letter(GENTEN,OPOS,ONAME);
+}
+
+##########################################
+# 10.12.04
+
+Enclosing<- function(...)
+{
+ Eps=10^(-7) # Scilab 16.12.05
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ P<- varargin[[1]]
+ if(Mixtype(P)==2){
+ Tmp<- Op(1,P)
+ if(mode(Tmp)!="numeric" || length(Tmp)>1){
+ AnsL<- EnclosingS(...)
+ AnsL<- Joincrvs(AnsL) # 10.12.04
+ }
+ }
+ Tmp1=Op(1,AnsL) # Scilab 16.12.05from
+ Tmp2=Op(nrow(AnsL),AnsL)
+ if(Norm(Tmp2-Tmp1)>Eps){
+ AnsL=Appendrow(AnsL,Tmp1)
+ }
+ return(AnsL)
+}
+
+#########################################
+
+EnclosingS<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ AnsL<- list()
+ PdataL<- varargin[[1]]
+ Nall<-length(PdataL)
+ Eps<- 10^(-3)
+ EEps<- 0.1
+ S<- c()
+ Flg<- 0
+ for (I in Looprange(2,Nargs)){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
+ S<- Tmp
+ }
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ if(Flg==0){
+ Eps<- Tmp
+ Flg=Flg+1
+ }
+ else{
+ EEps<- Tmp
+ }
+ }
+ }
+ F<- Op(1,PdataL); G<- Op(Nall,PdataL)
+ KL<- IntersectcrvsPp(F,G)
+ if(length(KL)==1){
+ Tmp<- Op(1,KL)
+ P<- Op(1,Tmp)
+ T1<- Op(2,Tmp)
+ }
+ if(length(KL)==0){
+ if(Numptcrv(F)>Numptcrv(G)){
+ Tmp<- Nearestpt(F,G)
+ P<- Op(1,Tmp)
+ T1=Op(2,Tmp)
+ }
+ else{
+ Tmp<- Nearestpt(G,F)
+ P<- Op(3,Tmp)
+ T1<- Op(4,Tmp)
+ }
+ }
+ if(length(KL)>=2){
+ if(length(S)==0){
+ return("No Start Point")
+ }
+ Tmp<- Op(1,KL)
+ P<- Op(1,Tmp)
+ T1<- Op(2,Tmp)
+ Tmp<- Norm(P-S)
+ for (I in Looprange(2,length(KL))){
+ Tmp1<- Op(1,Op(I,KL))
+ Tmp2<- Norm(Tmp1-S)
+ if(Tmp2<Tmp){
+ P<- Tmp1
+ T1<- Op(2,Op(I,KL))
+ Tmp<- Tmp2
+ }
+ }
+ }
+ S<- P
+ AnsL<- list()
+ for (N in Looprange(1,Nall)){
+ F<- Op(N,PdataL)
+ if(N>1) P<- Q
+ if(N==Nall){
+ Q=S
+ }
+ else{
+ Flg<- 0
+ G<- Op(N+1,PdataL)
+ KL<- IntersectcrvsPp(G,F)
+ if(length(KL)==1){
+ Tmp<- Op(1,KL)
+ Q<- Op(1,Tmp)
+ T3<- Op(2,Tmp)
+ Flg<- 10
+ }
+ if(length(KL)==0) Flg<- 1
+ if(length(KL)>=2){ # Maple bug?
+ Tmp1<- Op(1,Op(1,KL))
+ Tmp2<- Op(1,Op(2,KL))
+ Tmp<- Norm(Tmp1-Tmp2)
+ if(Tmp<Eps*10) Flg<- 1
+ }
+ if(Flg==1){
+ if(Numptcrv(F)>Numptcrv(G)){
+ Tmp<- Nearestpt(F,G)
+ Q<- Op(1,Tmp)
+ T3<- Op(4,Tmp)
+ Flg<- 10
+ }
+ else{
+ Tmp<- Nearestpt(G,F)
+ Q<- Op(3,Tmp)
+ T3<- Op(2,Tmp)
+ Flg<- 10
+ }
+ }
+ if(Flg<10){
+ T2<- Inf
+ for (I in Looprange(1,length(KL))){
+ Dt<- Op(I,KL)
+ Tmp1<- Op(1,Dt)
+ Tmp<- Op(3,Dt)
+ Tmp2<- Paramoncurve(Tmp1,Tmp,F)
+ Tmp3<- Op(2,Dt)
+ if(Tmp2>T1+Eps && Tmp2<T2-Eps){
+ Q<- Tmp1
+ T2<- Tmp2
+ T3<- Tmp3
+ }
+ }
+ }
+ }
+ Tmp<- Partcrv(P,Q,F)
+ T1<- T3
+ AnsL<- Mixjoin(AnsL,list(Tmp))
+ }
+ return(AnsL)
+}
+
+########################################
+
+Endpicture<-function(...)
+{
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ if(Nargs==0)
+ {
+ Drwxy()
+ }
+ else
+ {
+ if(varargin[[1]]==1) Drwxy()
+ }
+ cat("\\end{picture}}%",file=Wfile,append=TRUE)
+# MEMORI<<-MEMORINow*1000/2.54/MilliIn
+ Setunitlen("1cm")
+}
+
+#########################################
+
+Execmd<- function(StrL)
+{
+ if(mode(StrL)=="character" && length(StrL)==1){
+ StrL<- list(StrL)
+ }
+ for (I in Looprange(1,length(StrL))){
+ if(!is.na(Op(I,StrL)) && nchar(Op(I,StrL))>0){
+ eval(parse(text=Op(I,StrL)))
+ }
+ }
+}
+
+#########################################
+
+Expr<-function(...)
+{ ## Scaling is implemented
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ Irng<-c(seq(from=1,to=Nargs,by=3))
+ for (I in Irng)
+ {
+ Tmp<-varargin[[I]]
+ P<- Doscaling(Tmp)
+ X<-P[1]
+ Y<-P[2]
+ Houkou<-varargin[[I+1]]
+ Mojiretu<-paste("$",varargin[[I+2]],"$",sep="")
+ Hset<-Houkou
+ Vhoko<-"c"
+ if(length(grep("n",Hset))>0)
+ {
+ Vhoko<-"n"; Y<-Y+MEMORI
+ }
+ if(length(grep("s",Hset))>0)
+ {
+ Vhoko<-"s"; Y<-Y-MEMORI
+ }
+ Hhoko<-"c"
+ if(length(grep("e",Hset))>0)
+ {
+ Hhoko<-"e"; X<-X+MEMORI
+ }
+ if(length(grep("w",Hset))>0)
+ {
+ Hhoko<-"w"; X<-X-MEMORI
+ }
+ Hoko<-paste(Vhoko,Hhoko,sep="")
+ Suu<-"+-.0123456789"
+ SuuL<-Suu
+ J<-1; Dstr<-""
+ while (J<=nchar(Houkou))
+ {
+ Tmp<-substring(Houkou,J,J)
+ if(length(grep(Tmp,Suu))>0)
+ {
+ if(Dstr=="") Hk<-substring(Houkou,J-1,J-1)
+ Dstr<-paste(Dstr,Tmp,sep="")
+ }
+ else
+ {
+ if(Dstr!="")
+ {
+ Nmbr<-as.numeric(Dstr)
+ D<-Nmbr*MEMORI
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
+ Dstr<-""
+ }
+ }
+ J<-J+1
+ }
+ if(Dstr!="")
+ {
+ Nmbr<-as.numeric(Dstr)
+ D<-Nmbr*MEMORI;
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
+ }
+ CalcWidth(Hoko,Mojiretu)
+ CalcHeight(Hoko,Mojiretu)
+ cat("\\put(",file=Wfile,append=TRUE)
+ Tmp1<- sprintf("%7.7f",X) # 11.07.19
+ Tmp2<- sprintf("%7.7f",Y) # 11.07.19
+ Str<-paste(Tmp1,",",Tmp2,sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Tmp<-"){\\hspace*{\\Width}"
+ Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+}
+
+##########################################
+
+Exprrot<- function(...)
+{
+ varargin<- list(...)
+ P<- varargin[[1]]
+ V<- varargin[[2]]; N<- 3
+ P<- Doscaling(P)
+ V<- Doscaling(V)
+ Tmov<- 0
+ Tmp<- varargin[[N]]
+ if(mode(Tmp)=="numeric"){
+ Tmov<- Tmp; N<- N+1
+ }
+ Nmov<- 0
+ Tmp<- varargin[[N]]
+ if(mode(Tmp)=="numeric"){
+ Nmov<- Tmp; N<- N+1
+ }
+ Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26
+ Tv<- 1/Norm(V)*V
+ Nv<- c(-Tv[2],Tv[1])
+ P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv
+ Tmp<- acos(V[1]/Norm(V))
+ Theta<- round(Tmp*180/pi)
+ if(V[2]>=0){
+ Units<- ""
+ }
+ else{
+ Units<- "units=-360,"
+ }
+ Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="")
+ Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="")
+ Letter(P,"c",Tmp)
+}
+
+######################################################
+
+Findcell<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ TbL<- varargin[[1]]
+ Ag<- varargin[[2]]
+ Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ if(mode(Ag)=="character"){
+ Clm<- c()
+ Rstr<- ""
+ for (I in Looprange(1,nchar(Ag))){
+ C<- substr(Ag,I,I)
+ C<- toupper(C)
+ Tmp<- strsplit(Alpha,C)
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ Tmp1<- nchar(Tmp[1])
+ Clm<- c(Clm,Tmp1)
+ }
+ else{
+ Rstr<- paste(Rstr,C,sep="")
+ }
+ }
+ Nrg<- 0
+ for (I in seq(length(Clm),1,by=-1)){
+ Tmp<- Clm[I]
+ Tmp1<- length(Clm)-I
+ Nrg<- Nrg+Tmp*26^Tmp1
+ }
+ Mrg<- eval(parse(text=Rstr))
+ if(Nargs>=3){
+ Ag<- varargin[[3]]
+ Clm<- c()
+ Rstr<- ""
+ for (I in Looprange(1,nchar(Ag))){
+ C<- substr(Ag,1,1)
+ C<- toupper(C)
+ Tmp<- strsplit(Alpha,C)
+ if(length(Tmp)>1){
+ Clm<- c(Clm,Tmp+1)
+ }
+ else{
+ Rstr<- paste(Rstr,C,sep="")
+ }
+ }
+ Nrg2<- 0
+ for (I in seq(length(Clm),1,by=-1)){
+ Tmp<- Clm[I]
+ Tmp1<- length[Clm]-I
+ Nrg2<- Nrg2+Tmp*26^Tmp1
+ }
+ Nrg<- c(Nrg,Nrg2)
+ Tmp=eval(parse(text=Rstr))
+ Mrg<- c(Mrg,Tmp)
+ }
+ }
+ else{
+ Nrg<- varargin[[2]]
+ Mrg<- varargin[[3]]
+ }
+ if(length(Mrg)==1){
+ m1<- Mrg; m2<- m1+1
+ }
+ else{
+ m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12
+ }
+ if(length(Nrg)==1){
+ n1<- Nrg; n2<- n1+1
+ }
+ else{
+ n1<- Nrg[1]; n2<- Nrg[2]
+ }
+ n1<- n1+1; n2<- n2+1
+ m1<- m1+1; m2<- m2+1
+ Hind<- TbL[[2]]
+ Vind<- TbL[[3]]
+ Tmp<- TbL[[1]]
+ HL<- Tmp[Hind]
+ Tmp1<- Op(1,TbL[[4]])
+ Tmp2<- Op(2,TbL[[4]])
+ HL<- Mixjoin(list(Tmp1),HL,list(Tmp2))
+ VL<- Tmp[Vind]
+ Tmp1<- Op(1,TbL[[5]])
+ Tmp2<- Op(2,TbL[[5]])
+ VL<- Mixjoin(list(Tmp1),VL,list(Tmp2))
+ Tmp<- TbL[[6]]
+ Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp)))
+ Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp)))
+ HL<- Mixjoin(list(Tmp1),HL,list(Tmp2))
+ Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp)))
+ Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp)))
+ VL<- Mixjoin(list(Tmp1),VL,list(Tmp2))
+ Tmp<- HL[[n1]]
+ if(mode(Tmp)=="numeric"){
+ H1<- Tmp[1,1]
+ }
+ else{
+ Tmp1<- Tmp[[1]]
+ H1<- Tmp1[1,1]
+ }
+ Tmp<- HL[[n2]]
+ if(mode(Tmp)=="numeric"){
+ H2<- Tmp[1,1]
+ }
+ else{
+ Tmp1<- Tmp[[1]]
+ H2<- Tmp1[1,1]
+ }
+ Tmp<- VL[[m1]]
+ if(mode(Tmp)=="numeric"){
+ V1<- Tmp[1,2]
+ }
+ else{
+ Tmp1<- Tmp[[1]]
+ V1<- Tmp1[1,2]
+ }
+ Tmp<- VL[[m2]]
+ if(mode(Tmp)=="numeric"){
+ V2<- Tmp[1,2]
+ }
+ else{
+ Tmp1<- Tmp[[1]]
+ V2<- Tmp1[1,2]
+ }
+ Pt<- c((H1+H2)/2,(V1+V2)/2)
+ High<- (V1-V2)/2
+ Wide<- (H2-H1)/2
+ Out<- list(Pt,Wide,High)
+ return(Out)
+}
+
+############################################
+
+Flattenlist<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Out<- list()
+ for(N in Looprange(1,Nargs)){
+ D<- varargin[[N]]
+ if(is.data.frame(D) || !is.list(D)){ # modify
+ Out<- c(Out,list(D))
+ }
+ else{
+ for(I in Looprange(1,length(D))){
+ Ds<- D[[I]]
+ Tmp<- Flattenlist(Ds)
+ Out<- c(Out,Tmp)
+ }
+ }
+ }
+ return(Out)
+}
+
+############################################
+
+Fontsize<- function(Ookisa)
+{
+ Str<- "%"
+ S<- substr(Ookisa,1,1)
+ if(S=="n"){
+ Str<- "\\normalsize%"
+ }
+ if(S=="s"){
+ if(nchar(Ookisa)==1){
+ Tmp<- "n"
+ }
+ else{
+ Tmp<- substr(Ookisa,2,2)
+ }
+ if(Tmp=="s"){
+ Str<- "\\scriptsize%"
+ }
+ else{
+ Str<- "\\small%"
+ }
+ }
+ if(S=="f"){
+ Str<- "\\footnotesize%"
+ }
+ if(S=="t"){
+ Str<- "\\tiny%"
+ }
+ if(S=="l"){
+ Str<- "\\large%"
+ }
+ if(S=="L"){
+ if(nchar(Ookisa)==1){
+ Tmp<- "a"
+ }
+ else{
+ Tmp<- substr(Ookisa,2,2)
+ }
+ if(Tmp=="a"){
+ Str<- "\\Large%"
+ }
+ else{
+ Str<- "\\LARGE%"
+ }
+ }
+ if(S=="h"){
+ Str<- "\\huge%"
+ }
+ if(S=="H"){
+ Str<- "\\Huge%"
+ }
+ cat(Str,file=Wfile,append=TRUE)
+ cat("\n",file=Wfile,append=TRUE)
+}
+
+##########################################
+
+Fracform<- function(...)
+{
+ varargin<- list(...)
+ Eps<- 10^(-10)
+ Nmax<- 1/Eps
+ Nargs<- length(varargin)
+ X<- varargin[[1]]
+ Nr<- Nrow(X)
+ X<- as.matrix(X,nrow=Nr)
+ for (I in Looprange(2,Nargs)){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)!="numeric"){
+ next
+ }
+ if(Tmp>1){
+ Nmax<- Tmp
+ }
+ else if(Tmp>0){
+ Eps<- Tmp
+ }
+ }
+ Tmp<- rep("",length(X))
+ Out<- matrix(Tmp,nrow=nrow(X))
+ for (I in Looprange(1,nrow(X))){
+ for (J in Looprange(1,ncol(X))){
+ Dt<- X[I,J]
+ if(mode(Dt)=="character"){
+ Dt<- eval(parse(text=Dt))
+ }
+ R<- 1
+ N<- 0
+ Rmin<- R
+ Nr<- N
+ while (R>Eps && N<Nmax){
+ N<- N+1
+ M<- round(Dt*N)
+ R<- abs(Dt-M/N)
+ if(R<Rmin){
+ Rmin<- R
+ Nr<- N
+ }
+ }
+ if(N==Nmax){
+ N<- Nr
+ M<- round(Dt*N)
+ }
+ Tmp<- as.character(M)
+ if(N!=1){
+ Tmp<- paste(Tmp,"/",as.character(N),sep="")
+ }
+ Out[I,J]<- Tmp
+ }
+ }
+ if(nrow(Out)==1){
+ Out<- as.character(Out)
+ }
+ return(Out)
+}
+
+##############################################
+# 2011.12.17 ( list )
+
+Framedata<-function(...)
+{
+ varargin<- Flattenlist(list(...))
+ N<-length(varargin)
+ if(N<= 1){
+ H<- 1.0*10^(-4);
+ PA<-c(XMIN+H,YMIN+H)
+ PB<-c(XMAX-H,YMIN+H)
+ PC<-c(XMAX-H,YMAX-H)
+ PD<-c(XMIN+H,YMAX-H)
+ }
+ else{
+ Tmp<-varargin[[N]]
+ if(is.numeric(Tmp) && length(Tmp)==1){
+ Dy<-Tmp; Dx<-Dy
+ Tmp<-varargin[[N-1]]
+ if(is.numeric(Tmp) && length(Tmp)==1){
+ Dx<-Tmp
+ }
+ Tmp<-varargin[[1]]
+ X<-Tmp[1]; Y<-Tmp[2]
+ X1<-X-Dx; X2<-X+Dx; Y1<-Y-Dy; Y2<-Y+Dy
+ }
+ else{
+ Tmp<-varargin[[1]]
+ X1<-Tmp[1]; X2<-Tmp[2]
+ Tmp<-varargin[[2]]
+ Y1<-Tmp[1]; Y2<-Tmp[2]
+ }
+ PA<-c(X1,Y1); PB<-c(X2,Y1)
+ PC<-c(X2,Y2); PD<-c(X1,Y2)
+ }
+ Out<- Listplot(c(PA,PB,PC,PD,PA))
+ return(Out)
+}
+
+###################################
+
+Hatchdata<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ ShaL<- list()
+ Nargs<- length(varargin)
+ Kakudo<- 45
+ Kankaku<- 0.125*1000/2.54/MilliIn
+ Tmp<- Doscaling(c(XMIN,YMIN))
+ Xmn<- Tmp[1]; Ymn<- Tmp[2]
+ Tmp<- Doscaling(c(XMAX,YMAX))
+ Xmx<- Tmp[1]; Ymx<- Tmp[2]
+ for (N in seq(Nargs,1, by=-1))
+ {
+ Tmp<- varargin[[N]]
+ if(mode(Tmp)=="list")
+ {
+ break
+ }
+ }
+ if(N<Nargs)
+ {
+ Kakudo<- varargin[[N+1]]
+ if(N==Nargs-2)
+ {
+ Kankaku<- 0.125*varargin[[Nargs]]
+ }
+ }
+ NaitenL<- varargin[[1]]
+ if(mode(NaitenL)!="list")
+ {
+ NaitenL<- list(NaitenL)
+ }
+ Ns<- 2
+ StartP<- Op(1,NaitenL)
+ if(mode(StartP)=="character")
+ {
+ StartP<- c((Xmn+Xmx)/2, (Ymn+Ymx)/2)
+ }
+ if(mode(varargin[[2]])=="numeric")
+ {
+ StartP<- varargin[[2]]
+ StartP<- Doscaling(StartP)
+ Ns<- 3
+ }
+ Tmp<- list()
+ for ( I in Looprange(Ns,N))
+ {
+ Tmp1<- list(varargin[[I]])
+ Tmp2<- Mixjoin(Tmp, Tmp1)
+ Tmp<- Tmp2
+ }
+ Bdy<- Kyoukai(Tmp)
+ Bdys<-list()
+ for (I in 1:length(Bdy))
+ {
+ Tmp1<- Bdy[[I]]
+ Tmp2<- Doscaling(Tmp1)
+ Bdys<- Mixjoin(Bdys,list(Tmp2))
+ }
+ Bdy<- Bdys
+ PtnL<- list()
+ for (I in Looprange(1,length(NaitenL)))
+ {
+ Tmp<- Op(I, NaitenL)
+ if(mode(Tmp)=="numeric")
+ {
+ Tmp1<- Naigai(Tmp,Bdy)
+ Tmp2<- Mixjoin(PtnL, list(Tmp1))
+ PtnL<- Tmp2
+ }
+ else
+ {
+ if(mode(Tmp)!="character")
+ {
+ return("Mode Error")
+ }
+ Ptn<-c()
+ for (J in 1:nchar(Tmp))
+ {
+ if(Op(J,Tmp)=="i")
+ {
+ Ptn<- c(Ptn,1)
+ }
+ else
+ {
+ Ptn<- c(Ptn,0)
+ }
+ }
+ PtnL<- Mixjoin(PtnL, list(Ptn))
+ }
+ }
+ Call<- length(Bdy)
+ Ptn<- c(seq(0, 0, length=Call))
+ if(Member(Ptn,PtnL))
+ {
+ Wn<- Doscaling(Framedata())
+ Tmp<- Mixjoin(Bdy,list(Wn))
+ Bdy<- Tmp
+ Tmp<- list()
+ for (I in Looprange(1, length(PtnL)))
+ {
+ Tmp1<- c(Op(I,PtnL),1)
+ Tmp2<- Mixjoin(Tmp,list(Tmp1))
+ Tmp<- Tmp2
+ }
+ PtnL<- Tmp
+ }
+ V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180))
+ Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180))
+ Tmp<- Op(1,NaitenL)
+ if(mode(Tmp)=="numeric" && length(Tmp)==2)
+ {
+ Tmp<- Doscaling(Tmp)
+ Delta<- Tmp-StartP
+ K<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ PA<- StartP+K*Kankaku*Vm
+ Sha<- Makeshasen(PtnL,PA,V,Bdy)
+ I <- 1
+ while (length(Sha)>0)
+ {
+ Tmp<- Mixjoin(ShaL, list(Sha))
+ ShaL <- Tmp
+ Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy)
+ I <- I+1
+ }
+ Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy)
+ I<- 2
+ while (length(Sha)>0)
+ {
+ for (J in 1:length(Sha))
+ {
+ Tmp<- Mixjoin(ShaL,list(Sha[[J]]))
+ ShaL<- Tmp
+ }
+ Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy)
+ I<- I+1
+ }
+ }
+ else
+ {
+ Delta<- c(Xmn,Ymn)-StartP
+ K1<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ Delta<- c(Xmx,Ymn)-StartP
+ K2<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ Delta<- c(Xmx,Ymx)-StartP
+ K3<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ Delta<- c(Xmn,Ymx)-StartP
+ K4<- trunc(Dotprod(Delta,Vm)/Kankaku)
+ IM<- max(K1,K2,K3,K4)
+ Im<- min(K1,K2,K3,K4)
+ for (I in Im:IM)
+ {
+ Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy)
+ for (J in Looprange(1,length(Sha)))
+ {
+ Tmp<- Mixjoin(ShaL, list(Sha[[J]]))
+ ShaL<- Tmp
+ }
+ }
+ }
+ ShaLs<-list()
+ for (I in Looprange(1,length(ShaL)))
+ {
+ Tmp<- ShaL[[I]]
+ Tmp1<- Unscaling(Tmp)
+ Tmp2<- Mixjoin(ShaLs, list(Tmp1))
+ ShaLs<- Tmp2
+ }
+ ShaL<- ShaLs
+ return(ShaL)
+}
+
+######################################
+
+Htickmark<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ ArgsL<- varargin
+ if(mode(ArgsL[[1]])=="character"){
+ Str<- ArgsL[[1]]
+ Tmp<- strsplit(Str,"m")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ I<- nchar(Tmp[1])+1
+ }
+ else{
+ I<- 0
+ }
+ Tmp<- strsplit(Str,"n")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ J<- nchar(Tmp[1])+1
+ }
+ else{
+ J<- 0
+ }
+ Tmp<- strsplit(Str,"r")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ K=nchar(Tmp[1])+1
+ }
+ else{
+ K<- 0
+ }
+ if(K>0){
+ S<- substr(Str,K+1,nchar(Str))
+ R<- as.numeric(S)
+ if(is.na(R)){
+ R<- 1
+ }
+ }
+ else{
+ R<- 1
+ K<- nchar(Str)+1
+ }
+ if(J>0){
+ S<- substr(Str,J+1,K-1)
+ Dn<- as.numeric(S)
+ if(is.na(Dn)){
+ Dn<- 1
+ }
+ }
+ else{
+ Dn<- 1000
+ J<- nchar(Str)+1
+ }
+ S<- substr(Str,I+1,J-1)
+ Dm<- as.numeric(S)
+ if(is.na(Dm)){
+ Dm<- 1
+ }
+ ArgsL<- list()
+ for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ }
+ MemoriList<- list()
+ Memori<- list()
+ for (N in 1:length(ArgsL)){
+ Dt<- ArgsL[[N]]
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(Dt[1],Dt[2])
+ next
+ }
+ if(mode(Dt)=="character"){
+ Memori<- Mixjoin(Memori,Dt)
+ }
+ else{
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(Dt,GENTEN[2])
+ }
+ }
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ for (N in 1:length(MemoriList)){
+ Dt<- MemoriList[[N]]
+ Ndt<- length(Dt)
+ X=Op(1,Dt)
+ Y=Op(2,Dt)
+ Tmp<-Doscaling(c(X,Y))
+ X<- Tmp[1]
+ Y<- Tmp[2]
+ Moji<- Op(Ndt,Dt)
+ Tmp1<- Unscaling(c(X,Y+MARKLEN))
+ Tmp2<- Unscaling(c(X,Y-MARKLEN))
+ Fd<- Listplot(c(Tmp1,Tmp2))
+ Drwline(Fd)
+ if(Ndt==3){
+ Tmp<-Unscaling(c(X,Y-MARKLEN))
+ Expr(Tmp,"s",Moji)
+ }
+ if(Ndt==4){
+ Houkou<- Op(3,Dt)
+ Tmp<-grep("s",Houkou)
+ if(length(Tmp)>0){
+ Tmp<-Unscaling(c(X,Y-MARKLEN))
+ Expr(Tmp,Houkou,Moji)
+ }
+ else{
+ Tmp<- Unscaling(c(X,Y+MARKLEN))
+ Expr(Tmp,Houkou,Moji)
+ }
+ }
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+}
+
+#############################################
+# 2013.08.07
+
+Integrate<- function(Fs,Vs, Intv){
+ if(is.function(Fs)){
+ Fn<- Fs
+ }
+ else{
+ Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="")
+ eval(parse(text=Str))
+ }
+ Tmp<- integrate(Fn, Intv[[1]], Intv[[2]])
+ Out<- Tmp[[1]]
+ return(Out)
+}
+
+#############################################
+
+Intersectcrvs<-function(...)
+{
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ Eps<-10^(-4)
+ Tmp<-varargin[[Nargs]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1)
+ {
+ Eps<-Tmp
+ }
+ G1<-varargin[[1]]
+ if(mode(G1)=="numeric")
+ {
+ G1<-list(G1)
+ }
+ G2<-varargin[[2]]
+ if(mode(G2)=="numeric")
+ {
+ G2<-list(G2)
+ }
+ PL<-list()
+ for (N in 1:length(G1))
+ {
+ for (M in 1:length(G2))
+ {
+ KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps)
+ for (I in Looprange(1,length(KL)))
+ {
+ Tmp<-KL[[I]]
+ P<-Tmp[1]
+ PL<-append(PL,P)
+ }
+ }
+ }
+ return(PL)
+}
+
+###########################################
+
+IntersectcrvsPp<-function(...)
+{
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ G1<-varargin[[1]]; G2<-varargin[[2]]
+ Eps<- 10.0^(-4)
+ if(Nargs>2) Eps<-varargin[[3]]
+ SqEps<- 10.0^(-10)
+ Eps2<- 0.1
+ if(Nargs>3) Eps2<-varargin[[4]]
+ Data1<-G1
+ Data2<-G2
+ if(Nrow(Data1)==Nrow(Data2))
+ {
+ Tmp<-seq(Nrow(Data2),1, by=-1)
+ Tmp1<-Data2[Tmp,]
+ Eps0<-10^(-6)
+ Tmp2<-Norm(Data1-Data2)
+ Tmp3<-Norm(Data1-Tmp1)
+ if(Tmp2<Eps0||Tmp3<Eps0)
+ {
+ KL<-list()
+ return(KL)
+ }
+ }
+ KL1<-list()
+ KL2<-list()
+ for (I in Looprange(1,Nrow(Data1)-1))
+ {
+ A<-Data1[I,]
+ B<-Data1[I+1,]
+ for (J in Looprange(1,Nrow(Data2)-1))
+ {
+ P<-Data2[J,]; Q<-Data2[J+1,]
+ Tmp<-Koutenseg(A,B,P,Q,Eps,Eps2)
+ if(mode(Tmp)=="list")
+ {
+ if(Tmp[[3]]==0)
+ {
+ Tmp1<-list(Tmp[[1]],Tmp[[2]],I,J)
+ KL1<-append(KL1,list(Tmp1))
+ }
+ else
+ {
+ Tmp2<-list(Tmp[[1]],Tmp[[2]],I,J)
+ KL2<-append(KL2, list(Tmp2))
+ }
+ }
+ }
+ }
+ KL<-list()
+ if(length(KL1)>0)
+ {
+ Tmp<-KL1[[1]]
+ P<-Tmp[[1]]
+ T<-Tmp[[2]]
+ I<-Tmp[[3]]
+ J<-Tmp[[4]]
+ Tmp<-list(P,I+T,J)
+ KL<-list(Tmp)
+ }
+ for (N in Looprange(2,length(KL1)))
+ {
+ Tmp<-KL1[[N]]
+ P<-Tmp[[1]]
+ Flg<-0
+ for (K in 1:length(KL))
+ {
+ if(1>length(KL)) break
+ Tmp<-KL[[K]]
+ if(Norm(P-Tmp[[1]])^2<SqEps)
+ {
+ Flg<-1
+ break
+ }
+ }
+ if(Flg==0)
+ {
+ Tmp<-KL1[[N]]
+ T<-Tmp[[2]]
+ I<-Tmp[[3]]
+ J<-Tmp[[4]]
+ Tmp<-list(P,I+T,J)
+ KL<-append(KL,list(Tmp))
+ }
+ }
+ for (N in Looprange(1,length(KL2)))
+ {
+ Tmp<-KL2[[N]]
+ P<-Tmp[[1]]
+ Flg<-0
+ for (K in Looprange(1,length(KL)))
+ {
+ Tmp<-KL[[K]]
+ if(Norm(P-Tmp[[1]])^2<SqEps)
+ {
+ Flg<-1
+ break
+ }
+ }
+ if(Flg==0)
+ {
+ Tmp<-KL2[[N]]
+ T<-Tmp[[2]]
+ T<-min(max(T,0),1)
+ I<-Tmp[[3]]
+ J<-Tmp[[4]]
+ Tmp<-list(P,I+T,J)
+ KL<-append(KL,list(Tmp))
+ }
+ }
+ return(KL)
+}
+
+###########################################
+# 13.12.20 debugged
+
+Invdashline<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Nall<- Nargs; Sen<- 1 ; Gap<- 1
+ Tmp<- varargin[[Nall]]
+ if(is.numeric(Tmp) && length(Tmp)==1 && Tmp>0){ # 13.12.20
+ Tmp1<- varargin[[Nall-1]]
+ if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20
+ Sen<- Tmp1; Gap<- Tmp
+ Nall<- Nall-2
+ }
+ else{
+ Sen<- Tmp; Gap<- Sen
+ Nall<- Nall-1
+ }
+ }
+ Sen<- 1000/2.54/MilliIn*Sen
+ Gap<- 1000/2.54/MilliIn*Gap
+ for (N in Looprange(1,Nall)){
+ Figdata<- varargin[[N]]
+ Makehasen(Figdata,Sen,Gap,1)
+ }
+}
+
+#########################################
+
+Invert<- function(Pd)
+{
+ OutL=Pd[nrow(Pd):1,]
+ return(OutL)
+}
+
+############################################
+
+InWindow<-function(PA)
+{
+ Eps<-10.0^(-6);
+ if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20
+ X<-PA[1]; Y<-PA[2];
+ if(X>XMIN-Eps && X<XMAX+Eps && Y>YMIN-Eps && Y<YMAX+Eps)
+ Rx<-"i"
+ else
+ Rx<-"o"
+ return(Rx)
+ }else{
+ return("o")
+ }
+}
+
+#######################################
+
+Joincrvs<- function(...)
+{
+ varargin<- list(...)
+ Nall<- length(varargin)
+ Eps<- 10^(-4)
+ Tmp<- varargin[[Nall]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ Eps<- Tmp
+ Nall<- Nall-1
+ }
+ QdL<- Flattenlist(varargin[1:Nall]) # 11.06.25
+ if(length(QdL)==0){
+ PtL<-c()
+ return(PtL)
+ }
+ PtL<- Op(1,QdL)
+ for (I in Looprange(2,length(QdL))){
+ Qd<- Op(I,QdL)
+ if(Numptcrv(Qd)<=1){next} # 11.06.25
+ P<- Ptend(PtL)
+ S<- Ptstart(PtL)
+ Q<- Ptstart(Qd)
+ R<- Ptend(Qd)
+ MN<- min(Norm(P-Q),Norm(P-R),Norm(S-Q),Norm(S-R))
+ if(MN==Norm(P-R)){
+ Qd<- Invert(Qd)
+ }
+ else if(MN==Norm(S-Q)){
+ PtL=Invert(PtL)
+ }
+ else if(MN==Norm(S-R)){
+ PtL<- Invert(PtL)
+ Qd<- Invert(Qd)
+ }
+ if(MN>Eps){
+ PtL<- Appendrow(PtL,Qd)
+ }
+ else{
+ if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)}
+ PtL<- Appendrow(PtL,Qd[2:nrow(Qd),]) # 11.06.25
+ }
+ }
+ return(PtL)
+}
+
+########################################
+# 2011.11.02
+
+Joingraphics<- function(...)
+{
+ varargin<- list(...)
+ Ls<- Flattenlist(varargin)
+ N<- length(Ls)
+ Tp<- Ls[[N]]
+ Listflg<- 0
+ if( is.character(Tp)){
+ Tmp<- toupper(substr(Tp,1,1))
+ if(Tmp=="L"){
+ Listflg<- 1
+ }
+ N<- N-1
+ Ls<- Ls[1:N]
+ }
+ if(Listflg==1){
+ P<- Ls
+ }
+ else{
+ P<- c()
+ for (I in 1:N){
+ Tmp<- Ls[[I]]
+ P<- Appendrow(P,c(Inf,Inf))
+ P<- Appendrow(P,Tmp)
+ }
+ P<- P[2:nrow(P),]
+ }
+ return(P)
+}
+
+########################################
+
+Kouten<- function(PA,V,P,Q)
+{
+ Eps<- 10.0^(-6)
+ A1<- PA[1]; A2<- PA[2]
+ V1<- V[1]; V2<- V[2]
+ P1<- P[1]; P2<- P[2]
+ U1<- Q[1]-P1; U2<- Q[2]-P2
+ Tmp<- Norm(P-Q)*Norm(V)
+ if(Tmp==0)
+ {
+ Out<- list(Inf,-Inf)
+ return(Out)
+ }
+ D<- U1*V2-U2*V1
+ if(abs(D)/Tmp<Eps)
+ {
+ Out<- list(Inf,-Inf)
+ return(Out)
+ }
+ S<- ((-A2+P2)*V1+(A1-P1)*V2)/D
+ if(S>1+Eps || S<Eps)
+ {
+ Out<-list(Inf,-Inf)
+ return(Out)
+ }
+ T<- ((-A2+P2)*U1+(A1-P1)*U2)/D
+ Tmp<- PA+T*V
+ Out<- list(T,Tmp,sign(D))
+ return(Out)
+}
+
+##########################################
+
+KoutenList<- function(PA,V,Bdy)
+{
+ Eps<-10.0^(-6)
+ TenL<-list()
+ for (N in 1:length(Bdy))
+ {
+ KL<- Op(N,Bdy)
+ for (K in Looprange(1, Nrow(KL)-1))
+ {
+ P<- Op(K,KL); Q<- Op(K+1,KL)
+ if(P!="/" && Q!="/")
+ {
+ Tmp<- Kouten(PA,V,P,Q);
+ if(Tmp[[1]]!=Inf)
+ {
+ Ten<- append(Tmp,N)
+ Flg<- 0
+ NN<- length(TenL)
+ I<- 1
+ while (Flg==0 && I<=NN)
+ {
+ Tmp<- Op(I,TenL)
+ if(Op(1,Ten)<Op(1,Tmp)-Eps)
+ {
+ Tmp1<- TenL[Looprange(1,I-1)]
+ Tmp2<- TenL[Looprange(I,length(TenL))]
+ TenL<- Mixjoin(Tmp1,list(Ten),Tmp2)
+ Flg<-1
+ }
+ else
+ if(Op(1,Ten)<Op(1,Tmp)+Eps)
+ {
+ if(Op(4,Ten)!=Op(4,Tmp))
+ {
+ Tmp1<- TenL[Looprange(1,I-1)]
+ Tmp2<- TenL[Looprange(I,length(TenL))]
+ TenL<- Mixjoin(Tmp1,list(Ten),Tmp2)
+ Flg<-1
+ }
+ else
+ if(Op(3,Ten)!=Op(3,Tmp))
+ {
+ Tmp1<- TenL[Looprange(I,I-1)]
+ Tmp2<- TenL[Looprange(I+1,length(TenL))]
+ TenL<- Mixjoin(Tmp1,Tmp2)
+ }
+ Flg<- 1
+ }
+ I<- I+1
+ }
+ if(Flg==0)
+ {
+ TenL<- Mixjoin(TenL,list(Ten))
+ }
+ }
+ }
+ }
+ }
+ return(TenL)
+}
+
+##########################################
+
+Koutenseg<-function(...)
+{
+ #pointdata on AB at which AB intersects CD
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ Eps0 <- 10^(-4)
+ A<-varargin[[1]]; V<-varargin[[2]]-A
+ Sv2 <- V[1]^2+V[2]^2
+ if(Sv2<10^(-6))
+ {
+ Out<-Inf
+ return(Out)
+ }
+ P<-varargin[[3]]-A; Q<-varargin[[4]]-A
+ Eps <- 10.0^(-3)
+ if(Nargs>=5)
+ {
+ Eps<-varargin[[5]]
+ }
+ Eps2 <- 0.2
+ if(Nargs>=6)
+ {
+ Eps2<-varargin[[6]]
+ }
+ Eps<-min(Eps2,Eps/sqrt(Sv2))
+ P1<-(P[1]*V[1]+P[2]*V[2])/Sv2
+ P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2
+ Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2
+ Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2
+ m1 <- -Eps; M1 <- 1+Eps
+ m2 <- -Eps; M2 <- Eps
+ if(max(P1,Q1)<m1 || min(P1,Q1)>M1)
+ {
+ Out<-Inf
+ return(Out)
+ }
+ if(max(P2,Q2)<m2 || min(P2,Q2)>M2)
+ {
+ Out<-Inf
+ return(Out)
+ }
+ if(P2*Q2<0)
+ {
+ T<- P1-(Q1-P1)/(Q2-P2)*P2
+ if(T>m1 && T<M1)
+ {
+ if(T > -Eps0 && T<1+Eps0)
+ {
+ Tmp1<-A+T*V
+ Tmp2<-min(max(T,0),1)
+ Out<-list(Tmp1,Tmp2,0)
+ }
+ else
+ {
+ Tmp1<-A+T*V
+ Tmp2<-min(max(T,0),1)
+ Out<-list(Tmp1,Tmp2,1)
+ }
+ return(Out)
+ }
+ if(P1<m1 || P1>M1 || P2<m2 || P2>M2)
+ {
+ if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
+ {
+ Out<-Inf
+ return(Out)
+ }
+ T<-min(max(Q1,0),1)
+ Tmp=A+T*V
+ Out<-list(Tmp,T,1)
+ return(Out)
+ }
+ T<-min(max(P1,0),1)
+ Tmp<-A+T*V
+ Out<-list(Tmp,T,1)
+ return(Out)
+ }
+ if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0)
+ {
+ T<- P1
+ Tmp<- A+T*V
+ Out<- list(Tmp, T, 0)
+ return(Out)
+ }
+ if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2<Eps0)
+ {
+ T<- Q1
+ Tmp<-A+T*V
+ Out<- list(Tmp,T,0)
+ return(Out)
+ }
+ if(P1<m1 || P1>M1 || P2<m2 || P2>M2)
+ {
+ if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
+ {
+ Out<-Inf
+ return(Out)
+ }
+ T<-min(max(Q1,0),1)
+ Tmp<-A+T*V
+ Out<-list(Tmp,T,1)
+ return(Out)
+ }
+ if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2)
+ {
+ T<-min(max(P1,0),1)
+ Tmp<-A+T*V
+ Out<-list(Tmp,T,1)
+ return(Out)
+ }
+ if(abs(P2)<abs(Q2))
+ {
+ T<-min(max(P1,0),1)
+ }
+ else
+ {
+ T<-min(max(Q1,0),1)
+ }
+ Tmp<A+T*V
+ Out<-list(Tmp,T,1)
+ return(Out)
+}
+
+##########################################
+
+Kukeiwake<- function(PL)
+{
+ Eps<-10.0^(-6)
+ NW<- c(XMIN,YMAX); SW<-c(XMIN,YMIN)
+ SE<- c(XMAX,YMIN); NE<-c(XMAX,YMAX)
+ Tmp<-matrix(c(NW,SW,SE,NE,NW),nrow=2)
+ Sikaku<- t(Tmp)
+ Kt<- IntersectcrvsPp(PL,Sikaku)
+ if(length(Kt)!=2)
+ {
+ print("not two points")
+ return(c())
+ }
+ Tmp<- Op(1,Kt)
+ Pt1<- Op(1,Tmp)
+ N1<- trunc(Op(2,Tmp))
+ M1<- Op(3,Tmp)
+ Tmp<- Op(2,Kt)
+ Pt2<- Op(1,Tmp)
+ N2<- trunc(Op(2,Tmp))
+ M2<- Op(3,Tmp)
+ T1<- Paramoncurve(Pt1,M1,Sikaku) #18.02.06
+ T2<- Paramoncurve(Pt2,M2,Sikaku)
+ QL<c()
+ if(Norm(Pt1-Op(N1+1,PL))>Eps)
+ {
+ QL<-Pt1
+ }
+ Tmp<-Appendrow(QL,PL[(N1+1):N2,])
+ QL<- Tmp
+ if(Norm(Pt2-Op(N2,PL))>Eps)
+ {
+ Tmp<-Appendrow(QL,Pt2)
+ QL<- Tmp
+ }
+ HidariL<- QL
+ Ms<- M2+1; Me<- M1
+ if(T1<T2+Eps) Me<- M1+4
+ for (M in Looprange(Ms,Me))
+ {
+ Tmp<- Op(Nrow(HidariL),HidariL)
+ P<-Op(((M-1) %% 4)+1,Sikaku)
+ if(Norm(Tmp-P)>Eps)
+ {
+ Tmp<-Append(HidariL,P)
+ HidariL<-Tmp
+ }
+ }
+ Tmp<- Op(Nrow(HidariL),HidariL)
+ if(Norm(Tmp-Pt1)>Eps)
+ {
+ Tmp<-Append(HidariL,Pt1)
+ HidariL<-Tmp
+ }
+ MigiL<- QL
+ Ms<- M2; Me<- M1+1
+ if(T1>T2-Eps) Me<- Me-4
+ for (Mm in Looprange(Me,Ms))
+ {
+ M<- Me+Ms-Mm
+ Tmp<- Op(Nrow(MigiL),MigiL)
+ P<- Op(((M-1) %% 4)+1,Sikaku)
+ if(Norm(Tmp-P)>Eps)
+ {
+ Tmp<-Appendrow(MigiL,P)
+ MigiL<-Tmp
+ }
+ }
+ Tmp<- Op(Nrow(MigiL),MigiL)
+ if(Norm(Tmp-Pt1)>Eps)
+ {
+ Tmp<-Appendrow(MigiL,Pt1)
+ MigiL<-Tmp
+ }
+ Out<- list(HidariL,MigiL)
+ return(Out)
+}
+
+###################################
+# 17.09.24 Eps
+
+Kyoukai<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps0<- 10^(-7)
+ DataL<-list()
+ for (I in 1:Nargs){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric"){
+ DataL<- Mixjoin(DataL,list(list(Tmp)))
+ }
+ if(mode(Tmp)=="list"){
+ if(mode(Tmp[[1]])!="list"){
+ DataL<- Mixjoin(DataL, list(Tmp))
+ }
+ else{
+ DataL<-Mixjoin(DataL,Tmp)
+ }
+ }
+ }
+ Eps<- 10.0^(-4) #17.09.24
+ PLall<- list()
+ Sflg<- 0
+ N<- length(DataL)
+ for (I in Looprange(1,N)){
+ Data<- Op(I, DataL)
+ Tmp<- Op(length(Data),Data)
+ if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){
+ Rg<-Tmp ; Nd<-length(Data)-1
+ }
+ else{
+ if(mode(Tmp)=="character"){
+ Rg<- Tmp ; Nd<-length(Data)-1
+ }
+ else{
+ Rg<- "c" ; Nd<-length(Data)
+ }
+ }
+ for (J in Looprange(1,Nd)){
+ Tmp<- Op(J,Data)
+ if(mode(Tmp)=="character"){
+ Rg<- Tmp
+ next
+ }
+ Points<- Tmp
+ P1<- Ptstart(Points)
+ P2<- Ptend(Points)
+ if(J==1){
+ PL<- Points
+ Pfirst<- P1
+ Plast<- P2
+ if(Nd>=2){
+ Tmp<- Op(2,Data)
+ P<- Ptstart(Tmp)
+ Q<- Ptend(Tmp)
+ if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){
+ Tmp< Length(PL)
+ PL<-PL[Tmp:1,]
+ Pfirst<- Ptstart(PL)
+ Plast<- Ptend(PL)
+ }
+ }
+ }
+ else{
+ if(Norm(P1-Plast)<Eps){
+ Stp<-1; Ks<-2; Ke=Length(Points)
+ }
+ else{
+ if(Norm(P2-Plast)<Eps) {
+ Stp<- -1; Ks<-Length(Points)-1; Ke=1
+ }
+ else{
+ Tmp<-Appendrow(PL,c(Inf,Inf))
+ PL<- Appendrow(Tmp,Points)
+ Sflg<- 1
+ Pfirst<- P1
+ Plast<- P2
+ Stp<- 1; Ks<- Length(Points)-1; Ke<- 1
+ }
+ }
+ for (K in seq(Ks,Ke, by=Stp)){
+ Tmp<- Appendrow(PL,Op(K,Points))
+ PL<-Tmp
+ }
+ Plast<- Op(Ke,Points)
+ }
+ }
+ if(Norm(Pfirst-Plast)>Eps){
+ Np<- Length(PL)
+ if(Rg=="c"){
+ Tmp<- Appendrow(PL,Pfirst)
+ PL<- Tmp
+ }
+ else if(Rg=="s"){
+ Tmp<- c(PL[1:Np,2],YMIN)
+ Y<- min(Tmp)-1
+ P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y)
+ Tmp<- Appendrow(PL,P)
+ Tmp=Appendrow(Tmp,Q)
+ PL=Appendrow(Tmp,Pfirst)
+ }
+ else if(Rg=="n"){
+ Tmp<- c(PL[1:Np,2],YMAX)
+ Y<-max(Tmp)+1
+ P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y)
+ Tmp<- Appendrow(PL,P)
+ Tmp<- Appendrow(Tmp,Q)
+ PL<- Appendrow(Tmp,Pfirst)
+ }
+ else if(Rg=="w"){
+ Tmp<- c(PL[1:Np,1],XMIN)
+ X<- min(Tmp)-1
+ P<- c(X,Plast[2]); Q<- c(X,Pfirst[2])
+ Tmp<- Appendrow(PL,P)
+ Tmp<- Appendrow(Tmp,Q)
+ PL<- Appendrow(Tmp,Pfirst)
+ }
+ else if(Rg=="e"){
+ Tmp<- c(PL[1:Np,1],XMAX)
+ X<- max(Tmp)+1
+ P<- c(X,Plast[2]); Q<- c(X,Pfirst[2])
+ Tmp<- Appendrow(PL,P)
+ Tmp<- Appendrow(Tmp,Q)
+ PL<- Appendrow(Tmp,Pfirst)
+ }
+ else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){
+ Tmp<- Kukeiwake(PL)
+ Tmp1<- Op(1,Tmp)
+ Tmp2<- Naigai(Rg,list(Tmp1))
+ if(Tmp2==c(1)){
+ PL<-Op(1,Tmp)
+ }
+ else{
+ PL<- Op(2,Tmp)
+ }
+ }
+ }
+ Tmp<- Ptstart(PL)
+ for (J in Looprange(2,Length(PL))){
+ P<- Op(J,PL)
+ Q<- Op(Length(Tmp),Tmp)
+ if(Norm(P-Q)>Eps){
+ Tmp1<-Appendrow(Tmp,P)
+ Tmp<-Tmp1
+ }
+ }
+ PL<-Tmp
+ PLall<-c(PLall,list(PL))
+ }
+ if(length(PLall)==1 && Sflg==0){
+ Tmp<- Op(1,PLall)
+# Tmp<- Op(1,Tmp)
+ if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){
+ Tmp1<- Appendrow(Tmp,Ptstart(Tmp))
+ PLall<- list(Tmp1)
+ }
+ }
+ return(PLall)
+}
+
+######################################
+
+Letter<-function(...)
+{ ## Scaling is implemented
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ Irng<-c(seq(from=1,to=Nargs,by=3))
+ for (I in Irng)
+ {
+ Tmp<-varargin[[I]]
+ P<- Doscaling(Tmp)
+ X<-P[1]
+ Y<-P[2]
+ Houkou<-varargin[[I+1]]
+ Mojiretu<-varargin[[I+2]]
+ Hset<-Houkou
+ Vhoko<-"c"
+ if(length(grep("n",Hset))>0)
+ {
+ Vhoko<-"n"; Y<-Y+MEMORI
+ }
+ if(length(grep("s",Hset))>0)
+ {
+ Vhoko<-"s"; Y<-Y-MEMORI
+ }
+ Hhoko<-"c"
+ if(length(grep("e",Hset))>0)
+ {
+ Hhoko<-"e"; X<-X+MEMORI
+ }
+ if(length(grep("w",Hset))>0)
+ {
+ Hhoko<-"w"; X<-X-MEMORI
+ }
+ Hoko<-paste(Vhoko,Hhoko,sep="")
+ Suu<-"+-.0123456789"
+ SuuL<-Suu
+ J<-1; Dstr<-""
+ while (J<=nchar(Houkou))
+ {
+ Tmp<-substring(Houkou,J,J)
+ if(length(grep(Tmp,SuuL))>0)
+ {
+ if(Dstr=="") Hk<-substring(Houkou,J-1,J-1)
+ Dstr<-paste(Dstr,Tmp,sep="")
+ }
+ else
+ {
+ if(Dstr!="")
+ {
+ Nmbr<-as.numeric(Dstr)
+ D<-Nmbr*MEMORI
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
+ Dstr<-""
+ }
+ }
+ J<-J+1
+ }
+ if(Dstr!="")
+ {
+ Nmbr<-as.numeric(Dstr)
+ D<-Nmbr*MEMORI;
+ if(Hk=="n") Y<-Y+D
+ if(Hk=="s") Y<-Y-D
+ if(Hk=="e") X<-X+D
+ if(Hk=="w") X<-X-D
+ }
+ CalcWidth(Hoko,Mojiretu)
+ CalcHeight(Hoko,Mojiretu)
+ cat("\\put(",file=Wfile,append=TRUE)
+ Tmp1<- sprintf("%7.7f",X) # 11.07.19
+ Tmp2<- sprintf("%7.7f",Y) # 11.07.19
+ Str<-paste(Tmp1,",",Tmp2,sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Tmp<-"){\\hspace*{\\Width}"
+ Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+}
+
+######################################################
+
+Letterrot<- function(...)
+{
+ varargin<- list(...)
+ P<- varargin[[1]]
+ V<- varargin[[2]]; N<- 3
+ P<- Doscaling(P)
+ V<- Doscaling(V)
+ Tmov<- 0
+ Tmp<- varargin[[N]]
+ if(mode(Tmp)=="numeric"){
+ Tmov<- Tmp; N<- N+1
+ }
+ Nmov<- 0
+ Tmp<- varargin[[N]]
+ if(mode(Tmp)=="numeric"){
+ Nmov<- Tmp; N<- N+1
+ }
+ Mojiretu<- Assign(varargin[[N]]) #2017.11.26
+ Tv<- 1/Norm(V)*V
+ Nv<- c(-Tv[2],Tv[1])
+ P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv
+ Tmp<- acos(V[1]/Norm(V))
+ Theta<- round(Tmp*180/pi)
+ if(V[2]>=0){
+ Units<- ""
+ }
+ else{
+ Units<- "units=-360,"
+ }
+ Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="")
+ Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="")
+ Letter(P,"c",Tmp)
+}
+
+###################################
+# 10.12.04
+
+Lineplot<-function(...)
+{
+ varargin <- list(...)
+ Nargs<-length(varargin)
+ A<-varargin[[1]]
+ if(is.numeric(A)) {
+ Tmp<-length(A)
+ if(Tmp>3) {
+ B <- A[(Tmp/2+1):Tmp]
+ A <- A[1:(Tmp/2)]
+ Is <- 2
+ }
+ else {
+ B<-varargin[[2]]
+ Is <- 3
+ }
+ }
+ else {
+ B<-A[[2]]
+ A<-A[[1]]
+ Is <- 2
+ }
+ Mag <- 100 ; Semi <- "" ## 10.12.04
+ for (I in Looprange(Is,Nargs)) {
+ Tmp <- varargin[[I]]
+ switch ( mode(Tmp),
+ "numeric"= Mag <- Tmp,
+ "character"= Semi <- Tmp
+ )
+ }
+V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here
+ if(Semi=="") {
+ Out<- Listplot(c(A-V,A+V))
+ }
+ else if(Semi=="+") {
+ Out<- Listplot(c(A,A+V))
+ }
+ else {
+ Out<- Listplot(c(A-V,A))
+ } ## 10.12.04 to here
+ return(Out)
+}
+
+################################
+
+Listplot<-function(...)
+{
+ varargin<-list(...);
+ Z<-c();
+ for (I in 1:length(varargin))
+ {
+ Data<-varargin[[I]];
+ if(mode(Data)=="numeric")
+ {
+ if(class(Data)=="numeric")
+ {
+ Tmp<-matrix(Data,nrow=2);
+ Tmp<-t(Tmp);
+ Z<-Appendrow(Z,Tmp)
+ }
+ else
+ Z<-Appendrow(Z,Data)
+ }
+ else
+ {
+ for (J in 1:length(Data))
+ {
+ Tmp<-Data[[J]];
+ Z<-Appendrow(Z,Tmp)
+ }
+ }
+ }
+ return(Z)
+}
+
+##############################
+
+MakeBowdata <- function(PA,PB,H)
+{
+ Eps <- 10^(-5)
+ BOWSTART <<- PA
+ BOWEND <<- PB
+ D <- 1/2*Norm(PB-PA)
+ R <- (H^2+D^2)/(2*H)
+ A1 <- PA[1]; A2<-PA[2]
+ B1 <- PB[1]; B2<-PB[2]
+ if(abs(A2-B2)>Eps){
+# x <- poly(0,"X")
+# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)
+# Eq1 <- (A1-x)^2+(A2-y)^2-R^2
+# Tmp <- coeff(Eq1)
+# C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3]
+ C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2
+ C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2
+ C2<- 1+(A1-B1)^2/(A2-B2)^2
+ Det <- sqrt(C1^2-4*C0*C2)
+ Ansx1 <- (-C1+Det)/(2*C2)
+ Ansx2 <- (-C1-Det)/(2*C2)
+ Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)
+ PC <- c(Ansx1,Tmp)
+ Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2)
+ PC2 <- c(Ansx2,Tmp)
+ }
+ else{
+ Tmp <- 0.5*(PA+PB)
+ PC <- Tmp+c(0,R-H) # 11.06.02
+ PC2 <- Tmp-c(0,R-H)
+ }
+ VA <- PA-PC
+ VB <- PB-PC
+ if(VA[1]*VB[2]-VA[2]*VB[1]<0) {
+ PC <- PC2
+ }
+ AngA <- acos((PA[1]-PC[1])/R)
+ if(PA[2]-PC[2]<0){
+ AngA <- -AngA
+ }
+ AngB <- acos((PB[1]-PC[1])/R)
+ if(PB[2]-PC[2]<0){
+ AngB <- -AngB
+ }
+ if(AngA>AngB) {
+ AngB <- AngB+2*pi
+ }
+ Out <- list(PC,R,AngA,AngB)
+ return(Out)
+}
+
+####################################################
+
+MakeCurves<-function(...){ ## Scaling is implemented
+ varargin<-list(...)
+ Figdata<-varargin[[1]]
+ if(class(Figdata)=="numeric"){
+ Figdata<-matrix(Figdata,nrow=1)
+ }
+ Ptout<-1
+ if(length(varargin)>=2) Ptout<-varargin[[2]]
+ Eps<-10.0^(-6)
+ IndM<-Dataindex(Figdata)
+ Atos<-c()
+ for (Nd in 1:Nrow(IndM)){
+ Tmp<-IndM[Nd,]
+ Motos<-Figdata[Tmp[1]:Tmp[2],]
+ All<-Nrow(Motos)
+ if(Nrow(Motos)==1){
+ if(InWindow(Motos)=="o"){
+ next
+ }
+ Tmp1<- as.numeric(Motos)
+ if(Ptout==1){
+ Drwpt(Tmp1)
+ }
+ else{
+ Tmp1<- Doscaling(Tmp1)
+ Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1)
+ next
+ }
+ }
+ Crv<-c()
+ for (I in Looprange(2,All)){
+ P<- Op(I-1,Motos)
+ Q<- Op(I,Motos)
+ Snbn<-MeetWindow(P,Q)
+ if(length(Snbn)==0){
+ if(length(Crv)>0){
+ Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
+ Crv<-c()
+ }
+ }
+ else{
+ if(Norm(Snbn[1,]-Snbn[2,])<Eps){ next} # naosi 101202
+ if(length(Crv)==0){
+ Crv<-Snbn
+ }
+ else{
+ Tmp<-Op(Nrow(Crv),Crv)
+ if(Norm(Tmp-Op(1,Snbn))<Eps){
+ Crv<-Appendrow(Crv,Op(2,Snbn))
+ }
+ else{
+ Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
+ Crv<-Snbn
+ }
+ }
+ }
+ }
+ if(Nrow(Crv)>=2)
+ {
+ Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv))
+ }
+ }
+ Outdata<-Atos[2:Nrow(Atos),]
+ if(class(Outdata)=="numeric")
+ {
+ Outdata<-matrix(Outdata,nrow=1)
+ }
+ return(Outdata)
+}
+
+######################################
+
+Makehasen<- function(Figdata,Sen,Gap,Ptn)
+{
+ Eps<- 10.0^(-6)
+ Clist<- MakeCurves(Figdata)
+ DinM<- Dataindex(Clist)
+ for (N in Looprange(1,Nrow(DinM))){
+ Tmp<- DinM[N,]
+ Data<- Clist[Tmp[1]:Tmp[2],]
+ Dtall<- Nrow(Data)
+ Len<- 0
+ Lenlist<- c(0)
+ for (I in Looprange(2,Dtall)){
+ Len<- Len+Norm(Data[I,]-Data[I-1,])
+ Lenlist<- c(Lenlist,Len)
+ }
+ Lenall<- Lenlist[Dtall]
+ if(Lenall==0){
+ next
+ }
+ Kari<- (Sen+Gap)*0.1
+ Naga<- Sen*0.1
+ Tobi<- Gap*0.1
+ if(Norm(Data[1,]-Data[Dtall,])<Eps){
+ Nsen<- max(ceiling(Lenall/Kari),3)
+ SegUnit<- Lenall/Nsen
+ Naga<- SegUnit*Sen/(Sen+Gap)
+ Tobi<- SegUnit*Gap/(Sen+Gap)
+ SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
+ }
+ else{
+ if(Ptn==0){
+ Nsen<- max(ceiling((Lenall+Tobi)/Kari),3)
+ SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap)
+ Naga<- SegUnit*Sen/(Sen+Gap)
+ Tobi<- SegUnit*Gap/(Sen+Gap)
+ SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
+ }
+ else{
+ Nsen<- max(ceiling((Lenall+Naga)/Kari),3)
+ SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap)
+ Naga<- SegUnit*Sen/(Sen+Gap)
+ Tobi<- SegUnit*Gap/(Sen+Gap)
+ SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit))
+ }
+ }
+ Hajime<- 1; Owari<- 1
+ Mojisu<- 0
+ for (I in Looprange(1,length(SegList))){
+ Len<- SegList[I]
+ J<- Owari
+ while (Len>=Lenlist[J]-Eps){
+ if(J==Dtall){
+ break
+ }
+ J<- J+1
+ }
+ Hajime<- J-1
+ J<- Hajime
+ while (Len+Naga>Lenlist[J]-Eps){
+ if(J==Dtall){
+ break
+ }
+ J<- J+1
+ }
+ Owari<- J-1
+ T<- (Len-Lenlist[Hajime])
+ T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime])
+ P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,])
+ X<- as.character(round(MilliIn*P[1]))
+ Y<- as.character(-round(MilliIn*P[2]))
+ Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ for (J in Looprange(Hajime+1,Owari)){
+ P<- Data[J,]
+ X<- as.character(round(MilliIn*P[1]))
+ Y<- as.character(-round(MilliIn*P[2]))
+ Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ }
+ T<- (Len+Naga-Lenlist[Owari])
+ T<- T/(Lenlist[Owari+1]-Lenlist[Owari])
+ P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,])
+ X<- as.character(round(MilliIn*P[1]))
+ Y<- as.character(-round(MilliIn*P[2]))
+ Str1<- paste("\\special{pa ",X," ",Y,"}",sep="")
+ Str2<- "\\special{fp}"
+ cat(Str1,file=Wfile,append=TRUE)
+ cat(Str2,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str1)+nchar(Str2)
+ if(Mojisu>80){
+ cat("%\n",file=Wfile,append=TRUE)
+ Mojisu<- 0
+ }
+ }
+ }
+ cat("%\n%\n",file=Wfile,append=TRUE);
+}
+
+######################################
+
+Makeliststr<- function(L)
+{
+ Out="list("
+ for (I in 1:length(L)){
+ Dt<- L[[I]]
+ if(mode(Dt)=="numeric"){
+ if(length(Dt)==1){
+ Dts<- as.character(Dt)
+ }
+ else{
+ Dts<- "c("
+ for (J in Looprange(1,Nrow(Dt))){
+ for (K in 1:ncol(Dt)){
+ Dts<- paste(Dts,as.character(Dt[J,K]),sep="")
+ if(K< ncol(Dt)){
+ Dts<- paste(Dts,",",sep="")
+ }
+ }
+ if(J<Nrow(Dt)){
+ Dts<- paste(Dts,";",sep="")
+ }
+ else{
+ Dts<- paste(Dts,")",sep="")
+ }
+ }
+ }
+ }
+ if(mode(Dt)=="character"){
+ Dts<- paste(Prime(),Dt,Prime(),sep="")
+ }
+ if(mode(Dt)=="list"){
+ Dts<- Makeliststr(Dt)
+ }
+ Out<- paste(Out,Dts,sep="")
+ if(I<length(L)){
+ Out<- paste(Out,",")
+ }
+ else{
+ Out<- paste(Out,")",sep="")
+ }
+ }
+ return(Out)
+}
+
+############################################
+
+Makeshasen<- function(PtnL,PA,V,Bdy)
+{
+ Eps<- 10^(-6)
+ TenL<- KoutenList(PA,V,Bdy)
+ Nten<- length(TenL)
+ Call<- length(Bdy)
+ Ptn<- c(seq(0, 0, length=Call))
+ Out<- list()
+ GL<- c()
+ Te<- -10^6
+ for (I in Looprange(1,Nten-1)){
+ TenP<- Op(I,TenL); TenQ<- Op(I+1,TenL)
+ Ts<- Op(1,TenP)
+ P<- Op(2,TenP); Q<- Op(2,TenQ)
+ NC<- Op(4,TenP)
+ Tmp<- (Op(NC,Ptn)+1) %% 2
+ Ptn[NC]<- Tmp
+ if(Op(1,TenQ)-Ts>Eps){
+ if(Member(Ptn,PtnL)){
+ if(abs(Te-Ts)>Eps){
+ if(Nrow(GL)>0){
+ Tmp<- Mixjoin(Out, list(GL))
+ Out<- Tmp
+ }
+ GL<- Listplot(P,Q)
+ }
+ else{
+ Tmp <- Appendrow(GL, Q)
+ GL<- Tmp
+ }
+ Te<- Op(1,TenQ)
+ }
+ }
+ }
+ if(Nrow(GL)>0){
+ Tmp<- Mixjoin(Out, list(GL))
+ Out<- Tmp
+ }
+ return(Out)
+}
+
+#############################################
+
+Mawarikomi<- function(...)
+{
+ varargin<- list(...)
+ haba<- "10cm"
+ Nargs<- length(varargin)
+ if(Nargs>0){
+ haba<- varargin[[1]]
+ }
+ cat("\\begin{mawarikomi}%\n",file="",append=TRUE)
+ cat("%<1>[5](0,0)%\n",file="",append=TRUE)
+ Str<- paste("{",haba,"}{%\n",sep="")
+ cat(Str,file="",append=TRUE)
+ cat("}%\n",file="",append=TRUE)
+ cat("\\end{mawarikomi}",file="",append=TRUE)
+}
+
+##############################################
+
+MeetWindow<-function(PA,PB)
+{
+ if(InWindow(PA)=="i" && InWindow(PB)=="i")
+ {
+ R<-Appendrow(PA,PB)
+ return(R)
+ };
+ Horner<-function(n,t)
+ {
+ PT<-(1-t)*PA+t*PB;
+ return(PT[n])
+ }
+ Eps<-10.0^(-6);
+ Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1);
+ if(PA[1]!=PB[1])
+ {
+ Txm<-(XMIN-PA[1])/(PB[1]-PA[1]);
+ TxM<-(XMAX-PA[1])/(PB[1]-PA[1]);
+ }
+ if(PA[2]!=PB[2])
+ {
+ Tym<-(YMIN-PA[2])/(PB[2]-PA[2]);
+ TyM<-(YMAX-PA[2])/(PB[2]-PA[2]);
+ }
+ Tmp<-Horner(2,Txm);
+ if(Tmp<YMIN-Eps || Tmp>YMAX+Eps)
+ {
+ Txm<-(-1);
+ }
+ Tmp<-Horner(2,TxM);
+ if(Tmp<YMIN-Eps || Tmp>YMAX+Eps)
+ {
+ TxM<-(-1)
+ }
+ Tmp<-Horner(1,Tym);
+ if(Tmp<XMIN-Eps || Tmp>XMAX+Eps)
+ {
+ Tym<--1
+ }
+ Tmp<-Horner(1,TyM);
+ if(Tmp<XMIN-Eps || Tmp>XMAX+Eps)
+ {
+ TyM<--1
+ }
+ Tans<-sort(c(Txm,TxM,Tym,TyM));
+ Tmp<-c();
+ for (I in 1:length(Tans))
+ {
+ Tmp1<-Tans[I];
+ if(Tmp1>-Eps && Tmp1<1+Eps)
+ {
+ if(length(Tmp)==0)
+ {
+ Tmp<-c(Tmp1);
+ }
+ else
+ {
+ if(abs(Tmp[length(Tmp)]-Tmp1)>Eps)
+ {
+ Tmp<-c(Tmp,Tmp1)
+ }
+ }
+ }
+ }
+ Tans<-Tmp;
+ if(length(Tans)==0)
+ {
+ R<-c();
+ return(R);
+ }
+ if(length(Tans)==1)
+ {
+ Ten1<-Horner(1:2,Tans[1]);
+ if(InWindow(PA)=="i")
+ {
+ R<-Appendrow(PA,Ten1)
+ return(R)
+ }
+ else
+ {
+ R<-Appendrow(Ten1,PB)
+ return(R)
+ }
+ }
+ Ten1<-Horner(1:2,Tans[1])
+ Ten2<-Horner(1:2,Tans[2])
+ R<-Appendrow(Ten1,Ten2)
+ return(R)
+}
+
+#########################################
+
+# New 10.03.21
+
+Mixjoin<-function(...)
+{
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ M<- list()
+ for (I in 1:Nargs)
+ {
+ Tmp<-varargin[[I]]
+ if(length(Tmp)==0) next
+ if(Mixtype(Tmp)==1)
+ {
+ Tmp<-list(Tmp)
+ }
+ if(length(M)==0){
+ M <- Tmp
+ }
+ else{
+ M<- c(M,Tmp)
+ }
+ }
+ return(M)
+}
+
+#################################
+
+Mixlength<- function(PL){
+ if(length(PL)==0){
+ return(0)
+ }
+ if(Mixtype(PL)==1){
+ Out<- Nrow(PL)
+ }
+ else{
+ Out<- length(PL)
+ }
+ return(Out)
+}
+
+###########################################
+
+Mixtype<- function(D)
+{
+ if(mode(D)!="list") return(1)
+ for (I in 1:length(D))
+ {
+ Tmp<- D[[I]]
+ if(mode(Tmp)=="list") return(3)
+ }
+ return(2)
+}
+
+###########################################
+
+Naigai<- function(A,Bdy)
+{
+ V<- c(1,1)
+ Call<-length(Bdy)
+ KL<- KoutenList(A,V,Bdy)
+ Ptn<- seq(1,1,length=Call)
+ for (K in Looprange(1,length(KL)))
+ {
+ Ten<- Op(K,KL)
+ T<- Op(1,Ten); NC<- Op(4,Ten)
+ if(T<0)
+ {
+ Tmp<- (Ptn[NC]+1) %% 2
+ Ptn[NC]<- Tmp
+ }
+ }
+ return(Ptn)
+}
+
+########################################
+
+Nearestpt<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ PL1<- varargin[[1]]
+ if(!is.matrix(PL1)){
+ Tmp<- matrix(PL1);
+ PL1<- t(Tmp)
+ }
+ if(Nrow(PL1)==1) Flg=0
+ else Flg=1
+ Eps<- 10.0^(-6)
+ PL<- varargin[[2]]
+ Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,]))
+ for(N in Looprange(1,Nrow(PL1))){
+ PA<- PL1[N,]
+ Pm<- PL[1,]
+ Im<- 1
+ Sm<- Norm(Pm-PA)
+ for(I in Looprange(1,Nrow(PL)-1)){
+ A1<- PL[I,1]; A2<-PL[I,2]
+ B1<- PL[I+1,1]; B2<-PL[I+1,2]
+ V1<- B1-A1; V2<-B2-A2
+ X1<- PA[1]; X2<-PA[2]
+ Tmp<-V2^2+V1^2
+ if(abs(Tmp)<Eps) next
+ T<- (-A2*V2-V1*A1+V1*X1+X2*V2)/Tmp
+ if(T< -Eps){
+ P<- c(A1,A2)
+ }else{
+ if(T>1+Eps){
+ P<- c(B1,B2)
+ }else{
+ P<- c(A1+T*V1,A2+T*V2)
+ }
+ }
+ S<- Norm(P-PA)
+ if(S<Sm-Eps){
+ Tmp<- Paramoncurve(P,I,PL)
+ Pm<- P; Im<- Tmp; Sm<- S
+ }
+ }
+ if(Sm<Op(5,Ans)) Ans<- list(PA,N,Pm,Im,Sm)
+ if(Flg==0){
+ Ans<- Ans[3:5]
+ }
+ }
+ return(Ans)
+}
+
+#########################################
+
+Newlength<- function()
+{
+ Tmp1<- "\\newlength{\\Width}%\n"
+ Tmp2<- "\\newlength{\\Height}%\n"
+ Tmp3<- "\\newlength{\\Depth}%\n"
+ cat(Tmp1,file="",append=TRUE);
+ cat(Tmp2,file="",append=TRUE);
+ cat(Tmp3,file="",append=TRUE);
+}
+
+#########################################
+
+Numptcrv<-function(Fig)
+{
+ return(Nrow(Fig))
+}
+
+# 2018.01.29
+Length<- function(Data){
+ if(is.matrix(Data)){return(nrow(Data))}
+ if(is.character(Data)){return(nchar(Data))}
+ return(length(Data))
+}
+
+#########################################
+
+Op<-function(N,Data)
+{
+ C <- c()
+ if(length(Data)==0) return(C)
+ if(mode(Data)=="list"){
+ if(class(Data)=="data.frame"){ # 10.02.23
+ C<- Data[N,]
+ }
+ else{
+ C<- Data[[N]]
+ }
+ return(C)
+ }
+ if(mode(Data)=="character"){
+ if(length(Data)==1){
+ C<- substring(Data,N,N)
+ }
+ else{
+ C<- Data[N]
+ }
+ return(C)
+ }
+ if(mode(Data)=="numeric"){
+ if(class(Data)=="matrix"){
+ Din<- Dataindex(Data)
+ if(nrow(Din)==1){
+ C<- Data[N,]
+ }
+ else{
+ Tmp1<- Din[N,1]
+ Tmp2<- Din[N,2]
+ C<- Data[Tmp1:Tmp2,]
+ }
+ }
+ else{
+ C=Data[N]
+ }
+ }
+ return(C)
+}
+
+#########################################
+# 2013.05.20 Changed ( Creator recorded)
+# 2013.12.18 Beginpicture inclued
+
+Openfile<-function(...)
+{
+ varargin<- list(...)
+ File<- varargin[[1]]
+ Bflg<- 0
+ Wfile<<- File
+ Creator<- ""
+ Cflg<- 0
+ Nargs<- length(varargin)
+ for(N in Looprange(2,Nargs)){
+ Tmp<- varargin[[N]]
+ Tmp1<- strsplit(Tmp,"=",fixed=TRUE)
+ Tmp1<- Tmp1[[1]]
+ if(length(Tmp1)>1){
+ Creator<- Tmp1[2]
+ Cflg<- 1
+ }
+ else{
+ Unitstr<- Tmp
+ Bflg<- 1
+ }
+ }
+ Recentf<- ""
+ Fv<- list.files()
+ Nv<- grep("\\.r$", Fv)
+ Rfiles<- Fv[Nv]
+ StrW<- paste("%%% ",File,sep="") #17.10.28
+ StrC<- paste("%%% Generator=",Creator,sep="")
+ if(Cflg==0){
+ }
+ cat(StrW,"\n",file=Wfile)
+ cat(StrC,"\n",file=Wfile,append=TRUE)
+ if(Bflg==1){
+ Beginpicture(Unitstr)
+ }
+}
+
+#########################################
+
+Openpar<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Tmp<- varargin[[1]]
+ Tmp1<- substr(Tmp,1,1)
+ if(Tmp1=="\\"){
+ Namestr<- Tmp
+ N<- 2
+ }
+ else{
+ Namestr<- "\\tmp"
+ N<- 1
+ }
+ Habastr<- varargin[[N]]
+ if(Nargs>N){
+ Posstr<- paste("[",varargin[[N+1]],"]",sep="")
+ }
+ else{
+ Posstr<- "[c]"
+ }
+ Openphr(Namestr)
+ S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="")
+ cat(S,file=Wfile,append=TRUE)
+}
+
+###################################
+
+Openphr<- function(Str)
+{
+ S<- paste("\\def",Str,"{%\n",sep="")
+ cat(S,file=Wfile,append=TRUE)
+}
+
+#####################################
+
+Ovalbox<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Pos<- varargin[[1]]
+ Dr<- varargin[[2]]
+ StrV<- varargin[[3]]
+ R<- 0.2
+ NDflg<- 0
+ for (I in Looprange(4,Nargs)){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric"){
+ R<- Tmp
+ }
+ else{
+ if(substr(Tmp,1,1)=="-"){
+ NDflg<- 1
+ Tmp1<- substr(Tmp,2,nchar(Tmp))
+ Cmdstr<- chartr("*","G",Tmp1)
+ }
+ }
+ }
+ Xr<- c(XMIN,XMAX)
+ Yr<- c(YMIN,YMAX)
+ Uv<- 0.6; Uh<- 0.8
+ N<- nchar(StrV)
+ W<- Uh;H<- Uv*N
+ Setwindow(c(-W/2,W/2),c(-H,0))
+ G<- Ovaldata(c(0,-H/2),W/2,H/2,R)
+ Openphr("\\ketpictmp")
+ Beginpicture("1cm")
+ if(NDflg==0){
+ Drwline(G)
+ }
+ else{
+ eval(parse(text=Cmdstr))
+ }
+ for (I in Looprange(1,N)){
+ Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV))
+ }
+ Endpicture(0)
+ Closephr()
+ Setwindow(Xr,Yr)
+ Letter(Pos,Dr,"\\ketpictmp")
+}
+
+##########################################
+
+Ovaldata<- function(...) #17.09.11
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==1){
+ Eps<- 1.0*10^(-4)
+ C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2)
+ Dx<- XMAX-C(1)-Eps
+ Dy<- YMAX-C(2)-Eps
+ N<- 1
+ }
+ else{
+ C<- varargin[[1]]
+ Dx<- varargin[[2]]
+ Dy<- varargin[[3]]
+ N<- 4
+ }
+ Rc<- 0.2
+ if(N<=Nargs){ #15.11.15
+ Rc<- varargin[[N]]*Rc #15.11.15
+ }
+ Out<- c()
+ P<- C+c(Dx-Rc,Dy-Rc)
+ Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29
+ Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy))
+ Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc))
+ G<- Joincrvs(Tmp3,Tmp1,Tmp2)
+ Tmp<- Reflectdata(G,c(C,C+c(0,1)))
+ G<- Joincrvs(G,Tmp)
+ Tmp<- Reflectdata(G,c(C,C+c(1,0)))
+ Out<- Joincrvs(G,Tmp)
+}
+
+#########################################
+
+Paramark<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ PA<- varargin[[1]]
+ PB<- varargin[[2]]
+ PC<- varargin[[3]]
+ R<- 0.5
+ if(Nargs>=4){
+ R<- varargin[[4]]*R
+ }
+ U<- R*(PA-PB)/Norm(PA-PB)
+ V<- R*(PC-PB)/Norm(PC-PB)
+ if(Crossprod(PA-PB,PC-PB)!=0){
+ P<- Listplot(c(PB+U,PB+U+V,PB+V))
+ }
+ else{
+ P<- c()
+ }
+}
+
+###########################################
+
+Paramoncurve<-function(...){
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ Eps<-10^(-8)
+ P<-varargin[[1]]
+ Gdata<-varargin[[Nargs]]
+ if(Nrow(P)>1){
+ Tmp<-P; P<-Gdata; Gdata<-Tmp
+ }
+ if(Nargs==2){
+ Tmp<-Nearestpt(P,Gdata)
+ Out<-Tmp[[2]]
+ return(Out)
+ }
+ N<-varargin[[2]]
+ PtL<-Gdata
+ N=min(N,Length(PtL)-1) #18.02.11from
+ Pa<-Ptcrv(N,PtL)
+ Pb<-Ptcrv(N+1,PtL)
+ V<-Pb-Pa
+ W<-P-Pa
+ D2<-Norm(V)^2
+ if(D2<Eps) return(0)
+ S<-Dotprod(V,W)/D2
+ S<-min(max(S,0),1)
+ Out=N+S #18.02.11until
+ return(Out)
+}
+
+##############################################
+
+Paramplot<- function(...)
+{
+ varargin<- list(...)
+ Eps<- 10^(-5)
+ Nargs<- length(varargin)
+ Fnflg<- 0
+ Fnstr<- varargin[[1]]; Is=2
+ Rgstr<- varargin[[Is]]; Is<- Is+1
+ Range<- c(0,2*pi)
+ N<- 50 # Numpoints
+ E<-c() # Exclusions
+ D<- Inf # Discont
+ for (I in Looprange(Is,Nargs))
+ {
+ Tmp<- varargin[[I]]
+ Tmp<- strsplit(Tmp,"=")
+ K<- Tmp[[1]]
+ Tmp<- K[1]
+ Lhs<- substring(Tmp,1,1)
+ Tmp1<- K[2]
+ Str<-paste(Lhs,"=",Tmp1,sep="")
+ eval(parse(text=Str))
+ }
+ Tmp<- strsplit(Rgstr,"=")
+ K<-Tmp[[1]]
+ if(length(K)>1)
+ {
+ Vname<- K[1]
+ Tmp1<- K[2]
+ Rng<- eval(parse(text=Tmp1))
+ }
+ else
+ {
+ Vname<- Rgstr
+ Rng<- c(0,2*pi)
+ }
+ T1<- Rng[1]; T2<- Rng[2]
+ Dt<- (T2-T1)/N #17.09.22
+ if(Fnflg==0)
+ {
+ Str<- gsub(Vname,"t",Fnstr)
+ }
+ if(abs(Dt)<Eps){ # 16.12.13
+ t=T1
+ P=eval(parse(text=Str))
+ return(P)
+ }
+ P<-c()
+ if(length(E)>0)
+ {
+ E<-sort(E)
+ E<E[length(E):1]
+ }
+ E<- c(E, Inf)
+ Tmp<- sort(E)
+ E<- E[length(Tmp):1]
+ Ke<- 1
+# for (t in seq(T1, T2+Eps, by=Dt)){#18.02.05
+ for(jj in 1:(N+1)){
+ t=T1+(jj-1)*Dt
+ Pa<- c()
+ if(t-E[Ke]< Eps)
+ {
+ if(Fnflg==0)
+ {
+ Tmp<-eval(parse(text=Str))
+ Pa<- Tmp
+ }
+ else
+ {
+ }
+ }
+ if(abs(t-E[Ke])<=Eps)
+ {
+ if(Nrow(P)>0 && Op(Nrow(P),P)!=c(Inf,Inf))
+ {
+ Pa<- c(Inf,Inf)
+ }
+ }
+ if(t-E[Ke]>Eps)
+ {
+ if(Fnflg==0)
+ {
+ Tmp<- eval(parse(text=Str))
+ Pa<- Tmp
+ }
+ else
+ {
+ }
+ Ke<-Ke+1
+ }
+ if(length(Pa)>0)
+ {
+ if(Pa[1]==Inf)
+ {
+ Tmp<-Appendrow(P,Pa)
+ P<-Tmp
+ }
+ else
+ {
+ if(Nrow(P)==0)
+ {
+ Tmp<- Appendrow(P,Pa)
+ P<-Tmp
+ }
+ else
+ {
+ Tmp<- Op(Nrow(P),P)
+ if(Tmp[1]==Inf)
+ {
+ Tmp<- Appendrow(P,Pa)
+ P<- Tmp
+ }
+ else
+ {
+ if(Norm(Tmp-Pa)<D)
+ {
+ Tmp<-Appendrow(P,Pa)
+ P<-Tmp
+ }
+ else
+ {
+ Tmp<- Appendrow(P,c(Inf,Inf),Pa)
+ P<- Tmp
+ }
+ }
+ }
+ }
+ }
+ }
+ Tmp<- Nrow(P)
+ Tmp1<- Op(Tmp,P)
+ if(Tmp1[1]==Inf)
+ {
+ P<- P[1:(Tmp-1),]
+ }
+ return(P)
+}
+
+#####################################
+
+Partcrv<- function(A,B,PkL)
+{
+ Eps<- 10.0^(-3)
+ if(mode(A)=="numeric" && length(A)==1){
+ if(A>B+Eps){
+ Npt<- Numptcrv(PkL)
+ Out1<- Partcrv(A,Npt,PkL)
+ Out2<- Partcrv(1,B,PkL)
+ Tmp<- Ptstart(PkL)-Ptend(PkL)
+ if(Norm(Tmp)<Eps){
+ Ans<- Joincrvs(Out1,Out2)
+ }
+ else{
+ Ans<- list(Out1,Out2)
+ }
+ return(Ans)
+ }
+ Is<- ceiling(A)
+ Ie<- floor(B)
+ PL<- c()
+ if(A<Is-Eps){
+ P<- (Is-A)*PkL[Is-1,]+(1-Is+A)*PkL[Is,]
+ PL<- c(P)
+ }
+ PL<- Appendrow(PL, PkL[Looprange(Is,Ie),])
+ if(B>Ie+Eps){
+ P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,]
+ PL<- Appendrow(PL,P)
+ }
+ Ans<- PL
+ return(Ans)
+ }
+ Tmp<- Nearestpt(A,PkL)
+ Ta<- Op(2,Tmp)
+ Tmp<- Nearestpt(B,PkL)
+ Tb<- Op(2,Tmp)
+ Ans<- Partcrv(Ta,Tb,PkL)
+}
+
+##########################################
+# 13.05.03
+
+Partframe<- function(Tb,St,Ed)
+{
+ G<- Dividetable(Tb)
+ Gw<- G[[1]]
+ Gt<- G[[2]]
+ Gy<- G[[3]]
+ Gwt<- Tb[[4]]
+ Gwy<- Tb[[5]]
+ Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]]))
+ Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]]))
+ Tmp1<- Ptstart(Gat[[St[1]]])
+ Tmp2<- Ptstart(Gay[[St[2]]])
+ Ps<- c(Tmp1[1],Tmp2[2])
+ Tmp1<- Ptstart(Gat[[Ed[1]]])
+ Tmp2<- Ptstart(Gay[[Ed[2]]])
+ Pe<- c(Tmp1[1],Tmp2[2])
+ Pars<- Paramoncurve(Ps,Gw)
+ Pare<- Paramoncurve(Pe,Gw)
+ if(Pars<Pare){
+ Out<- Partcrv(Pars,Pare,Gw)
+ }
+ else{
+ Tmp1<- Partcrv(Pars,Numptcrv(Gw),Gw)
+ Tmp2<- Partcrv(1,Pare,Gw)
+ Out<- Joincrvs(Tmp1,Tmp2)
+ }
+return(Out)
+}
+
+
+##########################################
+# 10.12.04
+
+Plotdata<- function(...)
+{
+ varargin<- list(...)
+ Eps<- 10^(-5)
+ Fnstr<- varargin[[1]]; Is<- 2
+ Fnflg<- 0
+ Rgstr<- varargin[[Is]]; Is<- Is+1
+ Tmp<- strsplit(Rgstr,"=")
+ K<-Tmp[[1]]
+ if(length(K)>1){
+ Vname<- K[1]
+ Tmp1<- K[2]
+ Rng<- eval(parse(text=Tmp1))
+ }
+ else{
+ Vname<- Rgstr
+ Rng<- c(XMIN,XMAX)
+ }
+ N<- 50 # Numpoints
+ E<-c() # Exclusions
+ Exfun<- "" # Exclusion function
+ D<- Inf # Discont
+ for (I in Looprange(Is,length(varargin))){
+ Tmp<- varargin[[I]]
+ Lhs<- substring(Tmp,1,1)
+ Tmp<- strsplit(Tmp,"=")
+ K<- Tmp[[1]]
+ Tmp1<- K[2]
+ Tmp2<- grep(Vname,Tmp1,fixed=TRUE) ## 10.12.04
+ if(length(Tmp2)==0){
+ Str<-paste(Lhs,"=",Tmp1,sep="")
+ eval(parse(text=Str))
+ }
+ else{
+ Exfun<-Tmp1
+ }
+ }
+ X1<- Rng[1]; X2<- Rng[2]
+ dx<- (X2-X1)/N # 17.09.22
+ if(Fnflg==0){
+ Str<- gsub(Vname,"x",Fnstr,fixed=TRUE)
+ }
+ if(abs(dx)<Eps){ # Scilab 16.12.13
+ x=X1
+ P=c(X1,eval(parse(text=Str)))
+ return(P)
+ }
+ Exfun<- gsub(Vname,"x",Exfun,fixed=TRUE)
+ P<-c()
+ if(length(E)>0){
+ E<-sort(E)
+ E<E[length(E):1]
+ }
+ E<- c(E, Inf)
+ Tmp<- sort(E)
+ E<- E[length(Tmp):1]
+ Ke<- 1
+ for (x in seq(X1,X2,by=dx)){
+ if(nchar(Exfun)>0){
+ Tmp<-eval(parse(text=Exfun))
+ if(abs(Tmp)<Eps){
+ P<- Appendrow(P,c(Inf,inf))
+ next
+ }
+ }
+ Pa<- c()
+ if(x-E[Ke]< -Eps){ ## 10.12.04
+ Tmp<-eval(parse(text=Str))
+ Pa<- c(x,Tmp)
+ }
+ if(abs(x-E[Ke])<=Eps){
+ if(Nrow(P)>0 && P[Nrow(P),]!=c(Inf,Inf)){
+ Pa<- c(Inf,Inf)
+ }
+ }
+ if(x-E[Ke]>Eps){
+ Tmp<- eval(parse(text=Str))
+ Pa<- c(x,Tmp)
+ Ke<-Ke+1
+ }
+ if(length(Pa)>0){
+ if(Pa[1]==Inf){
+ Tmp<-Appendrow(P,Pa)
+ P<-Tmp
+ }
+ else{
+ if(Nrow(P)==0){
+ Tmp<- Appendrow(P,Pa)
+ P<-Tmp
+ }
+ else{
+ Tmp<- P[Nrow(P),]
+ if(Tmp[1]==Inf){
+ Tmp<- Appendrow(P,Pa)
+ P<- Tmp
+ }
+ else{
+ if(Norm(Tmp-Pa)<D){
+ Tmp<-Appendrow(P,Pa)
+ P<-Tmp
+ }
+ else{
+ Tmp<- Appendrow(P,c(Inf,Inf),Pa)
+ P<- Tmp
+ }
+ }
+ }
+ }
+ }
+ }
+ Tmp<- Nrow(P)
+ Tmp1<-P[Tmp,]
+ if(Tmp1[1]==Inf)
+ {
+ P<- P[1:(Tmp-1),]
+ }
+ return(P)
+}
+
+######################################
+
+Pointoncurve<-function(...)
+{
+ varargin<-list(...)
+ Eps<-10^(-4)
+ T<-varargin[[1]]
+ Gdata<-varargin[[2]]
+ if(Nrow(T)>1)
+ {
+ Tmp<-T; T<-Gdata; Gdata<-Tmp
+ }
+ PtL<-Gdata
+ N<-trunc(T+Eps);
+ S<-max(T-N,0);
+ if(N==Nrow(PtL))
+ {
+ Out<-PtL[N,]
+ }
+ else
+ {
+ Pa<-PtL[N,]
+ Pb<-PtL[N+1,]
+ Out<-(1-S)*Pa+S*Pb
+ }
+ return(Out)
+}
+
+##############################################
+# 10.11.20
+# 13.05.03 Inf
+
+Pointdata<-function(...)
+{
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ PL<- list()
+ for (I in Looprange(1,Nargs)){ # 10.11.20
+ DL<-varargin[[I]]
+ DL<- Flattenlist(DL) # 10.11.20 from here
+ for (J in Looprange(1,length(DL))){
+ Dt<- DL[[J]]
+ if(is.matrix(Dt)|| is.data.frame(Dt)){
+ for (K in 1:nrow(Dt)){
+ Tmp<- as.numeric(Dt[K,])
+ if(Tmp[1]<Inf){
+ PL<- c(PL,list(Tmp))
+ }
+ }
+ }
+ else{
+ PL<- c(PL,list(Dt))
+ }
+ }
+ } # to here
+ if(length(PL)==1)
+ {
+ PL<-PL[[1]]
+ }
+ return(PL)
+}
+
+##############################################
+
+Prime<- function(...)
+{
+ varargin<- list(...)
+ if(length(varargin)==0){
+ Out="'"
+ }
+ else{
+ Out<- paste(varargin[[1]],"'",sep="")
+ }
+ return(Out)
+}
+
+############################################
+# 17.09.29
+
+Ptcrv<-function(N,Fig)
+{
+ if(is.matrix(Fig)){
+ return(Fig[N,])
+ }
+ else{
+ return(Fig)
+ }
+}
+
+#########################################
+
+Ptend<-function(Fig)
+{
+ if(Length(Fig)>0){ #18.02.09
+ return(Op(Length(Fig),Fig))
+ }else{
+ return(c())
+ }
+}
+
+#########################################
+
+Ptne<-function(...)
+{
+ varargin<- list(...)
+ if(length(varargin)==0){
+ Out<- c(XMAX,YMAX)
+ }
+ else{
+ G<- varargin[[1]]
+ XM<- max(G[,1])
+ YM<- max(G[,2])
+ Out<- c(XM,YM)
+ }
+ return(Out)
+}
+
+#########################################
+
+Ptnw<-function(...)
+{
+ varargin<- list(...)
+ if(length(varargin)==0){
+ Out<- c(XMIN,YMAX)
+ }
+ else{
+ G<- varargin[[1]]
+ Xm<- min(G[,1])
+ YM<- max(G[,2])
+ Out<- c(Xm,YM)
+ }
+ return(Out)
+}
+
+#########################################
+
+Ptse<-function(...)
+{
+ varargin<- list(...)
+ if(length(varargin)==0){
+ Out<- c(XMAX,YMIN)
+ }
+ else{
+ G<- varargin[[1]]
+ XM<- max(G[,1])
+ Ym<- min(G[,2])
+ Out<- c(XM,Ym)
+ }
+ return(Out)
+}
+
+#############################################
+
+Ptstart<-function(Fig)
+{
+ if(Length(Fig)>0){ #18.02.09
+ return(Op(1,Fig))
+ }else{
+ return(c())
+ }
+}
+
+#########################################
+
+Ptsw<-function(...)
+{
+ varargin<- list(...)
+ if(length(varargin)==0){
+ Out<- c(XMIN,YMAX)
+ }
+ else{
+ G<- varargin[[1]]
+ Xm<- min(G[,1])
+ Ym<- min(G[,2])
+ Out<- c(Xm,Ym)
+ }
+ return(Out)
+}
+
+##############################################
+
+Putcell<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ TbL<- varargin[[1]]
+ Str<- varargin[[Nargs]]
+ if(mode(Str)=="numeric"){
+ Str<- as.character(Str)
+ }
+ Pos<- varargin[[Nargs-1]]
+ Nrg<- varargin[[2]]
+ if(mode(Nrg)=="character"){
+ if(Nargs==4){
+ Cell<- Findcell(TbL,Nrg)
+ }
+ else{
+ Mrg<- varargin[[3]]
+ Cell<- Findcell(TbL,Nrg,Mrg)
+ }
+ }
+ else{
+ Mrg<- varargin[[3]]
+ Cell<- Findcell(TbL,Nrg,Mrg)
+ }
+ Pt<- Cell[[1]]; Dr<- "c"
+ Posh<- substr(Pos,1,1)
+ Post<- substr(Pos,2,nchar(Pos))
+ if(toupper(Posh)=="R"){
+ Pt<- Pt+c(Cell[[2]],0)
+ if(nchar(Post)==0){
+ Dr<- "w1"
+ }
+ else{
+ Dr<- paste("w",Post,sep="")
+ }
+ }
+ if(toupper(Posh)=="L"){
+ Pt=Pt-c(Cell[[2]],0)
+ if(nchar(Post)==0){
+ Dr<- "e1"
+ }
+ else{
+ Dr<- paste("e",Post,sep="")
+ }
+ }
+ if(toupper(Posh)=="U"){
+ Pt<- Pt+c(0,Cell[[3]])
+ if(nchar(Post)==0){
+ Dr<- "s1"
+ }
+ else{
+ Dr<- paste("s",Post,sep="")
+ }
+ }
+ if(toupper(Posh)=="D"){
+ Pt<- Pt-c(0,Cell[[3]])
+ if(nchar(Post)==0){
+ Dr<- "n1"
+ }
+ else{
+ Dr<- paste("n",Post,sep="")
+ }
+ }
+ if(toupper(Posh)=="B"){
+ Pt<- Pt-c(0,Cell[[3]])
+ if(nchar(Post)==0){
+ Dr<- "n1"
+ }
+ else{
+ Dr<- paste("n",Post,sep="")
+ }
+ Str<- paste("$\\mathstrut$",Str,sep="")
+ }
+ Letter(Pt,Dr,Str)
+}
+
+#############################################
+
+PutcoL<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ TbL<- varargin[[1]]
+ if(mode(TbL)!="list"){
+ return("Tabledata missing")
+ }
+ Ag<- varargin[[2]]
+ if(mode(Ag)=="numeric"){
+ CoL<- Ag
+ }
+ else{
+ Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ Clm<- c()
+ for (I in Looprange(1,nchar(Ag))){
+ C<- substr(Ag,I,I)
+ C<- toupper(C)
+ Tmp<- strsplit(Alpha,C)
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ Tmp1<- nchar(Tmp[1])
+ Clm<- c(Clm,Tmp1)
+ }
+ }
+ Nrg<- 0
+ for (I in seq(length(Clm),1,by=-1)){
+ Tmp<- Clm[I]
+ Tmp1<- length(Clm)-I
+ Nrg<- Nrg+Tmp*26^Tmp1
+ }
+ CoL<- Nrg
+ }
+ Nc<- length(TbL[[3]])+1
+ K<- 1
+ Dpos<- varargin[[3]]
+ for (I in Looprange(4,Nargs)){
+ if(I-3>Nc){
+ break
+ }
+ Dt<- varargin[[I]]
+ if(mode(Dt)!="list"){
+ Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02
+ K<- K+1
+ }
+ else{
+ N<- length(Dt)
+ Str<- Dt[[N]]
+ Rrng<- c(K,K+1)
+ Pos<- Dpos
+ for (J in Looprange(1,N-1)){
+ Tmp<- Dt[[J]]
+ if(mode(Tmp)=="numeric"){
+ Rrng<- c(K,K+Tmp)
+ }
+ if(mode(Tmp)=="character"){
+ Pos<- Tmp
+ }
+ }
+ Putcell(TbL,CoL,Rrng,Pos,Str)
+ K<- Crng[2]
+ }
+ }
+}
+
+Putcol<- function(...)
+{
+ PutcoL(...)
+}
+
+PutcoLexpr<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ TbL<- varargin[[1]]
+ if(mode(TbL)!="list"){
+ return("Tabledata missing")
+ }
+ Ag<- varargin[[2]]
+ if(mode(Ag)=="numeric"){
+ CoL<- Ag
+ }
+ else{
+ Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ Clm<- c()
+ for (I in Looprange(1,nchar(Ag))){
+ C<- substr(Ag,I,I)
+ C<- toupper(C)
+ Tmp<- strsplit(Alpha,C)
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ Tmp1<- nchar(Tmp[1])
+ Clm<- c(Clm,Tmp1)
+ }
+ }
+ Nrg<- 0
+ for (I in seq(length(Clm),1,by=-1)){
+ Tmp<- Clm[I]
+ Tmp1<- length(Clm)-I
+ Nrg<- Nrg+Tmp*26^Tmp1
+ }
+ CoL<- Nrg
+ }
+ Nc<- length(TbL[[3]])+1
+ K<- 1
+ Dpos<- varargin[[3]]
+ for (I in Looprange(4,Nargs)){
+ if(I-3>Nc){
+ break
+ }
+ Dt<- varargin[[I]]
+ if(mode(Dt)!="list"){
+ Dt<- paste("$",Dt,"$",sep="")
+ Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02
+ K<- K+1
+ }
+ else{
+ N<- length(Dt)
+ Str<- paste("$",Dt[[N]],"$",sep="")
+ Rrng<- c(K,K+1)
+ Pos<- Dpos
+ for (J in Looprange(1,N-1)){
+ Tmp<- Dt[[J]]
+ if(mode(Tmp)=="numeric"){
+ Rrng<- c(K,K+Tmp)
+ }
+ if(mode(Tmp)=="character"){
+ Pos<- Tmp
+ }
+ }
+ Putcell(TbL,CoL,Rrng,Pos,Str)
+ K<- Crng[2]
+ }
+ }
+}
+
+Putcolexpr<- function(...)
+{
+ PutcoLexpr(...)
+}
+
+#####################################################
+
+PutcoLstr<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Tb<- varargin[[1]]
+ Nr<- varargin[[2]]
+ Pos<- varargin[[3]]
+ Str<- varargin[[4]]
+ Sep<- ""
+ if(Nargs>4){
+ Sep<- varargin[[5]]
+ }
+ if(nchar(Sep)==0){
+ for (I in Looprange(1,nchar(Str))){
+ Tmp<- substr(Str,I,I)
+ Putcell(Tb,Nr,I,Pos,Tmp)
+ }
+ }
+ else{
+ Ltr<- ""
+ K<- 1
+ for (I in Looprange(1,length(Str))){
+ Tmp<- substr(Str,I,I)
+ if(Tmp==Sep){
+ Putcell(Tb,Nr,K,Pos,Ltr)
+ K<- K+1
+ Ltr<- ""
+ }
+ else{
+ Ltr<- paste(Ltr,Tmp,sep="")
+ }
+ }
+ if(nchar(Ltr)>0){
+ Putcell(Tb,Nr,K,Pos,Ltr)
+ }
+ }
+}
+
+#############################################
+
+Putrow<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ TbL<- varargin[[1]]
+ if(mode(TbL)!="list"){
+ return("Tabledata missing")
+ }
+ Row<- varargin[[2]]
+ Nr<- length(TbL[[2]])+1
+ K<- 1
+ Dpos<- varargin[[3]]
+ for (I in Looprange(4,Nargs)){
+ if(I-3>Nr){
+ break;
+ }
+ Dt<- varargin[[I]]
+ if(mode(Dt)!="list"){
+ Putcell(TbL,K,Row,Dpos,Dt) # 110308
+ K<- K+1
+ }
+ else{
+ N<- length(Dt)
+ Str<- Dt[[N]]
+ Crng<- c(K,K+1)
+ Pos<- Dpos
+ for (J in Looprange(1,N-1)){
+ Tmp<- Dt[[J]]
+ if(mode(Tmp)=="numeric"){
+ Crng<- c(K,K+Tmp)
+ }
+ if(mode(Tmp)=="character"){
+ Pos<- Tmp
+ }
+ }
+ Putcell(TbL,Crng,Row,Pos,Str)
+ K<- Crng[2]
+ }
+ }
+}
+
+Putrowexpr<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ TbL<- varargin[[1]]
+ if(mode(TbL)!="list"){
+ return("Tabledata missing")
+ }
+ Row<- varargin[[2]]
+ Nr<- length(TbL[[2]])+1
+ K<- 1
+ Dpos<- varargin[[3]]
+ for (I in Looprange(4,Nargs)){
+ if(I-3>Nr){
+ break;
+ }
+ Dt<- varargin[[I]]
+ if(mode(Dt)!="list"){
+ Dt<- paste("$",Dt,"$",sep="")
+ Putcell(TbL,K,Row,Dpos,Dt) #110308
+ K<- K+1
+ }
+ else{
+ N<- length(Dt)
+ Str<- paste("$",Dt[[N]],"$",sep="")
+ Crng<- c(K,K+1)
+ Pos<- Dpos
+ for (J in Looprange(1,N-1)){
+ Tmp<- Dt[[J]]
+ if(mode(Tmp)=="numeric"){
+ Crng<- c(K,K+Tmp)
+ }
+ if(mode(Tmp)=="character"){
+ Pos<- Tmp
+ }
+ }
+ Putcell(TbL,Crng,Row,Pos,Str)
+ K<- Crng[2]
+ }
+ }
+}
+
+####################################################
+
+Putrowstr<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Tb<- varargin[[1]]
+ Nr<- varargin[[2]]
+ Pos<- varargin[[3]]
+ Str<- varargin[[4]]
+ Sep<- ""
+ if(Nargs>4){
+ Sep<- varargin[[5]]
+ }
+ if(nchar(Sep)==0){
+ for (I in Looprange(1,nchar(Str))){
+ Tmp<- substr(Str,I,I)
+ Putcell(Tb,I,Nr,Pos,Tmp)
+ }
+ }
+ else{
+ Ltr<- ""
+ K<- 1
+ for (I in Looprange(1,length(Str))){
+ Tmp<- substr(Str,I,I)
+ if(Tmp==Sep){
+ Putcell(Tb,K,Nr,Pos,Ltr)
+ K<- K+1
+ Ltr<- ""
+ }
+ else{
+ Ltr<- paste(Ltr,Tmp,sep="")
+ }
+ }
+ if(nchar(Ltr)>0){
+ Putcell(Tb,K,Nr,Pos,Ltr)
+ }
+ }
+}
+
+############################################
+# 11.05.28
+
+Ratiocmyk<- function(Color)
+{
+ if(is.numeric(Color)){
+ return(Color)
+ }
+ R<-
+ switch(Color,
+ greenyellow=c(0.15,0,0.69,0),
+ yellow=c(0,0,1,0),
+ goldenrod=c(0,0.1,0.84,0),
+ dandelion=c(0,0.29,0.84,0),
+ apricot=c(0,0.32,0.52,0),
+ peach=c(0,0.5,0.7,0),
+ melon=c(0,0.46,0.5,0),
+ yelloworange=c(0,0.42,1,0),
+ orange=c(0,0.61,0.87,0),
+ burntorange=c(0,0.51,1,0),
+ bittersweet=c(0,0.75,1,0.24),
+ redorange=c(0,0.77,0.87,0),
+ mahogany=c(0,0.85,0.87,0.35),
+ maroon=c(0,0.87,0.68,0.32),
+ brickred=c(0,0.89,0.94,0.28),
+ red=c(0,1,1,0),
+ orangered=c(0,1,0.5,0),
+ rubinered=c(0,1,0.13,0),
+ wildstrawberry=c(0,0.96,0.39,0),
+ salmon=c(0,0.53,0.38,0),
+ carnationpink=c(0,0.63,0,0),
+ magenta=c(0,1,0,0),
+ violetred=c(0,0.81,0,0),
+ rhodamine=c(0,0.82,0,0),
+ mulberry=c(0.34,0.9,0,0.02),
+ redviolet=c(0.07,0.9,0,0.34),
+ fuchsia=c(0.47,0.91,0,0.08),
+ lavender=c(0,0.48,0,0),
+ thistle=c(0.12,0.59,0,0),
+ orchid=c(0.32,0.64,0,0),
+ darkorchid=c(0.4,0.8,0.2,0),
+ purple=c(0.45,0.86,0,0),
+ plum=c(0.5,1,0,0),
+ violet=c(0.79,0.88,0,0),
+ royalpurple=c(0.75,0.9,0,0),
+ blueviolet=c(0.86,0.91,0,0.04),
+ periwinkle=c(0.57,0.55,0,0),
+ cadetblue=c(0.62,0.57,0.23,0),
+ cornflowerblue=c(0.65,0.13,0,0),
+ midnightblue=c(0.98,0.13,0,0.43),
+ navyblue=c(0.94,0.54,0,0),
+ royalblue=c(1,0.5,0,0),
+ blue=c(1,1,0,0),
+ cerulean=c(0.94,0.11,0,0),
+ cyan=c(1,0,0,0),
+ processblue=c(0.96,0,0,0),
+ skyblue=c(0.62,0,0.12,0),
+ turquoise=c(0.85,0,0.2,0),
+ tealblue=c(0.86,0,0.34,0.02),
+ aquamarine=c(0.82,0,0.3,0),
+ bluegreen=c(0.85,0,0.33,0),
+ emerald=c(1,0,0.5,0),
+ junglegreen=c(0.99,0,0.52,0),
+ seagreen=c(0.69,0,0.5,0),
+ green=c(1,0,1,0),
+ forestgreen=c(0.91,0,0.88,0.12),
+ pinegreen=c(0.92,0,0.59,0.25),
+ limegreen=c(0.5,0,1,0),
+ yellowgreen=c(0.44,0,0.74,0),
+ springgreen=c(0.26,0,0.76,0),
+ olivegreen=c(0.64,0,0.95,0.4),
+ rawsienna=c(0,0.72,1,0.45),
+ sepia=c(0,0.83,1,0.7),
+ brown=c(0,0.81,1,0.6),
+ tan=c(0.14,0.42,0.56,0),
+ gray=c(0,0,0,0.5),
+ black=c(0,0,0,1),
+ white=c(0,0,0,0)
+ )
+ if(length(R)<4){
+ print("No color")
+ return(c())
+ }
+ return(R)
+}
+
+############################################
+# 11.01.07
+
+Readtextdata<- function(...)
+{
+ varargin<- list(...)
+ OutL<- list()
+ Nargs<- length(varargin)
+ Fname<- varargin[[1]]
+ Tmp<- readLines(Fname,n=1)
+ if(length(grep("\t",Tmp))>0){
+ Sep<- "\t"
+ }
+ else if(length(grep(",",Tmp))>0){
+ Sep<- ","
+ }
+ else{
+ Sep<- " "
+ }
+ Hajime<- c(1,1)
+ Owari<- c(Inf,Inf)
+ C<- Inf
+ R<- Inf
+ Rna<- FALSE
+ Cna<- TRUE
+ Mat<- FALSE
+ Num<- TRUE
+ D<- -Inf
+ Flg<- 0
+ for (I in Looprange(2,Nargs)){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric"){
+ if (Flg==0){
+ Hajime<- Tmp
+ Flg<- 1
+ }
+ else{
+ Owari<- Tmp
+ }
+ }
+ else{
+ eval(parse(text=Tmp))
+ }
+ }
+ Tmp<- Hajime+c(R-1,C-1)
+ Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2]))
+ if(Cna){
+ Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE)
+ }
+ else{
+ Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE)
+ Nv<- c(1:ncol(Df))
+ colnames(Df)<- Nv
+ }
+ if(Rna){
+ rownames(Df)<-Df[,1]
+ Hajime<- Hajime+c(0,1)
+ }
+ if(Mat){
+ M<- as.matrix(Df)
+ Tmp1<- min(Owari[1],nrow(M))
+ Tmp2<- min(Owari[2],ncol(M))
+ Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2])
+ if(Num){
+ Tmp1<- as.numeric(Out)
+ Out<- matrix(Tmp1,nrow=nrow(Out))
+ }
+ }
+ else{
+ Tmp1<- min(Owari[1],nrow(Df))
+ Tmp2<- min(Owari[2],ncol(Df))
+ Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2]
+ }
+ if(D!=-Inf){ # 11.01.20 v2
+ Tmp<- ncol(Out) # 11.01.07
+ Tmp1<- rep(Inf,Tmp)
+ Out[Out[,1]<=D,]<- Tmp1 # 11.01.07
+ }
+ return(Out)
+}
+
+##################################
+
+Reflectdata<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10^(-8)
+ ML<- varargin[[1]]
+ if(Mixtype(ML)==1){
+ ML<- list(ML)
+ }
+ if(Nargs==1){
+ PtA<- c(0,0); PtB<- PtA
+ }
+ else{
+ Pts<- varargin[[2]]
+ if(length(Pts)==2){
+ PtA<- Pts; PtB<- PtA
+ }
+ else{
+ PtA<- Pts[1:2]; PtB<- Pts[3:4]
+ }
+ }
+ OutL<- list()
+ for (N in Looprange(1,length(ML))){
+ GL<- Op(N,ML)
+ Out<- c()
+ for (I in Looprange(1,Nrow(GL))){
+ if(is.matrix(GL)){ # 10.12.07
+ Tmp<- GL[I,]
+ }
+ else{
+ Tmp<- GL
+ }
+ X1<- Tmp[1]
+ Y1<- Tmp[2]
+ if(X1==Inf){
+ X2<- X1
+ Y2<- Y1
+ }
+ else{
+ if(Norm(PtA-PtB)<Eps){
+ X2<- 2*PtA[1]-X1
+ Y2<- 2*PtA[2]-Y1
+ }
+ else{
+ U<- PtB[1]-PtA[1]
+ V<- PtB[2]-PtA[2]
+ A<- PtA[1]
+ B<- PtA[2]
+ X2<- (U^2-V^2)/(U^2+V^2)*X1+2*U*V/(U^2+V^2)*Y1
+ X2<- X2-2*V*(U*B-V*A)/(U^2+V^2)
+ Y2<- 2*U*V/(U^2+V^2)*X1-(U^2-V^2)/(U^2+V^2)*Y1
+ Y2<- Y2+2*U*(U*B-V*A)/(U^2+V^2)
+ }
+ }
+ Out<- Appendrow(Out,c(X2,Y2))
+ }
+ OutL<- Mixjoin(OutL,list(Out))
+ }
+ if(length(OutL)==1){
+ OutL<- Op(1,OutL)
+ }
+ return(OutL)
+}
+
+##########################################
+
+Writetextdata<- function(...)
+{
+ varargin<- list(...)
+ OutL<- list()
+ Nargs<- length(varargin)
+ Data<- varargin[[1]]
+ Fname<- varargin[[2]]
+ Sep=","
+ for (I in Looprange(3,Nargs)){
+ Tmp<- varargin[[I]]
+ eval(parse(text=Tmp))
+ }
+ write.table(Data,Fname,sep=Sep,row.names=FALSE,na="")
+}
+
+##########################################
+# 2014.12.17
+# 2015.10.29
+
+WriteOutData<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+# if modulo(Nargs,2)==0 then
+# Fname=Fnameout;
+# Nst=1;
+# else
+ Fname=varargin[[1]]
+ Nst=2;
+# end;
+ for(N in seq(Nst,Nargs,by=2)){
+ Gname=varargin[[N]]
+ Tmp=paste(Gname,"//",sep="")
+ if(N==Nst){
+ cat(Tmp,"\n",sep="",file=Fname)
+ }
+ else{
+ cat(Tmp,"\n",sep="",file=Fname,append=TRUE)
+ }
+ Gdata=varargin[[N+1]]
+ Gdata=Flattenlist(Gdata)
+ if(!is.list(Gdata)){Gdata=list(Gdata)}
+ for(K in Looprange(1,length(Gdata))){
+ GL=Dividegraphics(Gdata[[K]])
+# for(J in seq(1,length(GL))){
+ for(J in Looprange(1,length(GL))){
+ cat("start//","\n",sep="",file=Fname,append=TRUE)
+ Str=""
+ Iend=Numptcrv(GL[[J]])
+# for(II in seq(1,Iend)){
+ for(II in Looprange(1,Iend)){
+ Pt=Ptcrv(II,GL[[J]])
+ if(nchar(Str)>0){
+ Str=paste(Str,",",sep="")
+ }
+ if(length(Pt)<3){
+ Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="")
+ }
+ else{
+ Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="")
+ }
+ if(nchar(Str)>80){
+ cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE)
+ Str=""
+ }
+ }
+ if(nchar(Str)>0){
+ cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE)
+ }
+ if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){
+# cat("end////","\n",sep="",file=Fname,append=TRUE)
+ cat("end//","\n",sep="",file=Fname,append=TRUE)
+ }
+ else{
+ cat("end//","\n",sep="",file=Fname,append=TRUE)
+ }
+ }
+ }
+ }
+ cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05
+}
+
+###### Old ####################################
+# 2015.10.23
+ReadOutData<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Fname=varargin[[1]]
+ cmdall=readLines(Fname)
+ cmdall=gsub("//","",cmdall,fixed=TRUE)
+ varname=cmdall[1]
+ outdt=list()
+ varL=c()
+ ptL=list()
+ flg=0
+ for(cmd in cmdall){
+ if(nchar(cmd)>0){
+ if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){
+ if(cmd=="start"){
+ pts=c()
+ }
+ if(cmd=="end"){
+ ptL=c(ptL,list(pts))
+ }
+ if(substring(cmd,1,1)=="["){
+ tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="")
+ tmp1=strsplit(tmp1,"]",fixed=TRUE)
+ tmp1=tmp1[[1]]
+ tmp1=gsub(",[","c(",tmp1,fixed=TRUE)
+ for(st in tmp1){
+ tmp=eval(parse(text=paste(st,")",sep="")))
+ pts=rbind(pts,tmp)
+ }
+ row.names(pts)=1:nrow(pts)
+ }
+ }
+ else{
+ varname=cmd
+ varL=c(varL,varname)
+ if(flg==0){ # 17.10.07from
+ flg=1
+ }else{
+ outdt=c(outdt,list(ptL))
+ } # 17.10.07until
+ ptL=c()
+ }
+ }
+ }
+ outdt=c(outdt,list(ptL)) # 17.10.07
+ names(outdt)=varL
+ for(var in varL){
+ tmp=paste(var,"<<- outdt$",var,sep="")
+ eval(parse(text=tmp))
+ }
+# print(varL)
+ outdt
+}
+
+####################################################
+
+ReadOutData<- function(...){ #2017.10.23
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Fname=varargin[[1]]
+ cmdall=readLines(Fname)
+ cmdall=gsub("//","",cmdall,fixed=TRUE)
+ varname=""#17.12.13 cmdall[1]
+ outdt=list()
+ varL=c()
+ ptL=list()
+ flg=0
+ for(cmd in cmdall){
+ if(nchar(cmd)>0){
+ if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){
+ if(cmd=="start"){
+ tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="")
+ eval(parse(text=tmp))
+ Ctr=Ctr+1
+ }
+ if(cmd=="end"){
+ }
+ if(substring(cmd,1,1)=="["){
+ tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="")
+ tmp1=strsplit(tmp1,"]",fixed=TRUE)
+ tmp1=tmp1[[1]]
+ tmp1=gsub(",[","c(",tmp1,fixed=TRUE)
+ for(st in tmp1){
+ tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="")
+ tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")#
+ eval(parse(text=tmp))
+ }
+ }
+ }
+ else{
+ # 17.12.13from
+ if(nchar(varname)>0){
+ tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="")
+ eval(parse(text=tmp))
+ }
+ # 17.12.13until
+ varname=cmd
+ tmp=paste(varname,"<<- list()",sep="")
+ eval(parse(text=tmp))
+ Ctr=0
+ if(flg==0){ # 17.10.07from
+ flg=1
+ }else{
+ } # 17.10.07until
+ }
+ }
+ }
+ # 17.12.13from
+ tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="")
+ eval(parse(text=tmp))
+ # 17.12.13until
+}
+
+####################################################
+
+Rotatedata<- function(..., deg=FALSE)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10^(-8)
+ ML<- varargin[[1]]
+ if(Mixtype(ML)==1){
+ ML<- list(ML)
+ }
+ Theta<- varargin[[2]]
+ if(deg) Theta<- Theta*pi/180 # 10.12.07
+ if(Nargs==2){
+ Pt<- c(0,0)
+ }
+ else{
+ Pt<- varargin[[3]]
+ }
+ Cx<- Pt[1]; Cy<- Pt[2]
+ OutL<- c()
+ for (N in Looprange(1,length(ML))){
+ GL<- Op(N,ML)
+ Out<- c()
+ for (I in Looprange(1,Nrow(GL))){
+ if(is.matrix(GL)){
+ Tmp<- GL[I,]
+ }
+ else{
+ Tmp<- GL
+ }
+ X1<- Tmp[1]
+ Y1<- Tmp[2]
+ if(X1==Inf){
+ X2<- X1
+ Y2<- Y1
+ }
+ else{
+ X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta)
+ Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta)
+ }
+ Out<- Appendrow(Out,c(X2,Y2))
+ }
+ if(nrow(Out)==1){
+ Out<- Out[1,]
+ }
+ OutL<- Mixjoin(OutL,list(Out))
+ }
+ if(length(OutL)==1){
+ OutL<- Op(1,OutL)
+ }
+ return(OutL)
+}
+
+###############################################
+
+Scaledata<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10^(-8)
+ ML<- varargin[[1]]
+ if(Mixtype(ML)==1){
+ ML<- list(ML)
+ }
+ A<- varargin[[2]]
+ B<- varargin[[3]]
+ if(Nargs==3){
+ Pt<- c(0,0)
+ }
+ else{
+ Pt<- varargin[[4]]
+ }
+ OutL<- list()
+ for (N in Looprange(1,length(ML))){
+ GL<- Op(N,ML)
+ Out<- c()
+ for (I in Looprange(1,Nrow(GL))){
+ if(is.matrix(GL)){ # 10.12.07
+ Tmp<- GL[I,]
+ }
+ else{
+ Tmp<- GL
+ }
+ X1<- Tmp[1]
+ Y1<- Tmp[2]
+ if(X1==Inf){
+ X2<- X1
+ Y2<-Y1
+ }
+ else{
+ X2<- Pt[1]+A*(X1-Pt[1])
+ Y2<- Pt[2]+B*(Y1-Pt[2])
+ }
+ Out<- Appendrow(Out,c(X2,Y2))
+ }
+ OutL<- Mixjoin(OutL,list(Out))
+ }
+ if(length(OutL)==1){
+ OutL<- Op(1,OutL)
+ }
+ return(OutL)
+}
+
+################################
+
+Setarrow<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0){
+ Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="")
+ Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="")
+ return(Str)
+ }
+ Flg<- 0
+ for (I in 1:Nargs){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric"){
+ Flg<- Flg+1
+ if(Flg==1) YaSize<<-Tmp
+ if(Flg==2){
+ if(Tmp<5){
+ YaAngle<<- 18*Tmp
+ }
+ else{
+ YaAngle<<- Tmp
+ }
+ }
+ if(Flg==3) YaPosition<<- Tmp
+ if(Flg==4) YaThick<<- Tmp
+ }
+ if(mode(Tmp)=="character"){
+ YaStyle<<- Tmp
+ }
+ }
+}
+
+####################################
+
+Setax<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0){
+ if(ZIKU=="line"){
+ Tmp<- ","
+ }
+ else{
+ Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="")
+ }
+ Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="")
+ Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="")
+ return(Str)
+ }
+ ArgL<- c()
+ Is<- 1
+ Tmp<- varargin[[1]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ Is<- varargin[[1]]
+ ArgL<- c()
+ for (I in Looprange(1,Is-1)){
+ ArgL<- c(ArgL,"")
+ }
+ for (I in Looprange(2,Nargs)){
+ ArgL<- c(ArgL,varargin[[I]])
+ }
+ }
+ else{
+ if(Nargs==1){
+ ArgL<- c(varargin[[1]])
+ }
+ else{
+ Tmp<- varargin[[2]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ ARROWSIZE<<-Tmp
+ ArgL<- c(varargin[[1]])
+ for (I in Looprange(3,Nargs)){
+ ArgL<- c(ArgL,varargin[[I]])
+ }
+ }
+ else{
+ ArgL<- c()
+ for (I in 1:Nargs){
+ ArgL<- c(ArgL,varargin[[I]])
+ }
+ }
+ }
+ }
+ for (I in Looprange(length(ArgL)+1,7)){
+ ArgL<- c(ArgL,"")
+ }
+ Zk<- ArgL[1]
+ if(nchar(Zk)>0){
+ ZL<-substr(Zk,2,nchar(Zk))
+ Zk<-substr(Zk,1,1)
+ if(nchar(ZL)>0){
+ ARROWSIZE<<- as.numeric(ZL)
+ }
+ }
+ Xn<- ArgL[2]; Xp<- ArgL[3]
+ Yn<- ArgL[4]; Yp<- ArgL[5]
+ Genn<- ArgL[6]; Genp<- ArgL[7]
+ if(nchar(Zk)>0){
+ C<- Zk
+ if(C=="a"){
+ ZIKU<<- "arrow"
+ }
+ else{
+ ZIKU<<- "line"
+ }
+ }
+ if(nchar(Xn)>0){
+ XNAME<<- paste("$",Xn,"$",sep="")
+ }
+ if(nchar(Xp)>0){
+ XPOS<<- Xp
+ }
+ if(nchar(Yn)>0){
+ YNAME<<- paste("$",Yn,"$",sep="")
+ }
+ if(nchar(Yp)>0){
+ YPOS<<-Yp
+ }
+ if(nchar(Genn)>0){
+ ONAME<<- Genn
+ }
+ if(nchar(Genp)>0){
+ OPOS<<- Genp
+ }
+ Out<- "";
+}
+
+#################################
+# 11.08.24
+
+Setcolor<- function(...){
+ varargin<- list(...)
+ Color<- 'black'
+ Kosa<- 1
+ for(J in Looprange(1,length(varargin))){
+ Tmp<- varargin[[J]]
+ if(is.character(Tmp)) Color<- Tmp
+ if(is.numeric(Tmp)){
+ if(length(Tmp)==1){# 11.08.24
+ Kosa<- Tmp
+ }
+ else{
+ Color<- Tmp
+ }
+ }# 11.08.24
+ }
+ Iro<- Ratiocmyk(Color)
+ if(length(Iro)==0) return(c())
+ Str<- "\\color[cmyk]{" #17.09.22
+ for(J in 1:4){
+ Str<- paste(Str,as.character(Kosa*Iro[J]),sep="")
+ if(J<4){
+ Str<- paste(Str,",",sep="")
+ }
+ }
+ Str<- paste(Str,"}",sep="")
+ Texcom(Str)
+}
+
+##################################
+
+Setmarklen<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0){
+ Tmp<- MARKLENNow/MARKLENInit
+ Tmp=round(Tmp*100)/100
+ return(Tmp)
+ }
+ Size<- varargin[[1]]
+ MARKLENNow<<- MARKLENInit*Size
+ MARKLEN<<- MARKLENNow*1000/2.54/MilliIn
+}
+
+###############################
+
+Setorigin<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0){
+ return(GENTEN)
+ }
+ Pt<- varargin[[1]]
+ GENTEN<<- Pt;
+}
+
+################################
+
+Setscaling<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0)
+ {
+ return(c(SCALEY,LOGX,LOGY))
+ }
+ for (I in 1:Nargs)
+ {
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)=="numeric")
+ {
+ SCALEY<<- Tmp
+ }
+ if(mode(Tmp)=="character")
+ {
+ if(Tmp=="l")
+ {
+ LOGX<<- 0
+ LOGY<<- 1
+ }
+ else if(Tmp=="ll")
+ {
+ LOGX<<- 1
+ LOGY<<- 1
+ }
+ else
+ {
+ LOGX<<- 0
+ LOGY<<- 0
+ }
+ }
+ }
+ Tmp<- c(SCALEY,LOGX,LOGY);
+}
+
+#########################################
+
+Setpen<-function(Width)
+{
+ PenThick<<-round(PenThickInit*Width)
+ Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+}
+
+##############################################
+
+Setpt<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0)
+ {
+ Tmp<- TenSize/TenSizeInit
+ Tmp<- round(Tmp*100)/100
+ return(Tmp)
+ }
+ Size<- varargin[[1]]
+ TenSize<<- TenSizeInit*Size;
+}
+
+##############################################
+
+Setunitlen<-function(...)
+{
+ varargin<-list(...)
+ if(length(varargin)==0){
+ return(ULEN)
+ }
+ Ul=varargin[[1]]
+ Dx<-XMAX-XMIN
+ Dy<-YMAX-YMIN
+ Sym<-".0123456789 +-*/"
+ SL<-Sym
+ OL<-"+-*/"
+ if(nchar(Ul)>0){
+ ULEN<<-Ul
+ }
+ Is<-1
+ VL<-""
+ Ucode<-ULEN
+ for (I in 1:nchar(Ucode)){
+ C<-substring(Ucode,I,I)
+ if(length(grep(C,SL))>0){
+ if(length(grep(C,OL))>0){
+ Tmp<-substring(Ucode,Is,I-1)
+ Str<-paste(VL,Tmp,C,sep="")
+ VL<-Str
+ Is<-I+1
+ }
+ }
+ else{
+ Unit<-substring(Ucode,I,I+1)
+ Str<-substring(Ucode,Is,I-1)
+ VL<-paste(VL,Str,sep="")
+ break;
+ }
+ }
+ Valu<-eval(parse(text=VL))
+ Str<-as.character(Valu)
+ ULEN<<-paste(Str,Unit,sep="");
+ if(Unit=="cm") MilliIn<<-1000/2.54*Valu
+ if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10
+ if(Unit=="in") MilliIn<<-1000*Valu
+ if(Unit=="pt") MilliIn<<-1000/72.27*Valu
+ if(Unit=="pc") MilliIn<<-1000/6.022*Valu
+ if(Unit=="bp") MilliIn<<-1000/72*Valu
+ if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
+ if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu
+ if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
+ MARKLEN<<-MARKLENNow*1000/2.54/MilliIn
+ MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17
+}
+
+#########################################
+# 10.11.20
+
+Setwindow<-function(...)
+{
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ if(Nargs==0){
+ Out<-c(XMIN,XMAX,YMIN,YMAX)
+ return(Out)
+ }
+ if(Nargs==1){
+ Dt<- varargin[[1]]
+ if(is.list(Dt) && !is.data.frame(Dt)){
+ Tmp<- as.data.frame(Dt)
+ Dt<- t(Tmp)
+ }
+ Xm<- min(Dt[,1])
+ XM<- max(Dt[,1])
+ Ym<- min(Dt[,2])
+ YM<- max(Dt[,2])
+ Str<- "Setwindow("
+ Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="")
+ Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="")
+ Str<- paste(Str,")",sep="")
+ print(Str)
+ }
+ if(Nargs==2){
+ RgX<-varargin[[1]]
+ RgY<-varargin[[2]]
+ XMIN<<-RgX[1]; XMAX<<-RgX[2]
+ YMIN<<-RgY[1]; YMAX<<-RgY[2]
+ }
+ if(Nargs==4){
+ XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]]
+ YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]]
+ }
+ Out<- c(XMIN,XMAX,YMIN,YMAX);
+}
+
+#########################################
+
+Shadeold<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Iroflg=0
+ Kosa=1
+ if(Nargs>1){
+ Iro=varargin[[Nargs]]
+ if(is.character(Iro)){
+ Iroflg=1
+ if(length(grep("{",Iro))>0){
+ Str=paste("{\\color",Iro,sep="")
+ }
+ else{
+ Str=paste("{\\color{",Iro,"}",sep="")
+ }
+ }
+ else{
+ if(length(Iro)==1){
+ Kosa=Iro
+ }
+ else{
+ Iroflg=1
+ if(length(Iro)==4){
+ Str="{\\color[cmyk]{"
+ }
+ else{
+ if(length(Iro)==3){
+ Str="{\\color[rgb]{"
+ }
+ }
+ for(J in 1:length(Iro)){
+ Str=paste(Str,as.character(Iro[J]),sep="")
+ if(J<length(Iro)){
+ Str=paste(Str,",")
+ }
+ }
+ Str=paste(Str,"}")
+ }
+ }
+ if(Iroflg==1){
+ Str=paste(Str,"%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ }
+ }
+ Tmp=varargin[[1]]
+ Data=Kyokai(Tmp)
+ Data=list(Data) ####180327
+ for (I in Looprange(1, length(Data))){
+ PL<- Op(I,Data)
+ Mojisu<- 0
+ for (J in 1:Nrow(PL)){
+ P<- Doscaling(Op(J,PL))
+ X<- as.character(round(MilliIn*P[1]))
+ Y<- as.character(-round(MilliIn*P[2]))
+ Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ if(Mojisu>80){
+ cat("%\n",file=Wfile,append=TRUE)
+ Mojisu<- 0
+ }
+ }
+ Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
+ Str2<- paste("\\special{ip}%\n",sep="")
+ cat(Str1,file=Wfile,append=TRUE)
+ cat(Str2,file=Wfile,append=TRUE)
+ }
+ if(Iroflg==1){
+ cat("}%\n",file=Wfile,append=TRUE)
+ }
+}
+
+####### Shade new 17.09.24############
+
+Shade<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Iroflg<- 0
+ Kosa<- 1
+ if(Nargs>1){
+ Iro<- varargin[[Nargs]]
+ if(mode(Iro)=="character"){
+ Iroflg<- 1
+ if(length(grep(Iro,"{"))>0)
+ Str<- paste("{\\color",Iro,sep="")
+ else
+ Str<- paste("{\\color{",Iro,"}",sep="")
+ }
+ else{
+ if(length(Iro)==1)
+ Kosa<- Iro
+ else{
+ Iroflg<- 1
+ if(length(Iro)==4)
+ Str<- paste("{\\color[cmyk]{",sep="")
+ else
+ if(length(Iro)==3)
+ Str<- paste("{\\color[rgb]{",sep="")
+ for (J in Looprange(1,length(Iro))){
+ Str<- paste(Str,as.character(Iro[J]),sep="")
+ if(J<length(Iro))
+ Str<- paste(Str,",",sep="")
+ }
+ Str<- paste(Str,"}",sep="")
+ }
+ }
+ if(Iroflg==1){
+ if(Wfile=="default")
+ cat(Str,"%\n",file="",append=TRUE,sep="")
+ else
+ cat(Str,"%\n",file=Wfile,append=TRUE,sep="")
+ }
+ }
+ Tmp<- varargin[[1]]
+ Data<- Kyoukai(Tmp)
+ for (I in Looprange(1, length(Data))){
+ PL<- Op(I,Data)
+ Mojisu<- 0
+ for (J in 1:Nrow(PL)){
+ P<- Doscaling(Op(J,PL))
+ X<- as.character(round(MilliIn*P[1]))
+ Y<- as.character(-round(MilliIn*P[2]))
+ Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
+ if(Wfile=="default")
+ cat(Str,file="",append=TRUE,sep="")
+ else
+ cat(Str,file=Wfile,append=TRUE,sep="")
+ Mojisu<- Mojisu+nchar(Str)
+ if(Mojisu>80){
+ if(Wfile=="default")
+ cat("%\n",file="",append=TRUE,sep="")
+ else
+ cat("%\n",file=Wfile,append=TRUE,sep="")
+ Mojisu<- 0
+ }
+ }
+ Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
+ Str2<- paste("\\special{ip}%\n",sep="")
+ if(Wfile=="default"){
+ cat(Str1,file="",append=TRUE,sep="")
+ cat(Str2,file="",append=TRUE,sep="")
+ }
+ else{
+ cat(Str1,file=Wfile,append=TRUE,sep="")
+ cat(Str2,file=Wfile,append=TRUE,sep="")
+ }
+ }
+ if(Iroflg==1){
+ if(Wfile=="default")
+ cat("}%\n",file="",append=TRUE,sep="")
+ else
+ cat("}%\n",file=Wfile,append=TRUE,sep="")
+ }
+}
+
+##############################################
+# 11.01.07
+
+Splinedata<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10^(-3)
+ PL<- varargin[[1]]
+ if(mode(PL)=="character"){
+ Fname<- PL
+ PL<- Readtextdata(Fname)
+ }
+ else{
+ PL<- as.matrix(PL)
+ if(Nrow(PL)==1){
+ PL<- matrix(PL, nrow=length(PL)/2)
+ PL<- t(PL)
+ }
+ }
+ if(ncol(PL)==3){
+ Flg3<- 1
+ }
+ else{
+ Flg3<- 0
+ }
+ PLL<- Dividegraphics(PL)
+ N<- 50
+ C<- c()
+ for (I in Looprange(2,Nargs)){
+ Tmp<- varargin[[I]]
+ if(mode(Tmp)!="character") next
+ if(length(grep("=",Tmp,fixed=TRUE))>0){
+ eval(parse(text=Tmp))
+ }
+ else{
+ Tmp1<- substr(Tmp,1,1)
+ if(toupper(Tmp1)=="C"){
+ C<- 1:length(PLL)
+ }
+ }
+ }
+ Cflg<- rep(0,length(PLL))
+ for(J in Looprange(1,length(C))){
+ K<- C[J]
+ Cflg[K]<- 1
+ }
+ if(length(N)>1){
+ Nj<- as.numeric(N)
+ }
+ else{
+ Tmp<- lapply(PLL,nrow)
+ Tmp1<- as.numeric(Tmp)
+ MxP<- max(Tmp1)
+ Nj<- c()
+ for (J in 1:length(PLL)){
+ Tmp<- nrow(PLL[[J]])
+ Tmp1<- round(N/MxP*(Tmp-1))
+ Nj<- c(Nj,Tmp1)
+ }
+ }
+ OutL<- list()
+ for(J in 1:length(PLL)){
+ PL<- PLL[[J]]
+ if(Cflg[J]==1){
+ if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){
+ PL<-Appendrow(PL,PL[1,])
+ Nj[J]=round(N/MxP*nrow(PL))
+ }
+ else{
+ PL[Nrow(PL),]<- PL[1,]
+ }
+ }
+ Tn<- 1:Nrow(PL)
+ Xn<- PL[,1]
+ Yn<- PL[,2]
+ if(Flg3==1) Zn<- PL[,3]
+ if(Cflg[J]==0){
+ Dxn<- spline(Tn,Xn,n=Nj[J])
+ Dyn<- spline(Tn,Yn,n=Nj[J])
+ if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J])
+ }
+ else{
+ Dxn<- spline(Tn,Xn,method="periodic")
+ Dyn<- spline(Tn,Yn,method="periodic")
+ if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic")
+ }
+ Tmp1<- Dxn$y
+ Tmp2<- Dyn$y
+ Tmp3<-c()
+ if(Flg3==1) Tmp3<- Dzn$y
+ Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1))
+ OutL<- c(OutL,list(Out))
+ }
+ return(OutL)
+}
+
+############################################
+# 2013.05.03 Domain is optional
+
+Tabledata<- function(...){
+ varargin<- list(...)
+ Eps<- 0.001
+ Tmp<- varargin[[1]] # 130503 from
+ if(is.numeric(Tmp)){
+ Domain<- varargin[[1]]
+ VL<- varargin[[2]]
+ HL<- varargin[[3]]
+ }
+ else{
+ Domain<- c(-1,-1)
+ VL<- varargin[[1]]
+ HL<- varargin[[2]]
+ } # 130503 until
+ Hsize<- Domain[1]
+ SvL<- list(0)
+ S<- 0
+ for (I in Looprange(1,length(VL))){
+ Tmp<- VL[[I]]
+ S<- S+Tmp[1]
+ Tmp[1]<- S
+ SvL<- c(SvL,list(Tmp))
+ }
+ if(Hsize>S){
+ SvL<- c(SvL,list(Hsize))
+ }
+ Hsize<- Op(1,SvL[[length(SvL)]])
+ Vsize<- Domain[2]
+ ShL<- list(0)
+ S<- 0
+ for (I in Looprange(1,length(HL))){
+ Tmp<- HL[[I]]
+ S<- S+Tmp[1]
+ Tmp[1]<- S
+ ShL<- c(ShL,list(Tmp))
+ }
+ if(Vsize>S){
+ ShL<- c(ShL,list(Vsize))
+ }
+ Vsize<- Op(1,ShL[[length(ShL)]])
+ Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0
+ if(length(Domain)>2){
+ Marw<- Domain[3]
+ Mare<- Domain[4]
+ }
+ if(length(Domain)>4){
+ Marn<- Domain[5]
+ Mars<- Domain[6]
+ }
+ Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn))
+ Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps))
+ Gdata<- list(Tmp)
+ Tmp<- -Marw
+ Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))))
+ for (I in Looprange(1,length(SvL))){
+ Data<- SvL[[I]]
+ X<- Data[1]
+ if(length(Data)==1){
+ Y1<- 0
+ Y2<- Vsize
+ G<- Listplot(c(X,Y1),c(X,Y2))
+ }
+ else{
+ G<- c()
+ for (J in seq(2,length(Data),by=2)){
+ Y1<- Vsize-Op(1,ShL[[Data[J]]])
+ Y2<- Vsize-Op(1,ShL[[Data[J+1]]])
+ Tmp<- Listplot(c(c(X,Y1),c(X,Y2)))
+ Tmp1<- Appendrow(G,c(Inf,Inf))
+ G<- Appendrow(Tmp1,Tmp)
+ }
+ G<- G[2:nrow(G),]
+ }
+ Hdata<- c(Hdata,list(G))
+ }
+ Tmp<- Hsize+Mare
+ Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))
+ Hdata<- c(Hdata,list(Tmp1))
+ Tmp<- Vsize+Marn
+ Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp))))
+ for (I in Looprange(1,length(ShL))){
+ Data<- ShL[[I]]
+ Y<- Vsize-Data[1]
+ if(length(Data)==1){
+ X1<- 0
+ X2<- Hsize
+ G<- Listplot(c(X1,Y),c(X2,Y))
+ }
+ else{
+ G<- c()
+ for (J in seq(2,length(Data),by=2)){
+ X1<- Op(1,SvL[[Data[J]]])
+ X2<- Op(1,SvL[[Data[J+1]]])
+ Tmp<- Listplot(c(X1,Y),c(X2,Y))
+ G<- Appendrow(G,c(Inf,Inf))
+ G<- Appendrow(G,Tmp)
+ }
+ G<-G[2:nrow(G),]
+ }
+ Vdata<- c(Vdata,list(G))
+ }
+# Tmp<- Listplot(c(c(0,0),c(Hsize,0))) # 2011.03.02
+# Vdata<- Mixjoin(Vdata,list(Tmp))
+ Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars)))
+ Vdata<- Mixjoin(Vdata,list(Tmp))
+ Tmp1<- Hdata[Looprange(3,length(Hdata)-2)]
+ Tmp2<- Vdata[Looprange(3,length(Vdata)-2)]
+ Gdata<- Mixjoin(Gdata,Tmp1,Tmp2)
+ Hind<- Looprange(2,1+length(Tmp1))
+ Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2))
+ G=Gdata[[1]]
+ P1<- Ptsw(G); P2<- Ptnw(G)
+ Q1<- Ptse(G); Q2<- Ptne(G)
+ Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2)))
+ P1<- Ptnw(G); P2<- Ptne(G)
+ Q1<- Ptsw(G); Q2<- Ptse(G)
+ Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2)))
+ Tmp3<- Framedata()
+ Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3)
+ return(Out)
+}
+
+################################
+
+Texcom<- function(Meirei)
+{
+ if(Meirei=="\\thinlines"){
+ Setpen(1);
+ return();
+ }
+ if(Meirei=="\\thicklines"){
+ Setpen(2);
+ return()
+ }
+ if(Meirei=="\\Thicklines"){
+ Setpen(3);
+ return()
+ }
+ if(length(Meirei)==0){ # 09.12.07
+ Tmp<- c()
+ }
+ else{
+ Tmp<- grep("newline",Meirei)
+ }
+ if(length(Tmp)>0){
+ cat("\n",file=Wfile,append=TRUE);
+ }
+ else{
+ Tmp<- paste(Meirei,"%\n",sep="")
+ Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02
+ cat(Tmp,file=Wfile,append=TRUE);
+ }
+}
+
+###############################################
+
+Texctr<- function(N){
+ if(is.numeric(N)){
+ Alpha<- "abcdefghijklmnopqrstuvwxyz"
+ Out<- paste("ketpicctr",substr(Alpha,N,N),sep="")
+ }
+ else{
+ if(grep("\\",N,fixed=TRUE)>0){
+ Out<- substr(N,2,nchar(N))
+ }
+ else{
+ Out<- N
+ }
+ }
+ return(Out)
+}
+
+###############################################
+
+Texelse<- function (){
+ Texcom("");
+ Texcom("\\else")
+}
+
+###############################################
+
+Texend<- function()
+{
+ Texcom("%\n}")
+}
+
+###############################################
+
+Texendfor<- function(I){
+ Last<- TEXFORLAST[[TEXFORLEVEL]]
+ Texcom("")
+ Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="")
+ Texcom(Tmp)
+ Texcom("\\repeat")
+ Texcom("}")
+ TEXFORLEVEL<<- TEXFORLEVEL-1
+ TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)]
+}
+
+###############################################
+
+Texendif<- function(){
+ Texcom("")
+ Texcom("\\fi")
+ Texcom("}")
+}
+
+###############################################
+
+Texfor<- function(I,First,Last){
+ TEXFORLEVEL<<- TEXFORLEVEL+1;
+ Texsetctr(I,"0")
+ Texsetctr(I,paste(as.character(First),"-1",sep=""))
+ Texcom("")
+ Texcom("{")
+ Texcom("\\loop")
+ Texsetctr(I,"+1")
+ TEXFORLAST<<- c(TEXFORLAST,as.character(Last))
+}
+
+###############################################
+
+Texforinit<- function(){
+ TEXFORLEVEL<<- 0
+ TEXFORLAST<<- list()
+}
+
+###############################################
+
+Texif<- function(...){
+ varargin<- list(...)
+ Condstr<- varargin[[1]]
+ Tp<- 0
+ if(length(varargin)>1){
+ Tp<- varargin[[2]]
+ }
+ Texcom("")
+ Texcom("{")
+ if(Tp==0){
+ Texcom("\\ifnum")
+ }
+ else{
+ Texcom("\\ifdim ")
+ }
+ Texcom(paste(Condstr," ",sep=""))
+}
+
+######################################
+
+Texletter<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ for (I in seq(1,Nargs,by=3)){
+ P<- varargin[[I]]
+ X<- P[1]
+ if(mode(X)=="numeric"){
+ X<- as.character(X)
+ }
+ Y<- P[2]
+ if(mode(Y)=="numeric"){
+ Y<- as.character(Y)
+ }
+ Houkou<- varargin[[I+1]]
+ Mojiretu<- varargin[[I+2]]
+ Hset<- Houkou
+ Vhoko<- "c"
+ if(length(grep("n",Hset))>0){
+ Vhoko<- "n"
+ }
+ if(length(grep("s",Hset))>0){
+ Vhoko<- "s"
+ }
+ Hhoko<- "c";
+ if(length(grep("e",Hset))>0){
+ Hhoko<- "e"
+ }
+ if(length(grep("w",Hset))>0){
+ Hhoko<- "w"
+ }
+ Hoko<- paste(Vhoko,Hhoko,sep="")
+ CalcWidth(Hoko,Mojiretu)
+ CalcHeight(Hoko,Mojiretu)
+ Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="")
+ Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ }
+}
+
+##################################################
+
+Texnewcmd<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Str<- varargin[[1]]
+ S<- paste("\\newcommand{",Str,"}",sep="")
+ if(Nargs>1){
+ Tmp<- as.character(varargin[[2]])
+ S<- paste(S,"[",Tmp,"]",sep="")
+ }
+ if(Nargs>2){
+ Tmp<- varargin[[3]]
+ if(mode(Tmp)=="numeric"){
+ Tmp<- as.character(Tmp)
+ }
+ S<- paste(S,"[",Tmp,"]",sep="")
+ }
+ S<- paste(S,"{",sep="")
+ Texcom(S)
+}
+
+###############################################
+
+Texnewctr<- function(N)
+{
+ if(mode(N)=="character"){
+ Str<- paste("\\newcounter{",N,"}",sep="")
+ Texcom(Str)
+ }
+ else{
+ for (I in N){
+ Str<- paste("\\newcounter{",Texctr(I),"}",sep="")
+ Texcom(Str)
+ }
+ }
+}
+###############################################
+
+Texrenewcmd<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Str<- varargin[[1]]
+ S<- paste("\\renewcommand{",Str,"}",sep="")
+ if(Nargs>1){
+ Tmp<- as.character(varargin[[2]])
+ S<- paste(S,"[",Tmp,"]",sep="")
+ }
+ if(Nargs>2){
+ Tmp<- varargin[[3]]
+ if(mode(Tmp)=="numeric"){
+ Tmp<- as.character(Tmp)
+ }
+ S<- paste(S,"[",Tmp,"]",sep="")
+ }
+ S<- paste(S,"{",sep="")
+ Texcom(S)
+}
+
+###############################################
+
+Texsetctr<- function(Nctr,Opstr)
+{
+ Ctr<- Texctr(Nctr)
+ Opstr<- paste(Opstr,"%",sep="")
+ OperL<- "+-*/%"
+ Oper<- ""
+ Va<- ""
+ Evflg<- 0
+ Paflg<- 0
+ for (I in Looprange(1,nchar(Opstr))){
+ Tmp<- substring(Opstr,I,I)
+ if(Tmp=="("){
+ Paflg<- 1
+ if(nchar(Va)>0){
+ Evflg<- 1
+ Va<- paste(Va,Tmp,sep="")
+ }
+ next
+ }
+ if(Tmp==")"){
+ Paflg<- 0
+ if(Evflg>0){
+ Va<- paste(Va,Tmp,sep="")
+ }
+ next
+ }
+ if(Paflg>0){
+ Va<- paste(Va,Tmp,sep="")
+ next
+ }
+ if(length(grep(Tmp,OperL))==0){
+ Va<- paste(Va,Tmp,sep="")
+ }
+ else{
+ if(Evflg>0){
+ Tmp1<- eval(parse(text=Va))
+ Va<- paste("\\value{",Tmp1,"}",sep="")
+ Evflg<- 0
+ }
+ if(Oper==""){
+ if(nchar(Va)>0){
+ Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="")
+ Texcom(Str)
+ }
+ Oper<- Tmp
+ Va<-""
+ }
+ else if(Oper=="+"){
+ Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="")
+ Texcom(Str)
+ Oper<- Tmp
+ Va<-""
+ }
+ else if(Oper=="-"){
+ Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="")
+ Texcom(Str)
+ Oper<- Tmp
+ Va<-""
+ }
+ else if(Oper=="*"){
+ Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="")
+ Texcom(Str)
+ Oper<- Tmp
+ Va<-""
+ }
+ else if(Oper=="/"){
+ Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="")
+ Texcom(Str)
+ Oper<- Tmp
+ Va<-""
+ }
+ }
+ }
+}
+
+###############################################
+
+Texthectr<- function(N)
+{
+ Out<- paste("\\the",Texctr(N),sep="")
+ return(Out)
+}
+
+###############################################
+
+Texvalctr<- function(N){
+ Out<- paste("\\value{",Texctr(N),"}",sep="")
+ return(Out)
+}
+
+###############################################
+
+Texvctr<- function(N)
+{
+ Out<- paste("\\value{",Texctr(N),"}",sep="")
+ return(Out)
+}
+
+###############################################
+
+Tonumeric <- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Data<- varargin[[1]]
+ Sp<- c(1,1)
+ Ep<- c(Inf,Inf)
+ if(Nargs>1){
+ Sp<- varargin[[2]]
+ }
+ if(Nargs>2){
+ Ep<- varargin[[3]]
+ }
+ Nrs<- Sp[1]
+ Nre<- min(nrow(Data),Ep[1])
+ Ncs<- Sp[2]
+ Nce<- min(ncol(Data),Ep[2])
+ Tmp1<- Data[Nrs:Nre, Ncs:Nce]
+ Tmp2 <- as.numeric(Tmp1)
+ Out <- matrix(Tmp2,nrow=nrow(Tmp1))
+ Sp<- c()
+ for (I in 1:nrow(Out)){
+ for (J in 1:ncol(Out)){
+ Tmp<- Out[I,J]
+ if(!is.na(Tmp)){
+ Sp<- c(I,J)
+ break;
+ }
+ }
+ if(length(Sp)>0) break
+ }
+ if(length(Sp)==0){
+ return("Numeric data not found")
+ }
+ Ep<- c(nrow(Out),ncol(Out))
+ for (I in Sp[1]:nrow(Out)){
+ Tmp<- Out[I,Sp[2]]
+ if(is.na(Tmp)){
+ Ep[1]<- I-1
+ break
+ }
+ }
+ for (J in Sp[2]:ncol(Out)){
+ Tmp<- Out[Sp[1],J]
+ if(is.na(Tmp)){
+ Ep[2]<- J-1
+ break
+ }
+ }
+ Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]]
+ return(Out)
+}
+
+##################################################
+
+Translatedata<- function(...)
+{
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10^(-8)
+ ML<- varargin[[1]]
+ if(Mixtype(ML)==1){
+ ML<- list(ML)
+ }
+ Tmp=varargin[[2]]
+ if(mode(Tmp)=="numeric" && length(Tmp)>1){
+ A<- Tmp[1]; B<- Tmp[2]
+ }
+ else{
+ A<- Tmp
+ if(Nargs>=3){
+ B<- varargin[[3]]
+ }
+ else{
+ B<- 0
+ }
+ }
+ OutL<- list()
+ for (N in Looprange(1,length(ML))){
+ GL<- Op(N,ML)
+ Out<- c()
+ for (I in Looprange(1,Nrow(GL))){
+ if(is.matrix(GL)){ # 10.12.07
+ Tmp<- GL[I,]
+ }
+ else{
+ Tmp<- GL
+ }
+ X1<- Tmp[1]
+ Y1<- Tmp[2]
+ if(X1==Inf){
+ X2<- X1
+ Y2<-Y1
+ }
+ else{
+ X2<- X1+A
+ Y2<- Y1+B
+ }
+ Out<- Appendrow(Out,c(X2,Y2))
+ }
+ OutL<- Mixjoin(OutL,list(Out))
+ }
+ if(length(OutL)==1){
+ OutL<- Op(1,OutL)
+ }
+ return(OutL)
+}
+
+#######################################
+
+Unscaling<- function(G)
+{
+ GLg<- G
+ if(class(GLg)=="numeric"){
+ GLg<-c(G[1]/SCALEX, G[2]/SCALEY)
+ Tmp<-GLg
+ if(LOGX==1) Tmp[1]<- 10^(GLg[1])
+ if(LOGY==1) Tmp[2]<- 10^(GLg[2])
+ return(Tmp)
+ }
+ else{
+ Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2)
+ GLg<-G %*% Tmp1
+ Tmp<-GLg
+ if(LOGX==1) Tmp[,1]<- 10^(G[,1])
+ if(LOGY==1) Tmp[,2]<- 10^(G[,2])
+ return(Tmp)
+ }
+}
+
+#############################################
+
+Vtickmark<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ ArgsL<- varargin
+ if(mode(ArgsL[[1]])=="character"){
+ Str<- ArgsL[[1]]
+ Tmp<- strsplit(Str,"m")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ I<- nchar(Tmp[1])+1
+ }
+ else{
+ I<- 0
+ }
+ Tmp<- strsplit(Str,"n")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ J<- nchar(Tmp[1])+1
+ }
+ else{
+ J<- 0
+ }
+ Tmp<- strsplit(Str,"r")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ K=nchar(Tmp[1])+1
+ }
+ else{
+ K<- 0
+ }
+ if(K>0){
+ S<- substr(Str,K+1,nchar(Str))
+ R<- as.numeric(S)
+ if(is.na(R)){
+ R<- 1
+ }
+ }
+ else{
+ R<- 1
+ K<- nchar(Str)+1
+ }
+ if(J>0){
+ S<- substr(Str,J+1,K-1)
+ Dn<- as.numeric(S)
+ if(is.na(Dn)){
+ Dn<- 1
+ }
+ }
+ else{
+ Dn<- 1000
+ J<- nchar(Str)+1
+ }
+ S<- substr(Str,I+1,J-1)
+ Dm<- as.numeric(S)
+ if(is.na(Dm)){
+ Dm<- 1
+ }
+ ArgsL<- list()
+ for (I in 1:floor((YMAX-GENTEN[2])/Dm)){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ }
+ MemoriList<- list()
+ Memori<- list()
+ for (N in 1:length(ArgsL)){
+ Dt<- ArgsL[[N]]
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(Dt[1],Dt[2])
+ next
+ }
+ if(mode(Dt)=="character"){
+ Memori<- Mixjoin(Memori,Dt)
+ }
+ else{
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(GENTEN[1],Dt)
+ }
+ }
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ for (N in 1:length(MemoriList)){
+ Dt<- MemoriList[[N]]
+ Ndt<- length(Dt)
+ X=Op(1,Dt)
+ Y=Op(2,Dt)
+ Tmp<-Doscaling(c(X,Y))
+ X<- Tmp[1]
+ Y<- Tmp[2]
+ Moji<- Op(Ndt,Dt)
+ Tmp1<- Unscaling(c(X+MARKLEN,Y))
+ Tmp2<- Unscaling(c(X-MARKLEN,Y))
+ Fd<- Listplot(c(Tmp1,Tmp2))
+ Drwline(Fd)
+ if(Ndt==3){
+ Tmp<-Unscaling(c(X-MARKLEN,Y))
+ Expr(Tmp,"w",Moji)
+ }
+ if(Ndt==4){
+ Houkou<- Op(3,Dt)
+ Tmp<-grep("w",Houkou)
+ if(length(Tmp)>0){
+ Tmp<-Unscaling(c(X-MARKLEN,Y))
+ Expr(Tmp,Houkou,Moji)
+ }
+ else{
+ Tmp<- Unscaling(c(X+MARKLEN,Y))
+ Expr(Tmp,Houkou,Moji)
+ }
+ }
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+}
+
+############################################
+
+Windisp<-function(...){
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ Tmp<- Doscaling(c(XMIN,YMIN))
+ Xmn<- Tmp[1]; Ymn<- Tmp[2]
+ Tmp<- Doscaling(c(XMAX,YMAX))
+ Xmx<- Tmp[1]; Ymx<- Tmp[2]
+ plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="")
+ Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX)))
+ axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2))
+ Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0)))
+ axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2))
+ Tmp1<- c(XMIN,GENTEN[2])
+ Tmp2<- c(XMAX,GENTEN[2])
+ Tmp3<- Listplot(Tmp1,Tmp2)
+ Tmp<- MakeCurves(Tmp3,0)
+ if(Datalength(Tmp)>0){
+ lines(Tmp[,1],Tmp[,2],col="green")
+ }
+ Tmp1<- c(GENTEN[1],YMAX)
+ Tmp2<- c(GENTEN[1],YMIN)
+ Tmp3<- Listplot(Tmp1,Tmp2)
+ Tmp<- MakeCurves(Tmp3,0)
+ if(Datalength(Tmp)>0){
+ lines(Tmp[,1],Tmp[,2],col="green")
+ }
+ Tmp<-Doscaling(Framedata())
+ lines(Tmp[,1],Tmp[,2])
+ for (I in Looprange(1,Nargs)){
+ Pdata<-varargin[[I]]
+ if(mode(Pdata)=="numeric"){
+ Pdata<-list(Pdata)
+ }
+ while(Mixtype(Pdata)==3){ # 10.02.23
+ Tmp1<- list()
+ for(II in Looprange(1,length(Pdata))){
+ Tmp1<- Mixjoin(Tmp1,Pdata[[II]])
+ }
+ Pdata<- Tmp1
+ } # 10.02.23
+ for (II in Looprange(1,length(Pdata))){
+ Tmp<-Pdata[[II]]
+ P<-MakeCurves(Tmp,0)
+ Ndm<-Dataindex(P)
+ for (J in Looprange(1,Nrow(Ndm))){
+ Q<-P[Ndm[J,1]:Ndm[J,2],]
+ if(Nrow(Q)==1){
+ Tmp<-seq(1,Ncol(Q),by=2)
+ for (K in Tmp){
+ Pt<-Q[K:(K+1)]
+ points(Pt[1],Pt[2])
+ }
+ }
+ else{
+ lines(Q[,1],Q[,2])
+ }
+ }
+ }
+ }
+}
+
+############################################
+
+WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04
+ par(new=new)
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ if(!new) # 10.12.04
+ {
+ Tmp<- Doscaling(c(XMIN,YMIN))
+ Xmn<- Tmp[1]; Ymn<- Tmp[2]
+ Tmp<- Doscaling(c(XMAX,YMAX))
+ Xmx<- Tmp[1]; Ymx<- Tmp[2]
+ plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="")
+ Tick<- sort(c(YMIN,YMAX,vtick)) #### 10.12.04 from here
+ Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2)
+ Tmp<- Doscaling(Tmp1)
+ axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2))
+ Tick<- sort(c(XMIN,XMAX,htick))
+ Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2)
+ Tmp<- Doscaling(Tmp1)
+ axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2)) #### 10.12.04 to here
+ Tmp1<- c(XMIN,GENTEN[2])
+ Tmp2<- c(XMAX,GENTEN[2])
+ Tmp3<- Listplot(Tmp1,Tmp2)
+ Tmp<- MakeCurves(Tmp3,0)
+ if(Datalength(Tmp)>0){
+ lines(Tmp[,1],Tmp[,2],col="green")
+ }
+ Tmp1<- c(GENTEN[1],YMAX)
+ Tmp2<- c(GENTEN[1],YMIN)
+ Tmp3<- Listplot(Tmp1,Tmp2)
+ Tmp<- MakeCurves(Tmp3,0)
+ if(Datalength(Tmp)>0){
+ lines(Tmp[,1],Tmp[,2],col="green")
+ }
+ Tmp<-Doscaling(Framedata())
+ lines(Tmp[,1],Tmp[,2])
+ }
+ for (I in Looprange(1,Nargs)){
+ Pdata<-Flattenlist(varargin[[I]]) # 101129 from here
+ Cmd<- list()
+ for (II in Looprange(1,length(Pdata))){
+ Tmp<-Pdata[[II]]
+ if(length(Tmp)==1){
+ Cmd<- c(Cmd,list(Tmp))
+ next
+ }
+
+ P<-MakeCurves(Tmp,0)
+
+ if(length(Cmd)>0){
+ if(length(Cmd)>=3){
+ polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]])
+ }
+ else{
+ polygon(P,col=Cmd[[1]],border=Cmd[[2]])
+ }
+ next
+ } # 101129 to here
+ Ndm<-Dataindex(P)
+ for (J in Looprange(1,Nrow(Ndm))){
+ Q<-P[Ndm[J,1]:Ndm[J,2],]
+ if(Nrow(Q)==1){
+ Tmp<-seq(1,Ncol(Q),by=2)
+ for (K in Tmp){
+ Pt<-Q[K:(K+1)]
+ points(Pt[1],Pt[2],col=color)#taka101111
+ }
+ }
+ else{
+ lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111
+ }
+ }
+ }
+ }
+ par(new=FALSE)
+}
+
+######################################
+
+# 3D
+
+#################################
+
+# 10.08.16
+CameracoordCurve<- function(Curve){
+ Out<- c()
+ for(J in Looprange(1,Nrow(Curve))){
+ P<- Ptcrv(J,Curve) #P=Curve(J,:);
+ Tmp<- P-FocusPoint
+ X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3]
+ Tmp<- EyePoint-FocusPoint
+ E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3]
+ Ca<- E1/sqrt(E1^2+F1^2)
+ Sa<- F1/sqrt(E1^2+F1^2)
+ X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1
+ E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
+ Cb<- E2/sqrt(E2^2+G2^2)
+ Sb<- G2/sqrt(E2^2+G2^2)
+ X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb
+ E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb
+ Xz<- X3
+ Yz<- E3/(E3-X3)*Y3
+ Zz<- E3/(E3-X3)*Z3
+ Out<- rbind(Out,c(Yz,Zz,Xz))
+ }
+ rownames(Out)<- 1:Nrow(Out)
+ return(Out)
+}
+
+#########################################
+
+#100815
+CameraCurve<- function(Curve){
+ Eps<- 10^(-6)
+ for (I in Looprange(1,Nrow(Curve))){
+ P<- Curve[I,]
+ x<- P[1]; y<- P[2]; z<- P[3]
+ if(x!=Inf){
+ Tmp<- Perspt(P)
+ if(I==1){
+ AnsL<- rbind(c(),Tmp)
+ }else{
+ Tmp1<- AnsL[Nrow(AnsL),]
+ if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){
+ AnsL<- rbind(AnsL,Tmp)
+ }
+ }
+ }else{
+ AnsL<- rbind(AnsL,c(Inf,Inf))
+ }
+ }
+ rownames(AnsL)<- 1:Nrow(AnsL)
+ return(AnsL)
+}
+
+######################################
+
+Cancoordpara<- function(P){ # 18.02.15
+ Xz<- P[1]
+ Yz<- P[2]
+ Zz<- P[3]
+ X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA)
+ Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA)
+ Z<- Yz*sin(THETA)+Zz*cos(THETA)
+ Out<- c(X,Y,Z)
+ return(Out)
+}
+
+######################################
+
+Cancoordpers<- function(P){
+ Tmp<- EyePoint-FocusPoint
+ E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3]
+ Ca<- E1/sqrt(E1^2+F1^2)
+ Sa<- F1/sqrt(E1^2+F1^2)
+ E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
+ Cb<- E2/sqrt(E2^2+G2^2)
+ Sb<- G2/sqrt(E2^2+G2^2)
+ E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb
+ Xz<- P[3]; Yz<- P[1]; Zz<- P[2]
+ X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3
+ X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3
+ X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2
+ X<- X1+FocusPoint[1]
+ Y<- Y1+FocusPoint[2]
+ Z<- Z1+FocusPoint[3]
+ Out<- c(X,Y,Z)
+ return(Out)
+}
+
+#######################################
+
+Embed<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Pd3<- varargin[[1]]
+ if(Mixtype(Pd3)==1){
+ Pd3<- list(Pd3)
+ }
+ else if(Mixtype(Pd3)==3){
+ Tmp<- list();
+ for(I in Looprange(1,length(Pd3))){
+ Tmp<- c(Tmp,Pd3[[I]])
+ }
+ Pd3<- Tmp
+ }
+ Tmpf=varargin[[2]]
+ if(mode(Tmpf)=="character"){
+ Tmp<- varargin[[3]]
+ Tmp1<- gsub("c(","(",Tmp,fixed=TRUE)
+ Vstr<- gsub(")",")",Tmp1,fixed=TRUE)
+ Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="")
+ eval(parse(text=Str))
+ }
+ else{
+ Tmpfn<- Tmpf
+ }
+ Out<- list()
+ for(I in Looprange(1,length(Pd3))){
+ PD<- Pd3[[I]]
+ Ans<- c()
+ for(J in Looprange(1,Nrow(PD))){
+ P<- PD[J,]
+ Tmp<- Tmpfn(P[1],P[2])
+ Ans<- rbind(Ans,Tmp)
+ }
+ Out<- c(Out, list(Ans))
+ }
+ if(length(Out)==1){
+ Out<- Out[[1]]
+ }
+ return(Out)
+}
+
+#######################
+# 10.08.17
+# 14.03.30
+Facesdata<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ FL<- varargin[[1]]
+ PT<- varargin[[length(varargin)]]
+ Tmp<-grep("para",PT,fixed=TRUE)
+ if(length(Tmp)>0){
+ Ptype<- 1
+ }else{
+ Ptype<- -1
+ }
+ if(Nargs==2){
+ CLadd<- list()
+ }else{
+ CLadd<- varargin[[2]]
+ }
+ NohiddenL<- list()
+ HiddenL<- list()
+ Eps<- 10^(-4)
+ if(length(CLadd)>0){
+ if(mode(CLadd)=="numeric"){
+ C<- list()
+ if(Nrow(CLadd)>1){
+ for (I in Looprange(1,Nrow(CLadd))){
+ C<- c(C,list(CLadd[I,]))
+ }
+ }else{
+ I<- 1
+ while (I<=Ncol(CLadd)){
+ C<- c(C,list(CLadd[1,I:(I+2)]))
+ I<- I+3
+ }
+ }
+ CrvL<- list(C)
+ }else if(mode(CLadd[[1]])=="numeric"){
+ CrvL<- list()
+ for (J in Looprange(1,length(CL))){
+ Ctmp<- CLadd[[J]]
+ C<- list()
+ if(Nrow(Ctmp)>1){
+ for (I in Looprange(1,Nrow(Ctmp))){
+ C<- c(C,list(Ctmp[I,]))
+ }
+ }else{
+ I<- 1
+ while(I<=Ncol(Ctmp)){
+ C<- c(C,list(Ctmp[1,I:(I+2)]))
+ I<- I+3
+ }
+ }
+ CrvL<- c(CrvL,list(C))
+ }
+ }else{
+ CrvL<- CLadd
+ }
+ }else{
+ CrvL<- list()
+ }
+ Out<- MakeveLfaceL(FL)
+ VELNO<<- Out[[1]]
+ VELHI<<- list()
+ for (I in Looprange(1,length(CrvL))){
+ Tmp<- CrvL[[I]]
+ for (J in Looprange(1,length(Tmp)-1)){
+ Edge<- list(Tmp[J],Tmp[J+1])
+ Ntmp<- length(VELNO)
+ VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1)
+ }
+ }
+ FaceL<- Out[[2]]
+ Tmp<- grep("raw",PT,fixed=TRUE)
+ if(length(Tmp)==0){
+ for (Nf in Looprange(1,length(FaceL))){
+ Face<- FaceL[[Nf]]
+ Menkakusi2(Face,Nf,Ptype)
+ }
+ }
+ for (I in Looprange(1,length(VELNO))){
+ Edge<- Op(1,VELNO[[I]])
+ if(Norm(Edge[[1]]-Edge[[2]])>Eps){
+ NohiddenL<- c(NohiddenL,list(Spaceline(Edge)))
+ }
+ }
+ EdgeL<- list() # from 13.03.30
+ for(K in Looprange(1,length(VELHI))){
+ Edge<- Op(1,VELHI[[K]])
+ P<- Edge[[1]]; Q<- Edge[[2]]
+ if(Norm(P-Q)>Eps){
+ EdgeL<- c(EdgeL,list(Edge))
+ }
+ }
+ for(K in Looprange(1,length(EdgeL))){
+ Edge<- EdgeL[[K]]
+ P<- Edge[[1]]; Q<- Edge[[2]]
+ Cflg<- 0
+ for(J in Looprange(K+1,length(EdgeL))){
+ Ej<- EdgeL[[J]]
+ Pj<- Ej[[1]]; Qj<- Ej[[2]]
+ if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){
+ next
+ }
+ if(Norm(Q-Pj)<Eps){
+ EdgeL[[J]]<- list(P,Qj)
+ Cflg<- 1
+ break
+ }
+ if(Norm(P-Qj)<Eps){
+ EdgeL[[J]]=list(Q,Pj)
+ Cflg<- 1
+ break
+ }
+ }
+ if(Cflg==0){
+ HiddenL<- c(HiddenL,list(Spaceline(Edge)))
+ }
+ } # until 14.03.30
+ PHHIDDENDATA<<- HiddenL
+ return(NohiddenL)
+}
+
+##############################
+# 2014.03.31
+
+PhHiddenData<- function(){
+ PHHIDDENDATA
+}
+
+########## Old Fullform ( Check the case of Polygon )####################
+
+Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL)
+ Out<- list(Op(1,FdL))
+ N<- Mixlength(FdL)
+ for (Jrg in Looprange(1,N)){
+ Tmp<- Stripblanks(Op(Jrg,FdL))
+ Tmp1<- grep("=c(",Tmp,fixed=TRUE)
+ if(length(Tmp1)>0){
+ break
+ }
+ }
+ Urg<- Stripblanks(Op(Jrg,FdL))
+ StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]]
+ Uname<- StrV[1]
+ Vrg<- Stripblanks(Op(Jrg+1,FdL))
+ StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]]
+ Vname<- StrV[1]
+ if(Jrg==2){
+ Tmp<- Stripblanks(Op(1,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Zf<- StrV[2]
+ Tmp<- list(Uname,Vname,Zf,Urg,Vrg)
+ Out<- c(Out,Tmp)
+ }else if(Jrg==4){
+ Tmp<- Stripblanks(Op(1,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Zf<- StrV[2]
+ Tmp<- Stripblanks(Op(2,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Xname<- StrV[1]
+ Xf<- StrV[2]
+ Tmp<- Stripblanks(Op(3,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Yname<- StrV[1]
+ Yf<- StrV[2]
+ Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE)
+ Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE)
+ Tmp<- list(Xf,Yf,Zf,Urg,Vrg)
+ Out<- c(Out,Tmp)
+ }else{
+ Tmp<- Stripblanks(Op(2,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Xf<- StrV[2]
+ Tmp<- Stripblanks(Op(3,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Yf<- StrV[2]
+ Tmp<- Stripblanks(Op(4,FdL))
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]]
+ Zf<- StrV[2]
+ Tmp<- list(Xf,Yf,Zf,Urg,Vrg)
+ Out<- c(Out,Tmp)
+ }
+ DrwS<- "enws"
+ BdyL<- c()
+ for (I in Looprange(Jrg+2,Mixlength(FdL))){
+ Tmp<- Op(I,FdL)
+ if(mode(Tmp)=="character"){
+ if(length(Tmp)==0){
+ Tmp<- " "
+ }
+ DrwS<- Tmp
+ }
+ if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){
+ BdyL<- Tmp
+ }
+ }
+ Tmp<- list(DrwS,BdyL)
+ Out<- c(Out,Tmp)
+ return(Out)
+}
+
+####################################
+
+Initangle<- function (){
+ PHI<<- 30*pi/180
+ THETA<<- 60*pi/180
+}
+
+##########################
+
+Invparapt<- function(...){
+ varargin<- list(...)
+ Eps<- 10^(-4)
+ Fk<- varargin[[length(varargin)]]
+ NFk<- Numptcrv(Fk)
+ Tmp<- varargin[[1]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){ # debug
+ Ph<- Tmp
+ Fh<- varargin[[2]]
+ }else{
+ Fh<- Projpara(Fk)
+ if(NFk>2){
+ Tmp1<- Nearestpt(Tmp,Fh)
+ Ph<- Tmp1[[2]]
+ }else{
+ Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh)
+ V1<- Tmp-Ah; V2<- Bh-Ah
+ Tmp1<- Crossprod(V1,V2)
+ if(abs(Tmp1)>Eps){
+ print("Not on the line")
+ return(c())
+ }else{
+ Ph<- Dotprod(V1,V2)/Norm(V2)^2+1
+ }
+ }
+ }
+ if(NFk>2){
+ N<- trunc(Ph)
+ S0<- Ph-N
+ if(Ph>Numptcrv(Fh)-Eps){
+ Out<- list(Ptend(Fk),Numptcrv(Fh))
+ return(Out)
+ }
+ }else{
+ N<- 1
+ S0<- Ph-1
+ }
+ Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk)
+ Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh)
+ Ph<- (1-S0)*Ah+S0*Bh
+ T2<- S0
+ Pk<- (1-T2)*Ak+T2*Bk
+ Out<- list(Pk,N+T2)
+ return(Out)
+}
+
+#################################
+
+#100815
+Invperspt<- function(...){
+ varargin<-list(...)
+ Eps<- 10^(-4)
+ Fk<- varargin[[length(varargin)]]
+ NFk<- Numptcrv(Fk)
+ Tmp<- varargin[[1]]
+ if(mode(Tmp)=="numeric" && length(Tmp)==1){
+ Ph<- varargin[[1]]
+ Fh<- varargin[[2]]
+ }else{
+ Fh<- Projpers(Fk)
+ if(NFk>2){
+ Tmp1<- Nearestpt(Tmp,Fh)
+ Ph<- Tmp1[[2]]
+ }else{
+ Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh)
+ V1<- Tmp-Ah; V2<- Bh-Ah
+ Tmp1<- Crossprod(V1,V2)
+ if(abs(Tmp1)>Eps){
+ print("Not on the line")
+ Out<- c()
+ return(Out)
+ }else{
+ Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12
+ }
+ }
+ }
+ if(NFk>2){
+ N<- trunc(Ph)
+ S0<- Ph-N
+ if(Ph>Numptcrv(Fh)-Eps){
+ Out<- list(Ptend(Fk),Numptcrv(Fh))
+ return(Out)
+ }
+ }else{
+ N<- 1
+ S0<- Ph-1 # 09.11.12
+ }
+ Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk)
+ Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh)
+ Ph<- (1-S0)*Ah+S0*Bh
+ Phc<- Cancoordpers(c(Ph,0))
+ Ahc<- Cancoordpers(c(Ah,0))
+ Bhc<- Cancoordpers(c(Bh,0))
+ Vp<- Phc-EyePoint
+ Va<- Ak-EyePoint
+ AB<- Bk-Ak
+ Cp<- Crossprod(Vp,AB)
+ Nmr<- Crossprod(Va,Vp)
+ Mx<- max(abs(Cp))
+ if(abs(Cp[1])==Mx){
+ T2<- Nmr[1]/Cp[1]
+ }else if(abs(Cp[2])==Mx){
+ T2<- Nmr[2]/Cp[2]
+ }else{
+ T2<- Nmr[3]/Cp[3]
+ }
+ Pk<- (1-T2)*Ak+T2*Bk
+ Out<- list(Pk,N+T2)
+ return(Out)
+}
+
+#########################
+
+Kukannozoku<- function(Jokyo,KukanL){
+ Eps<- 10^(-6)
+ N<- Nrow(KukanL)
+ T1<- Jokyo[1]; T2<- Jokyo[2]
+ Tmp<- KukanL[1,]
+ T1<- max(T1,Tmp[1])
+ Tmp<- KukanL[N,]
+ T2<- min(T2,Tmp[2])
+ Res<- c()
+ Flg<- 0
+ for (I in Looprange(1,N)){
+ Ku<- KukanL[I,]
+ if(Flg==0){
+ if(Ku[2]<T1){
+ Res<- rbind(Res,Ku)
+ }else{
+ Flg<- 1
+ if(Ku[1]<T1-Eps){
+ Tmp<- c(Ku[1],T1)
+ Res<- rbind(Res,Tmp)
+ }
+ if(Ku[2]>T2+Eps){
+ Tmp<- c(T2,Ku[2])
+ Res<- rbind(Res,Tmp)
+ }
+ }
+ }else if(Flg==1){
+ if(Ku[2]<T2){
+ next
+ }else{
+ Flg<- 2
+ if(Ku[1]<T2-Eps){
+ Ku<- c(T2,Ku[2])
+ }
+ Res<- rbind(Res,Ku)
+ }
+ }else{
+ Res<- rbind(Res,Ku)
+ }
+ }
+ return(Res)
+}
+
+########################################
+
+Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){
+ Eps<- 10.0^(-3)
+ Dmat<- c()
+ Dind<- c()
+ for (I in Looprange(1,Mixlength(Plt2L))){
+ Dt<- Op(I,Plt2L)
+ N1<- Nrow(Dmat)+1
+ if(Nrow(Dmat)==0){
+ Dmat<- Dt
+ }else{
+ Dmat<- rbind(Dmat,Dt)
+ }
+ N2<- Nrow(Dmat)
+ Dind<- c(Dind,N1,N2)
+ }
+ Dind<- matrix(Dind,ncol=2,byrow=TRUE)
+ Nind<- Nrow(Dind)
+ Allres<- list()
+ for (Nobj in Looprange(1,Mixlength(Obj2L))){
+ Plt2<- Op(Nobj,Obj2L)
+ PhL<- Plt2[,1:2]
+ ClipL<- c()
+ for (Ns in Looprange(1,Nrow(PhL)-1)){
+ P1<- PhL[Ns:(Ns+1),]
+ for (I in Looprange(1,Nrow(Dind))){
+ Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
+ P2<- Tmp[,1:2]
+ KC<- IntersectcrvsPp(P1,P2,Eps)
+ if(Mixlength(KC)>0){
+ for (J in 1:Mixlength(KC)){
+ P<- Op(1,Op(J,KC))
+ Tmp<- Op(2,Op(J,KC))
+ if(Tmp<1+Eps && Ns==1){
+ next
+ }
+ if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
+ next
+ }
+ N1<- Ns
+ N2<- Op(3,Op(J,KC))
+ Pa<- Plt2[N1,1:2]
+ Za<- Plt2[N1,3]
+ Pb<- Plt2[N1+1,1:2]
+ Zb<- Plt2[N1+1,3]
+ if(Norm(Pa-Pb)<Eps){
+ next
+ }
+ T1<- Norm(Pa-P)/Norm(Pa-Pb)
+ Z1<- (1-T1)*Za+T1*Zb
+ Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
+ Pa<- Tmp[N2,1:2]
+ Za<- Tmp[N2,3]
+ Pb<- Tmp[N2+1,1:2]
+ Zb<- Tmp[N2+1,3]
+ if((Norm(Pa-Pb)<Eps)){
+ next
+ }
+ T2<- Norm(Pa-P)/Norm(Pa-Pb)
+ Z2<- (1-T2)*Za+T2*Zb
+ if(Z1<Z2-Eps2){
+ if(Nrow(ClipL)==0){
+ Tmp<- 1
+ }else{
+ Tmp1<- ClipL[,1]-P[1]
+ Tmp2<- ClipL[,2]-P[2]
+ Tmp3<- Tmp1^2+Tmp2^2
+ Tmp<- min(Tmp3)
+ }
+ if(Tmp>Eps^2){
+ Tmp1<- P1[2,]-P1[1,]
+ Tmp2<- Pb-Pa
+ Tmp3<- Dotprod(Tmp1,Tmp2)
+ Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2)
+ Tmp<- 1-0.5*Tmp3^2
+ ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp))
+ }
+ }
+ }
+ }
+ }
+ }
+ Te<- Nrow(Plt2)
+ KukanL<- rbind(c(),c(1.0,Te))
+ P1<- PhL
+ if(Nrow(ClipL)>0){
+ for (I in 1:Nrow(ClipL)){
+ P<- ClipL[I,1:2]
+ NN<- ClipL[I,3]
+ T<- NN+ClipL[I,4]
+ R<- ClipL[I,5]
+ Flg<- 0
+ for (J in NN:1){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){
+ next
+ }
+ Flg<- 1
+ break
+ }
+ if(Flg==0){
+ T1<- 1
+ }else{
+ T1<- J; T2<- T
+ H<- T2-T1
+ for (N in 1:10){
+ H<- H*0.5
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){
+ T2<- T2-H
+ }else{
+ T1<- T1+H
+ }
+ }
+ }
+ Ku<- c(T1)
+ Flg<- 0
+ for (J in Looprange(NN+1,Te)){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){
+ next
+ }
+ Flg<- 1
+ break
+ }
+ if(Flg==0){
+ T2<- Te
+ }else{
+ T1<- T; T2<- J
+ H<- T2-T1
+ for (N in 1:10){
+ H<- H*0.5
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){
+ T1<- T1+H
+ }else{
+ T2<- T2-H
+ }
+ }
+ }
+ Ku<- c(Ku,T2)
+ KukanL<- Kukannozoku(Ku,KukanL)
+ }
+ }
+ Res<- list()
+ for (I in Looprange(1,Nrow(KukanL))){
+ T1<- KukanL[I,1]; N1<- trunc(T1)
+ T2<- KukanL[I,2]; N2<- trunc(T2)
+ PtL<- list()
+ if(T1-N1<1-Eps){
+ Tmp<- Pointoncurve(T1,P1)
+ PtL<- list(Tmp)
+ }
+ for (J in Looprange(N1+1,N2)){
+ Tmp<- Pointoncurve(J,P1)
+ PtL<- c(PtL,list(Tmp))
+ }
+ if(T2-N2>Eps){
+ Tmp<- Pointoncurve(T2,P1)
+ PtL<- c(PtL,list(Tmp))
+ }
+ Res<- c(Res,list(Listplot(PtL)))
+ }
+ Allres<- c(Allres,Res)
+ }
+ return(Allres)
+}
+
+#########################
+
+#100815
+Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){
+ Eps<- 10.0^(-3)
+ Dmat<- c()
+ Dind<- c()
+ for (I in Looprange(1,Mixlength(Plt2L))){
+ Dt<- Op(I,Plt2L)
+ N1<- Nrow(Dmat)+1
+ Dmat<- rbind(Dmat,Dt)
+ N2<- Nrow(Dmat)
+ Dind<- rbind(Dind,c(N1,N2))
+ }
+ Nind<- Nrow(Dind)
+ Allres<- list()
+ for (Nobj in Looprange(1,Mixlength(Obj2L))){
+ Plt2<- Op(Nobj,Obj2L)
+ PhL<- Plt2[,1:2]
+ ClipL<- c()
+ for (Ns in Looprange(1,Nrow(PhL)-1)){
+ P1<- PhL[Ns:(Ns+1),]
+ for (I in Looprange(1,Nrow(Dind))){
+ Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
+ P2<- Tmp[,1:2]
+ KC<- IntersectcrvsPp(P1,P2,Eps)
+ if(Mixlength(KC)>0){
+ for (J in Looprange(1,Mixlength(KC))){#
+ P<- Op(1,Op(J,KC))
+ Tmp<- Op(2,Op(J,KC))
+ if(Tmp<(1+Eps) && Ns==1){
+ next
+ }
+ if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){
+ next
+ }
+ N1<- Ns
+ N2<- Op(3,Op(J,KC))
+ Pa<- Plt2[N1,1:2]
+ Za<- Plt2[N1,3]
+ Pb<- Plt2[N1+1,1:2]
+ Zb<- Plt2[N1+1,3]
+ if(Norm(Pa-Pb)<Eps){
+ next
+ }
+ T1<- Norm(Pa-P)/Norm(Pa-Pb)#norm(Pa-P)/norm(Pa-Pb)
+ Pka<- Cancoordpers(c(Pa[1],Pa[2],Za))
+ Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb))
+ if(T1>1-Eps){
+ Pk<- Pkb
+ }else{
+ Tmp1<- Listplot(c(Pa,Pb))
+ Tmp2<- Spaceline(c(Pka,Pkb))
+ Tmp<- Invperspt(1+T1,Tmp1,Tmp2)
+ Pk<- Op(1,Tmp)
+ }
+ Z1<- Zperspt(Pk)
+ Tmp<- Dmat[Dind[I,1]:Dind[I,2],]
+ Pa<- Tmp[N2,1:2]
+ Za<- Tmp[N2,3]
+ Pb<- Tmp[N2+1,1:2]
+ Zb<- Tmp[N2+1,3]
+ if(Norm(Pa-Pb)<Eps){
+ next
+ }
+ T2<- Norm(Pa-P)/Norm(Pa-Pb)
+ Pka<- Cancoordpers(c(Pa[1],Pa[2],Za))
+ Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb))
+ if(T2>(1-Eps)){
+ Pk<- Pkb
+ }else{
+ Tmp1<- Listplot(c(Pa,Pb))
+ Tmp2<- Spaceline(c(Pka,Pkb))
+ Tmp<- Invperspt(1+T2,Tmp1,Tmp2)
+ Pk<- Op(1,Tmp)
+ }
+ Z2<- Zperspt(Pk)
+ if(Z1<(Z2-Eps2)){
+ if(length(ClipL)==0){
+ Tmp<- 1
+ }else{
+ Tmp1<- ClipL[,1]-P[1]
+ Tmp2<- ClipL[,2]-P[2]
+ Tmp3<- Tmp1^2+Tmp2^2
+ Tmp<- min(Tmp3)
+ }
+ if(Tmp>Eps^2){
+ Tmp1<- P1[2,]-P1[1,]
+ Tmp2<- Pb-Pa
+ Tmp3<- Dotprod(Tmp1,Tmp2)
+ Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2)
+ Tmp<- 1-0.5*Tmp3^2
+ ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp))
+ }
+ }
+ }
+ }
+ }
+ }
+ Te<- Nrow(Plt2)
+ KukanL<- rbind(c(),c(1.0,Te))
+ P1<- PhL
+ if(Nrow(ClipL)>0){
+ for (I in Looprange(1,Nrow(ClipL))){
+ P<- ClipL[I,1:2]
+ NN<- ClipL[I,3]
+ T<- NN+ClipL[I,4]
+ R<- ClipL[I,5] #added 10.08.17
+ Flg<- 0
+ for (J in NN:1){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){#(norm(P-Q)<R)
+ next
+ }
+ Flg<- 1
+ break
+ }
+ if(Flg==0){
+ T1<- 1
+ }else{
+ T1<- J; T2<- T
+ H<- T2-T1
+ for (N in 1:10){
+ H<- H*0.5
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){ # norm(P-Q)<R
+ T2<- T2-H
+ }else{
+ T1<- T1+H
+ }
+ }
+ }
+ Ku<- c(T1)#Ku<- [T1]
+ Flg<- 0
+ for (J in Looprange(NN+1,Te)){
+ Q<- Pointoncurve(J,P1)
+ if(Norm(P-Q)<R){
+ next#continue
+ }
+ Flg<- 1
+ break
+ }
+ if(Flg==0){
+ T2<- Te
+ }else{
+ T1<- T; T2<- J
+ H<- T2-T1
+ for (N in 1:10){
+ H<- H*0.5
+ Q<- Pointoncurve(T1+H,P1)
+ if(Norm(P-Q)<R){
+ T1<- T1+H
+ }else{
+ T2<- T2-H
+ }
+ }
+ }
+ Ku<- c(Ku,T2)#[Ku,T2]
+ KukanL<- Kukannozoku(Ku,KukanL)
+ }
+ }
+ Res<- list()#[]
+ for (I in Looprange(1,Nrow(KukanL))){#(I=1:size(KukanL,1))
+ T1<- KukanL[I,1]; N1<- trunc(T1)
+ T2<- KukanL[I,2]; N2<- trunc(T2)
+ PtL<- list()#[]
+ if(T1-N1<1-Eps){
+ Tmp<- Pointoncurve(T1,P1)
+ PtL<- list(Tmp)#100816c(PtL,list(Tmp)) PtL<- MixS(Tmp)
+ }
+ for (J in Looprange(N1+1,N2)){
+ Tmp<- Pointoncurve(J,P1)
+ PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp)
+ }
+ if(T2-N2>Eps){
+ Tmp<- Pointoncurve(T2,P1)
+ PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp)
+ }
+ Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL))
+ }
+ Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res)
+ }
+ return(Allres)
+}
+
+##############################3
+
+MakeveLfaceL<- function(VfL){
+# // Out format
+# // VeL Edge, Face num(as numlist), VeL num
+# // FL Face (Vertexs)
+ Eps<- 10^(-4)
+ Tmp<- VfL[[length(VfL)]]
+ Tmp1<- Tmp[[1]]
+ if(mode(Tmp1)=="numeric"){
+ FvL<- list(VfL)
+ }else{
+ FvL<- VfL
+ }
+ EL<- list(); FL<- list()
+ for (Nn in Looprange(1,length(FvL))){
+ Tmp<- FvL[[Nn]]
+ VL<- Tmp[[1]]
+ if(length(VL)>0){
+ FnL<- Tmp[[2]]
+ FaceL<- list()
+ for (I in Looprange(1,length(FnL))){
+ Tmp1<- FnL[[I]]
+ PtL<- list()
+ for (J in Looprange(1,length(Tmp1))){
+ Tmp2<- Tmp1[[J]]
+ PtL[[J]]<- VL[[Tmp2]]
+ }
+ FaceL[[I]]<- PtL
+ }
+ }else{
+ FaceL<- list(Tmp[[2]])
+ }
+ for (I in Looprange(1,length(FaceL))){
+ Face<- FaceL[[I]]
+ Face<- c(Face,list(Face[[1]]))
+ FL<- c(FL,list(Face))
+ for (J in Looprange(1,length(Face)-1)){
+ Edge<- list(Face[[J]],Face[[J+1]])
+ Flg<- 0
+ for (K in Looprange(1,length(EL))){
+ Tmp<- EL[[K]]
+ Tmp1<- Tmp[[1]]
+ Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]])
+ Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]])
+ if(Tmp2<Eps || Tmp3<Eps){#(
+ Tmp<- EL[[K]]
+ Tmp1<- Tmp[[1]]
+ Tmp2<- c(Tmp[[2]],length(FL))
+ EL[[K]]<- list(Tmp1,Tmp2,K)
+ Flg<- 1
+ break
+ }
+ }
+ if(Flg==0){
+ Ntmp<- length(EL)
+ EL[[Ntmp+1]]<- list(Edge,c(length(FL)),Ntmp+1)
+ }
+ }
+ }
+ }
+ Out<- list(EL,FL)
+ return(Out)
+}
+
+###########################
+#// 09.10.29
+#// 09.11.15
+
+Menkakusi2<- function(Face,Nf,Ptype){
+# global THETA PHI EyePoint FocusPoint VELNO VELHI
+ Eps0<- 10^(-6)
+ Eps<- 10^(-4)
+ Tmp1<- Face[[1]]-Face[[2]]
+ Tmp2<- Face[[3]]-Face[[2]]
+ if(Norm(Tmp1)<Eps || Norm(Tmp2)<Eps){
+ return()
+ }
+ Vec<- 1/Norm(Tmp1)/Norm(Tmp2)*Crossprod(Tmp1,Tmp2)
+ if(Norm(Vec)<Eps){
+ return()
+ }
+ if(Ptype== -1){
+ W<- EyePoint
+ Tmp<- Dotprod(Vec,W-Face[[1]])
+ }else{
+ W<- c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA))
+ W<- 100*W
+ Tmp<- Dotprod(Vec,W-Face[[1]])
+ }
+ if(abs(Tmp)<Eps){
+ return()
+ }
+ if(Tmp<-Eps){
+ Vec<- -Vec
+ }
+ if(Ptype==-1){
+ G1<- Projpers(Spaceline(Face))
+ }else{
+ G1<- Projpara(Spaceline(Face))
+ }
+ VL<- list()
+ for (I in Looprange(1,Numptcrv(G1))){
+ VL[[I]]<- Ptcrv(I,G1)
+ }
+ Out1L<- list()
+ Out2L<- VELHI
+ for (N in Looprange(1,length(VELNO))){
+ Out1<- list()
+ Out2<- list()
+ Tmp<- VELNO[[N]]
+ Edge<- Tmp[[1]]
+ Ne<- Tmp[[2]]
+ NNe<- Tmp[[3]]
+ if(Member(Nf,Ne)){
+ Out1L<- c(Out1L, list(list(Edge,Ne,NNe)))
+ next
+ }
+ if(Ptype==-1){
+ PtA<- Perspt(Edge[[1]])
+ PtB<- Perspt(Edge[[2]])
+ }else{
+ PtA<- Parapt(Edge[[1]])
+ PtB<- Parapt(Edge[[2]])
+ }
+ if(Norm(PtA-PtB)<Eps){
+ next
+ }
+ Bdy<- list(G1)
+ V<- PtB-PtA
+ TenL<- KoutenList(PtA,V,Bdy)
+ Nten<- length(TenL)
+ if(Nten==0){ # debug 10.08.17
+ Out1L<- c(Out1L,list(list(Edge,Ne,NNe)))
+ next
+ }
+ Te<- 0
+ Pe3<- Edge[[1]]
+ if(Ptype==-1){
+ Tmp1<- Perspt(Pe3)
+ Tmp<- Invperspt(Tmp1,Spaceline(Face))
+ }else{
+ Tmp1<- Parapt(Pe3)
+ Tmp<- Invparapt(Tmp1,Spaceline(Face))
+ }
+ Qe3<- Tmp[[1]]
+ Flg<- 0
+ for (I in Looprange(1,Nten)){
+ TenP<- TenL[[I]]
+ Ts<- TenP[[1]]
+ P<- TenP[[2]]
+ if(Ts< -Eps){
+ next
+ }
+ Eline<- Spaceline(Edge)
+ if(Ptype==-1){
+ Tmp<- Invperspt(P,Eline)
+ Tmp1<- Invperspt(P,Spaceline(Face))
+ }else{
+ Tmp<- Invparapt(P,Eline)
+ Tmp1<- Invparapt(P,Spaceline(Face))
+ }
+ P3<- Tmp[[1]]; Q3<- Tmp1[[1]]
+ if(Ts>1-Eps){# // P3, Q3 are necessary
+ Flg<- I
+ break
+ }
+ if(abs(Te-Ts)>Eps0){
+ if((I%%2)==1){
+ Out1<- c(Out1,list(list(Pe3,P3)))
+ }else{
+ if(length(Qe3)==0){
+ Tmp<- Op(2,TenL[[I-1]])
+ if(Ptype==-1){
+ Tmp1<- Invperspt(Tmp,Spaceline(Face))
+ }else{
+ Tmp1<- Invparapt(Tmp,Spaceline(Face))
+ }
+ Qe3<- Tmp1[[1]]
+ }
+ PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3)
+ if(Ptype==-1){
+ Z1<- Zperspt(PM); Z2<- Zperspt(QM)
+ }else{
+ Z1<- Zparapt(PM); Z2<- Zparapt(QM)
+ }
+ if(Z1>Z2){
+ Out1<- c(Out1, list(list(Pe3,P3)))
+ }else{
+ Out2<- c(Out2, list(list(Pe3,P3)))
+ }##
+ }
+ }
+ Te<- Ts; Pe3<- P3; Qe3<- Q3
+ }
+ if(Flg==0){
+ if(Norm(Pe3-Edge[[2]])>Eps0){
+ Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
+ }
+ }else{
+ if((Flg%%2)==1){
+ Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
+ }else{
+ PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3)
+ if(Ptype==-1){
+ Z1<- Zperspt(PM); Z2<- Zperspt(QM)
+ }else{
+ Z1<- Zparapt(PM); Z2<- Zparapt(QM)
+ }
+ if(Z1>Z2){
+ Out1<- c(Out1, list(list(Pe3,Edge[[2]])))
+ }else{
+ Out2<- c(Out2, list(list(Pe3,Edge[[2]])))
+ }
+ }
+ }
+ for (I in Looprange(1,length(Out1))){
+ Tmp<- Out1[[I]]
+ if(I==1){
+ SeL<- Tmp
+ }else{
+ if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){
+ SeL[[2]]<- Tmp[[2]]
+ }else{
+ Out1L<- c(Out1L, list(list(SeL,Ne,NNe)))
+ SeL<- Tmp
+ }
+ }
+ }
+ if(length(Out1)>0){
+ Out1L<- c(Out1L, list(list(SeL,Ne,NNe)))
+ }
+ for (I in Looprange(1,length(Out2))){
+ Tmp<- Out2[[I]]
+ if(I==1){
+ SeL<- Tmp
+ }else{
+ if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){
+ SeL[[2]]<- Tmp[[2]]
+ }else{
+ Out2L<- c(Out2L, list(list(SeL,Ne,NNe)))
+ SeL<- Tmp
+ }
+ }
+ }
+ if(length(Out2)>0){
+ Out2L<- c(Out2L, list(list(SeL,Ne,NNe)))
+ }
+ }
+ VELNO<<- Out1L
+ VELHI<<- Out2L
+}
+
+###################################
+
+Parapt<- function(Plist){ # 18.02.19 changed (for point list)
+ if(!is.list(Plist)){Plist=list(Plist)}
+ Out=list()
+ for(jj in 1:length(Plist)){
+ P=Op(jj,Plist)
+ x<- P[1]
+ y<- P[2]
+ z<- P[3]
+ Xz<- -x*sin(PHI)+y*cos(PHI)
+ Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA)
+ Out<- c(Out,list(c(Xz,Yz)))
+ }
+ if(length(Out)==1){Out=Op(1,Out)}
+ return(Out)
+}
+
+###################################
+
+Partcrv3<- function(T1,T2,Fk){
+ Eps0=10^(-4)
+#// Tmp=Mixop(1,Fk)
+#// new part from
+ if(T1>(T2+Eps0)){
+ Npt<- Nrow(Fk)
+ Out1<- Partcrv3(T1,Npt,Fk)
+ Out2<- Partcrv3(1,T2,Fk)
+ Tmp<- Fk[1,]-Fk[Npt,]
+ if(Norm(Tmp)<Eps0){
+ PL<- Joincrvs(Out1,Out2)
+ }else{
+ PL<- list(Out1,Out2)
+ }
+ rownames(PL)<- 1:Nrow(PL)
+ return(PL)
+ }
+ if(floor(T1)==floor(T2)){ #18.02.26from
+ Tmp=floor(T1)
+ p1=Op(Tmp,Fk); p2=Op(Tmp+1,Fk)
+ PL=c(p1+(T1-Tmp)*(p2-p1))
+ PL=Appendrow(PL, p1+(T2-Tmp)*(p2-p1)) #18.02.26until
+ }else{
+ Is<- ceiling(T1)
+ Ie<- floor(T2)
+ PL<- c()
+ if(T1<Is-Eps0){
+ P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,]
+ PL<- Appendrow(PL, P) #18.02.10(bug)
+ }
+ PL<- Appendrow(PL,Fk[Is:Ie,])
+ if(T2>(Ie+Eps0)){
+ P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,]
+ PL<- Appendrow(PL,P)
+ }
+ }
+ return(PL)
+}
+
+###################################
+
+#100815
+Perspt<- function(P){
+ Tmp<- P-FocusPoint
+ X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3]
+ Tmp<- EyePoint-FocusPoint
+ E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3]
+ Ca<- E1/sqrt(E1^2+F1^2)
+ Sa<- F1/sqrt(E1^2+F1^2)
+ X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1
+ E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
+ Cb<- E2/sqrt(E2^2+G2^2)
+ Sb<- G2/sqrt(E2^2+G2^2)
+ X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb
+ E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb
+ Yz<- E3/(E3-X3)*Y3
+ Zz<- E3/(E3-X3)*Z3
+ Out<- c(Yz,Zz)
+ return(Out)
+}
+
+
+#################################
+
+Phcutdata<- function(VL,FaceL,PlaneD){
+ Out<- list()
+ EL<- list()
+ Eps<- 10^(-4)
+ for (I in Looprange(1,Mixlength(FaceL))){
+ Face<- Op(I,FaceL)
+ for (J in Looprange(1,length(Face))){
+ Nj<- J+1
+ if(J==length(Face)){
+ Nj<- 1
+ }
+ N1<- Face[J]; N2<- Face[Nj]
+ Tmp<- c(N1,N2)
+ Flg<- 0
+ for (K in Looprange(1,Mixlength(EL))){
+ Tmp1<- Op(K,EL)
+ Tmp2<- Tmp1[2:1]
+ if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){
+ Flg<- 1
+ break
+ }
+ }
+ if(Flg==0){
+ EL<- c(EL,list(Tmp))
+ }
+ }
+ }
+ Out0<- list()
+ for (I in Looprange(1,Mixlength(EL))){
+ Tmp<- Op(I,EL)
+ Tmp1<- Op(Tmp[1],VL)
+ Tmp2<- Op(Tmp[2],VL)
+ Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2)))
+ }
+ if(Mixtype(PlaneD)!=1){
+ V1<- Op(1,PlaneD)
+ Tmp<- Op(2,PlaneD)
+ if(length(Tmp)>1){
+ d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3]
+ }else{
+ d<- Tmp
+ }
+ }else if(mode(PlaneD)=="numeric"){
+ V1<- PlaneD[1:3]
+ d<- PlaneD[4]
+ }else{
+ StrV<- strsplit(PlaneD,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Tmp1<- StrV[1]
+ Tmp2<- StrV[2]
+ PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="")
+ }
+ x<- 0; y<- 0; z<- 0
+ d<- -eval(parse(text=PlaneD))
+ x<- 1; y<- 0; z<- 0;
+ Tmp1<- eval(parse(text=PlaneD))+d
+ x<- 0; y<- 1; z<- 0
+ Tmp2<- eval(parse(text=PlaneD))+d
+ x<- 0; y<- 0; z<- 1
+ Tmp3<- eval(parse(text=PlaneD))+d
+ V1<- c(Tmp1,Tmp2,Tmp3)
+ }
+ if(all(V1==c(0,0,0))){
+ return(Out0)
+ }
+ V3<- c(1,0,0)
+ Out1<- Rotate3data(Out0,V1,V3)
+ Tmp2<- Rotate3pt(c(1,0,0),V3,V1)
+ Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3]
+ x0<- d/Tmp
+ PtL<- list()
+ for (I in Looprange(1,Mixlength(Out1))){
+ Tmp<- Op(I,Out1)
+ Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,]
+ P<- list(Tmp1,Tmp2-Tmp1)
+ Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1])
+ if(abs(Tmp[[2]]) < Eps){
+ Tmp<- c()
+ }else{
+ Tmp1<- Tmp[[2]]
+ Tmp2<- x0-Tmp[[1]]
+ Tmp<- c(Tmp2/Tmp1)
+ }
+ if(length(Tmp)>0){
+ Tmp<- Tmp[1]
+ if(Tmp>-Eps && Tmp<(1+Eps)){
+ Tmp3<- P[[1]]+Tmp*P[[2]]
+ Tmp3<- Rotate3pt(Tmp3,V3,V1)
+ if(Tmp<Eps){
+ Tmp1<- Op(I,EL)
+ Tmp1<- Tmp1[1]
+ Tmp4<- list(c(Tmp1,Tmp1),Tmp3)
+ }else{
+ if(Tmp>1-Eps){
+ Tmp1<- Op(I,EL)
+ Tmp1<- Tmp1[2]
+ Tmp4<- list(c(Tmp1,Tmp1),Tmp3)
+ }else{
+ Tmp4<- list(Op(I,EL),Tmp3)
+ }
+ }
+ Flg<- 0
+ for (J in Looprange(1,Mixlength(PtL))){
+ Tmp<- Op(J,PtL)
+ Tmp<- Op(2,Tmp)
+ if(Norm(Tmp3-Tmp)<Eps){
+ Flg<- 1
+ break
+ }
+ }
+ if(Flg==0){
+ PtL<- c(PtL,list(Tmp4))
+ }
+ }
+ }
+ }
+ if(Mixlength(PtL)==0){
+ return(Out0)
+ }
+ PL<- list(Op(1,PtL))
+ QL<- PtL[2:Mixlength(PtL)]
+ N<- Mixlength(QL)
+ for (I in Looprange(2,N+1)){
+ Tmp1<- Op(Mixlength(PL),PL)
+ Tmp1<- Op(1,Tmp1)
+ for (J in Looprange(1,Mixlength(QL))){
+ Tmp2<- Op(J,QL)
+ Tmp2<- Op(1,Tmp2)
+ Flg<- 0
+ for (K in Looprange(1,Mixlength(FaceL))){
+ Tmp3<- Op(K,FaceL);
+ if(Member(Tmp1[1],Tmp3) &&
+ Member(Tmp1[2],Tmp3) &&
+ Member(Tmp2[1],Tmp3) &&
+ Member(Tmp2[2],Tmp3)){
+ Flg<- 1
+ break
+ }
+ }
+ if(Flg==1){
+ break
+ }
+ }
+ J<- min(J, Mixlength(QL))
+ PL<- c(PL,list(Op(J,QL)))
+ Tmp1<- QL[Looprange(1,J-1)]
+ Tmp2<- QL[Looprange(J+1,Mixlength(QL))]
+ QL<- c(Tmp1,Tmp2)
+ if(Mixlength(QL)==0){
+ break
+ }
+ }
+ PHCUTPOINTL<<- PL
+ Tmp<- list()
+ for (J in Looprange(1,Mixlength(PL))){
+ Tmp1<- Op(J,PL)
+ Tmp1<- Op(2,Tmp1)
+ Tmp<- c(Tmp,list(Tmp1))
+ }
+ Tmp1<- Op(1,PL)
+ Tmp1<- Op(2,Tmp1)
+ Tmp<- c(Tmp,list(Tmp1))
+ Out2<- Spaceline(Tmp)
+ Out<- c(Out0,list(Out2))
+}
+
+#########################################
+
+Phcutoffdata<- function(...){
+ varargin<-list(...)
+ Eps<- 10^(-4)
+ Out2<- list()
+ VL<- varargin[[1]]
+ FaceL<- varargin[[2]]
+ PlaneD<- varargin[[3]]
+ Sgnstr<- varargin[[4]]
+ Fugou<- 1
+ if(Sgnstr=="-" || Sgnstr=="n"){
+ Fugou<- -1
+ }
+ Out0<- Phcutdata(VL,FaceL,PlaneD)
+ PtL<- PHCUTPOINTL
+ PHVERTEXL<<- VL
+ PHFACEL<<- FaceL
+ if(length(PtL)==0){
+ Out2<- Out0
+ return(Out2)
+ }
+ N1<- Mixlength(VL)
+ Face<- c()
+ for (I in Looprange(1,Mixlength(PtL))){
+ Tmp<- Op(I,PtL)
+ Tmp3<- Op(1,Tmp)
+ Tmp1<- Tmp3[[1]]; Tmp2<- Tmp3[[2]] # debugged 10.08.14
+ if(Tmp1!=Tmp2){
+ VL<- c(VL,list(Op(2,Tmp)))
+ N1<- N1+1
+ Tmp1<- N1
+ }
+ Face<- c(Face,Tmp1)
+ PtL[[I]]<- list(Op(1,Tmp),Tmp1)
+ }
+ OutfL<- list(Face)
+ if(Mixtype(PlaneD)!=1){
+ V1<- Op(1,PlaneD)
+ Tmp<- Op(2,PlaneD)
+ if(length(Tmp)>1){
+ d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3]
+ }else{
+ d<- Tmp
+ }
+ }else if(mode(PlaneD)=="numeric"){
+ V1<- PlaneD[1:3]
+ d<- PlaneD[4]
+ }else{
+ StrV<- strsplit(PlaneD,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Tmp1<- StrV[1]
+ Tmp2<- StrV[2]
+ PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="")
+ }
+ x<- 0; y<- 0; z<- 0
+ d<- -eval(parse(text=PlaneD))
+ x<- 1; y<- 0; z<- 0
+ Tmp1<- eval(parse(text=PlaneD))+d
+ x<- 0; y<- 1; z<- 0
+ Tmp2<- eval(parse(text=PlaneD))+d
+ x<- 0; y<- 0; z<- 1
+ Tmp3<- eval(parse(text=PlaneD))+d
+ V1<- c(Tmp1,Tmp2,Tmp3)
+ }
+ for (I in Looprange(1,Mixlength(FaceL))){
+ Face<- Op(I,FaceL)
+ TmpL<- list()
+ for (J in Looprange(1,length(Face))){
+ N1<- Face[J]
+ if(J==length(Face)){
+ N2<- Face[1]
+ }else{
+ N2<- Face[J+1]
+ }
+ for (K in Looprange(1,Mixlength(PtL))){
+ Pd<- Op(K,PtL)
+ Tmp<- Op(1,Pd)
+ if(Tmp[1]==Tmp[2]){
+ if(Tmp[1]==N1){
+ TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd))))
+ }
+ }else{
+ if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){
+ TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd))))
+ }
+ }
+ }
+ }
+ if(Mixlength(TmpL)<2){
+ Flg<- 0
+ for (J in Looprange(1,length(Face))){
+ Tmp<- Op(Face[J],VL)
+ Tmp1<- Fugou*(Dotprod(V1,Tmp)-d)
+ if(Tmp1< -Eps){
+ Flg<- 1
+ break
+ }
+ }
+ if(Flg==0){
+ OutfL<- c(OutfL,list(Face))
+ }
+ next
+ }
+ Pd<- Op(1,TmpL)
+ Qd<- Op(2,TmpL)
+ Outf1<- c(Op(3,Pd))
+ Nf<- Op(1,Pd)+1
+ Tmp<- Op(2,Pd)
+ JJ<- 0
+ while (!all(Tmp==Op(2,Qd))){
+ JJ<- JJ+1
+ if(JJ>20){
+ print("bug")
+ return()
+ }
+ Tmp1<- Tmp[2]
+ if(Outf1[length(Outf1)]!=Tmp1){
+ Outf1<- c(Outf1,Tmp1)
+ }
+ Tmp<- c(Face[Nf])
+ Nf<- Nf+1
+ if(Nf>length(Face)){
+ Nf<- 1
+ }
+ Tmp<- c(Tmp,Face[Nf])
+ }
+ Tmp1<- Op(3,Qd)
+ if(Outf1[length(Outf1)]!=Tmp1){
+ Outf1<- c(Outf1,Tmp1)
+ }
+ Outf2<- c(Op(3,Pd))
+ Nf<- Op(1,Pd)
+ Tmp<- Op(2,Pd)
+ JJ<- 0
+ while (!all(Tmp==Op(2,Qd))){
+ JJ<- JJ+1
+ if(JJ>20){
+ print("bug")
+ return()
+ }
+ Tmp1<- Tmp[1]
+ if(Outf2[length(Outf2)]!=Tmp1){
+ Outf2<- c(Outf2,Tmp1)
+ }
+ Tmp<- c(Face[Nf])
+ Nf<- Nf-1
+ if(Nf<1){
+ Nf<- length(Face)
+ }
+ Tmp<- c(Face[Nf],Tmp)
+ }
+ Tmp1<- Op(3,Qd)
+ if(Outf2[length(Outf2)]!=Tmp1){
+ Outf2<- c(Outf2,Tmp1)
+ }
+ if(length(Outf1)<3 || length(Outf2)<3){
+ Face<- Outf1
+ if(length(Outf1)<length(Outf2)){
+ Face<- Outf2
+ }
+ Flg<- 0
+ for (J in Looprange(1,length(Face))){
+ Tmp<- Op(Face(J),VL)
+ Tmp1<- Fugou*(Dotprod(V1,Tmp)-d)
+ if(Tmp1<-Eps){
+ Flg<- 1
+ break
+ }
+ }
+ if(Flg==0){
+ OutfL<- c(OutfL,list(Face))
+ }
+ }else{
+ Tmp<- Op(Outf1[2],VL)
+ Tmp1<- Outf1
+ Tmp2<- Fugou*(Dotprod(V1,Tmp)-d)
+ if(Tmp2<0){
+ Tmp1<- Outf2
+ }
+ OutfL<- c(OutfL,list(Tmp1))
+ }
+ }
+ PHVERTEXL<<- VL
+ PHFACEL<<- OutfL
+ Out2<- Phcutdata(VL,OutfL,c(0,0,0,0))
+ return(Out2)
+}
+
+#######################
+
+Phparadata<- function(VL,FaceL){
+ Out<- Facesdata(list(VL,FaceL),"para")
+ return(Out)
+}
+
+####################################
+
+Phpersdata<- function(VL,FaceL){
+ Out<- Facesdata(list(VL,FaceL),"pers")
+ return(Out)
+}
+
+####################################
+
+Phspersdata<- function(Fdata){
+ Out<- Facesdata(Fdata,"pers")
+ return(Out)
+}
+
+####################################
+
+Phsparadata<- function(Fdata){
+ Out<- Facesdata(Fdata,"para")
+ return(Out)
+}
+
+#########################
+
+#100816
+Projpers<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Flg<- 0
+ if(Nargs==1 && Mixtype(varargin[[1]])==1){
+ Flg<- 1
+ }
+ CL<- list()
+ for (N in Looprange(1,Nargs)){
+ Crv<- varargin[[N]]
+ if(Mixtype(Crv)==1){
+ Tmp<- CameraCurve(Crv)
+ CL<- c(CL,list(Tmp))
+ }else{
+ if(Mixtype(Crv)==3){
+ ObjL<- list()
+ for (I in Looprange(1,Mixlength(Crv))){
+ Tmp1<- Op(I,Crv)
+ if(Mixtype(Tmp1)==1){
+ ObjL<- c(ObjL,list(Tmp1))
+ }else{
+ ObjL<- c(ObjL,Tmp1)
+ }
+ }
+ Crv<- ObjL
+ }
+ for (J in Looprange(1,Mixlength(Crv))){
+ Tmp<- CameraCurve(Op(J,Crv))
+ CL<- c(CL,list(Tmp))
+ }
+ }
+ }
+ if(Mixlength(CL)==1 && Flg==1){
+ CL<- Op(1,CL)
+ }
+ return(CL)
+}
+
+###################################
+
+ProjcoordCurve<- function(Curve){
+ SP<- sin(PHI); CP<- cos(PHI)
+ ST<- sin(THETA); CT<- cos(THETA)
+ Out<- c()
+ for (J in Looprange(1,Nrow(Curve))){
+ P<- Ptcrv(J,Curve)
+ x<- P[1]; y<- P[2]; z<- P[3]
+ Xz<- -x*SP+y*CP
+ Yz<- -x*CP*CT-y*SP*CT+z*ST
+ Zz<- x*CP*ST+y*SP*ST+z*CT
+ Out<- c(Out,Xz,Yz,Zz)
+ }
+ Out<- matrix(Out,ncol=3,byrow=TRUE)
+ return(Out)
+}
+
+#################################
+
+ProjCurve<- function(Curve){ # 2018.02.26 rewritten
+ AnsL= c()
+ SP=sin(PHI); CP=cos(PHI)
+ ST=sin(THETA); CT=cos(THETA)
+ for(I in Looprange(1,Length(Curve)) ){
+ P=Op(I,Curve)
+ x=P[1]; y=P[2]; z=P[3]
+ if(x!=Inf){
+ Xz=-x*SP+y*CP
+ Yz= -x*CP*CT-y*SP*CT+z*ST
+ AnsL=Appendrow(AnsL,c(Xz,Yz))
+ Tmp= c(Xz,Yz)
+ }else{
+ AnsL=Appendrow(AnsL,c(Inf,Inf))
+ }
+ }
+ return(AnsL)
+}
+
+####################################
+
+Projpara<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Flg<- 0
+ if((Nargs==1)&&(is.numeric(varargin[[1]]))){
+ Flg<- 1
+ }
+ CL<- list()
+ for (N in Looprange(1,Nargs)){
+ Crv<- varargin[[N]]
+ if(is.numeric(Crv)){
+ Tmp<- ProjCurve(Crv)
+ CL<- c(CL,list(Tmp))
+ }
+ else{
+ if(is.list(Crv)){
+ ObjL<- list()
+ for (I in Looprange(1,Mixlength(Crv))){
+ Tmp1<- Op(I,Crv)
+ if(is.numeric(Tmp1)){
+ ObjL<- c(ObjL,list(Tmp1))
+ }
+ else{
+ ObjL<- c(ObjL,Tmp1)
+ }
+ }
+ Crv<- ObjL
+ }
+ for (J in Looprange(1,length(Crv))){
+ Tmp<- ProjCurve(Op(J,Crv))
+ CL<- c(CL,list(Tmp))
+ }
+ }
+ }
+ if((length(CL)==1)&&(Flg==1)){
+ CL<- Op(1,CL)
+ }
+ return(CL)
+}
+
+#########################
+
+#100816
+Projpers<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Flg<- 0
+ if(Nargs==1 && Mixtype(varargin[[1]])==1){
+ Flg<- 1
+ }
+ CL<- list()
+ for (N in Looprange(1,Nargs)){
+ Crv<- varargin[[N]]
+ if(Mixtype(Crv)==1){
+ Tmp<- CameraCurve(Crv)
+ CL<- c(CL,list(Tmp))
+ }else{
+ if(Mixtype(Crv)==3){
+ ObjL<- list()
+ for (I in Looprange(1,Mixlength(Crv))){
+ Tmp1<- Op(I,Crv)
+ if(Mixtype(Tmp1)==1){
+ ObjL<- c(ObjL,list(Tmp1))
+ }else{
+ ObjL<- c(ObjL,Tmp1)
+ }
+ }
+ Crv<- ObjL
+ }
+ for (J in Looprange(1,Mixlength(Crv))){
+ Tmp<- CameraCurve(Op(J,Crv))
+ CL<- c(CL,list(Tmp))
+ }
+ }
+ }
+ if(Mixlength(CL)==1 && Flg==1){
+ CL<- Op(1,CL)
+ }
+ return(CL)
+}
+
+#########################################
+# 11.08.27
+# 14.03.23 Debugged "center"
+
+Rotate3data<- function(...){
+#Eps=10^(-4)
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Pd3<- varargin[[1]]
+ W1<- varargin[[2]]
+ W2<- varargin[[3]]
+ C<- c(0,0,0)
+ if(Nargs>=4){
+ C<- varargin[[4]]
+ }
+ if(Mixtype(Pd3)==1){
+ Pd3<- list(Pd3)
+ } else if(Mixtype(Pd3)==3){
+ Tmp<- list()
+ for (I in Looprange(1,Mixlength(Pd3))){
+ Tmp<- c(Tmp,Op(I,Pd3))
+ }
+ Pd3<- Tmp
+ }
+ Out<- list()
+ for (I in Looprange(1,Mixlength(Pd3))){
+ PD<- Op(I,Pd3)
+ Ans<- c()
+ for (J in Looprange(1,Nrow(PD))){
+ if(is.matrix(PD)){ # 11.08.27
+ P<- PD[J,]
+ }
+ else{
+ P<- PD
+ }
+ Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23
+ Ans<- rbind(Ans,Tmp)
+ } # 11.08.27
+ rownames(Ans)<- 1:Nrow(Ans) #10.08.16
+ Out<- c(Out,list(Ans))
+ }
+ if(Mixlength(Out)==1){
+ Out<- Op(1,Out)
+ }
+ return(Out)
+}
+
+#######################################
+
+Rotate3pt<- function(...){
+ varargin<-list(...)
+ Eps<-10^(-4)
+ Nargs<-length(varargin)
+ P<- varargin[[1]]
+ W1<- varargin[[2]]
+ W2<- varargin[[3]]
+ C<- c(0,0,0)
+ if(Nargs>=4){
+ C<- varargin[[4]]
+ }
+ if(mode(W2)=="numeric" && length(W2)==1){
+ Ct<- cos(W2)
+ St<- sin(W2)
+ V3<- 1/Norm(W1)*W1
+ if(V3[1]==0){
+ Tmp<- c(1,0,0)
+ }else{
+ Tmp<- c(0,1,0)
+ }
+ W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2],
+ Tmp[3]*V3[1]-Tmp[1]*V3[3],
+ Tmp[1]*V3[2]-Tmp[2]*V3[1])
+ V1<- 1/Norm(W1)*W1
+ V2<- c(V3[2]*V1[3]-V3[3]*V1[2],
+ V3[3]*V1[1]-V3[1]*V1[3],
+ V3[1]*V1[2]-V3[2]*V1[1])
+ }else{
+ Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2],
+ W1[3]*W2[1]-W1[1]*W2[3],
+ W1[1]*W2[2]-W1[2]*W2[1])
+ if(Norm(Tmp)<Eps){
+ Ans<- P
+ return(Ans)
+ }
+ V1<- 1/Norm(W1)*W1
+ Ns<- V1[1]*W2[1]+V1[2]*W2[2]+V1[3]*W2[3]
+ Tmp<- W2-Ns*V1
+ V2<- 1/Norm(Tmp)*Tmp
+ Tmp<- c(V1[2]*V2[3]-V1[3]*V2[2],
+ V1[3]*V2[1]-V1[1]*V2[3],
+ V1[1]*V2[2]-V1[2]*V2[1])
+ V3<- 1/Norm(Tmp)*Tmp
+ Ct<- Ns/Norm(W2)
+ St<- sqrt(1-Ct^2)
+ }
+ if(Norm(Tmp)<Eps){
+ Ans<- P
+ return(Ans)
+ }
+ V1x<- V1[1]; V1y<- V1[2]; V1z<- V1[3]
+ V2x<- V2[1]; V2y<- V2[2]; V2z<- V2[3]
+ V3x<- V3[1]; V3y<- V3[2]; V3z<- V3[3]
+ if(Mixtype(P)!=1){
+ PtL<- P
+ }else{
+ PtL<- list(P)
+ }
+ Ans<- list()
+ for (N in Looprange(1,Mixlength(PtL))){
+ P<- Op(N,PtL)
+ if(P[1]==Inf){
+ Ans<- c(Ans,list(c(Inf,Inf,Inf)))
+ next
+ }
+ x<- P[1]-C[1]; y=P[2]-C[2]; z=P[3]-C[3]
+ Tmp1<- ((V1x*Ct+V2x*St)*V1x+(-V1x*St+V2x*Ct)*V2x+V3x^2)*x
+ Tmp2<- ((V1x*Ct+V2x*St)*V1y+(-V1x*St+V2x*Ct)*V2y+V3x*V3y)*y
+ Tmp3<- ((V1x*Ct+V2x*St)*V1z+(-V1x*St+V2x*Ct)*V2z+V3x*V3z)*z
+ X<- Tmp1+Tmp2+Tmp3
+ Tmp1<- ((V1y*Ct+V2y*St)*V1x+(-V1y*St+V2y*Ct)*V2x+V3x*V3y)*x
+ Tmp2<- ((V1y*Ct+V2y*St)*V1y+(-V1y*St+V2y*Ct)*V2y+V3y^2)*y
+ Tmp3<- ((V1y*Ct+V2y*St)*V1z+(-V1y*St+V2y*Ct)*V2z+V3y*V3z)*z
+ Y<- Tmp1+Tmp2+Tmp3
+ Tmp1<- ((V1z*Ct+V2z*St)*V1x+(-V1z*St+V2z*Ct)*V2x+V3x*V3z)*x
+ Tmp2<- ((V1z*Ct+V2z*St)*V1y+(-V1z*St+V2z*Ct)*V2y+V3y*V3z)*y
+ Tmp3<- ((V1z*Ct+V2z*St)*V1z+(-V1z*St+V2z*Ct)*V2z+V3z^2)*z
+ Z<- Tmp1+Tmp2+Tmp3
+ Ans<- c(Ans,list(C+c(X,Y,Z)))
+ }
+ if(Mixlength(Ans)==1){
+ Ans<- Op(1,Ans)
+ }
+ return(Ans)
+}
+
+######################################
+
+Setangle<- function(...){
+ Eps<- 10^(-6)
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ if(Nargs==0) {
+ }
+ else if(Nargs==1){
+ V<- varargin[[1]]
+ V<- V/Norm(V)
+ THETA<<- acos(V[3])
+ if(abs(sin(THETA))<Eps){
+ PHI<<- 0
+ }
+ else{
+ PHI<<- acos(V[1]/sin(THETA))
+ if(V[2]< -Eps) PHI<<- -PHI
+ }
+ }
+ else{
+ PHI<<- varargin[[2]]*pi/180
+ THETA<<- varargin[[1]]*pi/180
+ }
+ Out<- paste("theta=",as.character(THETA*180/pi)," phi=",
+ as.character(PHI*180/pi),sep="")
+ return (Out)
+}
+
+#################################
+
+Setpers<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ if(Nargs==0){
+ }
+ else{
+ FocusPoint<<- varargin[[1]]
+ EyePoint<<- varargin[[2]]
+ }
+ F<- as.character(FocusPoint)
+ E<- as.character(EyePoint)
+ Out<- paste("Focus = c(",F[1],",",F[2],",",F[3],") , ",
+ " Eye = c(", E[1],",",E[2],",",E[3],") ",sep="")
+ return (Out)
+}
+
+#################################
+
+SetstereoL<- function(R,T,P,H){
+ X<- R*sin(T*pi/180)*cos(P*pi/180)
+ Y<- R*sin(T*pi/180)*sin(P*pi/180)
+ Z<- R*cos(T*pi/180)
+ Eye<- c(X+H/2*Y/(X^2+Y^2),Y-H/2*X/(X^2+Y^2),Z)
+ Out<- Setpers(c(0,0,0),Eye)
+ return(Out)
+}
+
+#################################
+
+SetstereoR<- function(R,T,P,H){
+ X<- R*sin(T*pi/180)*cos(P*pi/180)
+ Y<- R*sin(T*pi/180)*sin(P*pi/180)
+ Z<- R*cos(T*pi/180)
+ Eye<- c(X-H/2*Y/(X^2+Y^2),Y+H/2*X/(X^2+Y^2),Z)
+ Out<- Setpers(c(0,0,0),Eye)
+ return(Out)
+}
+
+###############################
+
+Sf3data<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ FdL<- Fullformfunc(varargin[[1]])
+ F<- Op(1,FdL)
+ Xf<- Op(2,FdL)
+ Yf<- Op(3,FdL)
+ Zf<- Op(4,FdL)
+ Urg<- Op(5,FdL)
+ Vrg<- Op(6,FdL)
+ Str<- strsplit(Urg,"=",fixed=TRUE)[[1]]
+ U<- Str[1]
+ Tmp<- Str[2]
+ Tmp<- eval(parse(text=Tmp))
+ Umin<- Tmp[1]; Umax<- Tmp[2]
+ Str<- strsplit(Vrg,"=",fixed=TRUE)[[1]]
+ V<- Str[1]
+ Tmp<- Str[2]
+ Tmp<- eval(parse(text=Tmp))
+ Vmin<- Tmp[1]; Vmax<- Tmp[2]
+ Ndu<- 25 ; Ndv<- 25; Np<- c(50,50)
+ if(Nargs>=3){
+ Ndu<- varargin[[2]]
+ Ndv<- varargin[[3]]
+ }
+ if(Nargs>=4){
+ Np<- varargin[[4]]
+ if(mode(Np)=="numeric" && length(Np)==1){
+ Np<- c(Np,Np)
+ }
+ }
+ Du<- (Umax-Umin)/Ndu
+ Dv<- (Vmax-Vmin)/Ndv
+ PL <- c()#PL <- []
+ Assign("Vmin",Vmin,"Vmax",Vmax)
+ Trgstr<- Assign("t=c(Vmin,Vmax)")
+ PL <- list()
+ for (I in Looprange(0,Ndu)){
+ U0 <- paste("(",as.character(Umin+I*Du),")",sep="")
+ Tmp<- gsub(U,U0,Xf,fixed=TRUE)
+ Tmp1<- gsub(V,"t",Tmp,fixed=TRUE)
+ Tmp<- gsub(U,U0,Yf,fixed=TRUE)
+ Tmp2<- gsub(V,"t",Tmp,fixed=TRUE)
+ Tmp<- gsub(U,U0,Zf,fixed=TRUE)
+ Tmp3<- gsub(V,"t",Tmp,fixed=TRUE)
+ Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="")
+ PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2])))
+ PL<- c(PL,list(PD))
+ }
+ Assign("Umin",Umin,"Umax",Umax)
+ Trgstr<- Assign("t=c(Umin,Umax)")
+ for (J in Looprange(0,Ndv)){
+ V0<- paste("(",as.character(Vmin+J*Dv),")",sep="")
+ Tmp<- gsub(V,V0,Xf,fixed=TRUE)
+ Tmp1<- gsub(U,"t",Tmp,fixed=TRUE)
+ Tmp<- gsub(V,V0,Yf,fixed=TRUE)
+ Tmp2<- gsub(U,"t",Tmp,fixed=TRUE)
+ Tmp<- gsub(V,V0,Zf,fixed=TRUE)
+ Tmp3<- gsub(U,"t",Tmp,fixed=TRUE)
+ Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")")
+ PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1])))
+ PL<- c(PL,list(PD))
+ }
+ return(PL)
+}
+
+###################################
+
+Skeletonparadata<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Out<- list()
+ ObjL<- Flattenlist(varargin[[1]])
+ Plt3L<- Flattenlist(varargin[[2]])
+ R<- 0.075*1000/2.54/MilliIn
+ if(Nargs>2){
+ R<- R*varargin[[3]]
+ }
+ Eps2<- 0.05
+ if(Nargs>3){
+ Eps2<- varargin[[4]]
+ }
+ Obj2L<- list()
+ for (I in Looprange(1,Mixlength(ObjL))){
+ Tmp<- ProjcoordCurve(Op(I,ObjL))
+ Obj2L<- c(Obj2L,list(Tmp))
+ }
+ Plt2L<- list()
+ for (I in Looprange(1,Mixlength(Plt3L))){
+ Tmp<- ProjcoordCurve(Op(I,Plt3L))
+ Plt2L<- c(Plt2L,list(Tmp))
+ }
+ Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2)
+ return(Out)
+}
+
+################################
+
+Skeletonpara3data<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ ObjL<- Flattenlist(varargin[[1]])
+ Plt3L<- Flattenlist(varargin[[2]])
+ R<- 0.075*1000/2.54/MilliIn
+ if(Nargs>2){
+ R=R*varargin[[3]]
+ }
+ Eps2<- 0.05
+ if(Nargs>3){
+ Eps2<- varargin[[4]]
+ }
+ Plt2L<- list()
+ for (I in Looprange(1,Mixlength(Plt3L))){
+ Tmp<- ProjcoordCurve(Op(I,Plt3L))
+ Plt2L<- c(Plt2L,list(Tmp))
+ }
+ Out<- list()
+ for (I in Looprange(1,Mixlength(ObjL))){
+ Obj3<- Op(I,ObjL)
+ Tmp<- ProjcoordCurve(Obj3)
+ Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2)
+ for (J in Looprange(1,Mixlength(Data))){
+ Gd<- Op(J,Data)
+ PtD<- c()
+ for (J in Looprange(1,Nrow(Gd))){
+ Tmp<- Ptcrv(J,Gd)
+ Tmp1<- Invparapt(Tmp,Obj3)
+ Tmp1<- Op(1,Tmp1)
+ PtD<- c(PtD,Tmp1)
+ }
+ PtD<- matrix(PtD,ncol=3,byrow=TRUE)
+ Out<- c(Out,list(PtD))
+ }
+ }
+ return(Out)
+}
+
+#################################
+
+#100815
+Skeletonpersdata<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Out<- list()
+ ObjL<- Flattenlist(varargin[[1]])
+ Plt3L<- Flattenlist(varargin[[2]])
+ R<- 0.075*1000/2.54/MilliIn
+ if(Nargs>2){
+ R<- R*varargin[[3]]
+ }
+ Eps2<- 0.05
+ if(Nargs>3){
+ Eps2<- varargin[[4]]
+ }
+ Obj2L<- list()
+ for (I in Looprange(1,Mixlength(ObjL))){
+ Tmp<- CameracoordCurve(Op(I,ObjL))
+ Obj2L<- c(Obj2L,list(Tmp))
+ }
+ Plt2L<- list()
+ for (I in Looprange(1,Mixlength(Plt3L))){
+ Tmp<- CameracoordCurve(Op(I,Plt3L))
+ Plt2L<- c(Plt2L,list(Tmp))
+ }
+ Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2)
+ return(Out)
+}
+
+#####################
+#100815
+Skeletonpers3data<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Out<- list()
+ ObjL<- Flattenlist(varargin[[1]])
+ Plt3L<- Flattenlist(varargin[[2]])
+ R<- 0.075*1000/2.54/MilliIn
+ if(Nargs>2){
+ R<- R*varargin[[3]]
+ }
+ Eps2<- 0.05
+ if(Nargs>3){
+ Eps2<- varargin[[4]]
+ }
+ Plt2L<- list()
+ for (I in Looprange(1,Mixlength(Plt3L))){
+ Tmp<- CameracoordCurve(Op(I,Plt3L))
+ Plt2L<- c(Plt2L,list(Tmp))
+ }
+ Out<- list()
+ for (I in Looprange(1,Mixlength(ObjL))){
+ Obj3<- Op(I,ObjL)
+ Tmp<- CameracoordCurve(Obj3)
+ Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2)
+ for (J in Looprange(1,Mixlength(Data))){
+ Gd<- Op(J,Data)
+ PtD<- c()
+ for (J in Looprange(1,Nrow(Gd))){
+ Tmp<- Gd[J,]
+ Tmp1<- Invperspt(Tmp,Obj3)
+ Tmp1<- Op(1,Tmp1)
+ PtD<- rbind(PtD,Tmp1)
+ }
+ Out<- c(Out,list(PtD))
+ }
+ }
+ return(Out)
+}
+
+#################################
+
+Spacecurve<- function(...){
+ Eps<- 10^(-5)
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Fnstr<- varargin[[1]]
+ Rgstr<- varargin[[2]]
+ Range<- c(0,2*pi)
+ N<- 50 #Numpoints
+ E<- c() #Exclusions
+ D<- Inf #Discont (Changed)
+ for(I in Looprange(3,Nargs)){
+ Tmp<- varargin[[I]]
+ StrV<- strsplit(Tmp,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ Tmp1<- toupper(StrV[1])
+ Lhs<- substr(Tmp1,1,1)
+ Str<- paste(Lhs,"=",StrV[2],sep="")
+ eval(parse(text=Str))
+ }
+ StrV<- strsplit(Rgstr,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Vname<- StrV[1]
+ Rng<- eval(parse(text=StrV[2]))
+ }
+ else{
+ Vname<- Rgstr
+ Rng<- c(XMIN,XMAX)
+ }
+ T1<- Rng[1]; T2<- Rng[2]
+ Dt<- (T2-T1)/N #17.09.22
+ Str<- gsub(Vname,"t",Fnstr)
+ Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines)
+ Str=gsub("]",")",Str,fixed=TRUE)
+ if(abs(Dt)<Eps){ # 16.12.13
+ t=T1
+ P=eval(parse(text=Str))
+ return(P)
+ }
+ P<- c()
+# E<- sort(E,decreasing=FALSE)
+ E<- c(E,Inf)
+ E<- sort(E,decreasing=FALSE)
+ Ke<- 1
+ for(jj in 1:(N+1)){
+ t=T1+(jj-1)*Dt
+ Pa<- c()
+ if(t-E[Ke]< Eps){
+ Pa<- eval(parse(text=Str))
+ }
+ if(abs(t-E[Ke])<=Eps){
+ if(length(P)>0 && P[Nrow(P),1]!=Inf){
+ Pa<- c(Inf,Inf,Inf)
+ }
+ }
+ if(t-E[Ke]>Eps){
+ Pa<- eval(parse(text=Str))
+ Ke<- Ke+1
+ }
+ if(length(Pa)>0){
+ if(Pa[1]==Inf){
+ P<- rbind(P,Pa)
+ }else if(length(P)==0){
+ P<- rbind(c(),c(Pa))
+ }
+ else{
+ Tmp<- P[Nrow(P),]
+ if(Tmp[1]==Inf){
+ P<- rbind(P,Pa)
+ }
+ else if( Norm(Tmp-Pa)<D){
+ P<- rbind(P,Pa)
+ }
+ else{
+ P<- rbind(P,c(Inf,Inf,Inf))
+ P<- rbind(P,Pa)
+ }
+ }
+ }
+ }
+ rownames(P)<- 1:Nrow(P) # 10.08.16
+ return(P)
+}
+
+########################################
+
+Spaceline<- function(...){
+ varargin<- list(...)
+ Z<- c()
+ for(I in 1:length(varargin)){
+ Data<- varargin[[I]]
+ if(Mixtype(Data)==1){
+ J<- 1
+ while (J<=Ncol(Data)){
+ Tmp<- Data[J:(J+2)]
+ Z<-c(Z,Tmp)
+ J<- J+3
+ }
+ next
+ }
+ if(Mixtype(Data)==3){
+ Tmp<- list()
+ for(I in 1:Mixlength(Data)){
+ Tmp<- c(Tmp,Op(I,Data))
+ }
+ Data<- Tmp
+ }
+ for(J in 1:Mixlength(Data)){
+ Tmp<- Op(J,Data)
+ Z<- c(Z,Tmp)
+ }
+ }
+ Z<- matrix(Z,ncol=3,byrow=TRUE)
+ return(Z)
+}
+
+#################################
+
+Translate3data<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Pd3<- varargin[[1]]
+ Mv<- varargin[[2]]
+ if(mode(Mv)=="numerice" && length(Mv)==1){
+ Mv<- c(varargin[[2]],varargin[[3]],varargin[[4]])
+ }
+ if(Mixtype(Pd3)==1){
+ Pd3<- list(Pd3)
+ }
+ else if(Mixtype(Pd3)==3){
+ Tmp<-list()
+ for(I in Looprange(1,Mixlength(Pd3))){
+ Tmp<- c(Tmp, Op(I,Pd3))
+ }
+ Pd3<- Tmp
+ }
+ Out<- list()
+ for(I in Looprange(1,Mixlength(Pd3))){
+ PD<- Op(I,Pd3)
+ PD<- rbind(c(),PD)
+ Ans<- c()
+ for(J in Looprange(1,Nrow(PD))){
+ P<- PD[J,]
+ Tmp<- P+Mv
+ Ans<- rbind(Ans,Tmp)
+ }
+ rownames(Ans)<- 1:Nrow(Ans)
+ Out<- c(Out,list(Ans))
+ }
+ if(Mixlength(Out)==1){
+ Out<- Op(1,Out)
+ }
+ return(Out)
+}
+
+###############################################
+
+Xyzax3data<- function(Xrange,Yrange,Zrange){
+ StrV<-strsplit(Xrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1) StrV<- StrV[2]
+ Tmp<- eval(parse(text=StrV))
+ Px<- c(Tmp[1],0,0)
+ Qx<- c(Tmp[2],0,0)
+ StrV<-strsplit(Yrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1) StrV<- StrV[2]
+ Tmp<- eval(parse(text=StrV))
+ Py<- c(0,Tmp[1],0)
+ Qy<- c(0,Tmp[2],0)
+ StrV<-strsplit(Zrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1) StrV<- StrV[2]
+ Tmp<- eval(parse(text=StrV))
+ Pz<- c(0,0,Tmp[1])
+ Qz<- c(0,0,Tmp[2])
+ Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz))
+ return(Out)
+}
+
+###################################
+
+Xyzaxparaname<- function(...){
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Eps<- 10.0^(-6)
+ Dr<- 0.19*1000/2.54/MilliIn
+ Tmp<- varargin[[Nargs]]
+ if(Nargs>1 && is.numeric(Tmp)){
+ Dr<- Dr*Tmp
+ Nargs<- Nargs-1
+ }
+ if(mode(varargin[[1]])=="character"){
+ Xname<- "x"
+ Yname<- "y"
+ Zname<- "z"
+ Xrange<- varargin[[1]]
+ Yrange<- varargin[[2]]
+ Zrange<- varargin[[3]]
+ StrV<-strsplit(Xrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Xname<- StrV[1]
+ StrV<- StrV[2]
+ }
+ Tmp<- eval(parse(text=StrV))
+ Px<- c(Tmp[1],0,0)
+ Qx<- c(Tmp[2],0,0)
+ StrV<-strsplit(Yrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Yname<- StrV[1]
+ StrV<- StrV[2]
+ }
+ Tmp<- eval(parse(text=StrV))
+ Py<- c(0,Tmp[1],0)
+ Qy<- c(0,Tmp[2],0)
+ StrV<-strsplit(Zrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Zname<- StrV[1]
+ StrV<- StrV[2]
+ }
+ Tmp<- eval(parse(text=StrV))
+ Pz<- c(0,0,Tmp[1])
+ Qz<- c(0,0,Tmp[2])
+ }else{
+ Data<- varargin[[1]]
+ Xname<- "x"; Yname<- "y"; Zname<- "z"
+ if(Nargs>1){
+ if(varargin[[2]]!=""){
+ Xname<- varargin[[2]]
+ }
+ if(varargin[[3]]!=""){
+ Yname<- varargin[[3]]
+ }
+ if(varargin[[4]]!=""){
+ Zname<- varargin[[4]]
+ }
+ }
+ Tmp<- Op(1,Data)
+ Px<- Tmp[1,]; Qx<- Tmp[2,]
+ Tmp<- Op(2,Data)
+ Py<- Tmp[1,]
+ Qy<- Tmp[2,]
+ Tmp<- Op(3,Data)
+ Pz<- Tmp[1,]
+ Qz<- Tmp[2,]
+ }
+ Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh)
+ Kekka<- list()
+ if(R>Eps){
+ Ch<- Qh+Dr/R*(Qh-Ph)
+ Kekka<- c(Kekka,list(Pointdata(Ch)))
+ Expr(Ch,"c",Xname)
+ }
+ Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh)
+ if(R>Eps){
+ Ch<- Qh+Dr/R*(Qh-Ph)
+ Kekka<- c(Kekka,list(Pointdata(Ch)))
+ Expr(Ch,"c",Yname)
+ }
+ Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh)
+ if(R>Eps){
+ Ch<- Qh+Dr/R*(Qh-Ph)
+ Kekka<- c(Kekka,list(Pointdata(Ch)))
+ Expr(Ch,"c",Zname)
+ }
+# return(Kekka)
+}
+
+###################################
+
+Xyzaxpersname<- function(...){
+ varargin<- list(...)
+ Eps<- 10.0^(-6)
+ Nargs<- length(varargin)
+ Dr<- 0.19*1000/2.54/MilliIn
+ Tmp<- varargin[[Nargs]]
+ if(Nargs>1 && mode(Tmp)=="numeric"){
+ Dr<- Dr*Tmp
+ Nargs<- Nargs-1
+ }
+ if(mode(varargin[[1]])=="character"){
+ Xname<- "x"
+ Yname<- "y"
+ Zname<- "z"
+ Xrange<- varargin[[1]]
+ Yrange<- varargin[[2]]
+ Zrange<- varargin[[3]]
+ StrV<-strsplit(Xrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Xname<- StrV[1]
+ StrV<- StrV[2]
+ }
+ Tmp<- eval(parse(text=StrV))
+ Px<- c(Tmp[1],0,0)
+ Qx<- c(Tmp[2],0,0)
+ StrV<-strsplit(Yrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Yname<- StrV[1]
+ StrV<- StrV[2]
+ }
+ Tmp<- eval(parse(text=StrV))
+ Py<- c(0,Tmp[1],0)
+ Qy<- c(0,Tmp[2],0)
+ StrV<-strsplit(Zrange,"=",fixed=TRUE)
+ StrV<- StrV[[1]]
+ if(length(StrV)>1){
+ Zname<- StrV[1]
+ StrV<- StrV[2]
+ }
+ Tmp<- eval(parse(text=StrV))
+ Pz<- c(0,0,Tmp[1])
+ Qz<- c(0,0,Tmp[2])
+ }else{
+ Data<- varargin[[1]]
+ Xname<- "x"; Yname<- "y"; Zname<- "z"
+ if(Nargs>1){
+ if(varargin[[2]]!=""){
+ Xname<- varargin[[2]]
+ }
+ if(varargin[[3]]!=""){
+ Yname<- varargin[[3]]
+ }
+ if(varargin[[4]]!=""){
+ Zname<- varargin[[4]]
+ }
+ }
+ Tmp<- Op(1,Data)
+ Px<- Tmp[1,]; Qx<- Tmp[2,]
+ Tmp<- Op(2,Data)
+ Py<- Tmp[1,]
+ Qy<- Tmp[2,]
+ Tmp<- Op(3,Data)
+ Pz<- Tmp[1,]
+ Qz<- Tmp[2,]
+ }
+ Ph<- Perspt(Px)
+ Qh<- Perspt(Qx)
+ R<- Norm(Ph-Qh)
+ Kekka<- list()
+ if(R>Eps){
+ Ch<- Qh+Dr/R*(Qh-Ph)
+ Kekka<- c(Kekka,list(Pointdata(Ch)))
+ Expr(Ch,"c",Xname)
+ }
+ Ph<- Perspt(Py)
+ Qh<- Perspt(Qy)
+ R<- Norm(Ph-Qh)
+ if(R>Eps){
+ Ch<- Qh+Dr/R*(Qh-Ph)
+ Kekka<- c(Kekka,list(Pointdata(Ch)))
+ Expr(Ch,"c",Yname)
+ }
+ Ph<- Perspt(Pz)
+ Qh<- Perspt(Qz)
+ R<- Norm(Ph-Qh)
+ if(R>Eps){
+ Ch<- Qh+Dr/R*(Qh-Ph)
+ Kekka<- c(Kekka,list(Pointdata(Ch)))
+ Expr(Ch,"c",Zname)
+ }
+# return(Kekka)
+}
+
+#########################
+#100815
+Zparapt<- function(P){#function Out=Zparapt(P)
+ x<- P[1]; y<- P[2]; z<- P[3]
+ Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA)
+ return(Out)
+}
+
+#########################
+#100815
+Zperspt<- function(P){
+ Tmp<- P-FocusPoint
+ X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3]
+ Tmp<- EyePoint-FocusPoint
+ E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3]
+ Ca<- E1/sqrt(E1^2+F1^2)
+ Sa<- F1/sqrt(E1^2+F1^2)
+ X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1
+ E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1
+ Cb<- E2/sqrt(E2^2+G2^2)
+ Sb<- G2/sqrt(E2^2+G2^2)
+ X3<- X2*Cb+Z2*Sb
+ return(X3)
+}
+
+##########################################
+
+
+
+##########################################
+
+# Stat Package
+
+##########################################
+
+# 2010.04.12
+
+# new
+
+# Htickmarklower, Vtickmarkleft, HtickmarklowerV
+# VtickmarkleftV, Insertcom, Replacecom
+# Maketexfile, Formatting
+# Drwhistframe, Histplotdata, Drwhistplot
+
+Htickmarklower<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ ArgsL<- varargin
+ if(mode(ArgsL[[1]])=="character"){
+ Str<- ArgsL[[1]]
+ Tmp<- strsplit(Str,"m")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ I<- nchar(Tmp[1])+1
+ }
+ else{
+ I<- 0
+ }
+ Tmp<- strsplit(Str,"n")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ J<- nchar(Tmp[1])+1
+ }
+ else{
+ J<- 0
+ }
+ Tmp<- strsplit(Str,"r")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ K=nchar(Tmp[1])+1
+ }
+ else{
+ K<- 0
+ }
+ if(K>0){
+ S<- substr(Str,K+1,nchar(Str))
+ R<- as.numeric(S)
+ if(is.na(R)){
+ R<- 1
+ }
+ }
+ else{
+ R<- 1
+ K<- nchar(Str)+1
+ }
+ if(J>0){
+ S<- substr(Str,J+1,K-1)
+ Dn<- as.numeric(S)
+ if(is.na(Dn)){
+ Dn<- 1
+ }
+ }
+ else{
+ Dn<- 1000
+ J<- nchar(Str)+1
+ }
+ S<- substr(Str,I+1,J-1)
+ Dm<- as.numeric(S)
+ if(is.na(Dm)){
+ Dm<- 1
+ }
+ ArgsL<- list()
+ for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ }
+ MemoriList<- list()
+ Memori<- list()
+ for (N in 1:length(ArgsL)){
+ Dt<- ArgsL[[N]]
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(Dt)
+ next
+ }
+ if(mode(Dt)=="character"){
+ Memori<- Mixjoin(Memori,Dt)
+ }
+ else{
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(Dt,GENTEN[2])
+ }
+ }
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ for (N in 1:length(MemoriList)){
+ Dt<- MemoriList[[N]]
+ Ndt<- length(Dt)
+ X=Op(1,Dt)
+ Y=Op(2,Dt)
+ Tmp<-Doscaling(c(X,Y))
+ X<- Tmp[1]
+ Y<- Tmp[2]
+ Moji<- Op(Ndt,Dt)
+ Tmp1<- Unscaling(c(X,Y))
+ Tmp2<- Unscaling(c(X,Y-2*MARKLEN))
+ Fd<- Listplot(c(Tmp1,Tmp2))
+ Drwline(Fd)
+ if(Ndt==3){
+ Tmp<-Unscaling(c(X,Y-2*MARKLEN))
+ Expr(Tmp,"s",Moji)
+ }
+ if(Ndt==4){
+ Houkou<- Op(3,Dt)
+ Tmp<-grep("s",Houkou)
+ if(length(Tmp)>0){
+ Tmp<-Unscaling(c(X,Y-2*MARKLEN))
+ Expr(Tmp,Houkou,Moji)
+ }
+ else{
+ Tmp<- Unscaling(c(X,Y))
+ Expr(Tmp,Houkou,Moji)
+ }
+ }
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+}
+
+Vtickmarkleft<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ ArgsL<- varargin
+ if(mode(ArgsL[[1]])=="character"){
+ Str<- ArgsL[[1]]
+ Tmp<- strsplit(Str,"m")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ I<- nchar(Tmp[1])+1
+ }
+ else{
+ I<- 0
+ }
+ Tmp<- strsplit(Str,"n")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ J<- nchar(Tmp[1])+1
+ }
+ else{
+ J<- 0
+ }
+ Tmp<- strsplit(Str,"r")
+ Tmp<- Tmp[[1]]
+ if(length(Tmp)>1){
+ K=nchar(Tmp[1])+1
+ }
+ else{
+ K<- 0
+ }
+ if(K>0){
+ S<- substr(Str,K+1,nchar(Str))
+ R<- as.numeric(S)
+ if(is.na(R)){
+ R<- 1
+ }
+ }
+ else{
+ R<- 1
+ K<- nchar(Str)+1
+ }
+ if(J>0){
+ S<- substr(Str,J+1,K-1)
+ Dn<- as.numeric(S)
+ if(is.na(Dn)){
+ Dn<- 1
+ }
+ }
+ else{
+ Dn<- 1000
+ J<- nchar(Str)+1
+ }
+ S<- substr(Str,I+1,J-1)
+ Dm<- as.numeric(S)
+ if(is.na(Dm)){
+ Dm<- 1
+ }
+ ArgsL<- list()
+ for (I in 1:floor((YMAX-GENTEN[2])/Dm)){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){
+ ArgsL<- Mixjoin(ArgsL,I*Dm)
+ if(I-floor(I/Dn)*Dn==0){
+ Str<- as.character(I*Dm*R)
+ ArgsL<- Mixjoin(ArgsL,Str)
+ }
+ }
+ }
+ MemoriList<- list()
+ Memori<- list()
+ for (N in 1:length(ArgsL)){
+ Dt<- ArgsL[[N]]
+ if(mode(Dt)=="numeric" && length(Dt)>1){
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(Dt)
+ next
+ }
+ if(mode(Dt)=="character"){
+ Memori<- Mixjoin(Memori,Dt)
+ }
+ else{
+ if(length(Memori)>0){
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ }
+ Memori<- list(GENTEN[1],Dt)
+ }
+ }
+ MemoriList<- Mixjoin(MemoriList,list(Memori))
+ for (N in 1:length(MemoriList)){
+ Dt<- MemoriList[[N]]
+ Ndt<- length(Dt)
+ X=Op(1,Dt)
+ Y=Op(2,Dt)
+ Tmp<-Doscaling(c(X,Y))
+ X<- Tmp[1]
+ Y<- Tmp[2]
+ Moji<- Op(Ndt,Dt)
+ Tmp1<- Unscaling(c(X,Y))
+ Tmp2<- Unscaling(c(X-2*MARKLEN,Y))
+ Fd<- Listplot(c(Tmp1,Tmp2))
+ Drwline(Fd)
+ if(Ndt==3){
+ Tmp<-Unscaling(c(X-2*MARKLEN,Y))
+ Expr(Tmp,"w",Moji)
+ }
+ if(Ndt==4){
+ Houkou<- Op(3,Dt)
+ Tmp<-grep("w",Houkou)
+ if(length(Tmp)>0){
+ Tmp<-Unscaling(c(X-2*MARKLEN,Y))
+ Expr(Tmp,Houkou,Moji)
+ }
+ else{
+ Tmp<- Unscaling(c(X,Y))
+ Expr(Tmp,Houkou,Moji)
+ }
+ }
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+}
+
+HtickmarklowerV<- function(Vec,digits=2,nsmall=2)
+{
+ for (I in 1:length(Vec)){
+ Tmp<- Vec[I]
+ Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall))
+ }
+}
+
+HtickLV<- function(...)
+{
+ HtickmarklowerV(...)
+}
+
+VtickmarkleftV<- function(Vec,digits=2,nsmall=2)
+{
+ for (I in 1:length(Vec)){
+ Tmp<- Vec[I]
+ Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall))
+ }
+}
+
+VtickLV<- function(...)
+{
+ VtickmarkleftV(...)
+}
+
+Insertcom<- function(CmdM,Npos,Str)
+{
+ if(is.matrix(CmdM)){
+ Cmd<- CmdM
+ }
+ else{
+ C<- paste("Cmd<- ",CmdM)
+ eval(parse(text=C))
+ }
+ Out<- Cmd[Looprange(1,Npos-1),]
+ Out<- c(Out,Str)
+ Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),]
+ Out<- c(Out,Tmp)
+ Out<- matrix(Out)
+ if(!is.matrix(CmdM)){
+ C<- paste(CmdM,"<<- Out")
+ eval(parse(text=C))
+ }
+ return(Out)
+}
+
+Replacecom<- function(CmdM,Npos,Str)
+{
+ if(is.matrix(CmdM)){
+ Cmd<- CmdM
+ }
+ else{
+ C<- paste("Cmd<- ",CmdM)
+ eval(parse(text=C))
+ }
+ Out<- Cmd[Looprange(1,Npos-1),]
+ Out<- c(Out,Str)
+ Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),]
+ Out<- c(Out,Tmp)
+ Out<- matrix(Out)
+ if(!is.matrix(CmdM)){
+ C<- paste(CmdM,"<<- Out")
+ eval(parse(text=C))
+ }
+ return(Out)
+}
+
+Deletecom<- function(CmdM,Npos)
+{
+ if(is.matrix(CmdM)){
+ Cmd<- CmdM
+ }
+ else{
+ C<- paste("Cmd<- ",CmdM)
+ eval(parse(text=C))
+ }
+ Out<- Cmd[Looprange(1,Npos-1),]
+ Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),]
+ Out<- c(Out,Tmp)
+ Out<- matrix(Out)
+ if(!is.matrix(CmdM)){
+ C<- paste(CmdM,"<<- Out")
+ eval(parse(text=C))
+ }
+ return(Out)
+}
+
+Maketexfile<- function(commands="",texfile="")
+{
+ Openfile(texfile)
+ Execmd(commands)
+ Closefile()
+}
+
+Formatting<- function(X,D=2,N=2)
+{
+ if(D>0){
+ Xs <- format(X,digits=D,nsmall=N)
+ }
+ else{
+ Xs<- as.character(X)
+ }
+ return(Xs)
+}
+
+################################
+
+Boxplotdata1 <-function(DataF1,CenterX,Width,...)
+{
+ Xr <- Width
+ Temp <- boxplot(DataF1[1],plot=FALSE)
+ Stats <- Temp$stats
+ rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige")
+ Out <- Temp$out
+ Lhige <- Stats["Lhige",1]
+ Uhige <- Stats["Uhige",1]
+ Q1 <- Stats["Q1",1]
+ Q2 <- Stats["Q2",1]
+ Q3 <- Stats["Q3",1]
+ CenterY <- (Q1+Q3)/2
+ C <- c(CenterX,CenterY)
+ V <- c(0,(Q3-Q1)/2)
+ G1 <- Framedata(C,Xr/2,V[2]) # box
+ Temp1 <- c(0,Q1-Lhige)
+ Temp2 <- c(0,Uhige-Q3)
+ G2 <- Listplot(C-V,C-V-Temp1) #
+ G3 <- Listplot(C+V,C+V+Temp2) #
+ Temp3 <- c(Xr/4,0)
+ G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) #
+ G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) #
+ Temp4 <- c(0,Q3-Q2)
+ Temp5 <- c(Xr/2,0)
+ G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) #
+ G7 <- list()
+ for(j in Looprange(1,length(Out))){
+ G7 <- c(G7,list(c(CenterX, Out[j])))
+ }
+ G7 <- G7[order(Out,decreasing=TRUE)]
+ list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7)
+}
+
+Boxplotdata2 <- function(Data,Ratio, ...)
+{
+ DataF<- Flattenlist(Data) # 11.07.21(from)
+ ymin<- Inf
+ ymax<- -Inf
+ for(J in 1:length(DataF)){
+ Tmp<- DataF[[J]]
+ ymin<- min(ymin, min(Tmp))
+ ymax<- max(ymax,max(Tmp))
+ } # 11.07.21(until)
+ dy <- ymax-ymin
+ Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy))
+ R1<- (YMAX-YMIN)/(XMAX-XMIN)
+ R<- Ratio/R1
+ Setscaling(R)
+ Delta <- XMAX/length(DataF)
+ W <- 0.6*Delta
+ PdL <- list()
+ for(i in 1:length(DataF)){ # 11.07.21
+ X <- (0.5+i-1)*Delta
+ G <- Boxplotdata1(DataF[i],X,W,...)
+ PdL <- c(PdL,list(G))
+ }
+ G <- Framedata()
+ Tmp<- list(frame=G)
+ PdL <-c(PdL,list(Tmp))
+ Epsi <-0
+ Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi))
+ return(PdL)
+}
+
+Drwboxframe<-function(BoxDataL)
+{
+ Setorigin(c(XMIN,YMIN))
+ Tmp<- Unscaling(c(0.2,0.2))
+ Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX))
+ Hako<- BoxDataL$plotdata
+ title<- BoxDataL$title
+ cap<- BoxDataL$cap
+ ylab<- BoxDataL$ylab
+ if(mode(title)!="list") title<- list(title)
+ if(mode(cap)!="list") cap<- list(cap)
+ if(mode(ylab)!="list") ylab<- list(ylab)
+ if(length(title)==0) title<- list("")
+ if(length(title)==1) title<- c(title, list("n"))
+ if(length(title)==2) title<- c(title, list(""))
+ if(length(cap)==0) cap<- list("")
+ if(length(cap)==1) cap<- c(cap, list("n"),0) # 11.11.27
+ if(length(cap)==2) cap<- c(cap, 0) # 11.11.27
+ if(length(ylab)==0) ylab<- list("")
+ if(length(ylab)==1) ylab <- c(ylab, list("n"))
+ if(length(ylab)==2) ylab<- c(ylab, list(""))
+ Temp <- Hako[[length(Hako)]]
+ Drwline(Temp$frame)
+ Fontsize(cap[[2]])
+ for(i in Looprange(1,length(Hako)-1)){
+ Temp <- Hako[[i]]
+ attach(Temp)
+ Dashline(uwhisker,lwhisker)
+ Drwline(median,2)
+ Drwline(box,lwp,uwp)
+ Drwpt(outliers,0)
+ X <- uwhisker[1,1]
+ detach(Temp)
+ Htickmarklower(X)
+ if(nchar(cap[[1]])<1) next # 2011.03.08
+ if(length(cap)==2 || cap[[3]]==0){
+ pos<- 1
+ if(length(cap)>=4) pos<- cap[[4]]
+ Tmp<- paste("s",as.character(pos),sep="")
+ Letter(c(X,YMIN),Tmp, Op(i,cap[[1]]))
+ }
+ else{
+ rotate<- cap[[3]]
+ if(length(cap)==3){
+ pos<- 0
+ }
+ else{
+ pos<- cap[[4]]
+ }
+ Temp1 <- rotate*pi/180
+ Temp <- c(cos(Temp1),sin(Temp1))
+ Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]]))
+ }
+ }
+ if(nchar(ylab[[1]])>0){
+ Fontsize(ylab[[2]])
+ Tmp1<- ylab[[1]]
+ Tmp3<- ylab[[3]]
+ if(nchar(Tmp3)>0){
+ Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
+ }
+ Letter(c(XMIN, YMAX),"n2",Tmp1)
+ Fontsize("n")
+ }
+ if(nchar(title[[1]])>0){
+ Fontsize(title[[2]])
+ Tmp1<- title[[1]]
+ Tmp3<- title[[3]]
+ if(nchar(Tmp3)>0){
+ Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
+ }
+ Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1)
+ }
+ Fontsize("n")
+}
+
+Drwboxplot<- function(dataf,var,size,
+ title=list(""), cap=list(colnames(dataf)),
+ ylab=list(""), ptsize=5,plot=TRUE,...)
+ #Return : title,cap,ylab,commands,plotdata,info
+{
+ Tmp <- boxplot(dataf, plot=FALSE, ...)
+ Stats <- Tmp$stats
+ DataF<- Flattenlist(dataf) # 11.07.21(from)
+ ymin<- Inf
+ ymax<- -Inf
+ for(J in 1:length(DataF)){
+ Tmp<- DataF[[J]]
+ ymin<- min(ymin, min(Tmp))
+ ymax<- max(ymax,max(Tmp))
+ } # 11.07.21(until)
+ Hako<- Boxplotdata2(dataf, size[2]/size[1], ...)
+ if(plot){
+ Windisp(Hako)
+ }
+ Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5)
+ unit<- paste(Tmp,"cm",sep="")
+ Setunitlen(unit)
+ Exstr<- c(
+ "","",
+ paste("Beginpicture(","'",unit,"')",sep=""),
+ paste("Setpt(",as.character(ptsize),")",sep=""),
+ "","",
+ paste("Drwboxframe(",var,")",sep=""),
+ paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""),
+ "","","","",
+ "Setpt(1)",
+ "Endpicture(0)"
+ )
+ Exstr<- matrix(Exstr)
+ Xpos<- c()
+ for(i in Looprange(1,length(Hako)-1)){
+ Temp <- Hako[[i]]
+ Temp1 <- Temp[[5]]
+ Xpos <- c(Xpos,Temp1[1,1])
+ }
+ Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos)
+ Tmp<- paste(var,"<<- ",
+ "list(title=title,cap=cap,ylab=ylab,",
+ "commands=Exstr,plotdata=Hako,info=Info)",sep="")
+ eval(parse(text=Tmp))
+}
+
+
+###########################################
+
+Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...)
+# 10.12.07 freq
+{
+ Temp <- hist(DataV,plot=FALSE,...)
+ Breaks <- Temp$breaks
+ Counts <- Temp$counts
+ Density <- Temp$density
+ Mids <- Temp$mids
+ if(!freq){
+ Data<- Density
+ }
+ else{
+ Data<- Counts
+ }
+ Ghist <- list()
+ for(i in Looprange(1,length(Breaks)-1)){
+ Tmp1 <- c(Breaks[i],Breaks[i+1])
+ Tmp2 <- c(0,Data[i])
+ G1 <- Framedata(Tmp1,Tmp2) #bar
+ Ghist <- c(Ghist,list(G1))
+ }
+ Bin <- Breaks[2]-Breaks[1]
+ Eps <- 0.7*Bin # 0.7 times Bin
+ Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps) # Put Eps at both sides
+ Temp2 <- c(0,max(Data)*1.02)
+ Setwindow(Temp1,Temp2)
+ Setorigin(c(Temp1[1],0))
+ R1<- (YMAX-YMIN)/(XMAX-XMIN)
+ R<- Ratio/R1
+ Setscaling(R)
+ VEps <- 0.05*(XMAX-XMIN)/5
+ Temp1<- Temp1-c(VEps,0)
+ Temp2<- Temp2-1/R*c(VEps,0)
+ Setwindow(Temp1,Temp2)
+ Fpt <- c(Mids[1]-Bin,0)
+ Lpt <- c(Mids[length(Mids)]+Bin,0)
+ Fp <- matrix(Fpt,nrow=1)
+ for(i in Looprange(1,length(Mids))){
+ Tmp <- c(Mids[i],Data[i])
+ Fp <- rbind(Fp,Tmp)
+ }
+ Fp <- rbind(Fp,Lpt)
+ rownames(Fp)<- c(1:nrow(Fp))
+ if(densplot){
+ Temp <- density(DataV)
+ X <- matrix(Temp$x)
+ Y <- matrix(Temp$y)
+ Gdens <- cbind(X,Y)
+ }
+ else{
+ Gdens <- list()
+ }
+ list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)),
+ breaks=Breaks,counts=Counts,density=Density,mids=Mids)
+}
+
+Drwhistframe<-function(HistDataL)
+{
+ title<- HistDataL$title
+ xlab<- HistDataL$xlab
+ ylab<- HistDataL$ylab
+ if(mode(title)!="list") title<- list(title)
+ if(mode(xlab)!="list") cap<- list(xlab)
+ if(mode(ylab)!="list") cap<- list(ylab)
+ if(length(title)==0) title<- list("")
+ if(length(title)==1) title<- c(title, list("n"))
+ if(length(title)==2) title<- c(title, list(""))
+ if(length(xlab)==0) xlab<- list("")
+ if(length(xlab)==1) xlab<- c(xlab, list("n"))
+ if(length(xlab)==2) xlab<- c(xlab, list(""))
+ if(length(xlab)==3) xlab<- c(xlab, list(8))
+ if(length(ylab)==0) ylab<- list("")
+ if(length(ylab)==1) ylab<- c(ylab, list("n"))
+ if(length(ylab)==2) ylab<- c(ylab, list(""))
+ if(nchar(title[[1]])>0){
+ Fontsize(title[[2]])
+ Tmp1<- title[[1]]
+ Tmp3<- title[[3]]
+ if(nchar(Tmp3)>0){
+ Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
+ }
+ Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1)
+ Fontsize("n")
+ }
+ if(nchar(xlab[[1]])>0){
+ Fontsize(xlab[[2]])
+ Tmp1<- xlab[[1]]
+ Tmp3<- xlab[[3]]
+ if(nchar(Tmp3)>0){
+ Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
+ }
+ Tmp4<- paste("s",as.character(xlab[[4]]),sep="")
+ Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1)
+ Fontsize("n")
+ }
+ if(nchar(ylab[[1]])>0){
+ Fontsize(ylab[[2]])
+ Tmp1<- ylab[[1]]
+ Tmp3<- ylab[[3]]
+ if(nchar(Tmp3)>0){
+ Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="")
+ }
+ Tmp<- Setorigin()
+ Letter(c(Tmp[1], YMAX),"n2",Tmp1)
+ Fontsize("n")
+ }
+
+ Setax(2," ")
+ Setax(4," ")
+ Setax(6," ")
+}
+
+Drwhistplot<- function(datav,var,size,freq=TRUE,
+ title=list(""), xlab=list(""), ylab=list(""),
+ plot=TRUE,densplot=FALSE,fpplot=TRUE,...)
+ #Output : title,xlab,ylab,commands,plotdata,info
+{
+ H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...)
+ Pd<- H$plotdata
+ Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot) # 10.12.07
+ if(fpplot){
+ Ghist<- c(Ghist,list(fpplot=Pd$fpplot))
+ }
+ if(plot){
+ Windisp(Ghist)
+ }
+ Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5)
+ unit<- paste(Tmp,"cm",sep="")
+ Setunitlen(unit)
+ Infostr<- paste(var,"$info",sep="")
+ Brkstr<- paste(Infostr,"$breaks",sep="")
+ Midstr<- paste(Infostr,"$mids",sep="")
+ if(!freq){
+ Digits<- ",2,2"
+ Denstr<- paste(Infostr,"$density",sep="")
+ }
+ else{
+ Digits<- ",0,0"
+ Denstr<- paste(Infostr,"$counts",sep="")
+ }
+
+ if(fpplot) Prefp<- "" else Prefp<- "#"
+ Exstr<- c(
+ "","",
+ paste("Beginpicture(","'",unit,"')",sep=""),
+ "","",
+ paste("Drwhistframe(",var,")",sep=""),
+ paste("HtickLV(",Midstr,",1,1)",sep=""),
+ paste("VtickLV(max(",Denstr,")",Digits,")",sep=""),
+ paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""),
+ paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""),
+ paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""),
+ "","","","",
+ "Endpicture(1)"
+ )
+ Exstr<- matrix(Exstr)
+ Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids,
+ window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2))
+ Tmp<- paste(var,"<<- ",
+ "list(title=title,xlab=xlab,ylab=ylab,",
+ "commands=Exstr,plotdata=Ghist,info=Info)",sep="")
+ eval(parse(text=Tmp))
+}
+
+##########################
+#17.09.30
+
+Bezierpt<- function(t,Ptlist,Ctrlist){
+ if(length(Ptlist)==6){
+ P0=Ptlist[1:3]
+ P3=Ptlist[4:6]
+ P1=Ctrlist[1:3]
+ if(length(Ctrlist)==3){
+ P2=P3
+ flg3=0
+ }else{
+ P2=Ctrlist[4:6]
+ flg3=1
+ }
+ }else{
+ P0=Ptlist[1:2]
+ P3=Ptlist[3:4]
+ P1=Ctrlist[1:2]
+ if(length(Ctrlist)==2){
+ P2=P3
+ flg3=0
+ }else{
+ P2=Ctrlist[3:4]
+ flg3=1
+ }
+ }
+ P4=(1-t)*P0+t*P1
+ P5=(1-t)*P1+t*P2
+ P6=(1-t)*P2+t*P3
+ P7=(1-t)*P4+t*P5
+ P8=(1-t)*P5+t*P6
+ P9=(1-t)*P7+t*P8
+ if(flg3==0){
+ Out=P7
+ }else{
+ Out=P9
+ }
+ return(Out)
+}
+
+Bezier<- function(...){
+ varargin<- list(...)
+ Nargs=length(varargin)
+ Ptlist=varargin[[1]]
+ Ctrlist=varargin[[2]]
+ Num=10
+ for(J in Looprange(3,Nargs)){
+ Tmp=varargin[[J]]
+ K=strsplit(Tmp,'=',fixe=TRUE)
+ K=K[[1]]
+ Tmp1=substring(K[1],1,1)
+ Lhs=toupper(Tmp1)
+ if(Lhs=="N"){
+ Num=eval(parse(text=K[2]))
+ }
+ }
+ if(length(Num)==1){
+ Num=rep(Num,length(Ctrlist)) #17.10.08
+ }
+ Out=c()
+ for(ii in Looprange(1,length(Ctrlist))){
+ Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]])
+ Tmp2=Ctrlist[[ii]]
+ if(ii==1){
+ St=0
+ }else{
+ St=1
+ }
+ for(J in Looprange(St,Num[ii])){
+ Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2)
+ Out=Appendrow(Out,Tmp)
+ }
+ }
+ return(Out)
+}
+
+#######################
+# 17.10.02
+
+Connectseg<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Pdata=varargin[[1]]
+ Eps=10^(-4)
+ if(Nargs>=2){
+ Eps=varargin[[2]]
+ }
+ if(is.matrix(Pdata)){
+ Din=Dataindex(Pdata)
+ tmp1=list()
+ for(J in 1:nrow(Din)){
+ tmp=Pdata[Din[J,1]:Din[J,2],]
+ tmp1=c(tmp1,list(tmp))
+ }
+ Pdata=tmp1
+ }
+ PlotL=list(Op(1,Pdata))
+ VI=Looprange(2,length(Pdata))
+ while(length(VI)>0){
+ Qd=Op(Length(PlotL),PlotL)
+ Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd)
+ Flg=0
+ for(J in 1:length(VI)){
+ Tmp1=Op(VI[J],Pdata)
+ P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1)
+ if(Norm(P-Ao)<Eps){
+ Tmp=Tmp1[Looprange(2,Length(Tmp1)),]
+ if(Length(Tmp)>0){
+ Qd=Appendrow(Qd,Tmp)
+ }
+ PlotL[[length(PlotL)]]=Qd
+ VI=VI[-J]
+ Flg=1
+ break
+ }
+ if(Norm(Q-Ao)<Eps){
+ Tmp=Tmp1[(nrow(Tmp1)-1):1,]
+ Qd=Appendrow(Qd,Tmp)
+ PlotL[[length(PlotL)]]=Qd
+ VI=VI[-J]
+ Flg=1
+ break
+ }
+ if(Norm(P-Ah)<Eps){
+ Tmp=Tmp1[2:nrow(Tmp1),]
+ Qd=Appendrow(Tmp,Qd)
+ PlotL[[length(PlotL)]]=Qd
+ VI=VI[-J]
+ Flg=1
+ break
+ }
+ if(Norm(Q-Ah)<Eps){
+ Tmp=Tmp1[(nrow(Tmp1)-1):1,]
+ Qd=Appendrow(Tmp,Qd)
+ PlotL[[length(PlotL)]]=Qd
+ VI=VI[-J]
+ Flg=1
+ break
+ }
+ }
+ if(Flg==0){
+ PlotL=c(PlotL,Pdata[VI[1]])
+ VI=VI[-1]
+ }
+ }
+ return(PlotL)
+}
+
+Implicitplot<- function(...){ #180402
+ varargin=list(...)
+ Eps=10^(-4)
+ Nargs=length(varargin)
+ Func=varargin[[1]]
+ Xrng=varargin[[2]]
+ Yrng=varargin[[3]]
+ Mdv=50;Ndv=50
+ for (I in Looprange(4,length(varargin))){
+ Str= varargin[[I]]
+ Tmp=strsplit(Str,"=",fixed=TRUE)
+ Tmp=Tmp[[1]]
+ Tmp1=toupper(Tmp[1])
+ if(substring(Tmp1,1,1)=="N"){
+ Mdv=eval(parse(text=Tmp[2]))
+ if(length(Mdv)==1){
+ Ndv=Mdv
+ }else{
+ Ndv=Mdv[2]
+ Mdv=Mdv[1]
+ }
+ }
+ }
+ Tmp=strsplit(Func,"=",fixed=TRUE)
+ Tmp=Tmp[[1]]
+ if(length(Tmp)==1){
+ Fn=Func
+ }else{
+ Fn=paste(Tmp[1],"-(",Tmp[2],")",sep="")
+ }
+ Tmp=strsplit(Xrng,"=",fixed=TRUE)
+ Tmp=Tmp[[1]]
+ Varx=Tmp[1]
+ Rngx=eval(parse(text=Tmp[2]))
+ Tmp=strsplit(Yrng,"=",fixed=TRUE)
+ Tmp=Tmp[[1]]
+ Vary=Tmp[1]
+ Rngy=eval(parse(text=Tmp[2]))
+ Tmp=paste("Impfun<- function(",Varx,",",Vary,"){",Fn,"}",sep="")
+ eval(parse(text=Tmp))
+ dx=(Rngx[2]-Rngx[1])/Mdv
+ dy=(Rngy[2]-Rngy[1])/Ndv
+ out=list()
+ for(jj in 1:Ndv){
+ yval1=Rngy[1]+(jj-1)*dy
+ yval2=Rngy[1]+jj*dy
+ xval1=Rngx[1]
+ eval11=Impfun(xval1,yval1)
+ eval12=Impfun(xval1,yval2)
+ for(ii in 1:Mdv){
+ xval2=Rngx[1]+ii*dx
+ eval21=Impfun(xval2,yval1)
+ eval22=Impfun(xval2,yval2)
+ pL=list(c(xval1,yval1));vL=c(eval11)
+ pL=c(pL,list(c(xval2,yval1)));vL=c(vL,eval21)
+ pL=c(pL,list(c(xval2,yval2)));vL=c(vL,eval22)
+ pL=c(pL,list(c(xval1,yval2)));vL=c(vL,eval12)
+ pL=c(pL,list(c(xval1,yval1)));vL=c(vL,eval11)
+ qL=c()
+ for(kk in 1:4){
+ if(abs(vL[kk])<=Eps){
+ qL=Appendrow(qL,pL[[kk]])
+ }else{
+ if(vL[kk]>Eps){
+ if(vL[kk+1]< -Eps){
+ tmp=1/(vL[kk]-vL[kk+1])*
+ (-vL[kk+1]*pL[[kk]]+vL[kk]*pL[[kk+1]])
+ qL=Appendrow(qL,tmp)
+ }
+ }else{
+ if(vL[kk+1]>Eps){
+ tmp=1/(-vL[kk]+vL[kk+1])*
+ (vL[kk+1]*pL[[kk]]-vL[kk]*pL[[kk+1]])
+ qL=Appendrow(qL,tmp)
+ }
+ }
+ }
+ }
+ xval1=xval2
+ eval11=eval21
+ eval12=eval22
+ if(Length(qL)==2){
+ out=c(out,list(qL))
+ }
+ }
+ }
+ if(length(out)>0){
+ out=Connectseg(out)
+ }
+ if(length(out)==1){
+ out=out[[1]]
+ }
+ return(out)
+}
+
+#########################
+# 17.10.06
+
+Deqdata=function(deq,rng,initt,initf,Num){
+ Eps=10^(-3)
+ inf=10^3
+ tmp=strsplit(deq,"=")[[1]]
+ tmp1=gsub("`","",tmp[1],fixed=TRUE)
+ tmp1=substring(tmp1,3,nchar(tmp1)-1)
+ Xname=strsplit(tmp1,",")[[1]]
+ func=tmp[2]
+ for(J in 1:(length(Xname))){
+ tmp1=paste("X[",as.character(J),"]",sep="")
+ func=gsub(Xname[J],tmp1,func,fixed=TRUE)
+ }
+ tmp=strsplit(rng,"=")[[1]]
+ tname=tmp[1]
+ tmp=eval(parse(text=tmp[2]))
+ t1=tmp[1]
+ t2=tmp[2]
+ tmp=paste("function(",tname,",X){",func,"}",sep="")
+ funP=eval(parse(text=tmp))
+ tmp=paste("function(",tname,",X){-",func,"}",sep="")
+ funN=eval(parse(text=tmp))
+ dt=(t2-t1)/Num
+ tt=initt
+ X0=initf
+ pdL=c(tt,X0)
+ for(J in Looprange(1,floor((t2-initt)/dt))){
+ kl1=dt*funP(tt,X0)
+ kl2=dt*funP(tt+dt/2,X0+kl1/2)
+ kl3=dt*funP(tt+dt/2,X0+kl2/2)
+ kl4=dt*funP(tt+dt,X0+kl3)
+ X0=X0+(kl1+2*kl2+2*kl3+kl4)/6
+ tt=initt+J*dt
+ tmp=c(tt,X0)
+ if(Norm(tmp)>inf){break}
+ pdL=Appendrow(pdL,tmp)
+ }
+ tt=initt
+ X0=initf
+ for(J in Looprange(1,floor((initt-t1)/dt))){
+ kl1=dt*funN(tt,X0)
+ kl2=dt*funN(tt+dt/2,X0+kl1/2)
+ kl3=dt*funN(tt+dt/2,X0+kl2/2)
+ kl4=dt*funN(tt+dt,X0+kl3)
+ X0=X0+(kl1+2*kl2+2*kl3+kl4)/6
+ tt=initt-J*dt
+ tmp=c(tt,X0)
+ if(Norm(tmp)>inf){break}
+ pdL=Appendrow(tmp,pdL)
+ }
+ pdL
+}
+
+Deqplot=function(...){
+ varargin=list(...)
+ deq=varargin[[1]]
+ rng=varargin[[2]]
+ initt=varargin[[3]]
+ initf=varargin[[4]]
+ Num=50
+ Sel=c(1,2)
+ for(J in Looprange(5,length(varargin))){
+ tmp1=varargin[[J]]
+ if(is.character(tmp1)){
+ tmp=strsplit(tmp1,"=")[[1]]
+ Num=eval(parse(text=tmp[2]))
+ }else{
+ SeL=tmp1
+ }
+ }
+ pdL=Deqdata(deq,rng,initt,initf,Num)
+ pdL=pdL[,SeL]
+}
+
+
+############## obj ###############
+
+Openobj<- function(Fnm){
+ OBJFMT<<- "%7.4f"
+ NPOINT<<- 0
+ NNORM<<- 0
+ OBJSCALE<<- 1
+ OBJFIGNO<<- 0
+ OBJJOIN<<- 0
+ Wfile<<- Fnm
+ Tmp=grep(".obj",Fnm,fixed=TRUE)
+ if(length(Tmp)==0){
+ if(nchar(Fnm)>0){
+ Wfile<<- paste(Fnm,".obj",sep="")
+ }
+ }
+ cat("",file=Wfile,sep="")
+ Wfile
+}
+
+Closeobj<- function(){
+ Wfile=""
+}
+
+Writeobjpoint<- function(P){
+ X=sprintf(OBJFMT,P[1]*OBJSCALE)
+ Y=sprintf(OBJFMT,P[2]*OBJSCALE)
+ Z=sprintf(OBJFMT,P[3]*OBJSCALE)
+ Str=paste("v",X,Y,Z,sep=" ")
+ Printobjstr(Str)
+ NPOINT<<- NPOINT+1
+ return(NPOINT)
+}
+
+Printobjstr<- function(Str){
+ cat(Str,"\n",sep="",file=Wfile,append=TRUE)
+}
+
+Objname<- function(){
+ if(OBJJOIN==0){
+ OBJFIGNO<<- OBJFIGNO+1
+ Gname=paste("ketfig",as.character(OBJFIGNO),sep="")
+ Printobjstr(paste("# ",Gname,sep=""))
+ Printobjstr(paste("g ",Gname,sep=""))
+ }
+}
+
+Objjoin<- function(...){
+ varargin=list()
+ if(length(varargin)>0){
+ OBJJOIN<<- abs(sign(varargin[[1]]))
+ }
+ OBJJOIN
+}
+
+Objsurf<- function(...){ #17.12.18
+ Args<- list(...)
+ Nargs<- length(Args)
+ Sel=Args[[Nargs]]; Nargs=Nargs-1
+ Rf=Args[[1]]
+ N=2
+ Mg=0; Ng=0
+ if(is.numeric(Args[[N]])){
+ if(length(Args[[N]])>2){
+ U=Args[[N]]
+ Mg=length(U)-1
+ N=N+1
+ }else if(length(Args[[N]])==2){
+ Intab=Args[[N]]
+ Ag=Intab[1]; Bg=Intab[2]
+ N=N+1
+ }else{
+ Ag=Args[N]; Bg=Args[N+1]
+ N=N+2
+ }
+ }else{
+ Tmp0=Args[[N]]
+ Tmp=grep("=",Tmp0,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1=strsplit(Tmp0,"=")
+ Tmp0=Tmp1[[1]][2]
+ }
+ Intab=eval(parse(text=Tmp0))
+ Ag=Intab[1]; Bg=Intab[2]
+ N=N+1
+ }
+ if(is.numeric(Args[[N]])){
+ if(length(Args[[N]])>2){
+ V=Args[[N]]
+ Ng=length(V)-1
+ N=N+1
+ }else if(length(Args[[N]])==2){
+ Intab=Args[[N]]
+ Cg=Intab[1]; Dg=Intab[2]
+ N=N+1
+ }else{
+ Cg=Args[[N]]; Dg=Args[[N+1]]
+ N=N+2
+ }
+ }else{ # the case of is.character(Args[[N]])
+ Tmp0=Args[[N]]
+ Tmp=grep("=",Tmp0,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp2=strsplit(Tmp0,"=")
+ Tmp0=Tmp2[[1]][2]
+ }
+ Intab=eval(parse(text=Tmp0))
+ Cg=Intab[1]; Dg=Intab[2]
+ N=N+1
+ }
+ if(Mg==0){
+ Mg=Args[[N]]
+ N=N+1
+ U=c()
+ for(J in Looprange(1,Mg+1)){
+ U=c(U,Ag+(J-1)/Mg*(Bg-Ag))
+ }
+ }
+ if(Ng==0){
+ Ng=Args[[N]]
+ V=c()
+ for(K in Looprange(1,Ng+1)){
+ V=c(V,Cg+(K-1)/Ng*(Dg-Cg))
+ }
+ }
+ Objname()
+ PL=list()
+ for(J in Looprange(1,Mg+1)){
+ for(K in Looprange(1,Ng+1)){
+ P=Rf(U[J],V[K])
+ Np=Writeobjpoint(P)
+ PL=c(PL,list(c(P,Np)))
+ }
+ }
+ Idx=1+(Ng+1)*(0:Mg)
+ Pus=PL[Idx]
+ Idx=(Ng+1)*(1:(Mg+1))
+ Pue=PL[Idx]
+ Idx=1:(Ng+1)
+ Pvs=PL[Idx]
+ Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1))
+ Pve=PL[Idx]
+ Printobjstr("vt 0 0")
+ Printobjstr("vt 1 0")
+ Printobjstr("vt 1 1")
+ Printobjstr("vt 0 1")
+ for(J in Looprange(1,Mg)){
+ for(K in Looprange(1,Ng)){
+ P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]]))
+ P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]]))
+ P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]]))
+ P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]]))
+ N1=""; N2=""; N3=""; N4=""
+ if(Sel=="+"){
+ Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="")
+ Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="")
+ }else{
+ Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="")
+ Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="")
+ }
+ Printobjstr(Str)
+ }
+ }
+ list(U,V,Pus,Pue,Pvs,Pve)
+}
+
+Objthicksurf<- function(...){
+ Args=list(...)
+ Nargs=length(Args)
+ Sel=Args[[Nargs]]; Nargs=Nargs-1
+ Selsurf=substring(Sel,1,1)
+ Selside=c("0","0","0","0")
+ Tmp=grep("w",Sel,fixed=TRUE)
+ if(length(Tmp)>0){
+ Selside[1]="w"
+ }
+ Tmp=grep("e",Sel,fixed=TRUE)
+ if(length(Tmp)>0){
+ Selside[2]="e"
+ }
+ Tmp=grep("s",Sel,fixed=TRUE)
+ if(length(Tmp)>0){
+ Selside[3]="s"
+ }
+ Tmp=grep("n",Sel,fixed=TRUE)
+ if(length(Tmp)>0){
+ Selside[4]="n"
+ }
+ Nfth=Args[[Nargs-2]]
+ Thick1=Args[[Nargs-1]]
+ Thick2=Args[[Nargs]]
+ Nargs=Nargs-3
+ Rfth=Args[[1]]
+ N=2
+ Mg=0; Ng=0
+ if(is.numeric(Args[[N]])){
+ if(length(Args[[N]])>2){
+ U=Args[[N]]
+ Mg=length(U)-1
+ N=N+1
+ }else if(length(Args[[N]])==2){
+ Intab=Args[[N]]
+ Ag=Intab[1]; Bg=Intab[2]
+ N=N+1
+ }else{
+ Ag=Args[[N]]; Bg=Args[[N+1]]
+ N=N+2
+ }
+ }else{
+ Tmp0=Args[[N]]
+ Tmp=strsplit(Tmp0,"=",fixe=TRUE)
+ if(length(Tmp)>0){
+ Tmp0=Tmp[[1]][2]
+ }
+ Intab=eval(parse(text=Tmp0))
+ Ag=Intab[1]; Bg=Intab[2]
+ N=N+1
+ }
+ if(is.numeric(Args[[N]])){
+ if(length(Args[[N]])>2){
+ V=Args[[N]]
+ Ng=length(V)-1
+ N=N+1
+ }else if(length(Args[[N]])==2){
+ Intab=Args[[N]]
+ Cg=Intab[1]; Dg=Intab[2]
+ N=N+1
+ }else{
+ Cg=Args[[N]]; Dg=Args[[N+1]]
+ N=N+2
+ }
+ }else{
+ Tmp0=Args[[N]]
+ Tmp=strsplit(Tmp0,"=",fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp0=Tmp[[1]][2]
+ }
+ Intab=eval(parse(text=Tmp0))
+ Cg=Intab[1]; Dg=Intab[2]
+ N=N+1
+ }
+ if(Mg==0){
+ Mg=Args[[N]]
+ N=N+1
+ U=c()
+ for(J in Looprange(1,Mg+1)){
+ U=c(U,Ag+(J-1)/Mg*(Bg-Ag))
+ }
+ }
+ if(Ng==0){
+ Ng=Args[[N]]
+ V=c()
+ for(K in Looprange(1,Ng+1)){
+ V=c(V,Cg+(K-1)/Ng*(Dg-Cg))
+ }
+ }
+ Objname()
+ Join=OBJJOIN
+ OBJJOIN<<- 1
+ F1=function(u,v){
+ Rfth(u,v)+Thick1*Nfth(u,v)
+ }
+ F2=function(u,v){
+ Rfth(u,v)+Thick2*Nfth(u,v)
+ }
+ Dt1=Objsurf(F1,U,V,Selsurf)
+ if(Selsurf=="+"){
+ Tmp="-"
+ }else{
+ Tmp="+"
+ }
+ Dt2=Objsurf(F2,U,V,Tmp);
+ Out=list(Dt1,Dt2);
+
+ if(Selside[1]!="0"){
+ Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1])
+ Out=c(Out,list(Dt))
+ }
+ if(Selside[2]!="0"){
+ Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2])
+ Out=c(Out,list(Dt))
+ }
+ if(Selside[3]!="0"){
+ Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3])
+ Out=c(Out,list(Dt))
+ }
+ if(Selside[4]!="0"){
+ Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4])
+ Out=c(Out,list(Dt))
+ }
+ OBJJOIN<<- Join
+}
+
+Objrecs<- function(...){
+ Eps=10^(-6)
+ Args=list(...)
+ Nargs=length(Args)
+ Tmp=Args[[1]]
+ PtL=Flattenlist(Tmp)
+ for(J in Looprange(1,length(PtL))){ #17.12.23from
+ Tmp=PtL[[J]]
+ if(!is.matrix(Tmp)){
+ PtL[[J]]=matrix(Tmp,nrow=1)
+ }
+ } #17.12.23until
+ PL1=list()
+ for(J in Looprange(1,length(PtL))){
+ Tmp=PtL[[J]]
+ for(K in Looprange(1,nrow(Tmp))){
+ PL1=c(PL1,list(Tmp[K,]))
+ }
+ }
+ Sel=Args[[Nargs]]; Nargs=Nargs-1
+ Objname()
+ for(J in Looprange(1,length(PL1))){
+ P=PL1[[J]]
+ if((length(P)<4) || (P[4]==0)){
+ Np=Writeobjpoint(P)
+ PL1[[J]]=c(P[1:3],Np)
+ }
+ }
+ Tmp=Args[[2]]
+ if((is.numeric(Tmp)) && (length(Tmp)==1)){
+ Drv=Tmp
+ Len=Norm(Drv)
+ PL2=list()
+ for(J in Looprange(1,length(PL1))){
+ Tmp=PL1[[J]]
+ P=Tmp[1:3]+Drv
+ Np=Writeobjpoint(P)
+ PL2=c(PL2,list(c(P[1:3],Np)))
+ if(J<length(PL1)){
+ Vec=PL1[[J+1]]-PL1[[J]]
+ if(Norm(Vec)>Eps){
+ Tmp1=Crossprod(Drv,Vec)
+ Tmp2=Crossprod(Tmp1,Vec)
+ Tmp3=Dotprod(Tmp2,Drv)
+ if(Tmp3<-Eps){
+ Tmp2=-Tmp2
+ }
+ Drv=Len/Norm(Tmp2)*Tmp2
+ }
+ }
+ }
+ }else{
+ PtL=Flattenlist(Tmp)
+ for(J in Looprange(1,length(PtL))){ #17.12.23from
+ Tmp=PtL[[J]]
+ if(!is.matrix(Tmp)){
+ PtL[[J]]=matrix(Tmp,nrow=1)
+ }
+ } #17.12.23until
+ PL2=list()
+ for(J in Looprange(1,length(PtL))){
+ Tmp=PtL[[J]]
+ for(K in Looprange(1,nrow(Tmp))){
+ PL2=c(PL2,list(Tmp[K,]))
+ }
+ }
+ for(J in Looprange(1,length(PL2))){
+ P=PL2[[J]]
+ if((length(P)<4) || (P[4]==0)){
+ Np=Writeobjpoint(P)
+ PL2[[J]]=c(P[1:3],Np)
+ }
+ }
+ }
+ Printobjstr("vt 0 0")
+ Printobjstr("vt 1 0")
+ Printobjstr("vt 1 1")
+ Printobjstr("vt 0 1")
+ for(J in Looprange(2,length(PL1))){
+ P1=sprintf("%1d",Op(4,PL1[[J-1]]))
+ P2=sprintf("%1d",Op(4,PL2[[J-1]]))
+ P3=sprintf("%1d",Op(4,PL2[[J]]))
+ P4=sprintf("%1d",Op(4,PL1[[J]]))
+ N1=""; N2=""; N3=""; N4=""
+ if(Sel=="+"){
+ Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="")
+ Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="")
+ }else{
+ Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="")
+ Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="")
+ }
+ Printobjstr(Str)
+ }
+ list(PL1,PL2)
+}
+
+Objpolygon<- function(...){
+ Eps=10^(-6)
+ Args=list(...)
+ Nargs=length(Args)
+ Tmp=Args[[1]]
+ PtL=Flattenlist(Tmp)
+ for(J in Looprange(1,length(PtL))){ #17.12.23from
+ Tmp=PtL[[J]]
+ if(!is.matrix(Tmp)){
+ PtL[[J]]=matrix(Tmp,nrow=1)
+ }
+ } #17.12.23until
+ PL=list()
+ for(J in Looprange(1,length(PtL))){
+ Tmp=PtL[[J]]
+ for(K in Looprange(1,nrow(Tmp))){
+ PL=c(PL,list(Tmp[K,]))
+ }
+ }
+ Sel=Args[[Nargs]]; Nargs=Nargs-1
+ Objname()
+ for(J in Looprange(1,length(PL))){
+ P=PL[[J]]
+ if((length(P)<4) || (P(4)==0)){
+ Np=Writeobjpoint(P)
+ PL[[J]]=c(P[1:3],Np)
+ }
+ }
+ if(Nargs==1){
+ Tmp=PL[[1]]
+ Cen=Tmp[1:3]
+ Nc=Tmp[4]
+ }else{
+ Tmp=Args[[2]]
+ if(length(Tmp)==1){
+ Tmp1=PL[[Tmp]]
+ Cen=Tmp1[1:3]
+ Nc=Tmp[4]
+ }else{
+ Cen=Tmp
+ Nc=Writeobjpoint(Cen)
+ }
+ }
+ for(J in Looprange(1,length(PL))){
+ if(J<length(PL)){
+ Je=J+1
+ }else{
+ Je=1
+ }
+ Pt1=Cen
+ PLj=PL[[J]]; PLje=PL[[Je]]
+ Pt2=PLj[1:3]; Pt3=PLje[1:3]
+ if(Norm(Crossprod(Pt2-Pt1,Pt3-Pt1))<Eps){
+ next
+ }
+ P1=sprintf("%1d",Nc)
+ P2=sprintf("%1d",PLj[4])
+ P3=sprintf("%1d",PLje[4])
+ if(Sel=="+"){
+ Str=paste("f",P1,P2,P3,"",sep=" ")
+ }else{
+ Str=paste("f",P1,P3,P2,"",sep=" ")
+ }
+ Printobjstr(Str)
+ }
+ PL
+}
+
+Objpolyhedron<- function(Vertex,Face){
+ OBJFIGNO<<- OBJFIGNO+1
+ Ninit=NPOINT
+ Objname()
+ for(N in Looprange(1,length(Vertex))){
+ P=Vertex[[N]]
+ Np=Writeobjpoint(P)
+ Vertex[[N]]=c(P[1:3],Np)
+ }
+ for(N in Looprange(1,length(Face))){
+ F=Face[[N]]+Ninit
+ Face[[N]]=F
+ Str="f"
+ for(J in Looprange(1,length(F))){
+ P=sprintf("%1d",F[J])
+ Str=paste(Str,P,sep=" ")
+ }
+ Printobjstr(Str)
+ }
+ list(Vertex,Face)
+}
+
+Objcurve<- function(...){
+ Eps=10^(-6)
+ Args=list(...)
+ Nargs=length(Args)
+ Tmp=Args[[1]]
+ PtL=Flattenlist(Tmp)
+ for(J in Looprange(1,length(PtL))){ #17.12.23from
+ Tmp=PtL[[J]]
+ if(!is.matrix(Tmp)){
+ PtL[[J]]=matrix(Tmp,nrow=1)
+ }
+ } #17.12.23until
+ PL=list()
+ for(J in Looprange(1,length(PtL))){
+ Tmp=PtL[[J]]
+ for(K in Looprange(1,nrow(Tmp))){
+ PL=c(PL,list(Tmp[K,]))
+ }
+ }
+ Closed=Norm(PL[[length(PL)]]-PL[[1]])<Eps
+ Pstr="xy"
+ Tmp=Args[[Nargs]]
+ if(is.character(Tmp)){
+ Pstr=Tmp
+ Nargs=Nargs-1
+ }
+ Sz=0.1
+ Np=4
+ if(Nargs>=2){
+ Sz=Args[[2]]
+ }
+ if(Nargs>=3){
+ Np=Args[[3]]
+ }
+ Assign("Sz",Sz)
+ if(Pstr=="xy"){
+ Vz=c(0,0,1)
+ Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)")
+ }
+ if(Pstr=="yz"){
+ Vz=c(1,0,0)
+ Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))")
+ }
+ if(Pstr=="zx"){
+ Vz=c(0,1,0)
+ Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))")
+ }
+ Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep=""))
+ P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]]
+ PQ1=Q-P
+ if(!Closed){
+ PQ2=PQ1
+ }else{
+ PQ2=P-R
+ }
+ Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2)
+ Vp1=Vp/Norm(Vp)
+ Theta=acos(min(Dotprod(Vz,Vp1),1));
+ Vj=Crossprod(Vz,Vp1)
+ if(Norm(Vj)<Eps){
+ Vj=Vz
+ }
+ Gc1=Rotate3data(Gc0,Vj,Theta)
+ CL=list(Translate3data(Gc1,P))
+ for(J in Looprange(2,length(PL)-1)){
+ P=PL[[J]]; Q=PL[[J+1]]
+ PQ2=Q-P
+ if(Norm(PQ2)<Eps){
+ next
+ }
+ Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2)
+ Vp2=Vp/Norm(Vp)
+ Theta=acos(min(Dotprod(Vp1,Vp2),1))
+ Vj=Crossprod(Vp1,Vp2)
+ if(Norm(Vj)<Eps){
+ Vj=Vp1
+ }
+ Gc2=Rotate3data(Gc1,Vj,Theta)
+ CL=c(CL,list(Translate3data(Gc2,P)))
+ PQ1=PQ2
+ Vp1=Vp2
+ Gc1=Gc2
+ }
+ if(!Closed){
+ Vp2=(Q-P)/Norm(Q-P)
+ Theta=acos(min(Dotprod(Vp1,Vp2),1))
+ Vj=Crossprod(Vp1,Vp2)
+ if(Norm(Vj)<Eps){
+ Vj=Vp1
+ }
+ Gc3=Rotate3data(Gc1,Vj,Theta)
+ CL=c(CL,list(Translate3data(Gc3,Q)))
+ }
+ Objname()
+ Join=Objjoin();
+ Objjoin(1)
+ GL1=CL[[1]]
+ for(J in Looprange(2,length(CL))){
+ GL2=CL[[J]]
+ Dt=Objrecs(GL1,GL2,"-")
+ GL1=Dt[[2]]
+ if(J==2){
+ GL0=Dt[[1]]
+ }
+ }
+ if(!Closed){
+ Objpolygon(CL[[1]],"-")
+ N=length(CL)
+ Objpolygon(CL[[N]],"+")
+ }else{
+ Objrecs(GL1,GL0,"-")
+ }
+ Out=CL
+ OBJJOIN<<- Join
+}
+
+Objsymb<- function(Symb,Thick,Face,Dir){
+ for(J in Looprange(1,length(Symb))){
+ Objcurve(Op(J,Symb),Thick,Face,Dir)
+ }
+}
+
+Symb3data<- function(Moji,Size,Kaiten,NV,Pos){
+ if(is.character(Moji)){
+ #Tmp=Symbdata(Moji)
+ # GY1=Tmp(2)
+ }else{
+ GY1=Moji
+ }
+ GY1=Scaledata(GY1,Size,Size)
+ GY1=Rotatedata(GY1,Kaiten*pi/180)
+ A=NV[1]; B=NV[2]; C=NV[3]
+ if(A^2+B^2==0){
+ E1=c(1,0,0)
+ E2=c(0,1,0)
+ }else{
+ E1=c(B,-A,0)
+ E2=c(-A*C,-B*C,A^2+B^2)
+ Tmp=matrix(c(E1,E2,NV),3,3)
+ D=det(Tmp)
+ if(D<0){
+ E1=-E1
+ }
+ E1=E1/Norm(E1)
+ E2=E2/Norm(E2)
+ }
+ Em<- function(X,Y){
+ c(E1[1]*X+E2[1]*Y,E1[2]*X+E2[2]*Y,E1[3]*X+E2[3]*Y)
+ }
+ GY1=Embed(GY1,Em)
+ GY1=Translate3data(GY1,Pos)
+ Flattenlist(GY1)
+}
+
+############## New Intersect 18.02.01 #############
+
+Intersectline<- function(p1,v1,p2,v2){
+ Eps0=10^(-5)
+ tmp=Dotprod(v1,v2)
+ tmp1=c(tmp,Norm(v1)^2)
+ tmp2=c(-Norm(v2)^2,-tmp)
+ tmp3=c(Dotprod(p2-p1,v2),Dotprod(p2-p1,v1))
+ d=Crossprod(tmp1,tmp2)
+ tmp=abs(Crossprod(v1,v2))
+ if(tmp>Eps0){
+ dt=Crossprod(tmp3,tmp2)
+ ds=Crossprod(tmp1,tmp3)
+ t=dt/d
+ s=ds/d
+ pt=p1+v1*t
+ out=list(pt,t,s)
+ }else{
+ tmp1=Crossprod(p2-p1,v1)/Norm(v1)
+ out=list(abs(tmp1))
+ }
+ return(out)
+}
+
+Intersectseg<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Eps0=10^(-4)
+ Eps1=0.01
+ seg1=varargin[[1]]
+ seg2=varargin[[2]]
+ if(Nargs>2){Eps1=varargin[[3]]}
+ p1=Op(1,seg1); q1=Op(2,seg1)
+ p2=Op(1,seg2); q2=Op(2,seg2)
+ if((Norm(q1-p1)<Eps0)||(Norm(q2-p2)<Eps0)){
+ out=list(-1)
+ }else{
+ tmp=Intersectline(p1,q1-p1,p2,q2-p2)
+ if(length(Op(1,tmp))>1){
+ pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp)
+ if((t*(t-1)<Eps0)&&(s*(s-1)<Eps0)){
+ out=list(0,pt,t,s)
+ }else{
+ t=min(max(t,0),1)
+ s=min(max(s,0),1)
+ tmp3=c(Norm(p1-p2),Norm(p1-q2),Norm(q1-p2),Norm(q1-q2)) #180317
+ tmp1=c(Op(2,q2-p2),-Op(1,q2-p2))
+ tmp=Intersectline(p1,tmp1,p2,q2-p2)
+ if(length(Op(1,tmp))>1){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
+ tmp3=c(tmp3,Norm(Op(1,tmp)-p1))
+ }
+ }
+ tmp=Intersectline(q1,tmp1,p2,q2-p2)
+ if(length(Op(1,tmp))>1){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
+ tmp3=c(tmp3,Norm(Op(1,tmp)-q1))
+ }
+ }
+ tmp1=c(Op(2,q1-p1),-Op(1,q1-p1))
+ tmp=Intersectline(p2,tmp1,p1,q1-p1);
+ if(length(Op(1,tmp))>1){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
+ tmp3=c(tmp3,Norm(Op(1,tmp)-p2))
+ }
+ }
+ tmp=Intersectline(q2,tmp1,p1,q1-p1); #180322
+ if(length(Op(1,tmp))>1){
+ if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){
+ tmp3=c(tmp3,Norm(Op(1,tmp)-q2))
+ }
+ }
+ out=list(min(tmp3),pt,t,s)
+ }
+ }else{
+ dist=tmp[[1]]
+ tmp1=q1-p1
+ n=c(tmp1[2],-tmp1[1])/Norm(tmp1)
+ pts=list()
+ tmp=Intersectline(p1,n,p2,q2-p2)
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
+ tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2
+ pts=c(pts,list(list(tmp1,0,tmp[[3]])))
+ }
+ tmp=Intersectline(q1,n,p2,q2-p2)
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
+ tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2
+ pts=c(pts,list(list(tmp1,1,tmp[[3]])))
+ }
+ tmp=Intersectline(p2,n,p1,q1-p1)
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
+ tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1
+ pts=c(pts,list(list(tmp1,tmp[[3]],0)))
+ }
+ if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){
+ tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1
+ pts=c(pts,list(list(tmp1,tmp[[3]],2)))
+ }
+ if(length(pts)==0){
+ tmp1=min(Norm(p2-p1),Norm(q2-p1),Norm(p2-q1),Norm(q2-q1))
+ out=list(tmp1)
+ }else{
+ if(dist>Eps1){
+ out=list(dist)
+ }else{
+ tmp=c();
+ for(j in 1:length(pts)){
+ tmp=Appendrow(tmp,Op(1,pts[[j]]))
+ }
+ tmp1=sum(tmp[,1])/(length(pts))
+ tmp2=sum(tmp[,2])/(length(pts))
+ tmp3=c(tmp1,tmp2)
+ tmp=Nearestpt(tmp3,seg1)
+ tmp1=tmp[[2]]
+ tmp=Nearestpt(tmp3,seg2)
+ tmp2=tmp[[2]]
+ out=list(dist,tmp3,tmp1,tmp2)
+ }
+ }
+ }
+ }
+ return(out)
+}
+
+Osplineseg<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Eps=10^(-2)
+ Eps0=10^(-6)
+ Ptlist=varargin[[1]]
+ Numstr="Num=20"
+ if(Nargs>1){
+ Numstr=varargin[[2]]
+ }
+ p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist)
+ tmp=Norm(p2-p0)*Norm(p3-p1)
+ tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2)
+ cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp
+ pQ=p1+cc*(p2-p0)
+ pR=p2+cc*(p1-p3)
+ ctrL=list(c(pQ,pR))
+ out=Bezier(list(p1,p2),ctrL,Numstr)
+ return(out)
+}
+
+Intersectpartseg<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ crv1=varargin[[1]]
+ crv2=varargin[[2]]
+ ii=varargin[[3]]
+ jj=varargin[[4]]
+ Eps1=varargin[[5]]
+ Eps2=varargin[[6]]
+ Dist=10*Eps2
+ if(Nargs>6){Dist=varargin[[7]]}
+ Eps00=10^(-8)
+ Eps0=10^(-4)
+ out=list()
+ seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1))
+ seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2))
+ tmp1=Op(2,seg1)-Op(1,seg1)
+ tmp2=Op(2,seg2)-Op(1,seg2)
+ snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2))
+ tmp=Intersectseg(seg1,seg2,Eps1)
+ dst=Op(1,tmp)
+ if(dst<Eps0){
+ out=list(Op(2,tmp),ii+Op(3,tmp),jj+Op(4,tmp),dst,snang)
+ }else{
+ if(dst<Eps2){
+ if((Length(crv1)==2)||(Norm(Op(2,seg1)-Op(1,seg1))>Dist-Eps0)){
+ os1=seg1
+ }else{
+ p1=Op(1,seg1); p2=Op(2,seg1)
+ if(ii==1){
+ p3=Op(3,crv1)
+ tmp=p2-p1
+ tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
+ p0=Reflectdata(p3,c((p1+p2)/2,tmp))
+ }else{
+ if(ii==Length(crv1)-1){
+ p0=Op(ii-1,crv1)
+ tmp=p2-p1
+ tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
+ p3=Reflectdata(p0,c((p1+p2)/2,tmp))
+ }else{
+ p0=Op(ii-1,crv1); p3=Op(ii+2,crv1)
+ }
+ }
+ os1=Osplineseg(list(p0,p1,p2,p3))
+ }
+ if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){
+ os2=seg2
+ }else{
+ p1=Op(1,seg2); p2=Op(2,seg2)
+ if(jj==1){
+ p3=Op(3,crv2)
+ tmp=p2-p1
+ tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
+ p0=Reflectdata(p3,c((p1+p2)/2,tmp))
+ }else{
+ if(jj==Length(crv2)-1){
+ p0=Op(jj-1,crv2)
+ tmp=p2-p1
+ tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp))
+ p3=Reflectdata(p0,c((p1+p2)/2,tmp))
+ }else{
+ p0=Op(jj-1,crv2); p3=Op(jj+2,crv2)
+ }
+ }
+ os2=Osplineseg(list(p0,p1,p2,p3))
+ }
+ tmp2=list()
+ for(kk in Looprange(1,Length(os1)-1)){
+ for(ll in Looprange(1,Length(os2)-1)){
+ seg1=Listplot(Op(kk,os1),Op(kk+1,os1))
+ seg2=Listplot(Op(ll,os2),Op(ll+1,os2))
+ tmp=Intersectseg(seg1,seg2,Eps1)
+ if((Op(1,tmp)<Eps1)&&(length(tmp)>1)){ #18.02.05
+ if(Op(1,tmp)<dst+Eps00){
+ dst=Op(1,tmp)
+ tmp3=list()
+ for( nn in Looprange(1,length(tmp2))){
+ if(Op(1,tmp2[[nn]])<dst){
+ tmp3=c(tmp3,list(tmp2[[nn]]))
+ }
+ }
+ tmp2=c(tmp3,list(list(dst,Op(2,tmp))))
+ }
+ }
+ }
+ }
+ if(length(tmp2)>0){
+ tmp1=c()
+ for(nn in Looprange(1,length(tmp2))){
+ tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]]))
+ }
+ tmp=sum(tmp1[,1])/length(tmp2)
+ tmp=c(tmp,sum(tmp1[,2])/length(tmp2))
+ out=list(tmp)
+ p1=Op(ii,crv1); p2=Op(ii+1,crv1)
+ tmp=c(Op(2,p2-p1),-Op(1,p2-p1))
+ tmp=Intersectline(Op(1,out),tmp,p1,p2-p1)
+ tmp=min(max(Op(3,tmp),0),1)
+ out=c(out,list(ii+tmp))
+ p1=Op(jj,crv2); p2=Op(jj+1,crv2)
+ tmp=c(Op(2,p2-p1),-Op(1,p2-p1))
+ tmp=Intersectline(Op(1,out),tmp,p1,p2-p1)
+ tmp=min(max(Op(3,tmp),0),1)
+ out=c(out,list(jj+tmp,dst,snang))
+ }
+ }
+ }
+ return(out)
+}
+
+if(1==0){ #start of skip
+
+Collectnear<- function(ptdL,Eps2){
+ gL=list(Op(1,ptdL))
+ rL=ptdL[Looprange(2,length(ptdL))] #18.02.07
+ for( ii in Looprange(1,length(ptdL)-1)){
+ numL=c()
+ for(jj in Looprange(1,length(rL))){
+ tmp1=100
+ for(kk in Looprange(1,length(gL))){
+ tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]]))
+ if(tmp<tmp1){tmp1=tmp}
+ }
+ if(tmp1<Eps2){numL=c(numL,jj)}
+ }
+ if(length(numL)==0){
+ break
+ }else{
+ gL=c(gL,rL[numL]) #18.02.05
+ tmp=setdiff(1:(length(rL)),numL)
+ rL=rL[tmp]
+ }
+ }
+ return(list(gL,rL))
+}
+
+}# end of skip
+
+Collectsameseg<- function(ptdL){
+ Eps00=10^(-8)
+ if(length(ptdL)==0){
+ gL=list();rL=list()
+ }else{
+ tmp1md=ptdL[1]
+ rL=ptdL[Looprange(2,length(ptdL))]
+ tmp1=tmp1md[[1]]
+ kk=floor(Op(2,tmp1))
+ if(Op(2,tmp1)<kk+Eps00){
+ s1=kk-1-Eps00; e1=s1+2+2*Eps00
+ }else{
+ s1=kk-Eps00; e1=s1+1+2*Eps00
+ }
+ kk=floor(Op(3,tmp1))
+ if(Op(3,tmp1)<kk+Eps00){
+ s2=kk-1-Eps00; e2=s2+2+2*Eps00
+ }else{
+ s2=kk-Eps00; e2=s2+1+2*Eps00
+ }
+ diffL=c()
+ for(ii in Looprange(1,length(rL))){
+ tmp=rL[[ii]]
+ tmp1=Op(2,tmp);tmp2=Op(3,tmp)
+ if((tmp1>s1)&&(tmp1<e1)&&(tmp2>s2)&&(tmp2<e2)){
+ tmp1md=c(tmp1md,list(tmp))
+ }else{
+ diffL=c(diffL,ii)
+ }
+ }
+ tmp=c()
+ for(ii in Looprange(1,length(tmp1md))){
+ tmp=c(tmp,Op(4,tmp1md[[ii]]))
+ }
+ dst=min(tmp)
+ gL=list()
+ for(ii in Looprange(1,length(tmp1md))){
+ tmp=tmp1md[[ii]]
+ if(Op(4,tmp)<dst+Eps00){
+ gL=c(gL,list(tmp))
+ }
+ }
+ tmp1=rL
+ rL=rL[diffL]
+ }
+ return(list(gL,rL))
+}
+
+Groupnearpt<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Eps1=varargin[[Nargs]]
+ plist=varargin[[1]]
+ qlist=varargin[[2]]
+ if(!is.list(qlist)){
+ qlist=plist
+ plist=list()
+ }
+ if(length(qlist)==0){
+ return(plist)
+ }
+ pt=qlist[[1]]
+ qlist=qlist[Looprange(2,length(qlist))]
+ if(length(plist)==0){
+ plist=list(matrix(pt,nrow=1))
+ }else{
+ flg=0
+ for(ii in Looprange(1,length(plist))){
+ gL=plist[[ii]]
+ for(jj in Looprange(1,Length(gL))){
+ if(Norm(Op(jj,gL)-pt)<Eps1){
+ flg=1
+ break
+ }
+ }
+ if(flg==1){
+ plist[[ii]]=Appendrow(gL,pt)
+ break
+ }
+ }
+ if(flg==0){
+ plist=c(plist,list(matrix(pt,nrow=1)))
+ }
+ }
+ out=Groupnearpt(plist,qlist,Eps1)
+ return(out)
+}
+
+IntersectcurvesPp<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Eps0=10^(-4)
+ Eps1=0.01
+# Eps2=0.05
+ Eps2=0.1
+ Dist=10*Eps2
+ if(Nargs>2){Eps1=varargin[[3]]}
+ if(Nargs>3){Eps2=varargin[[4]]}
+ if(Nargs>4){Dist=varargin[[5]]}
+ tmp1=varargin[[1]]
+ crv1=matrix(Op(1,tmp1),nrow=1)
+ for(ii in Looprange(2,Length(tmp1))){
+ tmp=Op(Length(crv1),crv1)
+ if(Norm(tmp-Op(ii,tmp1))>Eps0){
+ crv1=Appendrow(crv1,Op(ii,tmp1))
+ }
+ }
+ tmp2=varargin[[2]]
+ crv2=matrix(Op(1,tmp2),nrow=1)
+ for(ii in Looprange(2,Length(tmp2))){
+ tmp=Op(Length(crv2),crv2)
+ if(Norm(tmp-Op(ii,tmp2))>Eps0){
+ crv2=Appendrow(crv2,Op(ii,tmp2))
+ }
+ }
+ if(Length(crv1)!=Length(crv2)){
+ self=0
+ }else{
+ self=1
+ for(ii in Looprange(1,Length(crv1))){
+ if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){
+ self=0
+ break
+ }
+ }
+ }
+ out=list()
+ for(ii in Looprange(1,Length(crv1)-1)){
+ if(self==0){
+ loopL=Looprange(1,Length(crv2)-1)
+ }else{
+ loopL=Looprange(ii+2,Length(crv2)-1)
+ }
+ for(jj in loopL){
+ tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist)
+ if(length(tmp)>1){ #18.02.05
+ if(length(out)==0){
+ out=list(tmp)
+ }else{
+ tmp1=Op(length(out),out)
+ if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){
+ out=c(out,list(tmp))
+ }
+ }
+ if(self==1){
+ tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp))
+ out=c(out,list(tmp))
+ }
+ }
+ }
+ }
+ tmp2=out
+ out=list()
+ tmp1=tmp2
+ for(ii in Looprange(1,length(tmp2))){
+ tmp=Collectsameseg(tmp1)
+ out=c(out,list(Op(1,tmp)))
+ if(length(Op(2,tmp))==0){
+ break
+ }else{
+ tmp1=Op(2,tmp)
+ }
+ }
+ for(ii in Looprange(1,length(out))){
+ tmp1=Op(ii,out)
+ if(length(tmp1)==1){
+ out[[ii]]=Op(1,tmp1)
+ }else{
+ tmp=c()
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=c(tmp,Op(4,tmp1[[jj]]))
+ }
+ dst=min(tmp)
+ tmp=c()
+ for(jj in Looprange(1,length(tmp1))){
+ if(Op(4,tmp1[[jj]])<dst+Eps0){
+ tmp=c(tmp,Op(1,tmp1[[jj]]))
+ }
+ }
+ tmp=matrix(tmp,ncol=2,byrow=TRUE)
+ tmp=c(sum(tmp[,1]),sum(tmp[,2]))/Length(tmp)
+ tmp2=list(tmp)
+ tmp=Nearestpt(Op(1,tmp2),crv1)
+ tmp2=c(tmp2,list(Op(2,tmp)))
+ tmp=Nearestpt(Op(1,tmp2),crv2)
+ tmp2=c(tmp2,list(Op(2,tmp)))
+ tmp2=c(tmp2,list(list(dst,Op(5,tmp1[[1]]))))
+ out[[ii]]=tmp2
+ }
+ }
+ return(out)
+}
+
+Intersectcurves<- function(...){
+ dtL=IntersectcurvesPp(...)
+ out=list()
+ for(jj in Looprange(1,length(dtL))){
+ out=c(out,list(Op(1,dtL[[jj]])))
+ }
+ return(out)
+}
+
+############## end of New Intersect #############
+
+############## New Enclosing2 #############
+
+Enclosing2<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ plist=varargin[[1]]
+ Eps0=10^(-5)
+ Eps1=0.01
+ Eps2=0.1
+ Start=c()
+ flg=0
+ for(ii in Looprange(2,Nargs)){
+ tmp=varargin[[ii]]
+ if(length(tmp)>1){
+# Start=tmp
+ }else{
+ if(flg==0){Eps1=tmp}
+ if(flg==1){Eps2=tmp}
+ flg=flg+1
+ }
+ }
+ flg=0
+ AnsL=c()
+ if(length(plist)==1){
+ Fdata=plist[[1]]
+ tmp1=Op(1,Fdata)
+ tmp2=Op(Length(Fdata),Fdata)
+ if(Norm(tmp1-tmp2)<Eps0){
+ AnsL=Fdata
+ }else{
+ AnsL=Appendrow(Fdata,tmp1)
+ }
+ flg=1
+ }
+ if(flg==0){
+ Fdata=Op(1,plist)
+ Gdata=Op(length(plist),plist)
+ KL=IntersectcurvesPp(Fdata,Gdata)
+ if(length(KL)==0){
+ tmp1=Op(Length(Gdata),Gdata)
+ tmp2=Op(1,Fdata)
+ tmp=Listplot(tmp1,tmp2)
+ plist=c(plist,list(tmp))
+ Start=tmp2
+ tst=1
+# flg=1
+ }else{
+ if(length(KL)==1){
+ tmp=Op(1,KL)
+ tst=Op(2,tmp)
+ Start=crv(tst,Fdata)
+ }
+ if(length(KL)>1){
+ KL=Quicksort(KL,2)
+ if(length(Start)==0){
+ tmp=Op(1,KL)
+ tst=Op(2,tmp)
+ Start=Pointoncurve(tst,Fdata)
+ }else{
+ tmp=c()
+ for(ii in Looprange(1,length(KL))){
+ tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start)))
+ }
+ tmp=min(tmp)
+ tmp1=list()
+ for(ii in Looprange(1,length(KL))){
+ tmp2=Op(1,KL[[ii]])
+ if(Norm(tmp2-Start)==tmp){
+ tmp1=c(tmp1,list(tmp2))
+ }
+ }
+ tmp=Op(1,tmp1)
+ tst=Op(2,tmp)
+ Start=Pointoncurve(tst,Fdata)
+ }
+ }
+ }
+ }
+ if(flg==0){
+ t1=tst
+ for(nn in Looprange(1,length(plist))){
+ Fdata=Op(nn,plist)
+ if(nn==length(plist)){
+ nxtno=1
+ }else{
+ nxtno=nn+1
+ }
+ Gdata=Op(nxtno,plist)
+ KL=IntersectcurvesPp(Fdata,Gdata)
+ if(length(KL)==0){
+ tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from
+ Gdata=Appendrow(tmp,Gdata)
+ plist[[nxtno]]=Gdata
+ t2=Length(Fdata)
+ ss=1 #18.02.02until
+ }else{
+ tmp=Op(1,KL)
+ t2=Op(2,tmp)
+ ss=Op(3,tmp)
+ if(abs(t2-t1)<Eps0){
+ if(length(KL)>1){
+ tmp=Op(2,KL)
+ t2=Op(2,tmp)
+ ss=Op(3,tmp)
+ }else{
+# println(text(nn)+" and "+text(nn+1)+" not intersect");
+# flg=1
+ }
+ }
+ }
+ if(flg==0){
+ tmp=Partcrv(t1,t2,Fdata)
+ if(nn==1){
+ AnsL=tmp
+ }else{
+ tmp=tmp[2:Length(tmp),]
+ AnsL=Appendrow(AnsL,tmp)
+ }
+ t1=ss
+ }
+ }
+ }
+ return(AnsL)
+}
+
+############## end of Enclosing2 #############
+
+############## start of surface drawing #############
+
+Fullformfunc<- function(FdL){
+ ADDPOINT<<- list() #18.02.19
+ Out=list(Op(1,FdL))
+ N=length(FdL)
+ for(Jrg in Looprange(1,N)){
+ Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE)
+ if(length(Tmp)>0){
+ break
+ }
+ }
+ Urg=Stripblanks(Op(Jrg,FdL))
+ Tmp=strsplit(Urg,"=",fixed=TRUE)
+ UNAME<<- Tmp[[1]][1]
+ URNG<<- eval(parse(text=Tmp[[1]][2]))
+ Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",",
+ sprintf("%6.7f",URNG[2]),")",sep="")
+ Vrg=Stripblanks(Op(Jrg+1,FdL))
+ Tmp=strsplit(Vrg,"=",fixed=TRUE)
+ VNAME<<- Tmp[[1]][1]
+ VRNG<<- eval(parse(text=Tmp[[1]][2]))
+ Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",",
+ sprintf("%6.7f",VRNG[2]),")",sep="")
+ if(Jrg==2){
+ Xf=UNAME
+ Yf=VNAME
+ Tmp=Stripblanks(Op(1,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Zf=Tmp[[1]][2]
+ Tmp=list(UNAME,VNAME,Zf,Urg,Vrg)
+ Out=c(Out,Tmp)
+ }else if(Jrg==4){
+ Tmp=Stripblanks(Op(1,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Zf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(2,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Xname=Tmp[[1]][1]
+ Xf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(3,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Yname=Tmp[[1]][1]
+ Yf=Tmp[[1]][2]
+ Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE)
+ Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE)
+ Tmp=list(Xf,Yf,Zf,Urg,Vrg)
+ Out=c(Out,Tmp)
+ }else{
+ Tmp=Stripblanks(Op(2,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Xf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(3,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Yf=Tmp[[1]][2]
+ Tmp=Stripblanks(Op(4,FdL))
+ Tmp=strsplit(Tmp,"=",fixed=TRUE)
+ Zf=Tmp[[1]][2]
+ Tmp=list(Xf,Yf,Zf,Urg,Vrg)
+ Out=c(Out,Tmp)
+ }
+ tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='')
+ eval(parse(text=tmp))
+ tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='')
+ eval(parse(text=tmp))
+ tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='')
+ eval(parse(text=tmp))
+ tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='')
+ tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='')
+ eval(parse(text=tmp))
+ XYZstr<<- c(Xf,Yf,Zf)
+ DRWS<<- "enws"
+ BdyL=list()
+ for(I in Looprange(Jrg+2,length(FdL))){
+ Tmp=Op(I,FdL)
+ if(is.character(Tmp)){
+ if(nchar(Tmp)==0){
+ Tmp=" "
+ }
+ DRWS<<- list(Tmp)
+ }
+ if((is.numeric(Tmp))&&(Length(Tmp)>1)){
+ BdyL=list(Tmp)
+ }
+ }
+ BDYL<<- BdyL
+ Tmp=c(DRWS,BDYL)
+ Out=c(Out,Tmp)
+ return(Out)
+}
+
+Addpoints<- function(ptlist){
+ ADDPOINT<<- ptlist
+}
+
+Makexybdy<- function(Np){
+ Eps0=10^(-4)
+ Xystr=XYZstr[1:2]
+ Umin=URNG[1]; Umax=URNG[2]
+ Vmin=VRNG[1]; Vmax=VRNG[2]
+ Cflg=0
+ EhL=list()
+ Tmp=grep("e",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ Tmp=grep("n",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Cflg>0){
+ Tmp1=Op(length(EhL),EhL)
+ Tmp=Joincrvs(Tmp1,Tmp)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ EhL=c(Tmp1,Tmp)
+ }else{
+ Cflg=0
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ }
+ Tmp=grep("w",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Cflg>0){
+ Tmp1=Op(length(EhL),EhL)
+ Tmp=Joincrvs(Tmp1,Tmp)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ EhL=c(Tmp1,list(Tmp))
+ }else{
+ Cflg=0
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ }
+ Tmp=grep("s",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:2){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]))
+ Tmp=Paramplot(Tmp1,Tmp2,Tmp3)
+ if(Cflg>0){
+ Tmp1=Op(length(EhL),EhL)
+ Tmp=Joincrvs(Tmp1,Tmp)
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ }
+ Tmp1=EhL[Looprange(1,length(EhL)-1)]
+ EhL=c(Tmp1,list(Tmp))
+ }else{
+ Cflg=0
+ if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){
+ Cflg=1
+ Tmp[Length(Tmp),]=Tmp[1,]
+ }
+ EhL=c(EhL,list(Tmp))
+ }
+ }
+ return(EhL)
+}
+
+Partitionseg<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fig=varargin[[1]]
+ GL=varargin[[2]]; N=3
+ if(!is.list(GL)){GL=list(GL)} #18.02.21
+ Eps0=10^(-4)
+ Eps1=0.01
+ if(Nargs>2){
+ Eps1=varargin[[3]]
+ }
+ Eps2=0.1
+ if(Nargs>3){
+ Eps2=varargin[[4]]
+ }
+ if(Nargs>4){
+ Ns=varargin[[5]]
+ if(Ns>0){#18.02.21from
+ Other=Op(Ns,OTHERPARTITION)
+ }else{
+ Other=c()
+ }#18.02.21until
+ }else{
+ Ns=1
+ Other=c()
+ }
+ Npt=Length(Fig)
+ ParL=c(1,Npt,Other)
+ for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21
+ G=Op(N,GL)
+ KouL=IntersectcurvesPp(Fig,G,Eps1,Eps2)
+ Tmp1=c(); Tmp2=c()
+ for(jj in Looprange(1,length(KouL))){
+ tmp=Op(2,KouL[[jj]])
+ if((tmp>1+Eps0)&&(tmp<Npt-Eps0)){
+ Tmp1=c(Tmp1,tmp)
+ }
+ tmp=Op(3,KouL[[jj]])
+ if((tmp>1+Eps0)&&(tmp<Length(G)-Eps0)){
+ Tmp2=c(Tmp2,tmp)
+ }
+ }
+ ParL=c(ParL,Tmp1)
+ if((Ns>0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21
+ tmp=OTHERPARTITION[[N]]
+ OTHERPARTITION[[N]]<<- c(tmp,Tmp2)
+ }
+ }
+ tmp1=sort(ParL)
+ ParL=c()
+ tmp2=-1
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=Op(jj,tmp1)
+ if(abs(tmp-tmp2)>Eps1){
+ ParL=c(ParL,tmp)
+ tmp2=tmp
+ }
+ }
+ return(ParL)
+}
+
+Evlptablepara<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Tmp=varargin[[1]]
+ Mdv=50
+ Ndv=50
+ if(Nargs>=2){
+ Tmp=varargin[[2]]
+ if(is.list(Tmp)){Tmp=Op(1,Tmp)}
+ if(length(Tmp)>1){
+ Mdv=Tmp[1]
+ Ndv=Tmp[2]
+ }else{
+ Mdv=Tmp
+ if(Nargs==2){
+ Ndv=Mdv
+ }else{
+ Tmp1=varargin[[3]]
+ if((is.numeric(Tmp1)) && (length(Tmp1)==1)){
+ Ndv=Tmp1
+ }else{
+ Ndv=Mdv
+ }
+ }
+ }
+ }
+ U1=URNG[1]; U2=URNG[2]
+ V1=VRNG[1]; V2=VRNG[2]
+ Du=(U2-U1)/(Mdv)
+ Dv=(V2-V1)/(Ndv)
+ sph=sprintf("%7.7f",sin(PHI))
+ cph=sprintf("%7.7f",cos(PHI))
+ sth=sprintf("%7.7f",sin(THETA))
+ cth=sprintf("%7.7f",cos(THETA))
+ xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="")
+ tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="")
+ ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="")
+ dxu=Diff(xstr,UNAME)
+ dxv=Diff(xstr,VNAME)
+ dyu=Diff(ystr,UNAME)
+ dyv=Diff(ystr,VNAME)
+ I=1
+ Zval=c()
+ for(jj in 1:(Ndv+1)){
+ v=V1+(jj-1)*Dv
+ ZuL=c()
+ for(ii in 1:(Mdv+1)){
+ u=U1+(ii-1)*Du
+ tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="")
+ tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="")
+ Dxu=Funvalue(dxu,tmp1,tmp2)
+ Dxv=Funvalue(dxv,tmp1,tmp2)
+ Dyu=Funvalue(dyu,tmp1,tmp2)
+ Dyv=Funvalue(dyv,tmp1,tmp2)
+ Tmp=Dxu*Dyv-Dxv*Dyu
+ ZuL=c(ZuL,Tmp)
+ }
+ Zval=Appendrow(Zval,ZuL)
+ }
+ Yval=c()
+ for(jj in 1:(Ndv+1)){
+ v=V1+(jj-1)*Dv
+ Yval=c(Yval,v)
+ }
+ Xval=c()
+ for(ii in 1:(Mdv+1)){
+ u=U1+(ii-1)*Du
+ Xval=c(Xval,u)
+ }
+ return(list(Zval,Xval,Yval))
+}
+
+Evlpfun<- function(u,v){
+ tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="")
+ tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="")
+ Dxu=Funvalue(dxu,tmp1,tmp2)
+ Dxv=Funvalue(dxv,tmp1,tmp2)
+ Dyu=Funvalue(dyu,tmp1,tmp2)
+ Dyv=Funvalue(dyv,tmp1,tmp2)
+ Tmp=Dxu*Dyv-Dxv*Dyu
+ return(Tmp)
+}
+
+Envelopedata<- function(...){
+ varargin=list(...)
+ Eps0=10^(-4)
+ Nargs=length(varargin)
+ Fd=varargin[[1]]
+ Fullformfunc(Fd)
+ Mdv=50
+ Ndv=50
+ if(Nargs>=2){
+ Tmp=varargin[[2]]
+ if(is.list(Tmp)){Tmp=Op(1,Tmp)}
+ if(length(Tmp)>1){
+ Mdv=Tmp[1]
+ Ndv=Tmp[2]
+ }else{
+ Mdv=Tmp
+ if(Nargs==2){
+ Ndv=Mdv
+ }else{
+ Tmp1=varargin[[3]]
+ if((is.numeric(Tmp1)) && (length(Tmp1)==1)){
+ Ndv=Tmp1
+ }else{
+ Ndv=Mdv
+ }
+ }
+ }
+ }
+ sph=sprintf("%7.7f",sin(PHI))
+ cph=sprintf("%7.7f",cos(PHI))
+ sth=sprintf("%7.7f",sin(THETA))
+ cth=sprintf("%7.7f",cos(THETA))
+ xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="")
+ tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="")
+ ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="")
+ dxu<<- Diff(xstr,UNAME)
+ dxv<<- Diff(xstr,VNAME)
+ dyu<<- Diff(ystr,UNAME)
+ dyv<<- Diff(ystr,VNAME)
+ U1=URNG[1]; U2=URNG[2]
+ V1=VRNG[1]; V2=VRNG[2]
+ Du=(U2-U1)/Mdv
+ Dv=(V2-V1)/Ndv
+ Out=c()
+ for(J in 1:(Ndv)){
+ Vval1=VRNG[1]+(J-1)*Dv
+ Vval2=VRNG[1]+J*Dv
+ Uval1=URNG[1]
+ Eval11=Evlpfun(Uval1,Vval1)
+ Eval12=Evlpfun(Uval1,Vval2)
+ for(I in 1:(Mdv)){
+# Uval1=URNG[1]+(I-1)*Du
+ Uval2=URNG[1]+I*Du
+# Eval11=Evlpfun(Uval1,Vval1)
+# Eval12=Evlpfun(Uval1,Vval2)
+ Eval21=Evlpfun(Uval2,Vval1)
+ Eval22=Evlpfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ if(abs(VL[K])<=Eps0){
+ QL=Appendrow(QL,PL[K,])
+ }else if(VL[K]>Eps0){
+ if(VL[K+1]< -Eps0){
+ Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,])
+ QL=Appendrow(QL,Tmp)
+ }
+ }else{
+ if(VL[K+1]>Eps0){
+ Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,])
+ QL=Appendrow(QL,Tmp)
+ }
+ }
+ }
+ Uval1=Uval2
+ Eval11=Eval21
+ Eval12=Eval22
+ if(Length(QL)==2){
+ Out=Appendrow(Out,c(Inf,Inf))
+ Out=Appendrow(Out,QL)
+ }
+ }
+ }
+ Out=Out[2:nrow(Out),]
+ if(Length(Out)>0){
+ Out=Connectseg(Out)
+ }else{
+ Out=c()
+ }
+ return(Out)
+}
+
+Dropnumlistcrv<- function(QdL,Eps1){
+ Eps0=10^(-4)
+ if(!is.list(QdL)){
+ PdL=list(QdL)
+ }else{
+ PdL=QdL
+ }
+ OutL=list()
+ for(I in Looprange(1,length(PdL))){
+ Pd=Op(I,PdL)
+ PtL=c(1)
+ P=Op(1,Pd)
+ for(K in Looprange(2,Length(Pd)-1)){
+ if(Norm(P-Op(K,Pd))>Eps1){
+ PtL=c(PtL,K)
+ P=Op(K,Pd)
+ }
+ }
+ K=Length(Pd)
+ if(Norm(P-Op(K,Pd))>Eps1){ #18.02.12 eps
+ PtL=c(PtL,K)
+ }
+# if(length(PtL)==1){ #180306
+# }
+ OutL=c(OutL,list(PtL))
+ }
+ return(OutL)
+}
+
+Cuspsplitpara<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin);
+ Gdxy=varargin[[1]]
+ if(!is.list(Gdxy)){
+ Gdxy=list(Gdxy)
+ }
+ Eps0=10^(-4)
+ Eps1=0.01
+ if(Nargs>2){Eps1=varargin[[2]]}
+ N=2
+ CUSPSPLITPT<<- list()
+ OutkL=list()
+ for(Ng in Looprange(1,length(Gdxy))){
+ PtxyL=Op(Ng,Gdxy)
+ PtkL=c()
+ PthL=c()
+ for(I in Looprange(1,Length(PtxyL))){
+ Tmp=Op(I,PtxyL)
+ Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="")
+ eval(parse(text=Tmp1))
+ Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="")
+ eval(parse(text=Tmp1))
+ Tmp2=c(eval(parse(text=XYZstr[1])))
+ Tmp2=c(Tmp2,eval(parse(text=XYZstr[2])))
+ Tmp2=c(Tmp2,eval(parse(text=XYZstr[3])))
+ Tmp3=Parapt(Tmp2)
+ if(I==1){
+ PtkL=matrix(Tmp2,nrow=1)
+ PthL=matrix(Tmp3,nrow=1)
+ }else{
+ Tmp4=Op(Length(PthL),PthL)
+ if(Norm(Tmp3-Tmp4)>Eps0){
+ PtkL=Appendrow(PtkL,Tmp2)
+ PthL=Appendrow(PthL,Tmp3)
+ }
+ }
+ }
+ if(Length(PthL)==0){
+ return(list())
+ }
+ Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL)
+ Cflg=0
+ if(Norm(Ps-Pe)<Eps1){Cflg=1}
+ CuspL=c()
+ Cva=cos(10*pi/180)
+ for(I in Looprange(1,Length(PthL)-1)){
+ if(Length(PthL)==2){break}
+ Tmp=Op(I,PthL)
+ if(I==1){
+ if(Cflg==0){next}
+ Tmp1=Op(Length(PthL)-1,PthL)
+ }else{
+ Tmp1=Op(I-1,PthL)
+ }
+ Tmp2=Op(I+1,PthL)
+ V1=Tmp-Tmp1
+ V2=Tmp2-Tmp
+ Tmp3=Dotprod(V1,V2)/(Norm(V1)*Norm(V2))
+ Cuspflg=0
+ if(Tmp3<Cva){
+ P=Op(I,PthL)
+ Kaku=acos(Tmp3)*180/pi
+ if(Crossprod(V1,V2)<0){
+ Kaku=-Kaku
+ }
+ Cuspflg=0
+ for(J in Looprange(I+1,Length(PthL)-1)){
+ if(abs(Kaku)>90){
+ Cuspflg=1
+ break
+ }
+ Q=Op(J,PthL)
+ if(Norm(P-Q)>Eps1){
+ break
+ }
+ V1=Q-Op(J-1,PthL)
+ V2=Op(J+1,PthL)-Q
+ Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2))
+ Tmp=acos(Tmp3)*180/pi
+ if(Crossprod(V1,V2)<0){
+ Tmp=-Tmp
+ }
+ Kaku=Kaku+Tmp
+ }
+ if(Cuspflg==1){
+ Tmp=trunc((I+J)*0.5)
+ I=J
+ if(length(CuspL)==0){
+ CuspL=c(Tmp)
+ }else{
+ CuspL=c(CuspL,Tmp)
+ }
+ }
+ }
+ }
+ if(Cflg==0){
+ CuspL=c(1,CuspL,Length(PthL))
+ }else if(length(CuspL)==0){
+ CuspL=c(1,Length(PthL))
+ }else if(Op(1,CuspL)==1){
+ CuspL=c(CuspL,Length(PthL))
+ }else{
+ Tmp=Op(1,CuspL)
+ Tmp1=PthL[Tmp:Length(PthL),]
+ Tmp2=PthL[2:Tmp,]
+ PthL=Appendrow(Tmp1,Tmp2)
+ Tmp1=PtkL[Tmp:Length(PthL),]
+ Tmp2=PtkL[2:Tmp,]
+ PtkL=Appendrow(Tmp1,Tmp2)
+ CuspL=CuspL-Tmp+1
+ CuspL=c(CuspL,Length(PthL))
+ }
+ if(length(CuspL)==2){
+ Tmp4=PthL[Length(PthL),]
+ if(Length(PtkL)>=2){
+ CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4))
+ OutkL=c(OutkL,list(PtkL))
+ }
+ next
+ }
+ Outk=list()
+ Is=1
+ for(I in Looprange(1,length(CuspL)-1)){
+ Tmp1=CuspL[Is]; Tmp2=CuspL[I+1]
+ Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL)
+ if(Norm(Tmp3-Tmp4)>Eps1){
+ Tmpk=PtkL[Tmp1:Tmp2,]
+ Outk=c(Outk,list(Tmpk))
+ CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4))
+ Is=I+1
+ }
+ }
+ OutkL=c(OutkL,Outk)
+ }
+ Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps1*0.5)
+ Tmp=list()
+ for(I in Looprange(1,length(OutkL))){
+ Tmp2=Op(I,OutkL)
+ Tmp3=Op(I,Tmp1)
+ Tmp4=c()
+ for(J in Looprange(1,Length(Tmp3))){
+ Tmp5=Op(Tmp3[J],Tmp2)
+ Tmp4=Appendrow(Tmp4,Tmp5)
+ }
+ if(Length(Tmp4)>0){
+ Tmp=c(Tmp,list(Tmp4))
+ }
+ }
+ return(Tmp)
+}
+
+PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps1,Eps2){
+ Eps0=10^(-4)
+ Out=c()
+ Vec=1/Norm(Vec)*Vec
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ Tmp=paste("Eqfun<- function(U,V){",sep='')
+ if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){
+ Vstr=sprintf("%6.6f",Vec)
+ Pstr=sprintf("%6.6f",PtA)
+ Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='')
+ Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='')
+ }else{
+ Tmp=paste(Tmp,"Xfunc(U,V)}",sep='')
+ }
+ eval(parse(text=Tmp))
+ Dx=(URNG[2]-URNG[1])/Np[1]
+ Dy=(VRNG[2]-VRNG[1])/Np[2]
+ for(J in Looprange(1,Np[2])){ #180227
+ Vval1=VRNG[1]+(J-1)*Dy
+ Vval2=VRNG[1]+J*Dy
+ Uval1=URNG[1] #180306(3lines)
+ Eval11=Eqfun(Uval1,Vval1)
+ Eval12=Eqfun(Uval1,Vval2)
+ Uval1=URNG[1] #180305(3lines)
+ for(I in Looprange(1,Np[1])){ #180227
+# Uval1=URNG[1]+(I-1)*Dx
+ Uval2=URNG[1]+I*Dx
+# Eval11=Eqfun(Uval1,Vval1)
+# Eval12=Eqfun(Uval1,Vval2)
+ Eval21=Eqfun(Uval2,Vval1)
+ Eval22=Eqfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ P1=Op(K,PL); P2=Op(K+1,PL)
+ M1=Op(K,VL); M2=Op(K+1,VL)
+ if(abs(M1)<Eps0){
+ QL=Appendrow(QL,P1)
+ next
+ }
+ if(abs(M2)<Eps0){
+# QL=Appendrow(QL,P2)
+ next
+ }
+ if((M1> 0) && (M2> 0)){
+ next
+ }
+ if((M1< 0) && (M2< 0)){
+ next
+ }
+ Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
+ QL=Appendrow(QL,Tmp)
+ }
+ Uval1=Uval2 #180306(3lines)
+ Eval11=Eval21
+ Eval12=Eval22
+ if(Length(QL)==2){
+ Puv1=Op(1,QL); Puv2=Op(2,QL)
+ Tmp1=Op(1,Puv1)
+ Tmp2=Op(2,Puv1)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P1=c(Xv,Yv,Zv)
+ Tmp1=Op(1,Puv2)
+ Tmp2=Op(2,Puv2)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P2=c(Xv,Yv,Zv)
+ V1=Vec[1]; V2=Vec[2]; V3=Vec[3]
+ if(abs(V1)>Eps0){
+ M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3]
+ M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3]
+ }else if(abs(V2)>Eps0){
+ M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3]
+ M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3]
+ }else{
+ M1=PtA[2]-P1[2]
+ M2=PtA[2]-P2[2]
+ }
+ if(M1*M2>= 0){
+ if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
+ next
+ }
+ if(M1==0){
+ Pt=P1; Ptuv=Puv1
+ }else{
+ Pt=P2; Ptuv=Puv2
+ }
+ }else{
+ Pt=1/(M1-M2)*(-M2*P1+M1*P2)
+ Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2)
+ }
+ if(is.character(Uveq)){
+ Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='')
+ Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='')
+ Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE)
+ Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE)
+ Tmp=eval(parse(text=Tmp))
+ if(Tmp< -Eps0){
+ next
+ }
+ }
+ Tmp1=Crossprod(Pt-PtA,Vec)
+ if(Norm(Tmp1)<Eps1){ #18.02.19
+ if(Zparapt(Pt)>Zparapt(PtA)+Eps2){
+ return(list(1,Pt,Zparapt(Pt),Zparapt(PtA)))
+ }else{
+ Out=Appendrow(Out,Pt)
+ }
+ }
+ }
+ }
+ }
+ if(Length(Out)==0){
+ return(list(0,c()))
+ }
+ return(c(list(0,Out)))
+}
+
+Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps1,Eps2){
+ Eps0=10^(-4)
+ Fh=Projpara(Fk)
+ P1=Ptstart(Fh)
+ P2=Ptend(Fh)
+ Csp=CUSPPT
+ if(!is.list(Csp)){Csp=list(Csp)}
+ Cspflg=1
+ for(I in Looprange(1,length(Csp))){
+ Tmp=Op(I,Csp)
+ if(Norm(Tmp-P1)<Eps0){
+ if(Cspflg==1){Cspflg=2}
+ if(Cspflg==3){Cspflg=6}
+ next
+ }
+ if(Norm(Tmp-P2)<Eps0){
+ if(Cspflg==1){Cspflg=3}
+ if(Cspflg==2){Cspflg=6}
+ next
+ }
+ }
+ PaL=c()
+ tmp2=-1
+ for(jj in Looprange(1,length(Par)-1)){
+ tmp1=Op(jj,Par)
+ if(abs(tmp1-tmp2)>Eps0){ #180227
+ PaL=c(PaL,tmp1)
+ tmp2=tmp1
+ }
+ }
+ tmp1=PaL[length(PaL)] #18.02.26from
+ tmp2=Par[length(Par)]
+ if(abs(tmp1-tmp2)<Eps0){ #180227
+ PaL[length(PaL)]=tmp2
+ }else{
+ PaL=c(PaL,tmp2)
+ } #18.02.26until
+ SeL=c()
+ for(N in Looprange(1,length(PaL)-1)){
+ S=(PaL[N]+PaL[N+1])/2
+ Tmp=Invparapt(S,Fh,Fk)
+ PtA=Op(1,Tmp)
+ PtAp=Parapt(PtA)
+ Vec=c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA))
+ Flg=PthiddenQ(PtA,Vec,Uveq,Np,Eps1,Eps2)
+ if(Flg[[1]]==0){
+ SeL=c(SeL,N)
+ }
+ }
+ FigL=list()
+ FigkL=list()
+ for(I in Looprange(1,length(SeL))){
+ Tmp1=Pointoncurve(PaL[SeL[I]],Fh)
+ Tmp2=Pointoncurve(PaL[SeL[I]+1],Fh)
+ if(I==1){
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ if(Member(SeL[I]-1,SeL)){
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ FigL=c(FigL,list(Partcrv(SP,SQ,Fh)))
+ Tmp3=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp3)
+ Tmp3=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp3)
+ Tmp4=Partcrv3(TP,TQ,Fk)
+ FigkL=c(FigkL,list(Tmp4))
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }
+ }
+ }
+ if(length(SeL)>0){
+ if(Norm(P-Q)>Eps0){ #18.02.14
+ FigL=c(FigL,list(Partcrv(P,Q,Fh)))
+ Tmp3=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp3)
+ Tmp3=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp3)
+ FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk)))
+ }else{
+ FigL=c(FigL,list(Fh))
+ FigkL=c(FigkL,list(Fk))
+ }
+ }
+ Tmp=c()
+ for(I in Looprange(1,length(PaL)-1)){
+ if(!Member(I,SeL)){
+ Tmp=c(Tmp,I)
+ }
+ }
+ SeL=Tmp
+ HIDDENDATA<<- list()
+ for(I in Looprange(1,length(SeL))){
+ Tmp=PaL[SeL[I]]
+ Tmp1=Pointoncurve(Tmp,Fh)
+ Tmp=PaL[SeL[I]+1]
+ Tmp2=Pointoncurve(Tmp,Fh)
+ if(I==1){
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ if(Member(SeL[I]-1,SeL)){
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }else{
+ Tmp=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp)
+ Tmp=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp)
+ HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk)))
+ P=Tmp1; SP=PaL[SeL[I]]
+ Q=Tmp2; SQ=PaL[SeL[I]+1]
+ }
+ }
+ }
+ if(length(SeL)>0){
+ if(Norm(P-Q)>Eps0){ #18.02.14
+ Tmp=Invparapt(SP,Fh,Fk)
+ TP=Op(2,Tmp)
+ Tmp=Invparapt(SQ,Fh,Fk)
+ TQ=Op(2,Tmp)
+ HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk)))
+ }else{
+ HIDDENDATA<<- c(HIDDENDATA,list(Fk))
+ }
+ }
+ return(FigkL)
+}
+
+Borderparadata<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ FkL=varargin[[1]]
+ Np=c(50,50)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(2,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Umin=URNG[1]; Umax=URNG[2]
+ Vmin=VRNG[1]; Vmax=VRNG[2]
+ EkL=list()
+ Tmp=grep("e",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]),sep="")
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ Tmp=grep("n",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]),sep="")
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ Tmp=grep("w",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",VRNG)
+ Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[2]))
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ Tmp=grep("s",DRWS,fixed=TRUE)
+ if(length(Tmp)>0){
+ Tmp1="c("
+ for(jj in 1:3){
+ Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj])
+ Tmp1=paste(Tmp1,Tmp,",",sep="")
+ }
+ Tmp=substring(Tmp1,1,Length(Tmp1)-1)
+ Tmp1=paste(Tmp,")",sep="")
+ Tmp=sprintf("%6.6f",URNG)
+ Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='')
+ Tmp3=paste('N=',as.character(Np[1]))
+ Tmp=Spacecurve(Tmp1,Tmp2,Tmp3)
+ EkL=c(EkL,list(Tmp))
+ }
+ if(length(EkL)>0){
+ FkL=c(FkL,EkL)
+ }
+ Fall=Projpara(FkL)
+ if(is.numeric(Fall)){
+ Fall=list(Fall)
+ }
+ Fbdxy=Makexybdy(Np)
+ BORDERPT<<- list()
+ Tmp1=list()
+ for(I in Looprange(1,length(Fall))){
+ Tmp1=c(Tmp1,list(c()))
+ }
+ OTHERPARTITION<<- Tmp1
+ FsL=list()
+ BORDERHIDDENDATA<<- list()
+ starttime=proc.time()
+ for(I in Looprange(1,length(FkL))){
+ Tmp=Op(I,FkL)
+ Tmp=Projpara(Tmp)
+ Par=Partitionseg(Tmp,Fall,Eps1,Eps2,I)
+ Tmp1=Op(I,FkL)
+ Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps1,Eps2)
+ if(length(HIDDENDATA)>0){
+ BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA)
+ }
+ if(length(Tmp)>0){
+ FsL=c(FsL,Tmp)
+ }
+ Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='')
+ Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ }
+ return(FsL)
+}
+
+Sfbdparadata<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fd=varargin[[1]]
+ FdL=Fullformfunc(Fd)
+ Np=c(50,50)
+ Eps0=10^(-4)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(2,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ starttime=proc.time()
+# tmp=Evlptablepara(Np)
+# Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]]
+# Out3=Implicitplot(Zval,Xval,Yval)
+ Out3=Envelopedata(Fd) #180306
+ tmp3=list()
+ pts=list() #180306
+ for(jj in Looprange(1,length(Out3))){
+ tmp1=Op(jj,Out3)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ Nlist=Dropnumlistcrv(tmp2,Eps1)
+ Nlist=Nlist[[1]]
+ if(Length(Nlist)==1){ #180306from
+ tmp=Op(1,Nlist)
+ tmp=Op(tmp,tmp1)
+ pts=c(pts,list(tmp))
+# pts=c(pts,list(XYZfunc(tmp[1],tmp[2])))#180306until
+ }else{
+ tmp=c()
+ for(kk in Looprange(1,length(Nlist))){
+ tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18
+ }
+ if(Length(tmp)>0){
+ tmp3=c(tmp3,list(tmp))
+ }
+ }
+ }
+ Out3=tmp3
+ tmp3=pts #180306from
+ pts=list()
+ for(ii in Looprange(1,length(tmp3))){
+ tmp=Op(ii,tmp3)
+ tmp1=XYZfunc(tmp[1],tmp2[])
+ flg=0
+ for(jj in Looprange(1,length(pts))){
+ tmp=Op(jj,pts)
+ tmp2=XYZfunc(tmp[1],tmp2[])
+ if(Norm(tmp1-tmp2)<Eps1){
+ flg=1; break
+ }
+ }
+ if(flg==0){pts=c(pts,list(Op(ii,tmp3)))}
+ }
+ for(ii in Looprange(1,length(pts))){
+ tmp=Op(ii,pts)
+ tmp1=XYZfunc(tmp[1],tmp[2])
+ for(jj in Looprange(1,length(Out3))){
+ tmp2=Op(jj,Out3)
+ eps=1
+ for(kk in Looprange(1,Length(tmp2)-1)){
+ tmp=Op(kk,tmp2)
+ tmp1=XYZfunc(tmp[1],tmp[2])
+ tmp=Op(kk+1,tmp2)
+ tmp=XYZfunc(tmp[1],tmp[2])
+ eps=min(c(eps,Norm(tmp1-tmp)))
+ }
+ tmp=Ptstart(tmp2)
+ if(Norm(tmp1-XYZfunc(tmp[1],tmp[2]))<eps+Eps0){
+ Out3[[jj]]=Appendrow(Op(ii,pts),tmp2)
+ next
+ }
+ tmp=Ptend(tmp2)
+ if(Norm(tmp1-XYZfunc(tmp[1],tmp[2]))<eps+Eps0){
+ Out3[[jj]]=Appendrow(tmp2,Op(ii,pts))
+ next
+ }
+ }
+ } #180306until
+ IMPLICITDATA<<- Out3
+ Tmp=proc.time()-starttime
+ print(paste('ImplicitData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep=''))
+ starttime=proc.time()
+ Out4=Cuspsplitpara(Out3,Eps1)
+ CUSPDATA<<- Out4
+ CUSPPT<<- CUSPSPLITPT
+ Tmp=proc.time()-starttime
+ print(paste('CuspData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep=''))
+ Out5=Borderparadata(Out4,Np,Eps1,Eps2)
+ return(Out5)
+}
+
+Meetpoints<- function(PtA,PtB,Uveq,Np,Eps1){
+ Eps0=10^(-4)
+ Vec=PtB-PtA
+ if(Norm(Vec)<Eps0){return(list())} #18.02.24
+ Out=list()
+ Vec=1/Norm(Vec)*Vec
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ Tmp=paste("Eqfun<- function(U,V){",sep='')
+ if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){
+ Vstr=sprintf("%6.6f",Vec)
+ Pstr=sprintf("%6.6f",PtA)
+ Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='')
+ Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='')
+ }else{
+ Tmp=paste(Tmp,"Xfunc(U,V)}",sep='')
+ }
+ eval(parse(text=Tmp))
+ Dx=(URNG[2]-URNG[1])/Np[1]
+ Dy=(VRNG[2]-VRNG[1])/Np[2]
+ for(J in Looprange(1,Np[2])){
+ Vval1=VRNG[1]+(J-1)*Dy
+ Vval2=VRNG[1]+J*Dy
+ Uval1=URNG[1] #180305(3lines)
+ Eval11=Eqfun(Uval1,Vval1)
+ Eval12=Eqfun(Uval1,Vval2)
+ for(I in Looprange(1,Np[1])){
+# Uval1=URNG[1]+(I-1)*Dx
+ Uval2=URNG[1]+I*Dx
+# Eval11=Eqfun(Uval1,Vval1)
+# Eval12=Eqfun(Uval1,Vval2)
+ Eval21=Eqfun(Uval2,Vval1)
+ Eval22=Eqfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ P1=Op(K,PL); P2=Op(K+1,PL)
+ M1=Op(K,VL); M2=Op(K+1,VL)
+ if(abs(M1)<Eps0){
+ QL=Appendrow(QL,P1)
+ next
+ }
+ if(abs(M2)<Eps0){
+# QL=Appendrow(QL,P2)
+ next
+ }
+ if((M1> 0) && (M2> 0)){
+ next
+ }
+ if((M1< 0) && (M2< 0)){
+ next
+ }
+ Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
+ QL=Appendrow(QL,Tmp)
+ }
+ Uval1=Uval2 #180306(3lines)
+ Eval11=Eval21
+ Eval12=Eval22
+ if(Length(QL)==2){
+ Puv1=Op(1,QL); Puv2=Op(2,QL)
+ Tmp1=Op(1,Puv1)
+ Tmp2=Op(2,Puv1)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P1=c(Xv,Yv,Zv)
+ Tmp1=Op(1,Puv2)
+ Tmp2=Op(2,Puv2)
+ Xv=Xfunc(Tmp1,Tmp2)
+ Yv=Yfunc(Tmp1,Tmp2)
+ Zv=Zfunc(Tmp1,Tmp2)
+ P2=c(Xv,Yv,Zv)
+ V1=Vec[1]; V2=Vec[2]; V3=Vec[3]
+ if(abs(V1)>Eps0){
+ M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3]
+ M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3]
+ }else if(abs(V2)>Eps0){
+ M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3]
+ M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3]
+ }else{
+ M1=PtA[2]-P1[2]
+ M2=PtA[2]-P2[2]
+ }
+ if(M1*M2>= 0){ #18.02.21
+ if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
+ next
+ }
+ if(M1==0){
+ Pt=P1; Ptuv=Puv1
+ }else{
+ Pt=P2; Ptuv=Puv2
+ }
+ }else{
+ Pt=1/(M1-M2)*(-M2*P1+M1*P2)
+ Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2)
+ }
+ if(is.character(Uveq)){
+ Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='')
+ Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='')
+ Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE)
+ Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE)
+ Tmp=eval(parse(text=Tmp))
+ if(Tmp< -Eps0){
+ next
+ }
+ }
+ Tmp1=Crossprod(Pt-PtA,Vec)
+ if(Norm(Tmp1)<Eps1){ #18.02.19
+ Tmp1=Dotprod(Pt-PtA,Vec) #18.02.21
+ if((Tmp1>-Eps0)&&(Tmp1<Norm(PtB-PtA)+Eps0)){
+ Out=c(Out,list(Pt))
+ }
+ }
+ }
+ }
+ }
+ tmp1=Groupnearpt(Out,Eps1)
+ Out=list()
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=Op(jj,tmp1)
+ tmp=c(sum(tmp[,1]),sum(tmp[,2]),sum(tmp[,3]))/Length(tmp)
+ Out=c(Out,list(tmp))
+ }
+ return(Out)
+}
+
+Clipindomain<- function(ObjL,FigL){
+ Eps0=10^(-4)
+ Eps1=0.01
+ Eps2=0.05
+ Bdy=Kyoukai(FigL)
+ if(length(Bdy)>=2){
+ Fbdy=Joincrvs(FigL)
+ }else{
+ Fbdy=Op(1,FigL)
+ }
+ if(!is.list(ObjL)){
+ ObjL=list(ObjL)
+ }
+ if(!is.list(FigL)){
+ FigL=list(FigL)
+ }
+ OutL=list()
+ for(Nobj in Looprange(1,length(ObjL))){
+ Obj=Op(Nobj,ObjL)
+ ParL=c(1,Length(Obj))
+ Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2)
+ for(J in Looprange(1,length(Tmp))){
+ Tmp1=Op(J,Tmp)
+ ParL=c(ParL,Op(2,Tmp1))
+ }
+ ParL=sort(ParL)
+ Tmp=c(1)
+ for(I in Looprange(1,length(ParL))){
+ Tmp1=Op(length(Tmp),Tmp)
+ Tmp2=ParL[I]
+ if(Tmp2-Tmp1>Eps0){
+ Tmp=c(Tmp,Tmp2)
+ }
+ }
+ ParL=Tmp
+ Tmp1=Op(length(ParL),ParL)
+ Tmp2=Length(Obj)
+ if(abs(Tmp1-Tmp2)<Eps1){
+ ParL=c(ParL[Looprange(1,length(ParL)-1)],Tmp2)
+ }
+ Fig=list()
+ for(N in Looprange(1,length(ParL)-1)){
+ Tmp=(ParL[N]+ParL[N+1])*0.5
+ Tmp=Pointoncurve(Tmp,Obj)
+ Tmp=Naigai(Tmp,Bdy)
+ Tmp1=sum(Tmp)%%2
+ if(Tmp1==0){
+ next
+ }
+ Fig=c(Fig,list(Partcrv(ParL[N],ParL[N+1],Obj)))
+ }
+ OutL=c(OutL,Fig)
+ }
+ return(OutL)
+}
+
+Crvsfparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Sepflg=0
+ Tmp=varargin[[Nargs]]
+ if((is.numeric(Tmp))&&(Tmp<=0)){
+ Sepflg=1
+ Nargs=Nargs-1
+ }
+ Fk=varargin[[1]]
+ if(!is.list(Fk)){
+ FkL=list(Fk)
+ }else{
+ FkL=Fk
+ }
+ Fbdy=Projpara(varargin[[2]])
+ Fd=varargin[[3]];
+ Fullformfunc(Fd) #18.02.17
+ Np=c(50,50)
+ Eps0=10^(-4)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Out=list()
+ CRVSFHIDDENDATA<<- list()
+ for(Nn in Looprange(1,length(FkL))){
+ Fk=Op(Nn,FkL)
+ Tmp=Projpara(Fk)
+ Par=Partitionseg(Tmp,Fbdy,Eps1,Eps2,0)
+ if(Sepflg==0){
+ for(I in Looprange(1,Length(Fk)-1)){
+ Pa=Op(I,Fk)
+ Pb=Op(I+1,Fk)
+ PtL=Meetpoints(Pa,Pb,1,Np,Eps1)
+ for(J in Looprange(1,Length(PtL))){
+ Tmp=Op(J,PtL)
+ Tmp=Parapt(Tmp)
+ Tmp1=Paramoncurve(Tmp,I,Projpara(Fk))
+ Tmp2=min(abs(Par-Tmp1))
+ if(Tmp2*Norm(Parapt(Pb-Pa))>Eps0) { #180227
+ Par=c(Par,Tmp1)
+ }
+ }
+ Par=sort(Par)
+ }
+ }
+ for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from
+ tmp=Parapt(Op(jj,ADDPOINT))
+ tmp=Nearestpt(tmp,Projpara(Fk))
+ if(tmp[[3]]<Eps1){
+ Par=c(Par,tmp[[2]])
+ }
+ } #18.02.19until
+ tmp1=sort(Par)
+ Par=c()
+ tmp2=-1
+ for(jj in Looprange(1,length(tmp1))){
+ tmp=Op(jj,tmp1)
+ if(abs(tmp-tmp2)>Eps0){ #180227
+ Par=c(Par,tmp)
+ tmp2=tmp
+ }
+ }
+ Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps1,Eps2)
+ Out=c(Out,Tmp1)
+ CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA)
+ Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='')
+ Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ }
+ return(Out)
+}
+
+Crv3onsfparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fk=varargin[[1]]
+ if(!is.list(Fk)){
+ FkL=list(Fk)
+ }else{
+ FkL=Fk
+ }
+ Fbdy=Projpara(varargin[[2]])
+ Fd=varargin[[3]]
+ Fullformfunc(Fd) #18.02.17
+ Np=c(50,50)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Out=list()
+ CRVONSFHIDDENDATA<<- list()
+ for(Nn in Looprange(1,length(FkL))){
+ Fk=Op(Nn,FkL)
+ Tmp=Projpara(Fk)
+ Par=Partitionseg(Tmp,Fbdy,Eps1,Eps2,0)
+ for(jj in Looprange(1,length(ADDPOINT))){
+ tmp=Parapt(Op(jj,ADDPOINT))
+ tmp=Nearestpt(tmp,Projpara(Fk))
+ if(tmp[[3]]<Eps1){
+ Par=c(Par,tmp[[2]])
+ }
+ }
+ Par=sort(Par)
+ Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps1,Eps2)
+ Out=c(Out,Tmp1)
+ CRVONSFHIDDENDATA<<- c(CRVONSFHIDDENDATA,HIDDENDATA)
+ Tmp=paste('Crvonsfdata',formatC(Nn,width=2,flag="0"),'/',sep='')
+ Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ }
+ return(Out)
+}
+
+Crvonsfparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fuv=varargin[[1]]
+ Fbdy3=varargin[[2]]
+ Fd=varargin[[3]]
+ Fullformfunc(Fd)
+ if(!is.list(Fuv)){
+ Fuv=list(Fuv)
+ }
+ FkL=list()
+ for(jj in Looprange(1,length(Fuv))){
+ tmp1=Op(jj,Fuv)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ FkL=c(FkL,list(tmp2))
+ }
+ Np=c(50,50)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2)
+ return(Out)
+}
+
+Wireparadata<- function(...){
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ Fbdy3=varargin[[1]]
+ Fd=varargin[[2]]
+ FdL=Fullformfunc(Fd)
+ DuL=varargin[[3]]
+ DvL=varargin[[4]]
+ Np=c(50,50)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(5,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ if(is.numeric(DuL)){
+ tmp1=DuL
+ DuL=list()
+ for(jj in Looprange(1,tmp1)){
+ tmp=jj*(URNG[2]-URNG[1])/(tmp1+1)
+ DuL=c(DuL,list(tmp))
+ }
+ }
+ if(is.numeric(DvL)){
+ tmp1=DvL
+ DvL=list()
+ for(jj in Looprange(1,tmp1)){
+ tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1)
+ DvL=c(DvL,list(tmp))
+ }
+ }
+ Fuv=list()
+ for(jj in Looprange(1,length(DuL))){
+ tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="")
+ tmp2=paste("N=",as.character(Np[2]),sep="")
+ tmp1=Paramplot(tmp1,Op(6,FdL),tmp2)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,tmp)
+ }
+ Fuv=c(Fuv,list(tmp2))
+ }
+ FkL=list()
+ for(jj in Looprange(1,length(Fuv))){
+ tmp1=Op(jj,Fuv)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ FkL=c(FkL,list(tmp2))
+ }
+ Tmp1=proc.time()-starttime
+ cat(UNAME,"direction started","\n")
+ Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2)
+ WIREHIDDENDATA<<- CRVONSFHIDDENDATA
+ Fuv=list()
+ for(jj in Looprange(1,length(DvL))){
+ tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="")
+ tmp2=paste("N=",as.character(Np[2]),sep="")
+ tmp1=Paramplot(tmp1,Op(5,FdL),tmp2)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,tmp)
+ }
+ Fuv=c(Fuv,list(tmp2))
+ }
+ FkL=list()
+ for(jj in Looprange(1,length(Fuv))){
+ tmp1=Op(jj,Fuv)
+ tmp2=c()
+ for(kk in Looprange(1,Length(tmp1))){
+ tmp=Op(kk,tmp1)
+ tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2]))
+ }
+ FkL=c(FkL,list(tmp2))
+ }
+ cat(VNAME,"direction started","\n")
+ Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2)
+ WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA)
+ Out=c(Out1,Out2)
+ return(Out)
+}
+
+Intersectcrvsf<- function(...){
+ # bdyeq is the equation of boundary f(x,y,z) =0
+ starttime=proc.time()
+ varargin=list(...)
+ Nargs=length(varargin)
+ crv=varargin[[1]]
+ Fd=varargin[[2]]
+ Fullformfunc(Fd)
+ bdyflg=0
+ bdyeq=varargin[[Nargs]]
+ if(is.character(bdyeq)){
+ Nargs=Nargs-1
+ bdyflg=1
+ tmp=strsplit(bdyeq,"=",fixed=TRUE)
+ tmp=tmp[[1]]
+ if(length(tmp)>1){
+ bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="")
+ }
+ tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="")
+ eval(parse(text=tmp))
+ }
+ Eps0=10^(-4)
+ Np=c(50,50)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(3,Nargs)){
+ tmp=varargin[[jj]]
+ if((length(tmp)>1)||(tmp>1)){
+ Np=tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=tmp}
+ if(ctr==2){Eps2=tmp}
+ }
+ }
+ PtL=list()
+ for(I in Looprange(1,Length(crv)-1)){
+ Pa=Op(I,crv)
+ Pb=Op(I+1,crv)
+ if(bdyflg==0){
+ tmp=Meetpoints(Pa,Pb,1,Np,Eps1)
+ }else{
+ M1=bdyeq(Pa); M2=bdyeq(Pb)
+ if(M1*M2>= 0){ #18.02.21
+ if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){
+ next
+ }
+ if(M1==0){
+ tmp=list(Pa)
+ }else{
+ tmp=list(Pb)
+ }
+ }else{
+ while(Norm(Pb-Pa)>Eps0){
+ if(bdyeq(Pa)==0){
+ tmp=list(Pa)
+ break
+ }
+ if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){
+ Pa=(Pa+Pb)/2
+ }else{
+ Pb=(Pa+Pb)/2
+ }
+ }
+ tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb))
+ }
+ }
+ PtL=c(PtL,tmp)
+ }
+ Tmp=paste('Intersectcrvsf obtained : Time =',sep='')
+ Tmp1=proc.time()-starttime
+ print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep=''))
+ return(PtL)
+}
+
+Sfcutparadata<- function(...){
+ varargin=list(...)
+ Nargs=length(varargin)
+ CutD=varargin[[1]]
+ Fbdy3=varargin[[2]]
+ Fd=varargin[[3]]
+ FdL=Fullformfunc(Fd)
+ Np=c(50,50)
+ Eps0=10^(-4)
+ Eps1=0.01
+ Eps2=0.05
+ ctr=0
+ for(jj in Looprange(4,Nargs)){
+ Tmp=varargin[[jj]]
+ if((length(Tmp)>1)||(Tmp>1)){
+ Np=Tmp
+ if(length(Np)==1){
+ Np=c(Np,Np)
+ }
+ }else{
+ ctr=ctr+1
+ if(ctr==1){Eps1=Tmp}
+ if(ctr==2){Eps2=Tmp}
+ }
+ }
+ starttime=proc.time()
+ Tmp=strsplit(CutD,'=')
+ Tmp=Tmp[[1]]
+ if(length(Tmp)==1){
+ Eq=CutD
+ }else{
+ Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="")
+ }
+ Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE)
+ Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE)
+ Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE)
+ Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="")
+ eval(parse(text=Tmp))
+ Du=(URNG[2]-URNG[1])/Np[1]
+ Dv=(VRNG[2]-VRNG[1])/Np[2]
+ Out=list();Out2=list()
+ for(J in Looprange(1,Np[2])){
+ Vval1=VRNG[1]+(J-1)*Dv
+ Vval2=VRNG[1]+J*Dv
+ Uval1=URNG[1] #180305(3lines)
+ Eval11=Eqfun(Uval1,Vval1)
+ Eval12=Eqfun(Uval1,Vval2)
+ for(I in Looprange(1,Np[1])){
+# Uval1=URNG[1]+(I-1)*Du
+ Uval2=URNG[1]+I*Du
+# Eval11=Eqfun(Uval1,Vval1)
+# Eval12=Eqfun(Uval1,Vval2)
+ Eval21=Eqfun(Uval2,Vval1)
+ Eval22=Eqfun(Uval2,Vval2)
+ a1=Uval1;b1=Vval1;c1=Eval11
+ a2=Uval2;b2=Vval1;c2=Eval21
+ a3=Uval2;b3=Vval2;c3=Eval22
+ a4=Uval1;b4=Vval2;c4=Eval12
+ PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE)
+ VL=c(c1,c2,c3,c4,c1)
+ QL=c()
+ for(K in 1:4){
+ P1=Op(K,PL); P2=Op(K+1,PL)
+ M1=Op(K,VL); M2=Op(K+1,VL)
+ if(abs(M1)<Eps0){
+ QL=Appendrow(QL,P1)
+ next
+ }
+ if(abs(M2)<Eps0){
+# QL=Appendrow(QL,P2)
+ next
+ }
+ if((M1> 0) && (M2> 0)){
+ next
+ }
+ if((M1< 0) && (M2< 0)){
+ next
+ }
+ Tmp=1/(M1-M2)*(-M2*P1+M1*P2)
+ QL=Appendrow(QL,Tmp)
+ }
+ Uval1=Uval2 #180306(3lines)
+ Eval11=Eval21
+ Eval12=Eval22
+ if(Length(QL)==2){
+ q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2]
+ if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){
+ if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){
+ Out2=c(Out2,list(QL))
+ }else{
+ Out=c(Out,list(QL))
+ }
+ next
+ }
+ if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){
+ if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){
+ Out2=c(Out2,list(QL))
+ }else{
+ Out=c(Out,list(QL))
+ }
+ next
+ }
+ Out=c(Out,list(QL))
+ }
+ }
+ }
+ while(length(Out2)>0){
+ tmp1=Out2[[1]]
+ Out=c(Out,list(tmp1))
+ Out2=Out2[-1]
+ rmv=c()
+ for(jj in Looprange(1,length(Out2))){
+ tmp2=Out2[[jj]]
+ diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,])
+ diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,])
+ if((diff1<Eps0)||(diff2<Eps0)){
+ rmv=c(rmv,jj)
+ next
+ }
+ }
+ Out2=Out2[-rmv]
+ }
+ Out=Connectseg(Out,Eps1)
+ Tmp1=Out
+ Out=list()
+ for(ii in Looprange(1,length(Tmp1))){
+ Tmp2=Op(ii,Tmp1)
+ Tmp3=c()
+ for(jj in Looprange(1,Length(Tmp2))){
+ Tmp=Op(jj,Tmp2)
+ Tmp=XYZfunc(Tmp[1],Tmp[2])
+ if(Length(Tmp3)>0){
+ if(Norm(Op(Length(Tmp3),Tmp3)-Tmp)<Eps1){next}
+ }
+ Tmp3=Appendrow(Tmp3,Tmp)
+ }
+ Out=c(Out,list(Tmp3))
+ }
+ Out=Crv3onsfparadata(Out,Fbdy3,Fd,Np,Eps1,Eps2)
+ return(Out)
+}
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r
new file mode 100644
index 00000000..37033948
--- /dev/null
+++ b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r
@@ -0,0 +1,580 @@
+# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
+#
+#This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>
+
+
+#########################################
+
+ThisVersion<- "2ev5_2_3(17.10.28)"
+
+# 2017.10.28
+# Drwpt debugged ( Flattenlist )
+# 2017.10.07
+#
+
+#############################################
+
+Dottedline<- function(...)
+{
+ varargin <- list(...)
+ Nall <- length(varargin)
+ Nagasa <- 0.1
+ Ookisa <- PenThick*2 #17.10.07
+ I <- Nall
+ Tmp <- varargin[[I]]
+ while (mode(Tmp)=="numeric" && length(Tmp)==1 ) {
+ I <- I-1
+ Tmp <- varargin[[I]]
+ }
+ if (I==Nall-1) {
+ Nagasa<-Nagasa*varargin[[Nall]]
+ Nall <- Nall-1
+ }
+ if (I==Nall-2) {
+ Nagasa <- Nagasa*varargin[[Nall-1]]
+ Ookisa <- round(Ookisa*varargin[[Nall]])
+ Nall <- Nall-2
+ }
+ Nagasa <- 1000/2.54/MilliIn*Nagasa
+ Ra=Ookisa/MilliIn
+ for (N in 1:Nall) {
+ Pdata <- varargin[[N]]
+ if (mode(Pdata)=="numeric") {
+ Pdata <- list(Pdata)
+ }
+ for (II in 1:length(Pdata)) {
+ Clist <- MakeCurves(Op(II,Pdata))
+ DinM <- Dataindex(Clist)
+ Mojisu=0
+ for (n in Looprange(1,Nrow(DinM))) {
+ Tmp <- DinM[n,]
+ Data <- Clist[Tmp[1]:Tmp[2],]
+ Len <- 0
+ Lenlist <- c(0)
+ for (I in Looprange(2,Nrow(Data))) {
+ Len <- Len+Norm(Data[I,]-Data[I-1,])
+ Lenlist <- c(Lenlist,Len)
+ }
+ Lenall <- Lenlist[length(Lenlist)]
+ if (Lenall==0) {
+ next
+ }
+ Naga <- Nagasa
+ Nten <- round(Lenall/Naga)+1
+ if (Nten > 1) {
+ Seg <- Lenall/(Nten-1)
+ }
+ else {
+ Seg <- Lenall
+ }
+ Eps <- 10^(-6)*Seg
+ PPd<-c()
+ Hajime <- 1
+ for (I in Looprange(0,Nten-1)) {
+ Len <- Seg*I
+ if (I>0) {
+ J <- Hajime
+ while( Len>=Lenlist[J]+Eps) {
+ J <- J+1
+ }
+ Hajime <- J-1
+ }
+ T <- (Len-Lenlist[Hajime])/
+ (Lenlist[Hajime+1]-Lenlist[Hajime])
+ P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,])
+ PPd<-Appendrow(PPd,P)
+ if (I==Nten-1) {
+ if (Norm(P-Data[1,])<Eps) {
+ next
+ }
+ }
+ }
+ for (I in Looprange(1,Nrow(PPd))){
+ P<- Op(I,PPd)
+ if (Nrow(PPd)==1){
+ V<- c(1,0)
+ }
+ else if (I==1){
+ Tmp<- Op(I+1,PPd)-P
+ V<- 1/Norm(Tmp)*Tmp
+ }
+ else if (I==Nrow(PPd)){
+ Tmp<- P-Op(I-1,PPd)
+ V<- 1/Norm(Tmp)*Tmp
+ }
+ else{
+ Tmp1<- Op(I+1,PPd)-P
+ Tmp2<- P-Op(I-1,PPd)
+ Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2
+ V<- 1/Norm(Tmp3)*Tmp3
+ }
+ X=sprintf('%5.5f',P[1])
+ Y=sprintf('%5.5f',P[2])
+ Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu=Mojisu+nchar(Str)
+ if(Mojisu>80){
+ cat("\n",file=Wfile,append=TRUE)
+ Mojisu=0
+ }
+ }
+ }
+ }
+ if(Mojisu>0){
+ cat("\n",file=Wfile,append=TRUE)
+ }
+ }
+ Tmp<-PenThick/PenThickInit
+ Setpen(Tmp)
+}
+
+
+###########################################
+
+Drwline<-function(...)
+{
+ varargin<-list(...)
+ Nall<-length(varargin)
+ Thick<-0
+ Tmp<-varargin[[Nall]]
+ if (mode(Tmp)=="numeric" && length(Tmp)==1){
+ Setpen(Tmp)
+ Nall<-Nall-1
+ }
+ for (N in 1:Nall){
+ Pdata<-varargin[[N]]
+ if (length(Pdata)==0) next
+ if (mode(Pdata)!="list") Pdata<-list(Pdata)
+ while(Mixtype(Pdata)==3){
+ Tmp1<- list()
+ for(II in Looprange(1,length(Pdata))){
+ Tmp1<- Mixjoin(Tmp1,Pdata[[II]])
+ }
+ Pdata<- Tmp1
+ }
+ for (II in Looprange(1,length(Pdata))){
+ Clist<-MakeCurves(Pdata[[II]])
+ DinM<-Dataindex(Clist)
+ for (n in Looprange(1,Nrow(DinM))){
+ Tmp<-DinM[n,]
+ Data<-Clist[Tmp[1]:Tmp[2],]
+ Mojisu<-0
+ for (I in Looprange(1,Nrow(Data))){
+ Tmp<-Data[I,]
+ X=sprintf('%5.5f',Tmp[1])
+ Y=sprintf('%5.5f',Tmp[2])
+ Pt=paste('(',X,',',Y,')',sep="")
+ if(I==1){
+ Str=paste('\\polyline',Pt,sep="")
+ }else{
+ Str=Pt
+ }
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<-Mojisu+nchar(Str)
+ if (Mojisu>80){
+ cat("%\n",file=Wfile,append=TRUE)
+ Mojisu<-0
+ }
+ }
+ if (Mojisu!=0){
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+ cat("%\n",file=Wfile,append=TRUE)
+ }
+ }
+ }
+ if (Thick>0){
+ Tmp<-PenThick/PenThickInit
+ Setpen(Tmp)
+ }
+}
+
+###########################################
+
+Drwpt<-function(...)
+{
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ All=Nargs
+ if (TenSize>TenSizeInit){
+ N<- round(6*sqrt(TenSize/TenSizeInit))
+ }
+ else{
+ N<-4
+ }
+ Tmp<- varargin[[All]]
+ Iro=c(0,0,0,1)
+ Iroflg=0
+ if(is.character(Tmp)){
+ Iro=Ratiocmyk(Tmp)
+ Iroflg=1
+ All=All-1
+ }
+ Tmp<- varargin[[All]]
+ if (mode(Tmp)=="numeric"){
+ if (length(Tmp)>1){
+ Kosa<- 1; All<- Nargs
+ }
+ else{
+ Kosa<- Tmp; All<- All-1
+ }
+ }
+ else if (mode(Tmp)=="list"){
+ Kosa<- 1; All<- Nargs
+ }
+ Ra=TenSize*1000/2.54/MilliIn
+ if(Iroflg>0){
+ Str='{\\color[cmyk]{'
+ for(J in 1:4){
+ Str=paste(Str,as.character(Kosa*Iro[J]),sep="")
+ if(J<4){
+ Str=paste(Str,',',sep="")
+ }
+ }
+ Str=paste(Str,'}%',sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ }
+
+# CL<-c()
+# for (J in 0:N){
+# Tmp<- TenSize*0.5*1000/2.54/MilliIn
+# Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N))
+# CL<- append(CL,Tmp)
+# }
+# CL<- matrix(CL,nrow=2)
+# CL<- t(CL)
+ Mojisu=0
+ for (II in Looprange(1,All)){
+ MS<- varargin[[II]]
+ MS=Flattenlist(MS) #17.10.28
+ if (mode(MS)=="numeric"){
+ MS<- list(MS)
+ }
+ for (I in Looprange(1,length(MS))){
+ P<- MS[[I]]
+ if (InWindow(P)!="i") next
+ P<- Doscaling(P)
+ X=sprintf('%5.5f',P[1])
+ Y=sprintf('%5.5f',P[2])
+ Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu=Mojisu+nchar(Str)
+ if(Mojisu>80){
+ cat("\n",file=Wfile,append=TRUE)
+ Mojisu=0
+ }
+ }
+ }
+ Str="%"
+ if(Iroflg>0){
+ Str='}%'
+ }
+ if(Mojisu>0){
+ Str=paste('\n',Str,'\n',sep="")
+ }else{
+ Fmt=paste(Str,'\n',sep="")
+ }
+ cat(Str,file=Wfile,append=TRUE)
+}
+
+# PL<-c()
+# for (J in 0:N){
+# PL<- c(PL,P+CL[J+1,])
+# }
+# PL<-matrix(PL,nrow=2)
+# PL<-t(PL)
+# Mojisu<-0
+# for (J in 1:Nrow(PL)){
+# Q<- PL[J,]
+# X<- as.character(round(MilliIn*Q[1]))
+# Y<- as.character(-round(MilliIn*Q[2]))
+# Str<- paste("\\special{pa ",X," ",Y,"}",sep="")
+# cat(Str,file=Wfile,append=TRUE)
+# Mojisu<- Mojisu+nchar(Str)
+# if (Mojisu>80){
+# cat("#\n",file=Wfile,append=TRUE)
+# }
+# Mojisu=0
+# }
+# Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="")
+# Str2<- "\\special{fp}%\n"
+# cat(Str1,file=Wfile,append=TRUE)
+# cat(Str2,file=Wfile,append=TRUE)
+# }
+# }
+#}
+
+######################################
+
+Makehasen<- function(Figdata,Sen,Gap,Ptn)
+{
+ Eps<- 10.0^(-6)
+ Clist<- MakeCurves(Figdata)
+ DinM<- Dataindex(Clist)
+ for (N in Looprange(1,Nrow(DinM))){
+ Tmp<- DinM[N,]
+ Data<- Clist[Tmp[1]:Tmp[2],]
+ Dtall<- Nrow(Data)
+ Len<- 0
+ Lenlist<- c(0)
+ for (I in Looprange(2,Dtall)){
+ Len<- Len+Norm(Data[I,]-Data[I-1,])
+ Lenlist<- c(Lenlist,Len)
+ }
+ Lenall<- Lenlist[Dtall]
+ if (Lenall==0){
+ next
+ }
+ Kari<- (Sen+Gap)*0.1
+ Naga<- Sen*0.1
+ Tobi<- Gap*0.1
+ if (Norm(Data[1,]-Data[Dtall,])<Eps){
+ Nsen<- max(ceiling(Lenall/Kari),3)
+ SegUnit<- Lenall/Nsen
+ Naga<- SegUnit*Sen/(Sen+Gap)
+ Tobi<- SegUnit*Gap/(Sen+Gap)
+ SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
+ }
+ else{
+ if (Ptn==0){
+ Nsen<- max(ceiling((Lenall+Tobi)/Kari),3)
+ SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap)
+ Naga<- SegUnit*Sen/(Sen+Gap)
+ Tobi<- SegUnit*Gap/(Sen+Gap)
+ SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit))
+ }
+ else{
+ Nsen<- max(ceiling((Lenall+Naga)/Kari),3)
+ SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap)
+ Naga<- SegUnit*Sen/(Sen+Gap)
+ Tobi<- SegUnit*Gap/(Sen+Gap)
+ SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit))
+ }
+ }
+ Hajime<- 1; Owari<- 1
+ Mojisu<- 0
+ for (I in Looprange(1,length(SegList))){
+ Len<- SegList[I]
+ J<- Owari
+ while (Len>=Lenlist[J]-Eps){
+ if (J==Dtall){
+ break
+ }
+ J<- J+1
+ }
+ Hajime<- J-1
+ J<- Hajime
+ while (Len+Naga>Lenlist[J]-Eps){
+ if (J==Dtall){
+ break
+ }
+ J<- J+1
+ }
+ Owari<- J-1
+ T<- (Len-Lenlist[Hajime])
+ T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime])
+ P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,])
+ X0=sprintf('%5.5f',P[1])
+ Y0=sprintf('%5.5f',P[2])
+ Pt0=paste('(',X0,',',Y0,')',sep="")
+ Str=paste('\\polyline',Pt0,sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ for (J in Looprange(Hajime+1,Owari)){
+ P=Data[J,]
+ X=sprintf('%5.5f',P[1])
+ Y=sprintf('%5.5f',P[2])
+ Pt=paste('(',X,',',Y,')',sep="")
+ Str=Pt
+ cat(Str,file=Wfile,append=TRUE)
+ Pt0=Pt
+ Mojisu=Mojisu+nchar(Str)
+ }
+ T<- (Len+Naga-Lenlist[Owari])
+ T<- T/(Lenlist[Owari+1]-Lenlist[Owari])
+ P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,])
+ X=sprintf('%5.5f',P[1])
+ Y=sprintf('%5.5f',P[2])
+ Pt=paste('(',X,',',Y,')',sep="")
+ Str=Pt
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ if (Mojisu>80){
+ cat("%\n",file=Wfile,append=TRUE)
+ Mojisu<- 0
+ }
+ }
+ }
+ cat("%\n%\n",file=Wfile,append=TRUE);
+}
+
+#########################################
+
+Beginpicture<-function(ul)
+{ ## Scaling is implemented
+ Tmp<- Doscaling(c(XMIN,YMIN))
+ Xm<- Tmp[1]
+ Ym<- Tmp[2]
+ Tmp<- Doscaling(c(XMAX,YMAX))
+ XM<- Tmp[1]
+ YM<- Tmp[2]
+ Dx<- XM-Xm
+ Dy<- YM-Ym
+ Sym<-".0123456789 +-*/"
+ SL<-Sym
+ OL<-"+-*/"
+ if (ul!=""){
+ ULEN<<-ul;
+ }
+ Is<-1;
+ VL<-"";
+ Ucode<-ULEN
+ for (I in Looprange(1,nchar(Ucode))){
+ C<-substring(Ucode,I,I);
+ if (length(grep(C,SL,fixed=TRUE))>0){
+ if (length(grep(C,OL,fixed=TRUE))>0){
+ Tmp<-substring(Ucode,Is,I-1);
+ Str<-paste(VL,Tmp,C,sep="")
+ VL<-Str
+ Is<-I+1;
+ }
+ }
+ else{
+ Unit<-substring(Ucode,I,I+1);
+ Str<-substring(Ucode,Is,I-1);
+ VL<-paste(VL,Str,sep="")
+ break;
+ }
+ }
+ Valu<-eval(parse(text=VL));
+ Str<-as.character(Valu);
+ ULEN<<- paste(Str,Unit,sep="");
+ if (Unit=="cm") MilliIn<<-1000/2.54*Valu
+ if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10
+ if (Unit=="in") MilliIn<<-1000*Valu
+ if (Unit=="pt") MilliIn<<-1000/72.27*Valu
+ if (Unit=="pc") MilliIn<<-1000/6.022*Valu
+ if (Unit=="bp") MilliIn<<-1000/72*Valu
+ if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu
+ if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu;
+ if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10
+ MARKLEN<<- MARKLENNow*1000/2.54/MilliIn;
+ Str<-paste("{\\unitlength=",ULEN,"%\n",sep="");
+ cat(Str,file=Wfile,append=TRUE);
+ cat("\\begin{picture}%\n",file=Wfile,append=TRUE);
+ Str<-"(";
+ Tmp<-as.character(round(Dx,digits=6));
+ Str<-paste(Str,Tmp,",",sep="");
+ Tmp<-as.character(round(Dy,digits=6));
+ Str<-paste(Str,Tmp,")(",sep="");
+ Tmp<-as.character(round(Xm,digits=6));
+ Str<-paste(Str,Tmp,",",sep="");
+ Tmp<-as.character(round(Ym,digits=6));
+ Str<-paste(Str,Tmp,")%\n",sep="");
+ cat(Str,file=Wfile,append=TRUE);
+ Str=paste('\\linethickness{',as.character(PenThickInit/1000),'in}%',sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+}
+
+#########################################
+
+Setpen<-function(Width)
+{
+ PenThick<<-round(PenThickInit*Width)
+ Str=paste('\\linethickness{',as.character(PenThick/1000),'in}%',sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ cat("%\n",file=Wfile,append=TRUE)
+}
+
+#########################################
+
+Shade<- function(...)
+{ ## Scaling is implemented
+ varargin<- list(...)
+ Nargs<- length(varargin)
+ Iroflg=0
+ if(Nargs>1){
+ Iro=varargin[[Nargs]]
+ if(is.character(Iro)){
+ Iroflg=1
+ if(length(grep("{",Iro,fixed=TRUE))>0){
+ Str=paste("{\\color",Iro,sep="")
+ }
+ else{
+ Str=paste("{\\color{",Iro,"}",sep="")
+ }
+ }
+ else{
+ if(length(Iro)==1){
+ Kosa=Iro
+ }
+ else{
+ Iroflg=1
+ if(length(Iro)==4){
+ Str="{\\color[cmyk]{"
+ }
+ else{
+ if(length(Iro)==3){
+ Str="{\\color[rgb]{"
+ }
+ }
+ for(J in 1:length(Iro)){
+ Str=paste(Str,as.character(Iro[J]),sep="")
+ if(J<length(Iro)){
+ Str=paste(Str,",")
+ }
+ }
+ Str=paste(Str,"}")
+ }
+ }
+ if(Iroflg==1){
+ Str=paste(Str,"%\n",sep="")
+ cat(Str,file=Wfile,append=TRUE)
+ }
+ }
+ Mojisu=0
+ Tmp=varargin[[1]]
+ Data=Kyoukai(Tmp)
+ for (I in Looprange(1, length(Data))){
+ PL<- Op(I,Data)
+ Mojisu<- 0
+ for (J in 1:Nrow(PL)){
+ P<- Doscaling(Op(J,PL))
+ X=sprintf('%5.5f',P[1])
+ Y=sprintf('%5.5f',P[2])
+ Pt=paste('(',X,',',Y,')',sep="")
+ if(J==1){
+ Str=paste('\\polygon*',Pt,sep="")
+ }else{
+ Str=Pt
+ }
+ cat(Str,file=Wfile,append=TRUE)
+ Mojisu<- Mojisu+nchar(Str)
+ if (Mojisu>80){
+ cat("%\n",file=Wfile,append=TRUE)
+ Mojisu<- 0
+ }
+ }
+ }
+ if(Iroflg==1){
+ Str='}%'
+ if(Mojisu>0){
+ Str=paste('\n',Str,'\n',sep="")
+ }else{
+ Str=paste(Str,'\n')
+ }
+ cat(Str,file=Wfile,append=TRUE)
+ }
+}
diff --git a/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h b/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h
index bfcbbf23..27a5434f 100644
--- a/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h
+++ b/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h
@@ -1,76 +1,8 @@
-int length2(double gdata[][2]);
-int length3(double gdata[][3]);
-int length4(double gdata[][4]);
-int length5(double gdata[][5]);
-int length2i(int gdata[][2]);
-void copyd(int from, int upto, double q[], double p[]);
-void copyi(int from, int upto, int q[], int p[]);
-int addptd2(double gdata[][2], double pt[2]);
-int addptd3(double gdata[][3], double pt[3]);
-int addptd4(double gdata[][4], double pt[4]);
-int addptd5(double gdata[][5], double pt[5]);
-int add2(double gdata[][2], double x, double y);
-int add3(double gdata[][3], double x, double y, double z);
-int push2(double x, double y, double ptL[][2]);
-int push3(double x, double y, double z, double ptL[][3]);
-int push4(double x, double y, double z, double w, double ptL[][4]);
-int push5(double x, double y, double z, double w, double u, double ptL[][5]);
-void pull2(int num, double ptL[][2],double pt[2]);
-void pull3(int num, double ptL[][3],double pt[3]);
-void pull4(int num, double ptL[][4],double pt[4]);
-void pull5(int num, double ptL[][5],double pt[5]);
-int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]);
-int appendd3(int level, int from,int upto, double gdata[][3],double mat[][3]);
-int prependd2(int from,int upto, double gdata[][2],double mat[][2]);
-int appendd1(double numvec[], double num);
-int appendi1(int numvec[],int num);
-int prependi1(int num, int numvec[]);
-int removei2(int nrmv,int mat[][2]);
-int dataindexi1(int out[],int din[][2]);
-int dataindexd1(double out[],int din[][2]);
-int dataindexd2(int level,double out[][2],int din[][2]);
-int dataindexd3(int level, double out[][3],int din[][2]);
-int dataindexd4(int level, double out[][4],int din[][2]);
-void dispmatd1(int from, int upto, double mat[]);
-void dispmatd2(int from, int upto, double mat[][2]);
-void dispmatd3(int from, int upto, double mat[][3]);
-void dispmatd4(int from, int upto, double mat[][4]);
-void dispmatd5(int from, int upto, double mat[][5]);
-void dispmatd6(int from, int upto, double mat[][6]);
-void dispmati2(int from, int upto, int mat[][2]);
-void dispmati1(int from, int upto, int mat[]);
-int readdata3(const char *fname, double out[][3]);
-int readdata2(const char *fname, double out[][2]);
-int output2(const char *var, const char *fname, int level, double out[][2]);
-void simplesort(double number[]);
-int memberi(int a, int list[]);
-double dotprod(int dim, double p[], double q[]);
-double dist(int dim, double p[], double q[]);
-void pointoncurve(double t, double gdata[][2], double eps, double pt[]);
-int partcrv(double a,double b,double pkL[][2], double pL[][2]);
-int partcrv3(double a,double b,double pkL[][3], double pL[][3]);
-int connectseg(double pdata[][2], double eps, double out[][2]);
-void koutenseg(double a[2], double b[2], double c[2], double d[2],
- double eps, double eps2, double out[4]);
-double paramoncurve(double p[2], int n, double ptL[][2]);
-void nearestptpt(double pa[2], double pL[][2], double ans[4]);
-int intersectselfPp(double data1[][2],double eps,double eps1s,double kL[][4]);
-int intersectcrvsPp(double data1[][2], double data2[][2],
- double eps,double eps1s, double kL[][4]);
-int dropnumlistcrv(double qd[][2], double eps1, int out[]);
-int increasept2(double ptL[][2], int nn, double out[][2]);
-int increasept3(double ptL[][3], int nn, double out[][3]);
-void bezierpt(double t, double p0[2], double p3[2],
- double p1[2], double p2[2], double ptout[2]);
-int bezier(double ptL[][2], double ctrL[][4], int num, double out[][2]);
-int ospline(int level, double ptL[][2], int num, double out[][2]);
-void bezierpt3(double t, double p0[3], double p3[3],
- double p1[3], double p2[3], double ptout[3]);
-int bezier3(double ptL[][3], double ctrL[][6], int num, double out[][3]);
-int ospline3(int level, double ptL[][3], int num, double out[][3]);
-
-const double Inf=99999;
-const int Infint=30000;
+//20180308 norm added
+
+int length1(double gdata[]){
+ return floor(gdata[0]+0.5);
+}
int length2(double gdata[][2]){
return floor(gdata[0][0]+0.5);
@@ -88,6 +20,10 @@ int length5(double gdata[][5]){
return floor(gdata[0][0]+0.5);
}
+int length6(double gdata[][6]){
+ return floor(gdata[0][0]+0.5);
+}
+
int length2i(int gdata[][2]){
return gdata[0][0];
}
@@ -140,6 +76,15 @@ int push5(double x, double y, double z, double w, double u, double ptL[][5]){
return nall;
}
+int push6(double x, double y, double z, double w, double u, double v,double ptL[][6]){
+ int nall=ptL[0][0];
+ nall++;
+ ptL[nall][0]=x; ptL[nall][1]=y;ptL[nall][2]=z;
+ ptL[nall][3]=w; ptL[nall][4]=u; ptL[nall][5]=v;
+ ptL[0][0]=nall;
+ return nall;
+}
+
void pull3(int num, double ptL[][3],double pt[3]){
pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; pt[2]=ptL[num][2];
}
@@ -158,6 +103,11 @@ void pull5(int num, double ptL[][5],double pt[5]){
pt[2]=ptL[num][2]; pt[3]=ptL[num][3]; pt[4]=ptL[num][4];
}
+void pull6(int num, double ptL[][6],double pt[6]){
+ pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; pt[2]=ptL[num][2];
+ pt[3]=ptL[num][3]; pt[4]=ptL[num][4]; pt[5]=ptL[num][5];
+}
+
int add2(double gdata[][2], double x, double y){
int nall;
nall=push2(x, y, gdata);
@@ -194,6 +144,12 @@ int addptd5(double gdata[][5], double pt[5]){
return nall;
}
+int addptd6(double gdata[][6], double pt[6]){
+ int nall;
+ nall=push6(pt[0],pt[1],pt[2],pt[3],pt[4],pt[5],gdata);
+ return nall;
+}
+
int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]){
int j, np, nall=length2(mat);
np=upto-from+1;
@@ -423,11 +379,20 @@ int dataindexi1(int out[],int din[][2]){
return ctr;
}
-void dispmatd1(int from, int upto, double mat[]){
- int i;
- for(i=from; i<upto+1; i++){
- printf("%d %7.5f\n",i,mat[i]);
- }
+void dispvec(int n,double dt[]){
+ int i;
+ for(i=0; i<n; i++){
+ printf("%f ",dt[i]);
+ }
+ printf("\n");
+}
+
+void dispveci(int n,int dt[]){
+ int i;
+ for(i=0; i<n; i++){
+ printf("%d ",dt[i]);
+ }
+ printf("\n");
}
void dispmatd2(int from, int upto, double mat[][2]){
@@ -468,6 +433,49 @@ void dispmatd6(int from, int upto, double mat[][6]){
}
}
+void dispmatd2all(double mat[][2]){
+ int i;
+ if(mat[0][0]==0){printf("%s\n","no data");return;}
+ for(i=1; i<mat[0][0]+1; i++){
+ printf("%3d %7.5f %7.5f\n",i,mat[i][0],mat[i][1]);
+ }
+}
+
+void dispmatd3all(double mat[][3]){
+ int i;
+ if(mat[0][0]==0){printf("%s\n","no data");return;}
+ for(i=1; i<mat[0][0]+1; i++){
+ printf("%3d %7.5f %7.5f %7.5f\n",i,mat[i][0],mat[i][1],mat[i][2]);
+ }
+}
+
+void dispmatd4all(double mat[][4]){
+ int i;
+ if(mat[0][0]==0){printf("%s\n","no data");return;}
+ for(i=1; i<mat[0][0]+1; i++){
+ printf("%3d %7.5f %7.5f ",i,mat[i][0],mat[i][1]);
+ printf("%7.5f %7.5f\n",mat[i][2],mat[i][3]);
+ }
+}
+
+void dispmatd5all(double mat[][5]){
+ int i;
+ if(mat[0][0]==0){printf("%s\n","no data");return;}
+ for(i=1; i<mat[0][0]+1; i++){
+ printf("%3d %7.5f %7.5f ",i,mat[i][0],mat[i][1]);
+ printf("%7.5f %7.5f %7.5f\n",mat[i][2],mat[i][3],mat[i][4]);
+ }
+}
+
+void dispmatd6all(double mat[][6]){
+ int i;
+ if(mat[0][0]==0){printf("%s\n","no data");return;}
+ for(i=1; i<mat[0][0]+1; i++){
+ printf("%3d %7.5f %7.5f %7.5f ",i,mat[i][0],mat[i][1],mat[i][2]);
+ printf("%7.5f %7.5f %7.5f\n",mat[i][3],mat[i][4],mat[i][5]);
+ }
+}
+
void dispmati2(int from, int upto, int mat[][2]){
int i;
for(i=from; i<upto+1; i++){
@@ -482,19 +490,19 @@ void dispmati1(int from, int upto, int mat[]){
}
}
-int readdata3(const char *fname, double out[][3]){
+void readdata3(const char *fname, double out[][3]){
double data[DsizeL][4];
int i, j, ndata, nall;
FILE *fp;
fp=fopen(fname,"r");
if(fp==NULL){
printf("file not found\n");
- return 0;
+ return;
}
ndata=0;
i=1;
while( ! feof(fp) && i<DsizeL){
- for(j=0;j<=3;j++){
+ for(j=0;j<4;j++){
fscanf(fp,"%lf",&data[i][j]);
}
i++;
@@ -504,9 +512,36 @@ int readdata3(const char *fname, double out[][3]){
fclose(fp);
out[0][0]=0; nall=0;
for(i=1; i<=ndata; i++){
- nall=add3(out, data[i][1], data[i][2], data[i][3]);
+ nall=add3(out, data[i][0], data[i][1], data[i][2]);
}
- return nall;
+ return;
+}
+
+void readdata2(const char *fname, double out[][2]){
+ double data[DsizeL][3];
+ int i, j, ndata, nall;
+ FILE *fp;
+ fp=fopen(fname,"r");
+ if(fp==NULL){
+ printf("file not found\n");
+ return;
+ }
+ ndata=0;
+ i=1;
+ while( ! feof(fp) && i<DsizeL){
+ for(j=0;j<3;j++){
+ fscanf(fp,"%lf",&data[i][j]);
+ }
+ i++;
+ ndata++;
+ }
+ ndata--;
+ fclose(fp);
+ out[0][0]=0; nall=0;
+ for(i=1; i<=ndata; i++){
+ nall=add2(out, data[i][0], data[i][1]);
+ }
+ return;
}
int output2(const char *var, const char *fname, int level, double out[][2]){
@@ -542,33 +577,6 @@ int output2(const char *var, const char *fname, int level, double out[][2]){
return 0;
}
-int readdata2(const char *fname, double out[][2]){
- double data[DsizeL][3];
- int i, j, ndata, nall;
- FILE *fp;
- fp=fopen(fname,"r");
- if(fp==NULL){
- printf("file not found\n");
- return 0;
- }
- ndata=0;
- i=1;
- while( ! feof(fp) && i<DsizeL){
- for(j=0;j<=2;j++){
- fscanf(fp,"%lf",&data[i][j]);
- }
- i++;
- ndata++;
- }
- ndata--;
- fclose(fp);
- out[0][0]=0; nall=0;
- for(i=1; i<=ndata; i++){
- nall=add2(out, data[i][1], data[i][2]);
- }
- return nall;
-}
-
void simplesort(double number[]){
int i,j, total=number[0];
double tmp;
@@ -602,6 +610,12 @@ double dotprod(int dim, double p[], double q[]){
return ans;
}
+double norm(int dim, double p[]){
+ double ans;
+ ans=dotprod(dim,p,p);
+ return sqrt(ans);
+}
+
double dist(int dim, double p[], double q[]){
double tmp;
tmp=pow(q[0]-p[0],2)+pow(q[1]-p[1],2);
@@ -611,6 +625,34 @@ double dist(int dim, double p[], double q[]){
return sqrt(tmp);
}
+void crossprod(int dim,double a[3],double b[3], double out[3]){
+ if(dim==3){
+ out[0]=a[1]*b[2]-a[2]*b[1];
+ out[1]=a[2]*b[0]-a[0]*b[2];
+ out[2]=a[0]*b[1]-a[1]*b[0];
+ }else{
+ out[0]=a[0]*b[1]-a[1]*b[0];
+ out[1]=Inf;
+ }
+}
+
+void reflectpoint(double p1[2],double regard[][2],double p2[2]){
+ double pa[2],pb[2],u,v,a,b,u2,v2;
+ pull2(1,regard,pa);
+ if(length2(regard)==1){
+ p2[0]=2*pa[0]-p1[0]; p2[1]=2*pa[1]-p1[1];
+ }else{
+ pull2(2,regard,pb);
+ u=pb[0]-pa[0]; u2=pow(u,2.0);
+ v=pb[1]-pa[1]; v2=pow(v,2.0);
+ a=pa[0]; b=pa[1];
+ p2[0]=(u2-v2)/(u2+v2)*p1[0]+2*u*v/(u2+v2)*p1[1];
+ p2[0]=p2[0]-2*v*(u*b-v*a)/(u2+v2);
+ p2[1]=2*u*v/(u2+v2)*p1[0]-(u2-v2)/(u2+v2)*p1[1];
+ p2[1]=p2[1]+2*u*(u*b-v*a)/(u2+v2);
+ }
+}
+
void pointoncurve(double t, double gdata[][2], double eps, double pt[]){
double pa[2],pb[2], s;
int n, nall;
@@ -1557,3 +1599,529 @@ int ospline3(int level, double ptL[][3], int num, double out[][3]){
}
return nall;
}
+
+void segplot(double x1,double y1,double x2,double y2,double seg[][2]){
+ seg[0][0]=0;
+ push2(x1,y1,seg);
+ push2(x2,y2,seg);
+}
+
+void addsegplot(double x1,double y1,double seg[][2]){
+ push2(x1,y1,seg);
+}
+
+void circledata(double cx,double cy,double r, int num,double out[][2]){
+ double t,dt,pt[2];
+ int i;
+ dt=2*M_PI/num;
+ out[0][0]=0;
+ for(i=0; i<=num; i++){
+ push2(cx+r*cos(i*dt),cy+r*sin(i*dt),out);
+ }
+}
+
+void intersectline(double p1[2],double v1[2], double p2[2],double v2[2],double out[4]){
+ double tmp,d,dt,ds,t,s,tmp1[2],tmp2[2],tmp3[2],pt[2];
+ tmp=dotprod(2,v1,v2);
+ tmp1[0]=tmp; tmp1[1]=pow(norm(2,v1),2.0);
+ tmp2[0]=-pow(norm(2,v2),2.0);tmp2[1]=-tmp;
+ pt[0]=p2[0]-p1[0];pt[1]=p2[1]-p1[1];
+ tmp3[0]=dotprod(2,pt,v2);tmp3[1]=dotprod(2,pt,v1);
+ crossprod(2,tmp1,tmp2,pt); d=pt[0];
+ crossprod(2,v1,v2,pt); tmp=fabs(pt[0]);
+ if(tmp>Eps){
+ crossprod(2,tmp3,tmp2,pt); dt=pt[0];
+ crossprod(2,tmp1,tmp3,pt); ds=pt[0];
+ t=dt/d;
+ s=ds/d;
+ pt[0]=p1[0]+v1[0]*t; pt[1]=p1[1]+v1[1]*t;
+ out[0]=pt[0];out[1]=pt[1];out[2]=t; out[3]=s;
+ }else{
+ pt[0]=p2[0]-p1[0];pt[1]=p2[1]-p1[1];
+ crossprod(2,pt,v1,tmp1);
+ tmp=tmp1[0]/norm(2,v1);
+ out[0]=fabs(tmp); out[1]=Inf;
+ }
+}
+
+void intersectseg(double seg1[][2],double seg2[][2], double out[5]){
+ double p1[2],q1[2],p2[2],q2[2],pt[2],pt1[2],nv[2],pts[DsizeS][4];
+ double q1p1[2],q2p2[2],p1q2[2],q1p2[2],p1p2[2],q1q2[2];
+ double tmp[2],tmp1[2],tmp2[2],tmp3[2],tmp4[2];
+ double tmpd1,x,y,t,s,t1,s1,distance,tmpd[4],tmp3d[7];
+ int ctr=0, i;
+ pull2(1,seg1,p1); pull2(2,seg1,q1);
+ pull2(1,seg2,p2); pull2(2,seg2,q2);
+ q1p1[0]=q1[0]-p1[0];q1p1[1]=q1[1]-p1[1];
+ q2p2[0]=q2[0]-p2[0];q2p2[1]=q2[1]-p2[1];
+ p1q2[0]=p1[0]-q2[0];p1q2[1]=p1[1]-q2[1];
+ q1p2[0]=q1[0]-p2[0];q1p2[1]=q1[1]-p2[1];
+ p1p2[0]=p1[0]-p2[0];p1p2[1]=p1[1]-p2[1];
+ p1q2[0]=p1[0]-q2[0];p1q2[1]=p1[1]-q2[1];
+ q1q2[0]=q1[0]-q2[0];q1q2[1]=q1[1]-q2[1];
+ if((norm(2,q1p1)<Eps)||(norm(2,q2p2)<Eps)){
+ out[0]=-1; out[1]=Inf;
+ }else{
+ intersectline(p1,q1p1,p2,q2p2,tmpd);
+ if(tmpd[1]<Inf-Eps){
+ pt[0]=tmpd[0];pt[1]=tmpd[1];t=tmpd[2];s=tmpd[3];
+ if((t*(t-1)<Eps)&&(s*(s-1)<Eps)){
+ out[0]=0;out[1]=pt[0];out[2]=pt[1];out[3]=t;out[4]=s;
+ }else{
+ if(t<0){t=0;}; if(t>1){t=1;};
+ if(s<0){s=0;}; if(s>1){s=1;};
+ tmp3d[ctr]=norm(2,p1p2);ctr++;
+ tmp3d[ctr]=norm(2,p1q2);ctr++;
+ tmp3d[ctr]=norm(2,q1p2);ctr++;
+ tmp3d[ctr]=norm(2,q1q2);ctr++;
+ tmp1[0]=q2p2[1];tmp1[1]=-q2p2[0];
+ intersectline(p1,tmp1,p2,q2p2,tmpd);
+ if(tmpd[1]!=Inf){
+ pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3];
+ if(s1*(s1-1)<Eps){
+ tmp3d[ctr]=dist(2,pt1,p1);ctr++;
+ }
+ }
+ intersectline(q1,tmp1,p2,q2p2,tmpd);
+ if(tmpd[1]!=Inf){
+ pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3];
+ if(s1*(s1-1)<Eps){
+ tmp3d[ctr]=dist(2,pt1,q1);ctr++;
+ }
+ }
+ tmp1[0]=q1p1[1];tmp1[1]=-q1p1[0];
+ intersectline(p2,tmp1,p1,q1p1,tmpd);
+ if(tmpd[1]!=Inf){
+ pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3];
+ if(s1*(s1-1)<Eps){
+ tmp3d[ctr]=dist(2,pt1,p2);ctr++;
+ }
+ }
+ intersectline(q2,tmp1,p1,q1p1,tmpd);
+ if(tmpd[1]!=Inf){
+ pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3];
+ if(s1*(s1-1)<Eps){
+ tmp3d[ctr]=dist(2,pt1,q2);ctr++;
+ }
+ }
+ tmpd1=tmp3d[0];
+ for(i=1;i<ctr;i++){
+ if(tmp3d[i]<tmpd1){tmpd1=tmp3d[i];};
+ }
+ out[0]=tmpd1;out[1]=pt[0];out[2]=pt[1];
+ out[3]=t;out[4]=s;
+ }
+ }else{
+ distance=tmpd[0];
+ nv[0]=q1p1[1]/norm(2,q1p1);nv[1]=-q1p1[0]/norm(2,q1p1);
+ pts[0][0]=0;
+ intersectline(p1,nv,p2,q2p2,tmpd);
+ s1=tmpd[3];
+ if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){
+ x=(1-s1)*p2[0]+s1*q2[0];y=(1-s1)*p2[1]+s1*q2[1];
+ push4(x,y,0,s1,pts);
+ }
+ intersectline(q1,nv,p2,q2p2,tmpd);
+ s1=tmpd[3];
+ if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){
+ x=(1-s1)*p2[0]+s1*q2[0];y=(1-s1)*p2[1]+s1*q2[1];
+ push4(x,y,1,s1,pts);
+ }
+ intersectline(p2,nv,p1,q1p1,tmpd);
+ s1=tmpd[3];
+ if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){
+ x=(1-s1)*p1[0]+s1*q1[0];y=(1-s1)*p1[1]+s1*q1[1];
+ push4(x,y,s1,0,pts);
+ }
+ intersectline(q2,nv,p1,q1p1,tmpd);
+ if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){
+ x=(1-s1)*p1[0]+s1*q1[0];y=(1-s1)*p1[1]+s1*q1[1];
+ push4(x,y,s1,2,pts);
+ }
+ if(length4(pts)==0){
+ tmpd1=norm(2,p1p2);
+ if(norm(2,p1q2)<tmpd1){tmpd1=norm(2,p1q2);}
+ if(norm(2,q1p2)<tmpd1){tmpd1=norm(2,q1p2);}
+ if(norm(2,q1q2)<tmpd1){tmpd1=norm(2,q1q2);}
+ out[0]=tmpd1;out[1]=Inf;
+ }else{
+ if(distance>Eps1){
+ out[0]=distance;out[1]=Inf;
+ }else{
+ x=0; y=0;
+ for(i=1; i<=length4(pts); i++){
+ x=x+pts[i][0];
+ y=y+pts[i][1];
+ }
+ tmp3[0]=x/length4(pts); tmp3[1]=y/length4(pts);
+ nearestptpt(tmp3,seg1,tmpd);
+ t=tmpd[2];
+ nearestptpt(tmp3,seg2,tmpd);
+ s=tmpd[2];
+ out[0]=distance; out[1]=tmp3[0]; out[2]=tmp3[1];
+ out[3]=t;out[4]=s;
+ }
+ }
+ }
+ }
+}
+
+int osplineseg(double ptlist[5][2],int num,double out[][2]){
+ double p0[2],p1[2],p2[2],p3[2],p2p0[2],p3p1[2],p2p1[2];
+ double tmp,cc,pq[2],pr[2],knots[3][2],ctrlist[2][4];
+ pull2(1,ptlist,p0); pull2(2,ptlist,p1);
+ pull2(3,ptlist,p2); pull2(4,ptlist,p3);
+ p2p0[0]=p2[0]-p0[0];p2p0[1]=p2[1]-p0[1];
+ p3p1[0]=p3[0]-p1[0];p3p1[1]=p3[1]-p1[1];
+ p2p1[0]=p2[0]-p1[0];p2p1[1]=p2[1]-p1[1];
+ tmp=norm(2,p2p0)*norm(2,p3p1);
+ tmp=1+sqrt((1+dotprod(2,p2p0,p3p1)/tmp)/2);
+ cc=4*norm(2,p2p1)/3/(norm(2,p2p0)+norm(2,p3p1))/tmp;
+ pq[0]=p1[0]+cc*p2p0[0]; pq[1]=p1[1]+cc*p2p0[1];
+ pr[0]=p2[0]-cc*p3p1[0];pr[1]=p2[1]-cc*p3p1[1];
+ ctrlist[0][0]=0;
+ push4(pq[0],pq[1],pr[0],pr[1],ctrlist);
+ knots[0][0]=0;
+ addptd2(knots,p1);addptd2(knots,p2);
+ bezier(knots,ctrlist,num,out);
+ return length2(out);
+}
+
+void intersectpartseg(double crv1[][2],double crv2[][2],int ii, int jj,int num,double out[6]){
+ double distance=10*Eps2,seg1[3][2],seg2[3][2],tmpd[2],tmp1d[2],tmp2d[2];
+ double tmp,snang,dst,tmpd5[5],os1[DsizeS][2],os2[DsizeS][2];
+ double p0[2],p1[2],p2[2],p3[2],ptlist[5][2],regard[3][2];
+ double tmp1md[20][2],tmpd3[3],tmp3md3[20][3],tmp2md3[20][3];
+ double tmpd4[4],Eps00=pow(10,-8.0);
+ double sx,sy;
+ int kk,ll,nn;
+ out[0]=Inf;
+ for(kk=1;kk<6;kk++){out[kk]=0;}
+ seg1[0][0]=0;seg2[0][0]=0;
+ appendd2(1,ii,ii+1,crv1,seg1);
+ appendd2(1,jj,jj+1,crv2,seg2);
+ pull2(2,seg1,tmp1d);
+ pull2(1,seg1,tmpd);
+ tmp1d[0]=tmp1d[0]-tmpd[0]; tmp1d[1]=tmp1d[1]-tmpd[1];
+ pull2(2,seg2,tmp2d);
+ pull2(1,seg2,tmpd);
+ tmp2d[0]=tmp2d[0]-tmpd[0]; tmp2d[1]=tmp2d[1]-tmpd[1];
+ crossprod(2,tmp1d,tmp2d,tmpd);
+ snang=fabs(tmpd[0])/(norm(2,tmp1d)*norm(2,tmp2d));
+ intersectseg(seg1,seg2,tmpd5);
+ dst=tmpd5[0];
+ if(dst<Eps){
+ if(dst>-Eps){
+ out[0]=tmpd5[1];out[1]=tmpd5[2];out[2]=ii+tmpd5[3];
+ out[3]=jj+tmpd5[4];out[4]=dst;out[5]=snang;
+ }
+ }else{
+ if(dst<Eps2){
+ os1[0][0]=0;os2[0][0]=0;
+ pull2(1,seg1,tmp1d);
+ pull2(2,seg1,tmp2d);
+ tmpd[0]=tmp2d[0]-tmp1d[0];tmpd[1]=tmp2d[1]-tmp1d[1];
+ if((length2(crv1)==2)||(norm(2,tmpd)>distance-Eps)){
+ appendd2(1,1,2,seg1,os1);
+ }else{
+ pull2(1,seg1,p1);pull2(2,seg1,p2);
+ if(ii==1){
+ pull2(3,crv1,p3);
+ tmpd[0]=p2[0]-p1[0];tmpd[1]=p2[1]-p1[1];
+ tmp1d[0]=(p1[0]+p2[0])/2;
+ tmp1d[1]=(p1[1]+p2[1])/2;
+ tmp2d[0]=tmp1d[0]+tmpd[1];
+ tmp2d[1]=tmp1d[1]-tmpd[0];
+ regard[0][0]=0;
+ addptd2(regard,tmp1d); addptd2(regard,tmp2d);
+ reflectpoint(p3,regard,p0);
+ }else{
+ if(ii==length2(crv1)-1){
+ pull2(ii-1,crv1,p0);
+ tmpd[0]=p2[0]-p1[0]; tmpd[1]=p2[1]-p1[1];
+ tmp1d[0]=(p1[0]+p2[0])/2;
+ tmp1d[1]=(p1[1]+p2[1])/2;
+ tmp2d[0]=tmp1d[0]+tmpd[1];
+ tmp2d[1]=tmp1d[1]-tmpd[0];
+ regard[0][0]=0;
+ addptd2(regard,tmp1d); addptd2(regard,tmp2d);
+ reflectpoint(p0,regard,p3);
+ }else{
+ pull2(ii-1,crv1,p0);pull2(ii+2,crv1,p3);
+ }
+ }
+ ptlist[0][0]=0;
+ addptd2(ptlist,p0);addptd2(ptlist,p1);
+ addptd2(ptlist,p2);addptd2(ptlist,p3);
+ osplineseg(ptlist,num,os1);
+ }
+ pull2(1,seg2,tmp1d);
+ pull2(2,seg2,tmp2d);
+ if((length2(crv2)==2)||(dist(2,tmp2d,tmp1d)>distance-Eps)){
+ appendd2(1,1,2,seg2,os2);
+ }else{
+ pull2(1,seg2,p1);pull2(2,seg2,p2);
+ if(jj==1){
+ pull2(3,crv2,p3);
+ tmpd[0]=p2[0]-p1[0];tmpd[1]=p2[1]-p1[1];
+ tmp1d[0]=(p1[0]+p2[0])/2;
+ tmp1d[1]=(p1[1]+p2[1])/2;
+ tmp2d[0]=tmp1d[0]+tmpd[1];
+ tmp2d[1]=tmp1d[1]-tmpd[0];
+ regard[0][0]=0;
+ addptd2(regard,tmp1d); addptd2(regard,tmp2d);
+ reflectpoint(p3,regard,p0);
+ }else{
+ if(jj==length2(crv2)-1){
+ pull2(jj-1,crv2,p0);
+ tmpd[0]=p2[0]-p1[0]; tmpd[1]=p2[1]-p1[1];
+ tmp1d[0]=(p1[0]+p2[0])/2;
+ tmp1d[1]=(p1[1]+p2[1])/2;
+ tmp2d[0]=tmp1d[0]+tmpd[1];
+ tmp2d[1]=tmp1d[1]-tmpd[0];
+ regard[0][0]=0;
+ addptd2(regard,tmp1d); addptd2(regard,tmp2d);
+ reflectpoint(p0,regard,p3);
+ }else{
+ pull2(jj-1,crv2,p0);pull2(jj+2,crv2,p3);
+ }
+ }
+ ptlist[0][0]=0;
+ addptd2(ptlist,p0);addptd2(ptlist,p1);
+ addptd2(ptlist,p2);addptd2(ptlist,p3);
+ osplineseg(ptlist,num,os2);
+ }
+ tmp2md3[0][0]=0;
+ for(kk=1;kk<length2(os1);kk++){
+ for(ll=1;ll<length2(os2);ll++){
+ seg1[0][0]=0; seg2[0][0]=0;
+ pull2(kk,os1,tmpd);addptd2(seg1,tmpd);
+ pull2(kk+1,os1,tmpd);addptd2(seg1,tmpd);
+ pull2(ll,os2,tmpd);addptd2(seg2,tmpd);
+ pull2(ll+1,os2,tmpd);addptd2(seg2,tmpd);
+ intersectseg(seg1,seg2,tmpd5);
+ if((tmpd5[0]<Eps1)&&(tmpd5[1]<Inf-Eps)){
+ if(tmpd5[0]<dst+Eps00){
+ dst=tmpd5[0];
+ tmp3md3[0][0]=0;
+ for(nn=1;nn<=length3(tmp2md3);nn++){
+ pull3(nn,tmp2md3,tmpd3);
+ if(tmpd3[0]<dst+Eps00){
+ addptd3(tmp3md3,tmpd3);
+ }
+ }
+ tmp2md3[0][0]=0;
+ for(nn=1;nn<=length3(tmp3md3);nn++){
+ pull3(nn,tmp3md3,tmpd3);
+ addptd3(tmp2md3,tmpd3);
+ }
+ push3(dst,tmpd5[1],tmpd5[2],tmp2md3);
+ }
+ }
+ }
+ }
+ if(length3(tmp2md3)>0){
+ tmp1md[0][0]=0;
+ sx=0; sy=0;
+ for(nn=1;nn<=length3(tmp2md3);nn++){
+ pull3(nn,tmp2md3,tmpd3);
+ push2(tmpd3[1],tmpd3[2],tmp1md);
+ sx=sx+tmpd3[1];
+ sy=sy+tmpd3[2];
+ }
+ sx=sx/length3(tmp2md3);
+ sy=sy/length3(tmp2md3);
+ p0[0]=sx; p0[1]=sy;
+ pull2(ii,crv1,p1); pull2(ii+1,crv1,p2);
+ tmp1d[0]=p2[0]-p1[0];tmp1d[1]=p2[1]-p1[1];
+ tmpd[0]=tmp1d[1];tmpd[1]=-tmp1d[0];
+ intersectline(p0,tmpd,p1,tmp1d,tmpd4);
+ tmp=tmpd4[3];
+ if(tmp<0){tmp=0;}
+ if(tmp>1){tmp=1;}
+ out[0]=sx;out[1]=sy;out[2]=ii+tmp;
+ pull2(jj,crv2,p1); pull2(jj+1,crv2,p2);
+ tmp1d[0]=p2[0]-p1[0];tmp1d[1]=p2[1]-p1[1];
+ tmpd[0]=tmp1d[1];tmpd[1]=-tmp1d[0];
+ intersectline(p0,tmpd,p1,tmp1d,tmpd4);
+ tmp=tmpd4[3];
+ if(tmp<0){tmp=0;}
+ if(tmp>1){tmp=1;}
+ out[3]=jj+tmp;out[4]=dst;out[5]=snang;
+ }
+ }
+ }
+}
+
+void collectsameseg(double ptdL[][6],double rL[][6]){
+ double Eps00=pow(10,-8.0),tmp1d[2],tmp2d[2],tmp1d6[6],tmp2d6[6];
+ int ii,jj,kk,nr,ctr,numL[40],diffL[40];
+ double s1,e1,s2,e2,dst,tmp1,tmp2,tmp1md6[40][6];
+ rL[0][0]=0;
+ if(length6(ptdL)==0){
+ return;
+ }
+ for(ii=2;ii<=length6(ptdL);ii++){
+ pull6(ii,ptdL,tmp1d6);addptd6(rL,tmp1d6);
+ }
+ tmp1md6[0][0]=0;
+ pull6(1,ptdL,tmp1d6);
+ addptd6(tmp1md6,tmp1d6);
+ kk=tmp1d6[2];
+ if(tmp1d6[2]<kk+Eps00){
+ s1=kk-1-Eps00;e1=s1+2+2*Eps00;
+ }else{
+ s1=kk-Eps00; e1=s1+1+2*Eps00;
+ }
+ kk=tmp1d6[3];
+ if(tmp1d6[3]<kk+Eps00){
+ s2=kk-1-Eps00;e2=s2+2+2*Eps00;
+ }else{
+ s2=kk-Eps00; e2=s2+1+2*Eps00;
+ }
+ ctr=1;numL[0]=0;
+ for(ii=1;ii<=length6(rL);ii++){
+ pull6(ii,rL,tmp1d6);
+ tmp1=tmp1d6[2]; tmp2=tmp1d6[3];
+ if((tmp1>s1)&&(tmp1<e1)&&(tmp2>s2)&&(tmp2<e2)){
+ addptd6(tmp1md6,tmp1d6);
+ numL[ctr]=ii;ctr++;
+ }
+ }
+ dst=100;
+ for(ii=1;ii<=length6(tmp1md6);ii++){
+ pull6(ii,tmp1md6,tmp1d6);
+ if(tmp1d6[4]<dst){
+ dst=tmp1d6[4];
+ }
+ }
+ ptdL[0][0]=0;
+ for(ii=1;ii<=length6(tmp1md6);ii++){
+ pull6(ii,tmp1md6,tmp1d6);
+ if(tmp1d6[4]<dst+Eps00){
+ addptd6(ptdL,tmp1d6);
+ }
+ }
+ for(ii=0;ii<=length6(rL);ii++){
+ diffL[ii]=0;
+ }
+ for(ii=1;ii<=ctr;ii++){
+ kk=numL[ii];
+ diffL[kk]=1;
+ }
+ nr=length6(rL);
+ rL[0][0]=0;
+ for(ii=1;ii<=nr;ii++){
+ if(diffL[ii]==0){
+ pull6(ii,rL,tmp1d6);addptd6(rL,tmp1d6);
+ }
+ }
+}
+
+void intersectcurvesPp(double crv1s[][2],double crv2s[][2],int num,double out[][6]){
+ double Eps00=pow(10,-8.0),Dist=10*Eps2, crv1[DsizeL][2],crv2[DsizeL][2];
+ double tmp1md6[DsizeS][6],tmp2md6[DsizeS][6];
+ double tmpd[2],tmp1d[2],tmp2d[2],tmpd6[6],tmp1d6[6];
+ double sx,sy,dst,ans[4];
+ int ii,jj,kk,nall,self,js,je;
+ crv1[0][0]=0;
+ pull2(1,crv1s,tmpd);addptd2(crv1,tmpd);
+ for(ii=2;ii<=length2(crv1s);ii++){
+ pull2(length2(crv1),crv1,tmp1d);
+ pull2(ii,crv1s,tmp2d);
+ if(dist(2,tmp1d,tmp2d)>Eps){
+ addptd2(crv1,tmp2d);
+ }
+ }
+ crv2[0][0]=0;
+ pull2(1,crv2s,tmpd);
+ addptd2(crv2,tmpd);
+ for(ii=2;ii<=length2(crv2s);ii++){
+ pull2(length2(crv2),crv2,tmp1d);
+ pull2(ii,crv2s,tmp2d);
+ if(dist(2,tmp1d,tmp2d)>Eps){
+ addptd2(crv2,tmp2d);
+ }
+ }
+ if(length2(crv1)!=length2(crv2)){
+ self=0;
+ }else{
+ self=1;
+ for(ii=1;ii<=length2(crv1);ii++){
+ pull2(ii,crv1,tmp1d);pull2(ii,crv2,tmp2d);
+ if(dist(2,tmp1d,tmp2d)>0){
+ self=0;
+ break;
+ }
+ }
+ }
+ tmp1md6[0][0]=0;
+ for(ii=1;ii<=length2(crv1)-1;ii++){
+ if(self==0){
+ js=1; je=length2(crv2)-1;
+ }else{
+ js=ii+2; je=length2(crv2)-1;
+ }
+ for(jj=js;jj<=je;jj++){
+ intersectpartseg(crv1,crv2,ii,jj,num,tmpd6);
+ if(tmpd6[0]<Inf-Eps){
+ tmpd[0]=tmpd6[0];tmpd[1]=tmpd6[1];
+ if(length6(tmp1md6)==0){
+ addptd6(tmp1md6,tmpd6);
+ }else{
+ pull6(length6(tmp1md6),tmp1md6,tmp1d6);
+ tmp1d[0]=tmp1d6[0];tmp1d[1]=tmp1d6[1];
+ if(dist(2,tmp1d,tmpd)>Eps1){
+ addptd6(tmp1md6,tmpd6);
+ }
+ }
+ if(self==1){
+ push6(tmpd6[0],tmpd6[1],tmpd6[3],tmpd6[2],tmpd6[4],tmpd6[5],tmp1md6);
+ }
+ }
+ }
+ }
+ out[0][0]=0;
+ tmp2md6[0][0]=0;
+ while(length6(tmp1md6)>0){
+ collectsameseg(tmp1md6,tmp2md6);
+ dst=100;
+ for(ii=1;ii<=length6(tmp1md6);ii++){
+ pull6(ii,tmp1md6,tmpd6);
+ if(tmpd6[4]<dst){
+ dst=tmpd6[4];
+ }
+ }
+ sx=0; sy=0;nall=0;
+ for(ii=1;ii<=length6(tmp1md6);ii++){
+ pull6(ii,tmp1md6,tmpd6);
+ if(tmpd6[4]<dst+Eps00){
+ nall++;
+ sx=sx+tmpd6[0]; sy=sy+tmpd6[1];
+ }
+ tmp1d[0]=sx/nall; tmp1d[1]=sy/nall;
+ tmp1d6[0]=tmp1d[0];tmp1d6[1]=tmp1d[1];
+ nearestptpt(tmp1d,crv1,ans);
+ tmp1d6[2]=ans[2];
+ nearestptpt(tmp1d,crv2,ans);
+ tmp1d6[3]=ans[2];
+ tmp1d6[4]=dst;
+ tmp1d6[5]=tmpd6[5];
+ addptd6(out,tmp1d6);
+ }
+ tmp1md6[0][0]=0;
+ for(ii=1;ii<=length6(tmp2md6);ii++){
+ pull6(ii,tmp2md6,tmpd6);addptd6(tmp1md6,tmpd6);
+ }
+ }
+}
+
+void intersectcurves(double crv1[][2],double crv2[][2],int num,double out[][2]){
+ double out6[DsizeS][6],tmpd[2],tmpd6[6];
+ int jj;
+ intersectcurvesPp(crv1,crv2,num,out6);
+ out[0][0]=0;
+ for(jj=1;jj<=length6(out6);jj++){
+ pull6(jj,out6,tmpd6);push2(tmpd6[0],tmpd6[1],out);
+ }
+}
diff --git a/texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h b/texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h
new file mode 100644
index 00000000..7e83a2b9
--- /dev/null
+++ b/texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h
@@ -0,0 +1,97 @@
+int length1(double gdata[]);
+int length2(double gdata[][2]);
+int length3(double gdata[][3]);
+int length4(double gdata[][4]);
+int length5(double gdata[][5]);
+int length6(double gdata[][6]);
+int length2i(int gdata[][2]);
+void copyd(int from, int upto, double q[], double p[]);
+void copyi(int from, int upto, int q[], int p[]);
+int addptd2(double gdata[][2], double pt[2]);
+int addptd3(double gdata[][3], double pt[3]);
+int addptd4(double gdata[][4], double pt[4]);
+int addptd5(double gdata[][5], double pt[5]);
+int addptd6(double gdata[][6], double pt[6]);
+int add2(double gdata[][2], double x, double y);
+int add3(double gdata[][3], double x, double y, double z);
+int push2(double x, double y, double ptL[][2]);
+int push3(double x, double y, double z, double ptL[][3]);
+int push4(double x, double y, double z, double w, double ptL[][4]);
+int push5(double x, double y, double z, double w, double u, double ptL[][5]);
+int push6(double x, double y, double z, double w, double u, double v,double ptL[][6]);
+void pull2(int num, double ptL[][2],double pt[2]);
+void pull3(int num, double ptL[][3],double pt[3]);
+void pull4(int num, double ptL[][4],double pt[4]);
+void pull5(int num, double ptL[][5],double pt[5]);
+void pull6(int num, double ptL[][6],double pt[6]);
+int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]);
+int appendd3(int level, int from,int upto, double gdata[][3],double mat[][3]);
+int prependd2(int from,int upto, double gdata[][2],double mat[][2]);
+int appendd1(double numvec[], double num);
+int appendi1(int numvec[],int num);
+int prependi1(int num, int numvec[]);
+int removei2(int nrmv,int mat[][2]);
+int dataindexi1(int out[],int din[][2]);
+int dataindexd1(double out[],int din[][2]);
+int dataindexd2(int level,double out[][2],int din[][2]);
+int dataindexd3(int level, double out[][3],int din[][2]);
+int dataindexd4(int level, double out[][4],int din[][2]);
+void dispvec(int n,double dt[]);
+void dispveci(int n,int dt[]);
+void dispmatd2(int from, int upto, double mat[][2]);
+void dispmatd3(int from, int upto, double mat[][3]);
+void dispmatd4(int from, int upto, double mat[][4]);
+void dispmatd5(int from, int upto, double mat[][5]);
+void dispmatd6(int from, int upto, double mat[][6]);
+void dispmatd2all(double mat[][2]);
+void dispmatd3all(double mat[][3]);
+void dispmatd4all(double mat[][4]);
+void dispmatd5all(double mat[][5]);
+void dispmatd6all(double mat[][6]);
+void dispmati2(int from, int upto, int mat[][2]);
+void dispmati1(int from, int upto, int mat[]);
+void readdata3(const char *fname, double out[][3]);
+void readdata2(const char *fname, double out[][2]);
+int output2(const char *var, const char *fname, int level, double out[][2]);
+void simplesort(double number[]);
+int memberi(int a, int list[]);
+double dotprod(int dim, double p[], double q[]);
+double norm(int dim, double p[]);
+double dist(int dim, double p[], double q[]);
+void crossprod(int dim,double a[3],double b[3], double out[3]);
+void reflectpoint(double p1[2],double regard[][2],double p2[2]);
+void pointoncurve(double t, double gdata[][2], double eps, double pt[]);
+int partcrv(double a,double b,double pkL[][2], double pL[][2]);
+int partcrv3(double a,double b,double pkL[][3], double pL[][3]);
+int connectseg(double pdata[][2], double eps, double out[][2]);
+void koutenseg(double a[2], double b[2], double c[2], double d[2],
+ double eps, double eps2, double out[4]);
+double paramoncurve(double p[2], int n, double ptL[][2]);
+void nearestptpt(double pa[2], double pL[][2], double ans[4]);
+int intersectselfPp(double data1[][2],double eps,double eps1s,double kL[][4]);
+int intersectcrvsPp(double data1[][2], double data2[][2],
+ double eps,double eps1s, double kL[][4]);
+int dropnumlistcrv(double qd[][2], double eps1, int out[]);
+int increasept2(double ptL[][2], int nn, double out[][2]);
+int increasept3(double ptL[][3], int nn, double out[][3]);
+void bezierpt(double t, double p0[2], double p3[2],
+ double p1[2], double p2[2], double ptout[2]);
+int bezier(double ptL[][2], double ctrL[][4], int num, double out[][2]);
+int ospline(int level, double ptL[][2], int num, double out[][2]);
+void bezierpt3(double t, double p0[3], double p3[3],
+ double p1[3], double p2[3], double ptout[3]);
+int bezier3(double ptL[][3], double ctrL[][6], int num, double out[][3]);
+int ospline3(int level, double ptL[][3], int num, double out[][3]);
+void segplot(double x1,double y1,double x2,double y2,double seg[][2]);
+void addsegplot(double x1,double y1,double seg[][2]);
+void circledata(double cx,double cy,double r, int num,double out[][2]);
+void intersectline(double p1[2],double v1[2], double p2[2],double v2[2],double out[4]);
+void intersectseg(double seg1[][2],double seg2[][2], double out[5]);
+int osplineseg(double ptlist[5][2],int num,double out[][2]);
+void intersectpartseg(double crv1[][2],double crv2[][2],int ii, int jj,int num,double out[6]);
+void collectsameseg(double ptdL[][6],double rL[][6]);
+void intersectcurvesPp(double crv1s[][2],double crv2s[][2],int num,double out[][6]);
+void intersectcurves(double crv1[][2],double crv2[][2],int num,double out[][2]);
+
+const double Inf=99999;
+const int Infint=30000;
diff --git a/texmf-dist/scripts/ketcindy/ketlibC/surflib.h b/texmf-dist/scripts/ketcindy/ketlibC/surflib.h
index 1b2f6c48..d9c0fbdc 100644
--- a/texmf-dist/scripts/ketcindy/ketlibC/surflib.h
+++ b/texmf-dist/scripts/ketcindy/ketlibC/surflib.h
@@ -1,7 +1,7 @@
// 17.06.16 crvsfparadata changed ( num of devision )
int output3(const char *var, const char *fname, int level, double out[][3]){
- int nall=floor(out[0][0]+0.5), ndin, din[DsizeM][2],i,j;
+ int nall=floor(out[0][0]+0.5), ndin, din[DsizeM][2],i,j,ctr;
double tmpd[3];
FILE *fp;
fp=fopen(fname,"w");
@@ -16,11 +16,18 @@ int output3(const char *var, const char *fname, int level, double out[][3]){
for(i=1; i<=ndin; i++){
fprintf(fp,"start//\n");
fprintf(fp,"[");
+ ctr=0;
for(j=din[i][0]; j<=din[i][1]; j++){
pull3(j,out,tmpd);
fprintf(fp,"[ %7.5f, %7.5f, %7.5f]",tmpd[0],tmpd[1],tmpd[2]);
- if(j<din[i][1]){
- fprintf(fp,",");
+ ctr++;
+ if(ctr==5){
+ fprintf(fp,"]//\n[");
+ ctr=0;
+ }else{
+ if(j<din[i][1]){
+ fprintf(fp,",");
+ }
}
}
fprintf(fp,"]//\n");
@@ -38,7 +45,7 @@ int output3(const char *var, const char *fname, int level, double out[][3]){
int output3h(const char *var, const char *varh, const char *fname, double out[][3]){
// 17.06.09
double out1[DsizeLL][3], tmpd[3];
- int din1[DsizeM][2],ndin2, din2[DsizeM][2], i, j;
+ int din1[DsizeM][2],din2[DsizeM][2], i, j,ctr;
FILE *fp;
fp=fopen(fname,"w");
if (fp == NULL) {
@@ -48,16 +55,25 @@ int output3h(const char *var, const char *varh, const char *fname, double out[][
dataindexd3(3,out,din1);
out1[0][0]=0;
appendd3(0, din1[1][0],din1[1][1],out,out1);
- ndin2=dataindexd3(2, out1,din2);
+ dataindexd3(2, out1,din2);
fprintf(fp,"%s//\n",var);
- for(i=1; i<=ndin2; i++){
+ for(i=1; i<=length2i(din2); i++){
fprintf(fp,"start//\n");
fprintf(fp,"[");
+ ctr=0;
for(j=din2[i][0]; j<=din2[i][1]; j++){
pull3(j,out1,tmpd);
fprintf(fp,"[ %7.5f, %7.5f, %7.5f]",tmpd[0],tmpd[1],tmpd[2]);
- if(j<din2[i][1]){
- fprintf(fp,",");
+ ctr++;
+ if(ctr==5){
+ if(j<din2[i][1]){
+ fprintf(fp,"]//\n[");
+ ctr=0;
+ }
+ }else{
+ if(j<din2[i][1]){
+ fprintf(fp,",");
+ }
}
}
fprintf(fp,"]//\n");
@@ -66,15 +82,23 @@ int output3h(const char *var, const char *varh, const char *fname, double out[][
out1[0][0]=0;
fprintf(fp,"%s//\n",varh); //17.06.16from
appendd3(0, din1[2][0],din1[2][1],out,out1);
- ndin2=dataindexd3(2, out1,din2);
- for(i=1; i<=ndin2; i++){
+ dataindexd3(2, out1,din2);
+ for(i=1; i<=length2i(din2); i++){
fprintf(fp,"start//\n");
fprintf(fp,"[");
for(j=din2[i][0]; j<=din2[i][1]; j++){
pull3(j,out1,tmpd);
fprintf(fp,"[ %7.5f, %7.5f, %7.5f]",tmpd[0],tmpd[1],tmpd[2]);
- if(j<din2[i][1]){
- fprintf(fp,",");
+ ctr++;
+ if(ctr==5){
+ if(j<din2[i][1]){
+ fprintf(fp,"]//\n[");
+ ctr=0;
+ }
+ }else{
+ if(j<din2[i][1]){
+ fprintf(fp,",");
+ }
}
}
fprintf(fp,"]//\n");
@@ -174,14 +198,14 @@ double invparapt(double ph, double fh[][2], double fk[][3],double out[3]){
return n+s0;
}
-int surfcurve(int level, double crv[][2], double pdata[][3]){
+int surfcurve(short ch,int level, double crv[][2], double pdata[][3]){
double p2[2], pt[3];
int i, n, nall;
n=length2(crv);
pdata[0][0]=0;
for(i=1; i<=n; i++){
pull2(i,crv,p2);
- surffun(p2[0],p2[1],pt);
+ surffun(ch,p2[0],p2[1],pt);
nall=addptd3(pdata,pt);
}
return nall;
@@ -205,24 +229,25 @@ int xyzax3data(double x0, double x1, double y0, double y1, double z0, double z1,
return nall;
}
-void evlptablepara(void){
+void evlptablepara(short ch){
int i, j;
double u,v,u1,u2,v1,v2,pt1[3],pt2[3],pt2d1[2],pt2d2[2],dxu,dyu,dxv,dyv;
double du=(Urng[1]-Urng[0])/Mdv, dv=(Vrng[1]-Vrng[0])/Ndv;
+ double eps=0.00001;
for (j= 0; j < Ndv+1; j++) {
v=Vrng[0]+j*dv;
- v1=v-Eps/2; v2=v+Eps/2;
+ v1=v-eps/2; v2=v+eps/2;
for (i = 0; i < Mdv+1; i++) {
u=Urng[0]+i*du;
- u1=u-Eps/2; u2=u+Eps/2;
- surffun(u1,v,pt1); parapt(pt1,pt2d1);
- surffun(u2,v,pt2); parapt(pt2,pt2d2);
- dxu=(pt2d2[0]-pt2d1[0])/Eps;
- dyu=(pt2d2[1]-pt2d1[1])/Eps;
- surffun(u,v1,pt1); parapt(pt1,pt2d1);
- surffun(u,v2,pt2); parapt(pt2,pt2d2);
- dxv=(pt2d2[0]-pt2d1[0])/Eps;
- dyv=(pt2d2[1]-pt2d1[1])/Eps;
+ u1=u-eps/2; u2=u+eps/2;
+ surffun(ch,u1,v,pt1); parapt(pt1,pt2d1);
+ surffun(ch,u2,v,pt2); parapt(pt2,pt2d2);
+ dxu=(pt2d2[0]-pt2d1[0])/eps;
+ dyu=(pt2d2[1]-pt2d1[1])/eps;
+ surffun(ch,u,v1,pt1); parapt(pt1,pt2d1);
+ surffun(ch,u,v2,pt2); parapt(pt2,pt2d2);
+ dxv=(pt2d2[0]-pt2d1[0])/eps;
+ dyv=(pt2d2[1]-pt2d1[1])/eps;
Zval[j][i]=dxu*dyv-dxv*dyu;
}
}
@@ -234,6 +259,100 @@ void evlptablepara(void){
}
};
+double evlpfun(short ch, double u, double v){
+ double u1,u2,v1,v2,pt1[3],pt2[3],pt2d1[2],pt2d2[2],dxu,dyu,dxv,dyv;
+ double du=(Urng[1]-Urng[0])/Mdv, dv=(Vrng[1]-Vrng[0])/Ndv;
+ double eps=0.00001;
+ u1=u-eps/2; u2=u+eps/2;
+ if(u1<Urng[0]){u1=Urng[0];}
+ if(u2>Urng[1]){u2=Urng[1];}
+ surffun(ch,u1,v,pt1); parapt(pt1,pt2d1);
+ surffun(ch,u2,v,pt2); parapt(pt2,pt2d2);
+ dxu=(pt2d2[0]-pt2d1[0])/(u2-u1);
+ dyu=(pt2d2[1]-pt2d1[1])/(u2-u1);
+ v1=v-eps/2; v2=v+eps/2;
+ if(v1<Vrng[0]){v1=Vrng[0];}
+ if(v2>Vrng[1]){v2=Vrng[1];}
+ surffun(ch,u,v1,pt1); parapt(pt1,pt2d1);
+ surffun(ch,u,v2,pt2); parapt(pt2,pt2d2);
+ dxv=(pt2d2[0]-pt2d1[0])/(v2-v1);
+ dyv=(pt2d2[1]-pt2d1[1])/(v2-v1);
+ return dxu*dyv-dxv*dyu;
+};
+
+int envelopedata(short ch, double out[][2]){
+ int i, j, k, ctrq=0,ctr, nall;
+ double uval1,uval2,vval1,vval2,eval11,eval12,eval21,eval22;
+ double pl[5][2], vl[5], ql[11][2], out2[DsizeM][2];
+ double du=(Urng[1]-Urng[0])/Mdv;
+ double dv=(Vrng[1]-Vrng[0])/Mdv;
+ ctr=0;
+ for (j = 0; j < Ndv; j++) {
+ vval1=Vrng[0]+j*dv;
+ vval2=Vrng[0]+(j+1)*dv;
+ uval1=Urng[0];
+ eval11=evlpfun(ch,uval1,vval1);
+ eval12=evlpfun(ch,uval1,vval2);
+ for (i = 0; i < Mdv; i++) {
+ uval2=Urng[0]+(i+1)*du;
+ eval21=evlpfun(ch,uval2,vval1);
+ eval22=evlpfun(ch,uval2,vval2);
+ pl[0][0]=uval1; pl[0][1]=vval1; vl[0]=eval11;
+ pl[1][0]=uval2; pl[1][1]=vval1; vl[1]=eval21;
+ pl[2][0]=uval2; pl[2][1]=vval2; vl[2]=eval22;
+ pl[3][0]=uval1; pl[3][1]=vval2; vl[3]=eval12;
+ pl[4][0]=uval1; pl[4][1]=vval1; vl[4]=eval11;
+ ctrq=0;
+ for (k = 0; k < 4; k++) {
+ if(fabs(vl[k])<=Eps){
+ ql[ctrq][0]=pl[k][0];
+ ql[ctrq][1]=pl[k][1];
+ ctrq++;
+ }
+ else if(vl[k]>Eps){
+ if(vl[k+1]< -Eps){
+ ql[ctrq][0]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][0]+vl[k]*pl[k+1][0]);
+ ql[ctrq][1]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][1]+vl[k]*pl[k+1][1]);
+ ctrq++;
+ }
+ }
+ else{
+ if(vl[k+1]>Eps){
+ ql[ctrq][0]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][0]-vl[k]*pl[k+1][0]);
+ ql[ctrq][1]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][1]-vl[k]*pl[k+1][1]);
+ ctrq++;
+ }
+ }
+ }
+ uval1=uval2;
+ eval11=eval21;
+ eval12=eval22;
+ if(ctrq==2){
+ if(ctr>0){
+ ctr++;
+ out[ctr][0]=Inf;
+ out[ctr][1]=2; // 2 <- 0 ?
+ }
+ ctr++;
+ out[ctr][0]=ql[0][0];
+ out[ctr][1]=ql[0][1];
+ ctr++;
+ out[ctr][0]=ql[1][0];
+ out[ctr][1]=ql[1][1];
+ }
+ }
+ }
+ out[0][0]=ctr;
+ if(ctr>0){
+ nall=connectseg(out, Eps, out2);
+ out[0][0]=0;
+ nall=appendd2(2,1,nall,out2,out);
+ }
+ return nall;
+}
+
+/*
+
int implicitplot(double out[][2]){
int i, j, k, ctrq=0,ctr, nall;
double pl[5][2], vl[5], ql[11][2], out2[DsizeM][2];
@@ -291,7 +410,9 @@ int implicitplot(double out[][2]){
return nall;
}
-int cuspsplitpara(double pdata[][2], double outkL[][3]){
+*/
+
+int cuspsplitpara(short ch,double pdata[][2], double outkL[][3]){
int i, j, ng, n, nd, ndd, ndrop, is, ncusp=0, ncusppt,st, en, npk,nph, cflg;
int cusp[DsizeM], cuspflg;
int ntmp,ntmp1,ntmp2, ntmpnum, noutkL=0, noutk=0, nout=0;
@@ -314,7 +435,7 @@ int cuspsplitpara(double pdata[][2], double outkL[][3]){
npk=0; nph=0;
for(i=1; i<=en-st+1; i++){
pull2(st+i-1,pdata,tmp);
- surffun(tmp[0],tmp[1],pt3d);
+ surffun(ch,tmp[0],tmp[1],pt3d);
parapt(pt3d,pt2d);
if(i==1){
npk=addptd3(ptk,pt3d);
@@ -476,7 +597,7 @@ int cuspsplitpara(double pdata[][2], double outkL[][3]){
return noutkL;
}
-int makexybdy(double ehL[][2]){
+int makexybdy(short ch,double ehL[][2]){
int i, nehL, ntmpd2;
double ptd3[3],ptd2[2],tmpd2[DsizeM][2],du,dv;
ehL[0][0]=0; nehL=0;
@@ -485,7 +606,7 @@ int makexybdy(double ehL[][2]){
if(DrawE==1){
tmpd2[0][0]=0; ntmpd2=0;
for(i=0; i<=Ndv; i++){
- surffun(Urng[1],Vrng[0]+i*dv,ptd3);
+ surffun(ch,Urng[1],Vrng[0]+i*dv,ptd3);
ntmpd2=push2(ptd3[0],ptd3[1],tmpd2);
}
nehL=appendd2(2,1,ntmpd2,tmpd2,ehL);
@@ -493,7 +614,7 @@ int makexybdy(double ehL[][2]){
if(DrawN==1){
tmpd2[0][0]=0; ntmpd2=0;
for(i=0; i<=Mdv; i++){
- surffun(Urng[0]+i*du,Vrng[1],ptd3);
+ surffun(ch,Urng[0]+i*du,Vrng[1],ptd3);
ntmpd2=push2(ptd3[0],ptd3[1],tmpd2);
}
nehL=appendd2(2,1,ntmpd2,tmpd2,ehL);
@@ -501,7 +622,7 @@ int makexybdy(double ehL[][2]){
if(DrawW==1){
tmpd2[0][0]=0; ntmpd2=0;
for(i=0; i<=Ndv; i++){
- surffun(Urng[0],Vrng[0]+i*dv,ptd3);
+ surffun(ch,Urng[0],Vrng[0]+i*dv,ptd3);
ntmpd2=push2(ptd3[0],ptd3[1],tmpd2);
}
nehL=appendd2(2,1,ntmpd2,tmpd2,ehL);
@@ -509,7 +630,7 @@ int makexybdy(double ehL[][2]){
if(DrawS==1){
tmpd2[0][0]=0; ntmpd2=0;
for(i=0; i<=Mdv; i++){
- surffun(Urng[0]+i*du,Vrng[0],ptd3);
+ surffun(ch,Urng[0]+i*du,Vrng[0],ptd3);
ntmpd2=push2(ptd3[0],ptd3[1],tmpd2);
}
nehL=appendd2(2,1,ntmpd2,tmpd2,ehL);
@@ -517,142 +638,98 @@ int makexybdy(double ehL[][2]){
return nehL;
}
-int partitionseg(double fig[][2],double gL[][2], int ns, double out[]){
- int nother, ndin, din[DsizeM][2], ndin2, din2[DsizeM][2];
- int npar,nkouL, nout, ng;
- int npt=length2(fig), ngL=length2(gL), npp;
- int i, j, jj, n, k, ntmp1, ntmp2, ntmp3,tmp2i1[DsizeM], flg;
- double eps0=pow(10,-5.0),tmp1d2[2], tmp2d2[2],tmpd4[4], dtmp, s;
- double p[2], q[2], pd3[3], ans[4], tmp1d1[DsizeM], tmp2d1[DsizeM], tmp3d1[DsizeM];
- double other[DsizeM], parL[DsizeM], g[DsizeM][2], kouL[DsizeM][4];
+void partitionseg(double fig[][2],double gL[][2], int ns, double parL[]){
+ int ii,jj,kk,n,din[DsizeM][2],din2[DsizeM][2];
+ double eps0=pow(10,-5.0),tmpd4[4], tmpd6[6],tmp,tmp2;
+ double p[2], q[2], pd3[3], ans[4], tmp1d1[DsizeM], tmp2d1[DsizeM];
+ double other[DsizeM], g[DsizeM][2], kouL[DsizeS][4],kouL6[DsizeS][6];
if(ns>1){
- ndin=dataindexd1(Otherpartition,din);
- other[0]=0; nother=0;
- for(i=din[ns][0]; i<=din[ns][1]; i++){
- dtmp=Otherpartition[i];
- nother++;
- other[nother]=dtmp;
+ dataindexd1(Otherpartition,din);
+ other[0]=0;
+ for(ii=din[ns][0]; ii<=din[ns][1]; ii++){
+ appendd1(other,Otherpartition[ii]);
}
+ }else{
+ other[0]=0;
}
- else{
- other[0]=0; nother=0;
- Otherpartition[0]=0;
- ndin=dataindexd2(2,gL,din);
- for(i=1; i<=ndin-1; i++){
- Otherpartition[i]=Inf; Otherpartition[0]++;
- }
- }
- parL[1]=1; parL[2]=npt;
- parL[0]=2; npar=2;
- if(nother>0){
- for(i=1; i<=nother; i++){
- npar=appendd1(parL,other[i]);
+ parL[0]=0;
+ appendd1(parL,1);
+ appendd1(parL,length2(fig));
+ if(length1(other)>0){
+ for(ii=1; ii<=length1(other); ii++){
+ appendd1(parL,other[ii]);
}
}
- ndin=dataindexd2(2,gL,din);
- for(n=ns; n<=ndin; n++){
+ dataindexd2(2,gL,din);
+ for(n=ns; n<=din[0][0]; n++){
g[0][0]=0;
- ng=appendd2(0,din[n][0],din[n][1],gL,g);
- flg=0;
- for(i=1; i<=ng; i++){
- pull2(i,fig,tmp1d2);
- pull2(i,g,tmp2d2);
- if(dist(2,tmp1d2,tmp2d2)>Eps){
- flg=1;
- break;
- }
- }
- if(flg==0){
- nkouL=intersectselfPp(fig,Eps1, Eps2,kouL);
- }
- else{
- nkouL=intersectcrvsPp(fig, g, Eps1, Eps2, kouL);
- pull2(1,fig,tmp1d2);
- nearestptpt(tmp1d2,g,ans);
- if((ans[3]>eps0)&&(ans[3]<Eps1)){
- tmpd4[0]=ans[0]; tmpd4[1]=ans[1];
- tmpd4[2]=1; tmpd4[3]=floor(ans[2]+Eps);
- nkouL=addptd4(kouL, tmpd4);
+ appendd2(2,din[n][0],din[n][1],gL,g);
+ intersectcurvesPp(fig,g,20,kouL6);
+ kouL[0][0]=0;
+ for(ii=1;ii<=length6(kouL6);ii++){
+ pull6(ii,kouL6,tmpd6);
+ push4(tmpd6[0],tmpd6[1],tmpd6[2],tmpd6[3],kouL);
+ }
+ tmp1d1[0]=0;tmp2d1[0]=0;
+ for(jj=1;jj<=length4(kouL);jj++){
+ pull4(jj,kouL,tmpd4);
+ tmp=tmpd4[2];
+ if((tmp>1+Eps)&&(tmp<length2(fig)-Eps)){
+ appendd1(tmp1d1,tmp);
}
- pull2(npt,fig,tmp1d2);
- nearestptpt(tmp1d2,g, ans);
- tmpd4[0]=ans[0]; tmpd4[1]=ans[1];
- tmpd4[2]=ans[2]; tmpd4[3]=ans[3];
- if((tmpd4[3]>eps0)&&(tmpd4[3]<Eps1)){
- tmpd4[2]=npt; tmpd4[3]=floor(ans[2]+Eps);
- nkouL=addptd4(kouL, tmpd4);
- }
- }
- for(i=1; i<=nkouL; i++){
- p[0]=kouL[i][0]; p[1]=kouL[i][1]; //dim(kouL)=4
- s=kouL[i][2];
- npar=appendd1(parL,s);
- k=floor(kouL[i][3]+Eps);
- s=paramoncurve(p,k,g);
- ndin2=dataindexd1(Otherpartition,din2);
- ntmp1=din2[n][1]-din2[n][0]+1;
- for(j=1; j<=ntmp1; j++){
- tmp1d1[j]=Otherpartition[din2[n][0]+j-1];
+ tmp=tmpd4[3];
+ if((tmp>1+Eps)&&(tmp<length2(g)-Eps)){
+ appendd1(tmp2d1,tmp);
}
- tmp1d1[0]=ntmp1;
- ntmp1=appendd1(tmp1d1,s);
- simplesort(tmp1d1);
- tmp2d1[0]=0; ntmp2=0;
- for(j=1; j<=ndin2; j++){
- tmp3d1[0]=0; ntmp3=0;
- ndin2=dataindexd1(Otherpartition,din2);
- for(jj=din2[j][0]; jj<=din2[j][1]; jj++){
- ntmp3=appendd1(tmp3d1,Otherpartition[jj]);
- }
- if(j!=n){
- for(jj=1; jj<=ntmp3; jj++){
- ntmp2=appendd1(tmp2d1,tmp3d1[jj]);
+ }
+ for(jj=1;jj<=length1(tmp1d1);jj++){
+ appendd1(parL,tmp1d1[jj]);
+ }
+ if((ns>0)&&(n>ns)&&(length1(tmp2d1)>0)){
+ dataindexd1(Otherpartition,din);
+ tmp1d1[0]=0;
+ for(ii=1;ii<=length2i(din);ii++){
+ if(ii==n){
+ for(kk=1;kk<=length1(tmp2d1);kk++){
+ appendd1(tmp1d1,tmp2d1[kk]);
}
}
- else{
- for(jj=1; jj<=ntmp1; jj++){
- ntmp2=appendd1(tmp2d1,tmp1d1[jj]);
- }
+ for(jj=din[ii][0]; jj<=din[ii][1];jj++){
+ appendd1(tmp1d1,Otherpartition[jj]);
+ }
+ if(ii<length2i(din)){
+ appendd1(tmp1d1,Inf);
}
- ntmp2=appendd1(tmp2d1,Inf);
}
- ntmp2--;
- for(j=1; j<=ntmp2; j++){
- Otherpartition[j]=tmp2d1[j];
+ }
+ dataindexd1(tmp1d1,din);
+ Otherpartition[0]=0;
+ for(ii=1;ii<=length2i(din);ii++){
+ for(jj=din[ii][0];jj<=din[ii][1];jj++){
+ appendd1(Otherpartition,tmp1d1[jj]);
}
- Otherpartition[0]=ntmp2;
}
}
simplesort(parL);
- parL[1]=1;
- out[1]=parL[1];
- out[0]=1; nout=1;
- pointoncurve(parL[1],fig, Eps, p);
- Partitionpt[0][0]=0;
- npp=addptd2(Partitionpt, p);
- for(i=1; i<=npar; i++){
- pointoncurve(parL[i],fig, Eps, p);
- dtmp=out[nout];
- pointoncurve(dtmp,fig, Eps, q);
- if(dist(2,p,q)>Eps1){
- nout=appendd1(out,parL[i]);
- npp=addptd2(Partitionpt,p);
- }
- }
- if(out[nout]!=npt){
- out[nout]=npt;
- }
- if(nout==1){
- out[1]=1; out[2]=npt;
- out[0]=2; nout=2;
+ tmp1d1[0]=0;
+ for(ii=1;ii<=length1(parL);ii++){
+ appendd1(tmp1d1,parL[ii]);
+ }
+ parL[0]=0;
+ tmp2=-1;
+ for(jj=1;jj<=length1(tmp1d1);jj++){
+ tmp=tmp1d1[jj];
+ if(fabs(tmp-tmp2)>Eps1){
+ appendd1(parL,tmp);
+ tmp2=tmp;
+ }
}
- return nout;
}
-double funpthiddenQ(double u, double v, double pa[3]){
+double funpthiddenQ(short ch,double u, double v, double pa[3]){
double Vec[3]={sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)};
double eps0=pow(10,-4.0)*(XMAX-XMIN)/10, pt[3], out;
- surffun(u, v, pt);
+ surffun(ch,u, v, pt);
if((fabs(Vec[1])>eps0)||(fabs(Vec[0])>eps0)){
out=(Vec[1]*(pt[0]-pa[0])-Vec[0]*(pt[1]-pa[1]));
}
@@ -671,7 +748,7 @@ void makevaltable(double pta[3]){
v=Vrng[0]+j*dv;
for(i=0; i<=Mdv; i++){
u=Urng[0]+i*du;
- Zval[j][i]=funpthiddenQ(u, v, pta);
+ Zval[j][i]=funpthiddenQ(Ch,u, v, pta);
}
}
for(i=0; i<=Mdv; i++){
@@ -682,7 +759,7 @@ void makevaltable(double pta[3]){
}
}
-int pthiddenQ(double pta[3], int uveq, double eps[2]){
+int pthiddenQ(short ch,double pta[3], int uveq, double eps[2]){
int i, j, k, out, nqL, nsL, nptL, flg, nxt;
double Vec[3]={sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)};
double eps0, epspt, vec1[3], po[3]={0,0,0}, tmpd1, tmp1d1, tmp2d1, m1, m2;
@@ -737,8 +814,8 @@ int pthiddenQ(double pta[3], int uveq, double eps[2]){
if(nqL==2){
puv1[0]=qL[1][0]; puv1[1]=qL[1][1];
puv2[0]=qL[2][0]; puv2[1]=qL[2][1];
- surffun(puv1[0],puv1[1],p1d3);
- surffun(puv2[0],puv2[1],p2d3);
+ surffun(ch,puv1[0],puv1[1],p1d3);
+ surffun(ch,puv2[0],puv2[1],p2d3);
if(dist(2,p1d3,p2d3)<eps0){
continue;
}
@@ -935,18 +1012,18 @@ int nohiddenpara2(double paL[], double fk[][3], int uveq, double figkL[][3]){
s=(paL[n]+paL[n+1])/2.0;
ntmp=invparapt(s,fh,fk, pta);
parapt(pta,ptap);
- epstmp[0]=Eps1; epstmp[1]=Eps3;
+ epstmp[0]=Eps1; epstmp[1]=1;
if((n==1)&&(cspflg % 2==0)){
pull2(1,fh,p1);
dtmp=fmin(Eps1*dist(2,ptap, p1),Eps1);
- epstmp[0]=dtmp; epstmp[1]=Eps3;
+ epstmp[0]=dtmp; epstmp[1]=1;
}
if((n==npaL-1)&&(cspflg % 3==0)){
pull2(nfh,fh,p1);
dtmp=fmin(Eps1*dist(2, ptap, p1), Eps1);
- epstmp[0]=dtmp; epstmp[1]=Eps3;
+ epstmp[0]=dtmp; epstmp[1]=1;
}
- flg=pthiddenQ(pta, uveq, epstmp);
+ flg=pthiddenQ(Ch,pta, uveq, epstmp);
if(flg==0){
nseL=appendi1(seL,n);
}
@@ -1050,7 +1127,7 @@ int nohiddenpara2(double paL[], double fk[][3], int uveq, double figkL[][3]){
return nfigkL;
}
-int borderparadata(double fkL[][3], double fsL[][3]){
+int borderparadata(short ch,double fkL[][3], double fsL[][3]){
double ekL[DsizeL][3], fall[DsizeL][2], fbdxy[DsizeL][2];
double tmpd3[DsizeM][3], tmpd2[DsizeM][2], p[2], p3[3];
double figkL[DsizeM][3], du, dv;
@@ -1067,7 +1144,7 @@ int borderparadata(double fkL[][3], double fsL[][3]){
for(j=0; j<=Ndv; j++){
nall=add2(tmpd2, Urng[1], Vrng[0]+j*dv);
}
- nall=surfcurve(2, tmpd2,tmpd3);
+ nall=surfcurve(ch,2, tmpd2,tmpd3);
nekL=appendd3(2,1,nall,tmpd3,ekL);
}
if(DrawN==1){
@@ -1075,7 +1152,7 @@ int borderparadata(double fkL[][3], double fsL[][3]){
for(j=0; j<=Mdv; j++){
nall=add2(tmpd2, Urng[0]+j*du, Vrng[1]);
}
- nall=surfcurve(2, tmpd2,tmpd3);
+ nall=surfcurve(ch,2, tmpd2,tmpd3);
nekL=appendd3(2,1,nall,tmpd3,ekL);
}
if(DrawW==1){
@@ -1083,7 +1160,7 @@ int borderparadata(double fkL[][3], double fsL[][3]){
for(j=0; j<=Ndv; j++){
nall=add2(tmpd2, Urng[0], Vrng[0]+j*dv);
}
- nall=surfcurve(2, tmpd2,tmpd3);
+ nall=surfcurve(ch,2, tmpd2,tmpd3);
nekL=appendd3(2,1,nall,tmpd3,ekL);
}
if(DrawS==1){
@@ -1091,29 +1168,28 @@ int borderparadata(double fkL[][3], double fsL[][3]){
for(j=0; j<=Mdv; j++){
nall=add2(tmpd2, Urng[0]+j*du, Vrng[0]);
}
- nall=surfcurve(2, tmpd2,tmpd3);
+ nall=surfcurve(ch,2, tmpd2,tmpd3);
nekL=appendd3(2,1,nall,tmpd3,ekL);
}
if(nekL>0){
nfkL=appendd3(2,1,nekL,ekL,fkL);
}
nfall=projpara(fkL,fall);
- nfbdxy=makexybdy(fbdxy);
- Otherpartition[0]=0;
+ nfbdxy=makexybdy(ch,fbdxy);
ndin=dataindexd2(2,fall,din);
Borderpt[0][0]=0;
+ Otherpartition[0]=0;
for(i=1; i<=ndin-1; i++){
Otherpartition[i]=Inf; Otherpartition[0]++;
}
Borderhiddendata[0][0]=0;
- ndin=dataindexd2(2,fall,din);
ndin2=dataindexd3(2,fkL,din2);
for(i=1; i<= ndin2; i++){
tmpd3[0][0]=0;
ntmpd3=appendd3(0,din2[i][0],din2[i][1],fkL,tmpd3);
ntmpd2=projpara(tmpd3,tmpd2);
- npar=partitionseg(tmpd2,fall, 1,par);
- if(npar>2){
+ partitionseg(tmpd2,fall, 1,par);
+ if(length1(par)>2){
ntmp=npar-1;
tmpd2[0][0]=0; ntmpd2=0;
for(j=2; j<=ntmp; j++){
@@ -1139,24 +1215,152 @@ int borderparadata(double fkL[][3], double fsL[][3]){
return nfsL;
}
-int sfbdparadata(double outd3[][3]){
- double pdata[DsizeL][2], pdatad3[DsizeL][3];
- int nall, n;
- int cusp[DsizeM]; // remove?
- evlptablepara();
- nall=implicitplot(pdata);
- nall=cuspsplitpara(pdata, pdatad3);
+int dropnumlistcrv3(double qd[][3], double eps1, int out[]){
+ int i,j,k,nout,nall=length3(qd), nd, se, en, npd, nptL;
+ int din[DsizeM][2],ptL[DsizeL];
+ double eps=pow(10.0,-6.0), pd[DsizeL][3], p[3], tmp2d[3];
+ out[0]=0; nout=0;
+ nd=dataindexd3(2,qd,din);
+ for(j=1; j<=nd; j++){
+ se=din[j][0]; en=din[j][1];
+ pd[0][0]=0; npd=0;
+ npd=appendd3(0,se,en,qd,pd);
+ ptL[0]=0; nptL=0;
+ nptL=appendi1(ptL,1);
+ pull3(1,pd,p);
+ for(k=2; k<=npd-1; k++){
+ pull3(k,pd,tmp2d);
+ if(dist(3,p,tmp2d)>eps1){
+ nptL=appendi1(ptL,k);
+ pull3(k,pd,p);
+ }
+ }
+ pull3(npd-1,pd,p);
+ pull3(npd,pd,tmp2d);
+ if(dist(3,p,tmp2d)>eps){ // eps -> eps1 ?
+ nptL=appendi1(ptL,npd);
+ }
+// if(nptL==1){ptL[0]=0; nptL=0;}//180318db
+ if(nout>0){
+ nout=appendi1(out,Infint);
+ }
+ for(i=1; i<=nptL; i++){
+ nout=appendi1(out,ptL[i]);
+ }
+ }
+ out[0]=nout;
+ return nout;
+}
+
+int sfbdparadata(short ch,double outd3[][3]){
+ double pdatad3[DsizeL][3];
+ double pts[DsizeL][2],out3md[DsizeL][2],eps;
+ double tmpmd[DsizeL][2],tmp1md[DsizeL][2],tmp2md[DsizeL][2],tmp3md[DsizeL][2];
+ double tmpd[2],tmp1d[2],tmpd3[3],tmp1d3[3],tmp2d3[3],tmp2md3[DsizeL][3];
+ int din[DsizeS][2],nlist[DsizeL];
+ int ii,jj,kk,n,nall,flg;
+ envelopedata(ch, tmp3md);
+ out3md[0][0]=0;
+ pts[0][0]=0;
+ dataindexd2(2,tmp3md,din);
+ for(jj=1;jj<=length2i(din);jj++){
+ tmp1md[0][0]=0;
+ tmp2md3[0][0]=0;
+ for(kk=din[jj][0];kk<=din[jj][1];kk++){
+ pull2(kk,tmp3md,tmpd);
+ addptd2(tmp1md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmpd3);
+ addptd3(tmp2md3,tmpd3);
+ }
+ dropnumlistcrv3(tmp2md3,Eps1,nlist);
+ if(nlist[0]==1){
+ pull2(nlist[1],tmp1md,tmpd);
+ addptd2(pts,tmpd);
+ }else{
+ tmpmd[0][0]=0;
+ for(kk=1;kk<=nlist[0];kk++){
+ pull2(nlist[kk],tmp1md,tmpd);
+ addptd2(tmpmd,tmpd);
+ }
+ if(length2(tmpmd)>0){
+ appendd2(2,1,length2(tmpmd),tmpmd,out3md);
+ }
+ }
+ }
+ tmp3md[0][0]=0;
+ appendd2(2,1,length2(pts),pts,tmp3md);
+ pts[0][0]=0;
+ for(ii=1;ii<=length2(tmp3md);ii++){
+ pull2(ii,tmp3md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmp1d3);
+ flg=0;
+ for(jj=1;jj<=length2(pts);jj++){
+ pull2(jj,pts,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmp2d3);
+ if(dist(3,tmp1d3,tmp2d3)<Eps1){
+ flg=1; break;
+ }
+ }
+ if(flg==0){
+ pull2(ii,tmp3md,tmpd);
+ addptd2(pts,tmpd);
+ }
+ }
+ for(ii=1;ii<=length2(pts);ii++){
+ tmp3md[0][0]=0;
+ appendd2(2,1,length2(out3md),out3md,tmp3md);
+ out3md[0][0]=0;
+ pull2(ii,pts,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmp1d3);
+ dataindexd2(2,tmp3md,din);
+ for(jj=1;jj<=length2i(din);jj++){
+ tmp2md[0][0]=0;
+ appendd2(2,din[jj][0],din[jj][1],tmp3md,tmp2md);
+ pull2(jj,tmp3md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmp2d3);
+ eps=1;
+ for(kk=1;kk<=length2(tmp2md)-1;kk++){
+ pull2(kk,tmp2md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmp1d3);
+ pull2(kk+1,tmp2md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmpd3);
+ if(eps>dist(3,tmp1d3,tmpd3)){
+ eps=dist(3,tmp1d3,tmpd3);
+ }
+ }
+ pull2(1,tmp2md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmpd3);
+ if(dist(3,tmp1d3,tmpd3)<eps+Eps){
+ appendd2(2,ii,ii,pts,out3md);
+ for(kk=1;kk<=length2(tmp2md);kk++){
+ pull2(kk,tmp2md,tmpd);
+ addptd2(out3md,tmpd);
+ }
+ continue;
+ }
+ pull2(length2(tmp2md),tmp2md,tmpd);
+ surffun(ch,tmpd[0],tmpd[1],tmpd3);
+ if(dist(3,tmp1d3,tmpd3)<eps+Eps){
+ appendd2(2,1,length2(tmp2md),tmp2md,out3md);
+ pull2(ii,pts,tmpd);
+ addptd2(out3md,tmpd);
+ continue;
+ }
+ }
+ appendd2(2,1,length2(tmp2md),tmp2md,out3md);
+ }
+ nall=cuspsplitpara(ch,out3md, pdatad3);
n=length2(Cuspsplitpt);
Cusppt[0][0]=0;
nall=appendd2(0, 1,n,Cuspsplitpt,Cusppt);
- nall= borderparadata(pdatad3, outd3);
+ nall= borderparadata(ch,pdatad3, outd3);
push3(Inf,3,0,outd3);
nall=appendd3(0,1,length3(Borderhiddendata),Borderhiddendata,outd3);
push3(Inf,3,0,outd3);
return nall;
}
-void makevaltablemeet(double pa[3], double vec[3], double eps0){
+void makevaltablemeet(short ch,double pa[3], double vec[3], double eps0){
double u, v, du, dv, pt[3];
int i, j;
du=(Urng[1]-Urng[0])/Mdv;
@@ -1165,7 +1369,7 @@ void makevaltablemeet(double pa[3], double vec[3], double eps0){
v=Vrng[0]+j*dv;
for(i=0; i<=Mdv; i++){
u=Urng[0]+i*du;
- surffun(u, v, pt);
+ surffun(ch,u, v, pt);
if((fabs(vec[1])>eps0)||(fabs(vec[0])>eps0)){
Zval[j][i]=(vec[1]*(pt[0]-pa[0])-vec[0]*(pt[1]-pa[1]));
}
@@ -1182,7 +1386,7 @@ void makevaltablemeet(double pa[3], double vec[3], double eps0){
}
}
-int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]){
+int meetpoints(short ch,double pta[3], double ptb[3], double eps, double ptL[][3]){
double eps0=pow(10,-4.0), vec[3], out[DsizeM], pL[5][2], vL[5];
double qL[DsizeM][2], p1d2[2], p2d2[2], tmpd2[2], puv1d2[2], puv2d2[2];
double m1,m2, p1d3[3], p2d3[3], v1, v2, v3, ptd3[3], ptuvd2[2], tmp1d1;
@@ -1191,7 +1395,7 @@ int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]){
vec[0]=ptb[0]-pta[0]; vec[1]=ptb[1]-pta[1]; vec[2]=ptb[2]-pta[2];
out[0]=0; nout=0;
ptL[0][0]=0; nptL=0;
- makevaltablemeet(pta,vec,eps0);
+ makevaltablemeet(Ch,pta,vec,eps0);
for(j=0; j<=Ndv-2; j++){
for(i=0; i<=Mdv-2; i++){
pL[0][0]=Xval[i]; pL[0][1]=Yval[j]; vL[0]=Zval[j][i];
@@ -1225,8 +1429,8 @@ int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]){
if(nqL==2){
pull2(1, qL, puv1d2);
pull2(2, qL, puv2d2);
- surffun(puv1d2[0], puv1d2[1], p1d3);
- surffun(puv2d2[0], puv2d2[1], p2d3);
+ surffun(ch,puv1d2[0], puv1d2[1], p1d3);
+ surffun(ch,puv2d2[0], puv2d2[1], p2d3);
v1=vec[0]; v2=vec[1]; v3=vec[2];
if(fabs(v1)>eps0){
m1=pta[2]+v3/v1*(p1d3[0]-pta[0])-p1d3[2];
@@ -1296,7 +1500,7 @@ int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3
double fbdy[DsizeL][2], fk[DsizeM][3],fkp[DsizeM][3], outh[DsizeL][3];
double fh[DsizeM][2], parL[DsizeM], tmpmd3[DsizeM][3];
double ptL[DsizeM][3], tmpd2[2], tmpd3[3], tmp1d1, tmp2d1, dt;
- double po[2]={0,0}, epsd2[2]={Eps1,Eps3}, pa[3], pb[3];
+ double po[2]={0,0}, epsd2[2]={Eps1,1}, pa[3], pb[3];
int nbor=length3(Borderhiddendata), nfkL,nfbdkL, nfbdy, nfk, nall;
int ncshidden, npar, ndin, din[DsizeM][2], ndin2,din2[DsizeS][2];
int nn, i, j, k, n, nptL, nout;
@@ -1321,12 +1525,12 @@ int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3
}
nfk=appendd3(0,nfk,nfk,fkp,fk);
nall=projpara(fk,fh);
- npar=partitionseg(fh, fbdy,1, parL);
+ partitionseg(fh, fbdy,1, parL);
if(sepflg>=0){
for(i=1; i<=nfk-1; i++){
pull3(i,fk,pa);
pull3(i+1,fk,pb);
- nptL=meetpoints(pa,pb, Eps2,ptL);
+ nptL=meetpoints(Ch,pa,pb, Eps2,ptL);
for(j=1; j<=nptL; j++){
pull3(j,ptL,tmpd3);
parapt(tmpd3,tmpd2);
@@ -1394,7 +1598,7 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num,
nv=appendd1(vdiv,vdv[i]);
}
}
- nfbdxy=makexybdy(fbdxy);
+ nfbdxy=makexybdy(Ch,fbdxy);
Wirept[0][0]=0;
fsL[0][0]=0; nfsL=0;
fsLh[0][0]=0;
@@ -1407,13 +1611,13 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num,
p[0]=u; p[1]=v;
ntmp=addptd2(tmpmd2,p);
}
- nfkL=cuspsplitpara(tmpmd2, fkL);
+ nfkL=cuspsplitpara(Ch,tmpmd2, fkL);
ndin=dataindexd3(2,fkL,din);
for(j=1; j<=ndin; j++){
fk[0][0]=0;
nfk=appendd3(0, din[j][0], din[j][1], fkL,fk);
ntmp=projpara(fk,tmpmd2);
- npar=partitionseg(tmpmd2, fbdy, 1, par);
+ partitionseg(tmpmd2, fbdy, 1, par);
ntmp=length2(Partitionpt);
if(ntmp>2){
for(k=2; k<=ntmp; k++){
@@ -1436,13 +1640,13 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num,
p[0]=u; p[1]=v;
ntmp=addptd2(tmpmd2,p);
}
- nfkL=cuspsplitpara(tmpmd2, fkL);
+ nfkL=cuspsplitpara(Ch,tmpmd2, fkL);
ndin=dataindexd3(2,fkL,din);
for(j=1; j<=ndin; j++){
fk[0][0]=0;
nfk=appendd3(0, din[j][0], din[j][1], fkL,fk);
ntmp=projpara(fk,tmpmd2);
- npar=partitionseg(tmpmd2, fbdy, 1, par);
+ partitionseg(tmpmd2, fbdy, 1, par);
ntmp=length2(Partitionpt);
if(ntmp>2){
for(k=2; k<=ntmp; k++){
@@ -1464,13 +1668,13 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num,
/*
double cutfun(int ch, double u, double v){
double p[3],val ;
- surffun(u,v,p);
+ surffun(ch,u,v,p);
val=p[0]+p[1]-0.5;
return val;
}
*/
-void makevaltablecut(int ch){
+void makevaltablecut(int chcut){
double eps0=pow(10,-6.0), u, v, du, dv;
int i, j, nx=0, ny=0; ;
du=(Urng[1]-Urng[0])/Mdv;
@@ -1479,7 +1683,7 @@ void makevaltablecut(int ch){
v=Vrng[0]+j*dv;
for(i=0; i<=Mdv; i++){
u=Urng[0]+i*du;
- Zval[j][i]=cutfun(ch, u,v);
+ Zval[j][i]=cutfun(Ch,chcut, u,v);
}
}
for(i=0; i<=Mdv; i++){
@@ -1493,8 +1697,8 @@ void makevaltablecut(int ch){
int sfcutdata(int ch, double ekL[][3]){
double cutuvL[DsizeL][2], out1[DsizeM][2], out2[DsizeM][3], pt[3];
int i, j, nall, ndin, din[DsizeM][2], nekL,nout1,nout2;
- makevaltablecut(ch);
- nall=implicitplot(cutuvL);
+// makevaltablecut(ch); //180320
+// nall=implicitplot(cutuvL); //180320
ekL[0][0]=0; nekL=0;
ndin=dataindexd2(2,cutuvL,din);
for(i=1; i<=ndin; i++){
@@ -1502,7 +1706,7 @@ int sfcutdata(int ch, double ekL[][3]){
nout1=appendd2(2,din[i][0],din[i][1],cutuvL,out1);
out2[0][0]=0;
for(j=1; j<=nout1; j++){
- surffun(out1[j][0], out1[j][1], pt);
+ surffun(ch,out1[j][0], out1[j][1], pt);
nout2=addptd3(out2,pt);
}
nekL=appendd3(2,1,nout2,out2,ekL);
@@ -1598,7 +1802,7 @@ int kukannozoku(double jokyo[2], double kukanL[][2], double res[][2]){
int skeletondata3(double data[][3], double r00,
double eps1, double eps2, double allres[][3]){
double objL[DsizeLL][3], pltL[DsizeLL][3];
- double clipL[DsizeL][5];
+ double clipL[DsizeL][5],koc2d6[DsizeM][6],tmpd6[6];
double pts1[DsizeL][2],koc[DsizeM][4], koc2[DsizeM][4], kukanL[DsizeL][2];
double r0, t1, t2, z1, z2, tt, rr, origin[2], te, hh, ku[2], za, zb, ds[DsizeM],dmin;
double pt[2], pta[2], ptb[2], ptq[2];
@@ -1642,7 +1846,13 @@ int skeletondata3(double data[][3], double r00,
for(j=1; j<=length3(pltp); j++){
push2(pltp[j][0],pltp[j][1],plt2d);
}
- nkoc2=intersectcrvsPp(obj2d,plt2d,eps1,eps2,koc2);
+ intersectcurvesPp(obj2d,plt2d,20,koc2d6); //180324from
+ nkoc2=length6(koc2d6);
+ koc2[0][0]=0;
+ for(ii=1;ii<=nkoc2;ii++){
+ pull6(ii,koc2d6,tmpd6);
+ push4(tmpd6[0],tmpd6[1],tmpd6[2],tmpd6[3],koc2);
+ }//180324to
if(nkoc2>0){
koc[0][0]=0; nkoc=0;
pull2(1,plt2d,pta);
diff --git a/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h b/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h
index 49d2ed4c..df31a4d8 100644
--- a/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h
+++ b/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h
@@ -1,6 +1,10 @@
double Xval[DsizeS], Yval[DsizeS], Zval[DsizeS][DsizeS];
-double Implicitdata[DsizeL][2];
+//////////////////////
+short Ch=1;
+/////////////////////
+
+//double Implicitdata[DsizeL][2]; //180320
double Cuspsplitpt[DsizeL][2];
double Cusppt[DsizeM][2];
double Otherpartition [DsizeM];
@@ -21,21 +25,25 @@ int readdataC(const char *fname, double data[][3]);
void parapt(double pt3[3],double pt2[2]);
int projpara(double p3[][3], double p2[][2]);
double invparapt(double ph, double fh[][2], double fk[][3],double out[3]);
-int surfcurve(int level, double crv[][2], double pdata[][3]);
+int surfcurve(short ch,int level, double crv[][2], double pdata[][3]);
int xyzax3data(double x0, double x1, double y0, double y1, double z0, double z1,
double out[][3]);
-void evlptablepara(void);
-int implicitplot(double out[][2]);
-int cuspsplitpara(double pdata[][2], double outkL[][3]);
-int makexybdy(double ehL[][2]);
-int partitionseg(double fig[][2],double gL[][2], int ns, double out[]);
-void makevaltablepth(double pta[3]);
-int pthiddenQ(double pta[3], int uveq, double eps[2]);
+double evlpfun(short ch, double u, double v);
+int envelopedata(short ch, double out[][2]);
+void evlptablepara(short ch);
+//int implicitplot(double out[][2]);
+int cuspsplitpara(short ch,double pdata[][2], double outkL[][3]);
+double funpthiddenQ(short ch,double u, double v, double pa[3]);
+int makexybdy(short ch,double ehL[][2]);
+void partitionseg(double fig[][2],double gL[][2], int ns, double parL[]);
+void makevaltablepth(short ch,double pta[3]);
+int pthiddenQ(short ch,double pta[3], int uveq, double eps[2]);
int nohiddenpara2(double paL[], double fk[][3], int uveq, double figkL[][3]);
-int borderparadata(double fkL[][3], double fsL[][3]);
-int sfbdparadata(double outd3[][3]);
-void makevaltablemeet(double pa[3], double vec[3], double eps0);
-int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]);
+int borderparadata(short ch,double fkL[][3], double fsL[][3]);
+int dropnumlistcrv3(double qd[][3], double eps1, int out[]);
+int sfbdparadata(short ch,double outd3[][3]);
+void makevaltablemeet(short ch,double pa[3], double vec[3], double eps0);
+int meetpoints(short ch,double pta[3], double ptb[3], double eps, double ptL[][3]);
int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3]);
int sfcutdata(int ch, double ekL[][3]);
int crv3onsfparadata(double fk[][3], double fbdyd3[][3], double out[][3]);
@@ -46,4 +54,5 @@ int kukannozoku(double jokyo[2], double kukanL[][2], double res[][2]);
int skeletondata3(double data[][3], double r00, double eps1, double eps2,
double allres[][3]);
-double cutfun(int ch,double u, double v);
+double cutfun(short ch,int chcut,double u, double v);
+void makevaltablecut(int chcut);
diff --git a/texmf-dist/scripts/ketcindy/ketoutset.txt b/texmf-dist/scripts/ketcindy/ketoutset.txt
index f5709f55..38381ef2 100644
--- a/texmf-dist/scripts/ketcindy/ketoutset.txt
+++ b/texmf-dist/scripts/ketcindy/ketoutset.txt
@@ -61,18 +61,6 @@ if(islinux(),
PathAd="";
);
-if(isstring(Homehead),
- setdirectory(Homehead+pathsep()+getname());
- import("ketcindyhead.txt");
-,
- Dirfile=gethome()+pathsep()+"ketcindy";
-);
-println(makedir(Dirfile,"ketwork"));
-Dirwork=Dirfile+pathsep()+"ketwork";
-Dirwork=replace(Dirwork,pathsep()+pathsep(),pathsep());
-
-setdirectory(Dirwork);
-
if(indexof(PathT,"platex")>0,
Helplist(["+","+3d","+mv"],"helpJ");
,
diff --git a/texmf-dist/scripts/ketcindy/setketcindy.txt b/texmf-dist/scripts/ketcindy/setketcindy.txt
index a4c7fab2..39de2543 100644..100755
--- a/texmf-dist/scripts/ketcindy/setketcindy.txt
+++ b/texmf-dist/scripts/ketcindy/setketcindy.txt
@@ -1,7 +1,6 @@
-// e:2017.10.30
+// e:2018.02.26
Dirlib=Dirhead+pathsep()+"ketlib";
-Libname=Dirlib+pathsep()+"ketpic5_2_3";
-//LibnameS=Dirlib+pathsep()+"ketpicsciL6";
+Libname=Dirlib+pathsep()+"ketpiccurrent";
DirlibC=Dirhead+pathsep()+"ketlibC";
setdirectory(Dirlib);
import("ketcindylibbasic1r.cs");
diff --git a/texmf-dist/scripts/ketcindy/template1basic.cdy b/texmf-dist/scripts/ketcindy/template1basic.cdy
index e8bfa29a..806d69f2 100644
--- a/texmf-dist/scripts/ketcindy/template1basic.cdy
+++ b/texmf-dist/scripts/ketcindy/template1basic.cdy
Binary files differ
diff --git a/texmf-dist/scripts/ketcindy/template2advanced.cdy b/texmf-dist/scripts/ketcindy/template2advanced.cdy
index d7d6e55b..3fa2e25a 100644..100755
--- a/texmf-dist/scripts/ketcindy/template2advanced.cdy
+++ b/texmf-dist/scripts/ketcindy/template2advanced.cdy
Binary files differ