• w=z

  • w=zeta(z)

# zは複素数のベクトル
# int0,int1はintensityの上下限、sat0,sat1はSaturation(彩度)の上下限
my.hsv <- function(z,int0=0.6,sat0=0.3,int1=1,sat1=1){
# 複素数の偏角
	arg <- Arg(z)
	s <- which(arg<0)
	arg[s] <- arg[s]+2*pi
# 複素数の絶対値
	r <- Mod(z)
# 絶対値が非常に大きくてもそこそこの色になるように対数変換
	s <- which(r>1)
	r[s] <- log(r[s])
# 絶対値で周期性が出るように4のmod
	r. <- 4*(r%%1)
	k <- floor(r.)
	r. <- r.-k
# 明度が上限、明度が下限、彩度が上限、彩度が下限の4パターンを
# 4のmodに対応づける
# 明度・彩度を動かすときは、複素数の絶対値で1次線形変化
	inten <- sat <- rep(0,length(r))
	s <- which(k==0)
	inten[s] <- int1
	sat[s] <- sat1-(sat1-sat0)*r.[s]
	s <- which(k==1)
	inten[s] <- int1-(int1-int0)*r.[s]
	sat[s] <- sat0
	s <- which(k==2)
	inten[s] <- int0
	sat[s] <- sat1-(sat1-sat0)*(1-r.[s])
	s <- which(k==3)
	inten[s] <- int1-(int1-int0)*(1-r.[s])
	sat[s] <- sat1

	return(cbind(arg,inten,sat))
}
my.hsv2rgb <- function(h,s,v){
# 色相の6 のmodでぐるりの情報を作る
	hi <- floor(h/(2*pi)*6)
	hi[which(hi==6)] <- 0
# 色相のぐるりの余りをfに入れ、それと明度・彩度とでp,q,tという3変数を決める
# 3変数を色相からの値を取らせる1つの原色を除いた2原色の値を定めるために使う
# 使い方は巡回させることでうまいことやる
	f <- (h/(2*pi)*6) %%1
	p <- v*(1-s)
	q <- v *(1-f*s)
	t <- v *(1-(1-f)*s)
	r <- g <- b <- rep(0,length(h))
	s <- which(hi==0)
		r[s] <- v[s];g[s] <- t[s]; b[s] = p[s];
	s <- which(hi==1)
		r[s] <- q[s];g[s] <- v[s]; b[s] = p[s];
	s <- which(hi==2)
		r[s] <- p[s];g[s] <- v[s]; b[s] = t[s];
	s <- which(hi==3)

		r[s] <- p[s];g[s] <- q[s]; b[s] = v[s];
	s <- which(hi==4)
		r[s] <- t[s];g[s] <- p[s]; b[s] = v[s];
	s <- which(hi==5)
		r[s] <- v[s];g[s] <- p[s]; b[s] = q[s];
	return(cbind(r,g,b))
}
x <- seq(from=-4,to=4,len=100)
xx <- expand.grid(x,x)
z <- xx[,1]+1i * xx[,2]

# w = z

w <- z
hsv <- my.hsv(w,int0=0.6,sat0=0.2,int1=1,sat1=0.6)
col <- my.hsv2rgb(hsv[,1],hsv[,3],hsv[,2])
plot(xx,pch=20,col=rgb(col[,1],col[,2],col[,3]))

library(pracma)
x <- seq(from=-50,to=50,len=100)
xx <- expand.grid(x,x)
z <- xx[,1]+1i * xx[,2]

my.f <- zeta
w <- my.f(z)
hsv <- my.hsv(w,int0=0.6,sat0=0.2,int1=1,sat1=0.6)
col <- my.hsv2rgb(hsv[,1],hsv[,3],hsv[,2])
plot(xx,pch=20,col=rgb(col[,1],col[,2],col[,3]))
  • 円をアトラクタとして円の外側と内側とでは軌道の回転方向がかわるようなベクトル場は…

x <- seq(from=-1,to=1,len=100)
xx <- expand.grid(x,x)
z <- xx[,1]+1i * xx[,2]
my.vec <- function(x,R =1, k=1){
	r <- sqrt(sum(x^2))
	v <- c(-x[2],x[1])
	v <- v/r
	V <- k/abs(r-R)
	V.2 <- k/(R-r)
	v*V.2+V.2*x
}

my.f <- function(z){
	x <- c(Re(z),Im(z))
	w <- my.vec(x,R=0.5,k=1)
	w[1] + 1i*w[2]
}
w <- rep(0,length(z))
for(i in 1:length(w)){
	w[i] <- my.f(z[i])
}
hsv <- my.hsv(w,int0=0.6,sat0=0.2,int1=1,sat1=0.6)
col <- my.hsv2rgb(hsv[,1],hsv[,3],hsv[,2])
plot(xx,pch=20,col=rgb(col[,1],col[,2],col[,3]))

x <- seq(from=-1,to=1,len=100)*2*pi
xx <- expand.grid(x,x)
z <- xx[,1]+1i * xx[,2]
my.vec <- function(x){
	r <- sqrt(sum(x^2))
	r <- r^1*1
	M <- matrix(c(cos(r),-sin(r),sin(r),cos(r)),byrow=TRUE,2,2)
	tmp <- c(M %*% x)
	tmp/sqrt(sum(tmp^2))
}
w <- rep(0,length(z))
for(i in 1:length(w)){
	tmp <- my.vec(c(Re(z[i]),Im(z[i])))
	w[i] <- tmp[1] + 1i * tmp[2]
}
hsv <- my.hsv(w,int0=0.6,sat0=0.2,int1=1,sat1=0.6)
col <- my.hsv2rgb(hsv[,1],hsv[,3],hsv[,2])
plot(xx,pch=20,col=rgb(col[,1],col[,2],col[,3]))