Nothing
symbol <-
function(df,type="star",colin=NULL,colout=NULL,colin2=NA,colout2=1,ssize=NULL,labels=0,labelsize=0.6,scheme=1,sortby=0,descending=FALSE,coorx=NULL,coory=NULL,lty=1,
main=NULL,sub=NULL,xlab=NULL,ylab=NULL,add=FALSE,xlim=NULL,ylim=NULL,
facew=0.5,faceh=0.5,eyes=0.5,eyed=0.5,mouthw=0.5,mouthc=0.5,brows=0.5,browp=0.5,nosel=0.5,nosew=0.5,ears=0.5,pupils=0.5,
body=0.5,limb1=0.5,limb2=0.5,limb3=0.5,limb4=0.5,defcol=NA){
n<-dim(df)[1]
m<-dim(df)[2]
if (is.null(coorx) & !is.null(coory)) coorx<-1:n
if (!is.null(coorx) & is.null(coory)) coory<-1:n
# Plot range
if (is.null(coorx) & is.null(coory)){
minx<-0
maxx<-10
miny<-0
maxy<-10
} else
{
sortby<-0
minx<-min(coorx)-(max(coorx)-min(coorx))*0.05
maxx<-max(coorx)+(max(coorx)-min(coorx))*0.05
miny<-min(coory)-(max(coory)-min(coory))*0.05
maxy<-max(coory)+(max(coory)-min(coory))*0.05
}
if (!add) plot.new() else{
if (!is.null(xlim) & !is.null(ylim)){
minx<-xlim[1]
maxx<-xlim[2]
miny<-ylim[1]
maxy<-ylim[2]
}
}
lengthx<-maxx-minx
lengthy<-maxy-miny
plot.window(c(minx,maxx),c(miny,maxy))
if (!is.null(coorx) & !is.null(coory) & !add){
axis(1)
axis(2)
box()
}
title(main=main,sub=sub,xlab=xlab,ylab=ylab)
# Undefined faces
if (type=="face"){
if (is.na(colin2)) colin2<-"white"
if (facew==0.5 & faceh==0.5 & eyes==0.5 & eyed==0.5 & mouthw==0.5 & mouthc==0.5 & brows==0.5 & browp==0.5 & nosel==0.5 & nosew==0.5 & ears==0.5 & pupils==0.5){
for (i in 1:m){
if (is.numeric(df[,i])){
if (facew==0.5) facew<-i else if (faceh==0.5) faceh<-i else if (eyes==0.5) eyes<-i else if (eyed==0.5) eyed<-i else if (mouthw==0.5) mouthw<-i else if (mouthc==0.5) mouthc<-i else if (brows==0.5) brows<-i else if (browp==0.5) browp<-i else if (nosel==0.5) nosel<-i else if (nosew==0.5) nosew<-i else if (ears==0.5) ears<-i else if (pupils==0.5) pupils<-i
}
}
}
}
# Undefined sticks
if (type=="stick"){
if (body==0.5 & limb1==0.5 & limb2==0.5 & limb3==0.5 & limb4==0.5 ){
for (i in 1:m){
if (is.numeric(df[,i])){
if (body==0.5) body<-i else if (limb1==0.5) limb1<-i else if (limb2==0.5) limb2<-i else if (limb3==0.5) limb3<-i else if (limb4==0.5) limb4<-i
}
}
}
}
numattr<-nnumattr(df)
# Color segments of color icons
if (type=="icon"){
colorseg<-rep(defcol,times=8)
if (numattr==1){
for (i in 1:m) if (is.numeric(df[,i])){
colorseg<-rep(i,times=8)
break
}
} else
if (numattr==2){
a<-0
for (i in 1:m) if (is.numeric(df[,i])){
colorseg[(1+a*4):(4+a*4)]<-i
a<-a+1
if (a==2) break
}
} else
if (numattr<=4){
a<-0
for (i in 1:m) if (is.numeric(df[,i])){
colorseg[(1+a*2):(2+a*2)]<-i
a<-a+1
if (a==4) break
}
} else
{
a<-0
for (i in 1:m){
if (is.numeric(df[,i])){
colorseg[a+1]<-i
a<-a+1
}
if (a==8) break
}
}
}
# Symbol area, sorting, labels
squares<-ceiling(sqrt(n))
if (sortby>0 & sortby<=m) if (!descending) {df<-df[order(df[,sortby]),]} else {df<-df[order(-df[,sortby]),]}
if (labels>0 & labels<=m) labels<-df[,labels] else labels=NULL
border=colout2
col=colin2
# Cathegorical colors
colrs<-1:n
colrs2<-1:n
if (!is.null(colout)){
if (!is.numeric(df[,colout]))
for (i in 1:n){
for (a in 1:nlevels(df[,colout])) if (levels(df[,colout])[a]==df[i,colout]) colrs[i]<-rainbow(nlevels(df[,colout]))[a]
}
}
if (!is.null(colin)){
if (!is.numeric(df[,colin]))
for (i in 1:n){
for (a in 1:nlevels(df[,colin])) if (levels(df[,colin])[a]==df[i,colin]) colrs2[i]<-rainbow(nlevels(df[,colin]))[a]
}
}
# Coordinates and size of symbols
if (!is.null(coorx) & !is.null(coory)){
if (is.null(ssize)){
if (type=="stick") ssize<-0.02 else if (type=="icon") ssize=0.01 else ssize<-0.04
}
}else
{
coorx<-1:n
coory<-1:n
if (scheme==3){
coorx=NULL
coory=NULL
for (i in 0:(squares%/%2)){
coorx<-c(coorx,-i:i)
coorx<-c(coorx,seq(i+1,i+1,length=(i+1)*2))
coorx<-c(coorx,i:-i)
coorx<-c(coorx,seq(-i-1,-i-1,length=(i+1)*2))
coory<-c(coory,seq(i,i,length=i*2+1))
coory<-c(coory,i:(-i-1))
coory<-c(coory,seq(-i-1,-i-1,length=i*2+1))
coory<-c(coory,(-i-1):i)
}
if (squares%/%2==squares/2) shiftxy<-0.5 else shiftxy<-0
coorx<-coorx*lengthx/squares+lengthx/2-lengthx/squares*shiftxy+minx
coory<-coory*lengthy/squares+lengthy/2+lengthy/squares*shiftxy+miny
} else
{
for (i in 1:n){
if (scheme==2 & ((i-1)%/%squares)/2!=((i-1)%/%squares)%/%2) coorx[i]<-maxx-(((i-1)%%squares)*(lengthx/squares)+lengthx/squares/2)
else coorx[i]<-((i-1)%%squares)*(lengthx/squares)+lengthx/squares/2+minx
coory[i]<-maxy-(((i-1)%/%squares)*(lengthy/squares)+lengthy/squares/2)
}
}
if (is.null(ssize)) ssize<-1/(squares*3)
}
# Normalization
for (i in 1:m) df[,i]<-normalize(df[,i])
polx<-1:numattr
poly<-1:numattr
angle<-2*pi/numattr
for (i in 1:n){
numberofnum<-numattr
polx<-1:numattr
poly<-1:numattr
# Colors
if (!is.null(colout)){
if (is.numeric(df[,colout]))
border<-hsv(0,1,df[i,colout]) else
border<-colrs[i]
}
if (!is.null(colin)){
if (is.numeric(df[,colin]))
col<-hsv(0,0,df[i,colin]) else
col<-colrs2[i]
}
if (type=="icon"){
# Color icons
rect(coorx[i]-ssize*lengthx,coory[i]-ssize*lengthy,coorx[i]+ssize*lengthx,coory[i]+ssize*lengthy,col=defcol,border=NA)
polygon(c(coorx[i]-ssize*lengthx,coorx[i],coorx[i]),c(coory[i]+ssize*lengthy,coory[i]+ssize*lengthy,coory[i]),col=rainbow(133)[1+100*df[i,colorseg[1]]],border=NA)
polygon(c(coorx[i]+ssize*lengthx,coorx[i],coorx[i]),c(coory[i]+ssize*lengthy,coory[i]+ssize*lengthy,coory[i]),col=rainbow(133)[1+100*df[i,colorseg[2]]],border=NA)
polygon(c(coorx[i]+ssize*lengthx,coorx[i]+ssize*lengthx,coorx[i]),c(coory[i]+ssize*lengthy,coory[i],coory[i]),col=rainbow(133)[1+100*df[i,colorseg[3]]],border=NA)
polygon(c(coorx[i]+ssize*lengthx,coorx[i]+ssize*lengthx,coorx[i]),c(coory[i]-ssize*lengthy,coory[i],coory[i]),col=rainbow(133)[1+100*df[i,colorseg[4]]],border=NA)
polygon(c(coorx[i]+ssize*lengthx,coorx[i],coorx[i]),c(coory[i]-ssize*lengthy,coory[i]-ssize*lengthy,coory[i]),col=rainbow(133)[1+100*df[i,colorseg[5]]],border=NA)
polygon(c(coorx[i]-ssize*lengthx,coorx[i],coorx[i]),c(coory[i]-ssize*lengthy,coory[i]-ssize*lengthy,coory[i]),col=rainbow(133)[1+100*df[i,colorseg[6]]],border=NA)
polygon(c(coorx[i]-ssize*lengthx,coorx[i]-ssize*lengthx,coorx[i]),c(coory[i]-ssize*lengthy,coory[i],coory[i]),col=rainbow(133)[1+100*df[i,colorseg[7]]],border=NA)
polygon(c(coorx[i]-ssize*lengthx,coorx[i]-ssize*lengthx,coorx[i]),c(coory[i]+ssize*lengthy,coory[i],coory[i]),col=rainbow(133)[1+100*df[i,colorseg[8]]],border=NA)
} else
if (type=="stick"){
# Stick figures
if (body==0.5) {bd<-body} else {bd<-df[i,body]}
if (limb1==0.5) {l1<-limb1} else {l1<-df[i,limb1]}
if (limb2==0.5) {l2<-limb2} else {l2<-df[i,limb2]}
if (limb3==0.5) {l3<-limb3} else {l3<-df[i,limb3]}
if (limb4==0.5) {l4<-limb4} else {l4<-df[i,limb4]}
bx<-ssize*lengthx*sin(pi/2*(bd-0.5))*0.5
by<-ssize*lengthy*sin(pi/2-pi/2*(bd-0.5))*0.5
lines(c(coorx[i]+bx,coorx[i]-bx),c(coory[i]+by,coory[i]-by),col=border)
lines(c(coorx[i]+bx-ssize*lengthx*sin(pi/2*(1-l1))*0.5,coorx[i]+bx),c(coory[i]+by+ssize*lengthy*sin(pi/2-pi/2*(1-l1))*0.5,coory[i]+by),col=border)
lines(c(coorx[i]+bx+ssize*lengthx*sin(pi/2*l2)*0.5,coorx[i]+bx),c(coory[i]+by+ssize*lengthy*sin(pi/2-pi/2*l2)*0.5,coory[i]+by),col=border)
lines(c(coorx[i]-bx+ssize*lengthx*sin(pi/2*(1-l3))*0.5,coorx[i]-bx),c(coory[i]-by-ssize*lengthy*sin(pi/2-pi/2*(1-l3))*0.5,coory[i]-by),col=border)
lines(c(coorx[i]-bx-ssize*lengthx*sin(pi/2*l4)*0.5,coorx[i]-bx),c(coory[i]-by-ssize*lengthy*sin(pi/2-pi/2*l4)*0.5,coory[i]-by),col=border)
} else
if (type=="face"){
# Chernoff faces
if (facew==0.5) {fw<-ssize*lengthx/2*(1+facew)} else {fw<-ssize*lengthx/2*(1+df[i,facew])}
if (faceh==0.5) {fh<-ssize*lengthy/2*(1+faceh)} else {fh<-ssize*lengthy/2*(1+df[i,faceh])}
if (eyes==0.5) {es<-eyes} else {es<-df[i,eyes]+0.05}
if (eyed==0.5) {ed<-eyed} else {ed<-df[i,eyed]}
if (mouthw==0.5) {mw<-mouthw} else {mw<-df[i,mouthw]}
if (mouthc==0.5) {mc<-mouthc} else {mc<-df[i,mouthc]}
if (brows==0.5) {bs<-brows} else {bs<-df[i,brows]}
if (browp==0.5) {bp<-browp} else {bp<-df[i,browp]}
if (nosel==0.5) {nl<-nosel} else {nl<-df[i,nosel]}
if (nosew==0.5) {nw<-nosew} else {nw<-df[i,nosew]}
if (ears==0.5) {ea<-ears} else {ea<-df[i,ears]}
if (pupils==0.5) {ps<-pupils} else {ps<-df[i,pupils]}
# Ears
plotellipse(mid=c(coorx[i]-fw,coory[i]),lwd=1,rx=ssize*lengthx*0.5*ea,ry=ssize*lengthy*0.5*ea,dr=0.1,lcol=border,col=col)
plotellipse(mid=c(coorx[i]+fw,coory[i]),lwd=1,rx=ssize*lengthx*0.5*ea,ry=ssize*lengthy*0.5*ea,dr=0.1,lcol=border,col=col)
# Face
plotellipse(mid=c(coorx[i],coory[i]),lwd=1,rx=fw,ry=fh,dr=0.1,lcol=border,col=col)
# Eyes
ewx<-ssize*lengthx*es*0.25
ewy<-ssize*lengthy*es*0.25
ex<-ewx+(fw-2*ewx)*ed
ey<-ssize*lengthy/7+(fh-(ssize*lengthy/2))/3
plotellipse(mid=c(coorx[i]+ex,coory[i]+ey),lwd=1,rx=ewx,ry=ewy*0.8,dr=0.1,lcol=border,col=col)
plotellipse(mid=c(coorx[i]-ex,coory[i]+ey),lwd=1,rx=ewx,ry=ewy*0.8,dr=0.1,lcol=border,col=col)
# Pupils
plotellipse(mid=c(coorx[i]+ex-ewx+ewx*0.25+(2*ewx-2*ewx*0.25)*ps,coory[i]+ey),lwd=1,rx=ewx*0.25,ry=ewy*0.25,dr=0.1,lcol=border,col=border)
plotellipse(mid=c(coorx[i]-ex-ewx+ewx*0.25+(2*ewx-2*ewx*0.25)*ps,coory[i]+ey),lwd=1,rx=ewx*0.25,ry=ewy*0.25,dr=0.1,lcol=border,col=border)
# Brows
lines(c(coorx[i]+ex-ewx,coorx[i]+ex+ewx*1.1),c(coory[i]+ey+ewy*0.8+fh*0.4*bp-(ewy/2-ewy*bs),coory[i]+ey+ewy*0.8+fh*0.4*bp+(ewy/2-ewy*bs)),col=border)
lines(c(coorx[i]-ex-ewx,coorx[i]-ex+ewx*1.1),c(coory[i]+ey+ewy*0.8+fh*0.4*bp+(ewy/2-ewy*bs),coory[i]+ey+ewy*0.8+fh*0.4*bp-(ewy/2-ewy*bs)),col=border)
# Mouth
if (mc>=0.5){
mc<-abs(mc-0.5)
plotellipse(mid=c(coorx[i],coory[i]-fh/2+mc*ssize*lengthy*mw*0.7),rx=fw*mw*0.6,ry=mc*ssize*lengthy*mw,from=pi,to=pi*2,lwd=1,dr=0.1,lcol=border)
} else
{
mc<-abs(mc-0.5)
plotellipse(mid=c(coorx[i],coory[i]-fh/2-mc*ssize*lengthy*mw*0.7),rx=fw*mw*0.6,ry=mc*ssize*lengthy*mw,from=2*pi,to=3*pi,lwd=1,dr=0.1,lcol=border)
}
# Nose
polygon(c(coorx[i]-ssize*lengthx*nw*0.18,coorx[i],coorx[i]+ssize*lengthx*nw*0.18),c(coory[i]-ssize*lengthy*nl*0.25,coory[i]+ssize*lengthy*nl*0.25,coory[i]-ssize*lengthy*nl*0.25),col=col,border=border)
} else
for (a in 1:m){
if (is.numeric(df[,a])){
if (type=="profile"){
# Profiles
polx[numattr+1-numberofnum]<-coorx[i]-lengthx*ssize+(numattr-numberofnum)*lengthx*ssize*2/(numattr-1)
poly[numattr+1-numberofnum]<-coory[i]-lengthy*ssize/1.5+df[i,a]*lengthy*ssize*1.6
} else
if (type=="bar"){
# Bars
rect(coorx[i]-lengthx*ssize+(numattr-numberofnum)*lengthx*ssize*2/numattr,coory[i]-lengthy*ssize/1.5,coorx[i]-lengthx*ssize+(numattr-numberofnum)*lengthx*ssize*2/numattr+lengthx*ssize*2/numattr,coory[i]-lengthy*ssize/1.5+df[i,a]*lengthy*ssize*1.6,col=col,border=border)
} else
{
# Stars, suns, polygons
polx[numattr+1-numberofnum]<-coorx[i]+sin(angle*(numattr-numberofnum))*df[i,a]*lengthx*ssize
poly[numattr+1-numberofnum]<-coory[i]+sin(pi/2-angle*(numattr-numberofnum))*df[i,a]*lengthy*ssize
}
numberofnum<-numberofnum-1
}
}
if (type=="profile"){
polx<-c(coorx[i]-lengthx*ssize,polx,coorx[i]+lengthx*ssize)
poly<-c(coory[i]-lengthy*ssize/1.5,poly,coory[i]-lengthy*ssize/1.5)
}
if (type=="star" | type=="sun" | type=="polygon" | type=="profile") polygon(polx,poly,col=col,border=border)
if (type=="sun"){
for (a in 1:numattr){
polx[a]<-coorx[i]+sin(angle*(a-1))*lengthx*ssize
poly[a]<-coory[i]+sin(pi/2-angle*(a-1))*lengthy*ssize
}
}
if (type=="star" | type=="sun") {for (a in 1:numattr) lines(c(coorx[i],polx[a]),c(coory[i],poly[a]),col=border,lty=lty)}
if (!is.null(labels)){
text(coorx[i],coory[i]-lengthy*ssize*1.2,labels[i],cex=labelsize,col=border)
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.