summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r')
-rwxr-xr-xMaster/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r796
1 files changed, 497 insertions, 299 deletions
diff --git a/Master/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r b/Master/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r
index 840f076cf8e..160710e857b 100755
--- a/Master/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r
+++ b/Master/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r
@@ -16,10 +16,54 @@
#########################################
-ThisVersion<- "KeTpic for R v5_2_4(20180615)"
+ThisVersion<- "KeTpic for R v5_2_4(20181024)"
print(ThisVersion)
+# 20181024
+# Wireparadata debugged ( for DuL(DvL)=c(..) )
+# Nohiddenpara2 debugged (for SeL=Null )
+# 20181020
+# Setscaling changed ( Setscaling(scalex,scaley) supported )
+# 20181019
+# Arrowhead changed(debugged) ( for basic1.cs )
+# 20181017
+# Drwxy debugged (Doscaling)
+# Arrowhead debugged (Unscaling removed)
+# Paramplot debugged (Assign(fun,var,"t"))
+# 20181015
+# Listplot debugged ( Unscaling implemented )
+# 20180929
+# Paramplot Plotdata, Spacecurve , Implicitplot changed
+# ( Dt,dx not divided by N)
+# Shade changed (Kyoukai => Joincrvs)
+# 20180928
+# Paramplot changed ( case of stationary point)
+# 20180901
+# Objcurve debugged ( Assign rewritten )
+# 20180820,21
+# Drwxy changed ( optional arguments added )
+# Setax changed (ARROWSIZE removed )
+# 20180812
+# Assign debugged ( case nchar(vname)>1)
+# 20180808
+# Scalept3pt changed (ratio)
+# 20180807
+# Reflect3pt,Reflect3data,Scale3pt,Scale3data added
+# 20180717
+# Hatchdata debugged (width option)
+# Enclosing debugged ( for closed curve )
+# 20180713
+# Enclosing2 debugged (for Lineplot: distance of pts added)
+# 20180711
+# Enclosing2 debugged (length => Length)
+# 20180707
+# Enclosing2 debugged (epspara)
+# 20180706
+# Enclosing2 debugged (crv => c)
+# Hatchdata changed ( Interval > *2 )
+# 20180621
+# Kyoukai debugged (1st point converted to matrix, length=>Length)
# 20180615
# Assign changed (Replace function added)
# 20180603
@@ -428,8 +472,8 @@ print(ThisVersion)
XMIN<- -5
XMAX<- 5
YMIN<- -5 ; YMAX<- 5
-ZIKU<- "line"
-ARROWSIZE<- 1
+ZIKU<- "l"
+#ARROWSIZE<- 1
XNAME<- "$x$"
XPOS<- "e"
YNAME<- "$y$"
@@ -475,8 +519,8 @@ Ketinit<- function(){
XMIN<<- -5
XMAX<<- 5
YMIN<<- -5 ; YMAX<<- 5
-ZIKU<<- "line"
-ARROWSIZE<<- 1
+ZIKU<<- "l"
+#ARROWSIZE<<- 1
XNAME<<- "$x$"
XPOS<<- "e"
YNAME<<- "$y$"
@@ -916,11 +960,12 @@ Arrowdata<- function(...)
######################################
+# 2018.10.19 for new basic1.cs
# 2013.11.13 No Intersect debugged
-Arrowhead<-function(...)
-{ ## Scaling is implemented
- ## 12.01.08 Kirikomi
+Arrowhead<-function(...){
+ ## Scaling is implemented
+  ## 12.01.08 Kirikomi
Eps=10^(-3)
varargin<-list(...)
Nargs<-length(varargin)
@@ -959,60 +1004,56 @@ Arrowhead<-function(...)
}
Ookisa<-1000/2.54/MilliIn*Ookisa
Theta<-Hiraki*pi/180
+ P<- Doscaling(P)
+ Houkou<- Doscaling(Houkou)
if(Nrow(Houkou)>1){
- P<- Doscaling(P)
- Houkou<- Doscaling(Houkou)
- Tmp<-Nearestpt(P,Houkou)
- A<-Tmp[[1]]
+ Tmp<-Nearestpt(P,Houkou) #181019 (2lines)
+ P<- Tmp[[1]]
I<-floor(Tmp[[2]])
if(I==1){# 180511
if(Norm(Ptend(Houkou)-Ptstart(Houkou))<Eps){
I=Numptcrv(Houkou)
}
}
- G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29
+ G<-Circledata(c(P,Ookisa*cos(Theta)),"Num=10") #181019(2lines)
Flg<- 0 # 13.11.13
JL<-seq(I,1,by=-1)
for (J in JL){
- B<-Ptcrv(J,Houkou)
- Tmp<-IntersectcurvesPp(Listplot(list(A,B)),G) #180510
- if(length(Tmp)>0){
- Flg<- 1
- break
+ Tmp1=matrix(c(P,Op(J,Houkou)),ncol=2,byrow=TRUE) #181019
+# Tmp<-IntersectcurvesPp(Tmp1,G,0.001,0.01)
+ Tmp<-IntersectcrvsPp(Tmp1,G)
+ if(Length(Tmp)>0){
+ Houkou<-P-Op(1,Tmp[[1]])
+ 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
+ P<- P-0.5*Ookisa*cos(Theta)*Ev
}
if(length(grep("b",Str))>0){
- P<-P-Ookisa*cos(Theta)*Ev
+ 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
+ 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,fixed=TRUE))>0){
- Tmp<-Listplot(list(A,P,B))
+ Tmp<- matrix(c(A,P,B),ncol=2,byrow=TRUE)#181019(2lines)
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
+ Tmp<- matrix(c(A,P,B,C,A),ncol=2,byrow=TRUE) #181019(2lines)
Tmp1<- Unscaling(Tmp)
Shade(Tmp1)
- Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20
+ Tmp= matrix(c(A,P,B,C,A,P),ncol=2,byrow=TRUE)#181019(2lines)
Tmp1=Unscaling(Tmp)
Drwline(Tmp1,0.1) # 15.06.11, 15.06.14
}
@@ -1151,14 +1192,17 @@ Arrowline<- function(...)
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)
+ Tmp=SCALEY
+ Setscaling(1)
Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str)
+ Setscaling(Tmp)
}
#########################################
Assign<- function(...){
Replace=function (vname,rep,str){#180615from
- opv=c("+","-","*","/","(",")","=","<",">",""," ")
+ opv=c("+","-","*","/","(",")","=","<",">",""," ",",") #180812
out=""
start=1
Tmp=gregexpr(vname,str,fixed=TRUE)
@@ -1166,15 +1210,16 @@ Assign<- function(...){
if(min(Vp)>0){
for(j in Vp){
if(j==1){bf=""}else{bf=substring(str,j-1,j-1)}
- if(j==nchar(str)){af=""}else{af=substring(str,j+1,j+1)}
+ Tmp=j+nchar(vname)-1 #180812(2lines)
+ if(Tmp==nchar(str)){af=""}else{af=substring(str,Tmp+1,Tmp+1)}
tmp1=length(intersect(bf,opv))
tmp2=length(intersect(af,opv))
- tmp=substring(str,start,j)
+ tmp=substring(str,start,j+nchar(vname)-1) #180812
if((tmp1>0)&&(tmp2>0)){
tmp=gsub(vname,rep,tmp,fixed=TRUE)
}
out=paste(out,tmp,sep='')
- start=j+1
+ start=j+nchar(vname) #180812
}
}
out=paste(out,substring(str,start,nchar(str)),sep='')
@@ -1261,13 +1306,21 @@ Assign<- function(...){
}
}
}
+
+FlagL<<- 0
+
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(Nrow(Val)==1){
for (K in Looprange(1,length(Val))){
- Tmp<- paste(Vname,"[", as.character(K),"]",sep="")
+ if(length(Val)==1){
+ Tmp<- Vname
+ }
+ else{
+ Tmp<- paste(Vname,"[", as.character(K),"]",sep="")
+ }
if(mode(Val[K])=="numeric"){
Tmp1<- paste("(",as.character(Val[K]),")",sep="")
}
@@ -2373,24 +2426,69 @@ Drwpt<-function(...)
######################################################
-Drwxy<-function(...)
-{
+Drwxy<-function(...){ #180820
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)
+ Origin=GENTEN
+ Origins=Doscaling(Origin) #181016
+ Xrng=c(XMIN,XMAX)
+ Yrng=c(YMIN,YMAX)
+ Tmp1=Doscaling(c(XMIN,YMIN)) #181017from
+ Tmp2=Doscaling(c(XMAX,YMAX))
+ Xrngs=c(Tmp1[1],Tmp2[1])
+ Yrngs=c(Tmp1[2],Tmp2[2]) #181017from
+ Ziku=ZIKU #180821from
+ Xname=XNAME
+ Xpos=XPOS
+ Yname=YNAME
+ Ypois=YPOS
+ Oname=ONAME
+ Opos=OPOS #180821to
+ for(J in Looprange(1,Nargs)){
+ Tmp=strsplit(varargin[[J]],"=")
+ Tmp=Tmp[[1]]
+ Tmp1=toupper(substring(Tmp[1],1,1))
+ Tmp2=Tmp[2]
+ if(Tmp1=="O"){
+ Origin=eval(parse(text=Tmp2))
+ }
+ if(Tmp1=="X"){
+ Xrng=eval(parse(text=Tmp2))
+ }
+ if(Tmp1=="Y"){
+ Yrng=eval(parse(text=Tmp2))
+ }
+ if(Tmp1=="A"){ #180821from
+ if(substring(Tmp2,1,1)=="c"){
+ Tmp2=substring(Tmp2,3,nchar(Tmp2)-1)
+ }
+ Tmp2=gsub(",","','",Tmp2,fixed=TRUE)
+ Tmp2=paste("'",Tmp2,"'",sep="")
+ Tmp=paste("Setax(",Tmp2,")",sep="")
+ eval(parse(text=Tmp)) #180821to
+ }
+ }
+ Xrng=Xrng+Origin[1]
+ Yrng=Yrng+Origin[2]
+ Xrngs=Xrngs+Origins[1] #181016(2lines)
+ Yrngs=Yrngs+Origins[2]
+ Tmp<- substring(ZIKU,1,1) #180821
+ if(Tmp=="a")
+ {
+ Tmp=substring(ZIKU,2,nchar(ZIKU))
+ if(nchar(Tmp)==0){Tmp=1}else{Tmp=eval(parse(text=Tmp))}
+ Arrowline(c(Xrngs[1],Origins[2]),c(Xrngs[2],Origins[2]),Tmp)#181016(2lines)
+ Arrowline(c(Origins[1],Yrngs[1]),c(Origins[1],Yrngs[2]),Tmp)
}
else
{
- Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2])))
- Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX)))
+ Drwline(Listplot(c(Xrngs[1],Origins[2]),c(Xrngs[2],Origins[2])))#181016(2lines)
+ Drwline(Listplot(c(Origins[1],Yrngs[1]),c(Origins[1],Yrngs[2])))
}
- Letter(c(XMAX,GENTEN[2]),XPOS,XNAME)
- Letter(c(GENTEN[1],YMAX),YPOS,YNAME)
- Letter(GENTEN,OPOS,ONAME);
+ Letter(c(Xrng[2],Origin[2]),XPOS,XNAME)
+ Letter(c(Origin[1],Yrng[2]),YPOS,YNAME)
+ Letter(Origin,OPOS,ONAME)
+ Setax(Ziku,Xname,Xpos,Yname,Ypois,Oname,Opos) #180821
}
##########################################
@@ -3016,7 +3114,8 @@ Hatchdata<- function(...)
ShaL<- list()
Nargs<- length(varargin)
Kakudo<- 45
- Kankaku<- 0.125*1000/2.54/MilliIn
+# Kankaku<- 0.125*1000/2.54/MilliIn
+ Kankaku<- 0.25*1000/2.54/MilliIn #180706
Tmp<- Doscaling(c(XMIN,YMIN))
Xmn<- Tmp[1]; Ymn<- Tmp[2]
Tmp<- Doscaling(c(XMAX,YMAX))
@@ -3034,7 +3133,7 @@ Hatchdata<- function(...)
Kakudo<- varargin[[N+1]]
if(N==Nargs-2)
{
- Kankaku<- 0.125*varargin[[Nargs]]
+ Kankaku<- Kankaku*varargin[[Nargs]] #180716
}
}
NaitenL<- varargin[[1]]
@@ -3944,19 +4043,19 @@ Kyoukai<- function(...)
Eps<- 10.0^(-4) #17.09.24
PLall<- list()
Sflg<- 0
- N<- length(DataL)
+ N<- Length(DataL) #180621
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
+ Tmp<- Op(Length(Data),Data)
+ if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && Length(Tmp)>1){ #180621
+ Rg<-Tmp ; Nd<- Length(Data)-1 #180621
}
else{
if(mode(Tmp)=="character"){
- Rg<- Tmp ; Nd<-length(Data)-1
+ Rg<- Tmp ; Nd<- Length(Data)-1 #180621
}
else{
- Rg<- "c" ; Nd<-length(Data)
+ Rg<- "c" ; Nd<- Length(Data) #180621
}
}
for (J in Looprange(1,Nd)){
@@ -3977,7 +4076,7 @@ Kyoukai<- function(...)
P<- Ptstart(Tmp)
Q<- Ptend(Tmp)
if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){
- Tmp< Length(PL)
+ Tmp< Length(PL) #180621
PL<-PL[Tmp:1,]
Pfirst<- Ptstart(PL)
Plast<- Ptend(PL)
@@ -3986,11 +4085,11 @@ Kyoukai<- function(...)
}
else{
if(Norm(P1-Plast)<Eps){
- Stp<-1; Ks<-2; Ke=Length(Points)
+ Stp<-1; Ks<-2; Ke=Length(Points) #180621
}
else{
if(Norm(P2-Plast)<Eps) {
- Stp<- -1; Ks<-Length(Points)-1; Ke=1
+ Stp<- -1; Ks<-Length(Points)-1; Ke=1 #180621
}
else{
Tmp<-Appendrow(PL,c(Inf,Inf))
@@ -3998,7 +4097,7 @@ Kyoukai<- function(...)
Sflg<- 1
Pfirst<- P1
Plast<- P2
- Stp<- 1; Ks<- Length(Points)-1; Ke<- 1
+ Stp<- 1; Ks<- Length(Points)-1; Ke<- 1 #180621
}
}
for (K in seq(Ks,Ke, by=Stp)){
@@ -4009,7 +4108,7 @@ Kyoukai<- function(...)
}
}
if(Norm(Pfirst-Plast)>Eps){
- Np<- Length(PL)
+ Np<- Length(PL) #180621
if(Rg=="c"){
Tmp<- Appendrow(PL,Pfirst)
PL<- Tmp
@@ -4046,7 +4145,7 @@ Kyoukai<- function(...)
Tmp<- Appendrow(Tmp,Q)
PL<- Appendrow(Tmp,Pfirst)
}
- else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){
+ else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && Length(Rg)>1){ #180621
Tmp<- Kukeiwake(PL)
Tmp1<- Op(1,Tmp)
Tmp2<- Naigai(Rg,list(Tmp1))
@@ -4058,7 +4157,7 @@ Kyoukai<- function(...)
}
}
}
- Tmp<- Ptstart(PL)
+ Tmp<- matrix(Ptstart(PL),nrow=1) #180621
for (J in Looprange(2,Length(PL))){
P<- Op(J,PL)
Q<- Op(Length(Tmp),Tmp)
@@ -4070,7 +4169,7 @@ Kyoukai<- function(...)
PL<-Tmp
PLall<-c(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){
@@ -4249,34 +4348,27 @@ V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here
################################
-Listplot<-function(...)
-{
+Listplot<-function(...){
varargin<-list(...);
Z<-c();
- for (I in 1:length(varargin))
- {
+ 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)
+ if(mode(Data)=="numeric"){
+ if(class(Data)=="numeric"){
+ Tmp<- matrix(Data,nrow=2);
+ Tmp<- t(Tmp);
+ Z<-Appendrow(Z,Unscaling(Tmp)) #181015
+ }else{
+ Z<-Appendrow(Z,Unscaling(Data)) #181015
}
- else
- Z<-Appendrow(Z,Data)
- }
- else
- {
- for (J in 1:length(Data))
- {
+ }else{
+ for (J in 1:length(Data)){
Tmp<-Data[[J]];
- Z<-Appendrow(Z,Tmp)
+ Z<-Appendrow(Z,Unscaling(Tmp)) #181015
}
}
- }
- return(Z)
+ }
+ return(Z)
}
##############################
@@ -5124,9 +5216,11 @@ Paramplot<- function(...)
Nargs<- length(varargin)
Fnflg<- 0
Fnstr<- varargin[[1]]; Is=2
- Fnstr=Assign(Fnstr) #180510(for KeTCindy)
Rgstr<- varargin[[Is]]; Is<- Is+1
- Rgstr=Assign(Rgstr) #180510(for KeTCindy)
+ Tmp=strsplit(Rgstr,"=") #181017from
+ Var=Tmp[[1]][1]
+ Fnstr=Assign(Fnstr,Var,"t")
+ Rgstr=Assign(Rgstr,Var,"t") #181017from
Range<- c(0,2*pi)
N<- 50 # Numpoints
E<-c() # Exclusions
@@ -5156,7 +5250,7 @@ Paramplot<- function(...)
Rng<- c(0,2*pi)
}
T1<- Rng[1]; T2<- Rng[2]
- Dt<- (T2-T1)/N #17.09.22
+ Dt<- (T2-T1) #180929
if(Fnflg==0)
{
Str<- gsub(Vname,"t",Fnstr)
@@ -5176,9 +5270,8 @@ Paramplot<- function(...)
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
+ t=T1+(jj-1)*Dt/N #180929
Pa<- c()
if(t-E[Ke]< Eps)
{
@@ -5210,37 +5303,26 @@ Paramplot<- function(...)
}
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)
- {
+ }else{
+ if(Nrow(P)==0){
Tmp<- Appendrow(P,Pa)
P<-Tmp
- }
- else
- {
+ }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)
- {
- Tmp<-Appendrow(P,Pa)
- P<-Tmp
- }
- else
- {
+ }else{
+ if(Norm(Tmp-Pa)<D){
+ if(Norm(Tmp-Pa)>Eps){ #180928
+ Tmp<-Appendrow(P,Pa)
+ P<-Tmp
+ } #180928
+ }else{
Tmp<- Appendrow(P,c(Inf,Inf),Pa)
P<- Tmp
}
@@ -5375,11 +5457,11 @@ Plotdata<- function(...)
}
}
X1<- Rng[1]; X2<- Rng[2]
- dx<- (X2-X1)/N # 17.09.22
+ dx<- (X2-X1) #180929
if(Fnflg==0){
Str<- gsub(Vname,"x",Fnstr,fixed=TRUE)
}
- if(abs(dx)<Eps){ # Scilab 16.12.13
+ if(abs(dx/N)<Eps){ #180929
x=X1
P=c(X1,eval(parse(text=Str)))
return(P)
@@ -5394,7 +5476,9 @@ Plotdata<- function(...)
Tmp<- sort(E)
E<- E[length(Tmp):1]
Ke<- 1
- for (x in seq(X1,X2,by=dx)){
+# for (x in seq(X1,X2,by=dx)){
+ for (J in 0:N){ #180929
+ x=X1+dx*J/N #180929
if(nchar(Exfun)>0){
Tmp<-eval(parse(text=Exfun))
if(abs(Tmp)<Eps){
@@ -6587,21 +6671,14 @@ 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="")
+ if(Nargs==0){ #180821(next 2 lines)
+ Str<- paste(ZIKU,",",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){
+ if(is.numeric(Tmp)){ #180821
Is<- varargin[[1]]
ArgL<- c()
for (I in Looprange(1,Is-1)){
@@ -6611,50 +6688,18 @@ Setax<- function(...)
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]])
- }
- }
+ else{ #180821from
+ for (I in Looprange(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)
- }
- }
+ } #180821to
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"
- }
- }
+ On<- ArgL[6]; Op<- ArgL[7]
+ ZIKU<<- ArgL[1] #180821
if(nchar(Xn)>0){
XNAME<<- paste("$",Xn,"$",sep="")
}
@@ -6667,11 +6712,11 @@ Setax<- function(...)
if(nchar(Yp)>0){
YPOS<<-Yp
}
- if(nchar(Genn)>0){
- ONAME<<- Genn
+ if(nchar(On)>0){
+ ONAME<<- On
}
- if(nchar(Genp)>0){
- OPOS<<- Genp
+ if(nchar(Op)>0){
+ OPOS<<- Op
}
Out<- "";
}
@@ -6743,41 +6788,39 @@ Setorigin<- function(...)
################################
-Setscaling<- function(...)
-{
+Setscaling<- function(...){
varargin<- list(...)
Nargs<- length(varargin)
- if(Nargs==0)
- {
- return(c(SCALEY,LOGX,LOGY))
+ if(Nargs==0){
+ return(c(SCALEX,SCALEY,LOGX,LOGY))
}
- for (I in 1:Nargs)
- {
+ Tmp=varargin[[1]] #181020from
+ if((Nargs==1)&&(is.numeric(Tmp))){
+ SCALEY<<- Tmp
+ return(invisible(c(SCALEX,SCALEY,LOGX,LOGY)))
+ }
+ nCtr=1 #181020to
+ for (I in 1:Nargs){
Tmp<- varargin[[I]]
- if(mode(Tmp)=="numeric")
- {
- SCALEY<<- Tmp
+ if(mode(Tmp)=="numeric"){
+ if(nCtr==1)SCALEX<<- Tmp #181020(2llines)
+ if(nCtr==2)SCALEY<<- Tmp
+ nCtr=nCtr+1
}
- if(mode(Tmp)=="character")
- {
- if(Tmp=="l")
- {
+ if(mode(Tmp)=="character"){
+ if(Tmp=="l"){
LOGX<<- 0
LOGY<<- 1
- }
- else if(Tmp=="ll")
- {
+ }else if(Tmp=="ll"){
LOGX<<- 1
LOGY<<- 1
- }
- else
- {
+ }else{
LOGX<<- 0
LOGY<<- 0
}
}
}
- Tmp<- c(SCALEY,LOGX,LOGY);
+ Tmp<- c(SCALEX,SCALEY,LOGX,LOGY)
}
#########################################
@@ -7009,51 +7052,35 @@ Shade<- function(...)
}
}
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))){
+# Data<- Kyoukai(Tmp)
+ Data= Joincrvs(Tmp) #180929from
+ Data=list(Data) #180929to
+ for (I in Looprange(1, Length(Data))){ #180621
PL<- Op(I,Data)
+ PL=Appendrow(PL,Op(1,PL)) #180929
Mojisu<- 0
- for (J in 1:Nrow(PL)){
+ for (J in Looprange(1,Length(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="")
+ 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="")
+ 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="")
- }
+ 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="")
+ cat("}%\n",file=Wfile,append=TRUE,sep="")
}
}
@@ -9752,6 +9779,142 @@ Projpers<- function(...){
}
#########################################
+# 180807
+
+Reflect3data<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Pd3<- varargin[[1]]
+ VL<- varargin[[2]]
+ if(Mixtype(Pd3)==1){
+ Pd3<- list(Pd3)
+ } else if(Mixtype(Pd3)==3){
+ Tmp<- list()
+ for (I in Looprange(1,Length(Pd3))){
+ Tmp<- c(Tmp,Op(I,Pd3))
+ }
+ Pd3<- Tmp
+ }
+ Out<- list()
+ for (I in Looprange(1,Length(Pd3))){
+ PD<- Op(I,Pd3)
+ Ans<- c()
+ for (J in Looprange(1,Nrow(PD))){
+ if(is.matrix(PD)){
+ P<- PD[J,]
+ }
+ else{
+ P<- PD
+ }
+ Tmp<- Reflect3pt(P,VL)
+ Ans<- rbind(Ans,Tmp)
+ }
+ rownames(Ans)<- 1:Nrow(Ans)
+ Out<- c(Out,list(Ans))
+ }
+ if(Length(Out)==1){
+ Out<- Op(1,Out)
+ }
+ return(Out)
+}
+
+#######################################
+
+Reflect3pt<- function(...){
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ P<- varargin[[1]]
+ VL<- varargin[[2]]
+ if(Length(VL)==1){
+ Ans=2*Op(1,VL)-P
+ }
+ if(Length(VL)==2){
+ V1=Op(1,VL)
+ V2=Op(2,VL)
+ V3=(V2-V1)/Norm(V2-V1)
+ Tmp=V1+Dotprod(P-V1,V3)*V3
+ Ans=2*Tmp-P
+ }
+ if(Length(VL)==3){
+ V1=Op(1,VL)
+ V2=Op(2,VL)
+ V3=Op(3,VL)
+ Tmp=Crossprod(V2-V1,V3-V1)
+ Tmp1=P-Dotprod(Tmp, P-V1)/Norm(Tmp)^2*Tmp
+ Ans=2*Tmp1-P
+ }
+ return(Ans)
+}
+
+#########################################
+# 180807
+
+Scale3data<- function(...){
+ varargin<-list(...)
+ Nargs<- length(varargin)
+ Pd3<- varargin[[1]]
+ R<- varargin[[2]]
+ C<- varargin[[3]]
+ C<- c(0,0,0)
+ if(Nargs>=3){
+ C<- varargin[[3]]
+ }
+ if(Mixtype(Pd3)==1){
+ Pd3<- list(Pd3)
+ } else if(Mixtype(Pd3)==3){
+ Tmp<- list()
+ for (I in Looprange(1,Length(Pd3))){
+ Tmp<- c(Tmp,Op(I,Pd3))
+ }
+ Pd3<- Tmp
+ }
+ Out<- list()
+ for (I in Looprange(1,Length(Pd3))){
+ PD<- Op(I,Pd3)
+ Ans<- c()
+ for (J in Looprange(1,Nrow(PD))){
+ if(is.matrix(PD)){
+ P<- PD[J,]
+ }
+ else{
+ P<- PD
+ }
+ Tmp<- Scale3pt(P,R,C)
+ Ans<- rbind(Ans,Tmp)
+ }
+ rownames(Ans)<- 1:Nrow(Ans)
+ Out<- c(Out,list(Ans))
+ }
+ if(Length(Out)==1){
+ Out<- Op(1,Out)
+ }
+ return(Out)
+}
+
+#######################################
+
+Scale3pt<- function(...){
+ varargin<-list(...)
+ Nargs<-length(varargin)
+ P<- varargin[[1]]
+ R<- varargin[[2]]
+ if(length(R)==1){ #180808from
+ R=c(R,R,R)
+ } #180808to
+ C<- c(0,0,0)
+ if(Nargs>=3){
+ C<- varargin[[3]]
+ }
+ X1=P[1]; Y1=P[2]; Z1=P[3]
+ Cx=C[1]; Cy=C[2]; Cz=C[3]
+ X2=Cx+R[1]*(X1-Cx)
+ Y2=Cy+R[2]*(Y1-Cy)
+ Z2=Cz+R[3]*(Z1-Cz)
+ Ans=c(X2,Y2,Z2)
+ return(Ans)
+}
+
+#########################################
# 11.08.27
# 14.03.23 Debugged "center"
@@ -9785,7 +9948,7 @@ Rotate3data<- function(...){
}
else{
P<- PD
- }
+ }
Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23
Ans<- rbind(Ans,Tmp)
} # 11.08.27
@@ -9886,6 +10049,45 @@ Rotate3pt<- function(...){
return(Ans)
}
+#################################
+
+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)
+}
+
######################################
Setangle<- function(...){
@@ -10198,11 +10400,11 @@ Spacecurve<- function(...){
Rng<- c(XMIN,XMAX)
}
T1<- Rng[1]; T2<- Rng[2]
- Dt<- (T2-T1)/N #17.09.22
+ Dt<- (T2-T1) #180929
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
+ if(abs(Dt/N)<Eps){ #180929
t=T1
P=eval(parse(text=Str))
return(P)
@@ -10213,7 +10415,7 @@ Spacecurve<- function(...){
E<- sort(E,decreasing=FALSE)
Ke<- 1
for(jj in 1:(N+1)){
- t=T1+(jj-1)*Dt
+ t=T1+(jj-1)*Dt/N #180929
Pa<- c()
if(t-E[Ke]< Eps){
Pa<- eval(parse(text=Str))
@@ -10284,45 +10486,6 @@ Spaceline<- function(...){
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){
@@ -11490,17 +11653,17 @@ Implicitplot<- function(...){ #180402
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
+ dx=(Rngx[2]-Rngx[1]) #180929
+ dy=(Rngy[2]-Rngy[1]) #180929
out=list()
for(jj in 1:Ndv){
- yval1=Rngy[1]+(jj-1)*dy
- yval2=Rngy[1]+jj*dy
+ yval1=Rngy[1]+(jj-1)*dy/Ndv #180929
+ yval2=Rngy[1]+jj*dy/Ndv #180929
xval1=Rngx[1]
eval11=Impfun(xval1,yval1)
eval12=Impfun(xval1,yval2)
for(ii in 1:Mdv){
- xval2=Rngx[1]+ii*dx
+ xval2=Rngx[1]+ii*dx/Mdv #180929
eval21=Impfun(xval2,yval1)
eval22=Impfun(xval2,yval2)
pL=list(c(xval1,yval1));vL=c(eval11)
@@ -12135,18 +12298,18 @@ Objcurve<- function(...){
if(Nargs>=3){
Np=Args[[3]]
}
- Assign("Sz",Sz)
+# Assignadd("Sz",Sz) #180901
if(Pstr=="xy"){
Vz=c(0,0,1)
- Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)")
+ Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)","Sz",Sz) #180901
}
if(Pstr=="yz"){
Vz=c(1,0,0)
- Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))")
+ Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))","Sz",Sz) #180901
}
if(Pstr=="zx"){
Vz=c(0,1,0)
- Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))")
+ Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))","Sz",Sz) #180901
}
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]]
@@ -12218,7 +12381,7 @@ Objcurve<- function(...){
}
Objsymb<- function(Symb,Thick,Face,Dir){
- for(J in Looprange(1,length(Symb))){
+ for(J in Looprange(1,Length(Symb))){
Objcurve(Op(J,Symb),Thick,Face,Dir)
}
}
@@ -12750,6 +12913,7 @@ Enclosing2<- function(...){
Nargs=length(varargin)
plist=varargin[[1]]
Eps0=10^(-5)
+ epspara=1; #180707
Eps1=0.01
Eps2=0.1
Start=c()
@@ -12757,10 +12921,11 @@ Enclosing2<- function(...){
for(ii in Looprange(2,Nargs)){
tmp=varargin[[ii]]
if(length(tmp)>1){
-# Start=tmp
+ Start=tmp
}else{
- if(flg==0){Eps1=tmp}
- if(flg==1){Eps2=tmp}
+ if(flg==0){epspara=tmp}
+ if(flg==1){Eps1=tmp}
+ if(flg==2){Eps2=tmp}
flg=flg+1
}
}
@@ -12788,41 +12953,46 @@ Enclosing2<- function(...){
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)
+ Start=Op(1,tmp) #180706
}
if(length(KL)>1){
- KL=Quicksort(KL,2)
+ KL=Quicksort(KL,2) #180706from
if(length(Start)==0){
tmp=Op(1,KL)
tst=Op(2,tmp)
- Start=Pointoncurve(tst,Fdata)
+ Start=Op(1,tmp)
}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))
+ flgsame=0 #180717from
+ for(jj in Looprange(1,length(tmp1))){
+ if(Norm(tmp2-Op(jj,tmp1))<Eps1){
+ flgsame=1
+ break
+ }
}
+ if(flgsame==0){
+ tmp=c(tmp,Norm(Op(1,KL[[ii]])-Start))
+ tmp1=c(tmp1,list(tmp2))
+ } #180717to
}
- tmp=Op(1,tmp1)
+ tmp=order(tmp)
+ tmp=Op(tmp[1],KL)
tst=Op(2,tmp)
- Start=Pointoncurve(tst,Fdata)
+ Start=Op(1,tmp)#180706to
}
}
}
}
if(flg==0){
t1=tst
+ p1=Pointoncurve(t1,Fdata)#180713
for(nn in Looprange(1,length(plist))){
Fdata=Op(nn,plist)
if(nn==length(plist)){
@@ -12837,19 +13007,42 @@ Enclosing2<- function(...){
Gdata=Appendrow(tmp,Gdata)
plist[[nxtno]]=Gdata
t2=Length(Fdata)
- ss=1 #18.02.02until
+ ss=1 #18.02.02to
}else{
- tmp=Op(1,KL)
- t2=Op(2,tmp)
- ss=Op(3,tmp)
+# KL=Quicksort(KL,2); #180706from
+# for(j in Looprange(1,length(KL))){
+# tmp1=t1+epspara/50*Length(Fdata)#180713(2lines)
+# tmp2=Op(2,KL[[j]])
+# if((tmp2>tmp1)||((tmp2>t1)&&(Norm(Op(3,KL[[j]])-p1)>Eps1))){
+# break
+# } #180711,16
+# }
+# t2=Op(2,KL[[j]])
+# p2=Pointoncurve(t2,Fdata)#180713
+# ss=Op(3,KL[[j]])# 180706to
+ tmp=c() #180711from
+ for(j in Looprange(1,length(KL))){
+ tmp=c(tmp,Op(2,KL[[j]]))
+ }
+ tmp1=order(tmp)
+ tmp2=KL
+ KL=list()
+ for(j in tmp1){
+ tmp=tmp2[[j]]
+ tmp3=t1+epspara/50*Length(Fdata)
+ tmp4=Op(2,tmp)
+ if((tmp4>tmp3)||((tmp4>t1)&&(Norm(Op(1,tmp)-p1)>Eps1))){
+ KL=c(KL,list(tmp))
+ }
+ }
+ t2=Op(2,KL[[1]])
+ ss=Op(3,KL[[1]]) #180711from
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
}
}
}
@@ -12861,8 +13054,9 @@ Enclosing2<- function(...){
tmp=tmp[2:Length(tmp),]
AnsL=Appendrow(AnsL,tmp)
}
- t1=ss
}
+ t1=ss
+ p1=Pointoncurve(t1,Gdata)#180713
}
}
return(AnsL)
@@ -13713,10 +13907,14 @@ Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps1,Eps2){
FigkL=c(FigkL,list(Fk))
}
}
- Tmp=c()
- for(I in Looprange(1,length(PaL)-1)){
- if(!Member(I,SeL)){
- Tmp=c(Tmp,I)
+ if(length(SeL)==0){#181024from
+ Tmp=Looprange(1,length(PaL)-1)
+ }else{ #181024to
+ Tmp=c()
+ for(I in Looprange(1,length(PaL)-1)){
+ if(!Member(I,SeL)){
+ Tmp=c(Tmp,I)
+ }
}
}
SeL=Tmp
@@ -14377,7 +14575,7 @@ Wireparadata<- function(...){
if(ctr==2){Eps2=tmp}
}
}
- if(length(DuL)==1){ #180430
+ if(!is.list(DuL)){ #181024
tmp1=DuL
DuL=list()
for(jj in Looprange(1,tmp1)){
@@ -14385,7 +14583,7 @@ Wireparadata<- function(...){
DuL=c(DuL,list(tmp))
}
}
- if(length(DvL)==1){ #180430
+ if(!is.list(DvL)){ #181024
tmp1=DvL
DvL=list()
for(jj in Looprange(1,tmp1)){