PCA-Para (SCILAB)

// Grave este arquivo em um dir do disco com o nome pca.sci
// por exemplo :
// d:\bin\scilab2.5\quimiometria

function [t,p,Var]=pca(X,labx,laby);

// Análise de Componentes Principais usando decomposição singular de valores.
// t- matriz de escores dos numpc componetes principais
// p- matriz de loadings dos numpc componetes principais
// X- matriz de dados
// numpc - número de componetes principais
//
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/grupo/marlon.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/
// Vers. 3/08/2000
opcaofimpca=0;
while opcaofimpca~=3

if opcaofimpca~=2

[out,in]=argn(0);
[m,n]=size(X);
numpc=min([n m]);

// Pre-tratamento
lab_trat=['Sem Pre-tratamento';'Auto-escalar';'Centar na Media'];
opcaotrat=x_choose(lab_trat,'Escolha o Pre-Tratamento)');
if opcaotrat==1
X=X;
else
if opcaotrat==2
X=auto(X);
end;
if opcaotrat==3
X=mncn(X);
end;
end;

// Decomposição em valores singulares

[u,s,v]=svd(X);

// Calcula os numpc componentes principais

t=[];
// escores
t=u(:,1:numpc)*s(1:numpc,1:numpc);
// loadings
p=[];
p=v(:,1:numpc);

var=zeros(numpc,1);
for i=1:numpc
Xpc=zeros(m,n);
Xpc=[t(:,i)*p(:,i)'];
var(i)=(1-[(sum((Xpc(:)-X(:)).^2))/(sum(X(:).^2))])*100;
end;
Var=([[1:numpc]' var cumsum(var)]);

[nv,mv]=size(Var);
for i=1:nv,
tmp=[];
for j=1:mv
tmp=[tmp+[' ']+string(Var(i,j))];
end;
labV(i)=tmp;
end;
x_message([[' CP Variância Expl. Var. Acum'];labV]);

xclear()
numcp(X)

var=zeros(numpc,1);
for i=1:numpc
Xpc=zeros(m,n);
Xpc=[t(:,i)*p(:,i)'];
var(i)=(1-[(sum((Xpc(:)-X(:)).^2))/(sum(X(:).^2))])*100;
end;
Var=([[1:numpc]' var cumsum(var)]);

[nv,mv]=size(Var);
for i=1:nv,
tmp=[];
for j=1:mv
tmp=[tmp+[' ']+string(Var(i,j))];
end;
labV(i)=tmp;
end;
// x_message([[' CP Variância Expl. Var. Acum'];labV]);

[mt,nt]=size(t);
for i=1:nt, labpc(i)=['CP'+string(i)];end;
opcaopc=x_choose(labpc,'Escolha o número de Componentes Principais');

t=u(:,1:opcaopc)*s(1:opcaopc,1:opcaopc);
// loadings
p=[];
p=v(:,1:opcaopc);
numpc=opcaopc;

end; //opcaofimpca diferente de Varimax

if opcaofimpca==2
[t,p]=varimax(X,numpc)
end; //opcaofimpca igual de Varimax

// Graficos

cont_win=xget("window");
xset("window",cont_win)
xclear(cont_win+1)

if in==1
tmp=[];
for j=1:n
tmp=[tmp;['Variável-']+string(j)];
end;
laby=tmp
tmp=[];
for j=1:m
tmp=[tmp;['Amostra-']+string(j)];
end;
labx=tmp

end;

tmp=[];
for j=1:n
tmp=[tmp;string(j)];
end;
laby_aux=tmp
tmp=[];
for j=1:m
tmp=[tmp;string(j)];
end;
labx_aux=tmp

tmp=[];
for j=1:5
tmp=[tmp;string(j)];
end;
labfont=tmp

opcaografico=0;
while opcaografico~=6
lab_trat=['Gráfico de Escores';'Gráfico de Loadings';'Gráfico Biplot ';'Gráfico de Escores-3D';'Gráfico de Loadings-3D';'FIM'];
opcaografico=x_choose(lab_trat,'Escolha o tipo de Gráfico');
if opcaografico==1
titulo=['Gráfico de Escores'];
if opcaofimpca==2,titulo=['Gráfico de Escores-Varimax'];end;
fonte=x_choose(labfont,'Escolha o tamanho da Fonte');
opcaonomegraf=x_choose(['Sim';'Nao'],'Deseja inserir nomes no gráfico');
if opcaonomegraf==1
escores(t,labx,titulo,fonte)
else
escores(t,labx_aux,titulo,fonte)
end;

end;
if opcaografico==2
titulo=['Loadings'];
if opcaofimpca==2,titulo=['Gráfico de Loadings-Varimax'];end;
fonte=x_choose(labfont,'Escolha o tamanho da Fonte');
opcaonomegraf=x_choose(['Sim';'Nao'],'Deseja inserir nomes no gráfico');
if opcaonomegraf==1
loadings(p,laby,titulo,fonte)
else
loadings(p,laby_aux,titulo,fonte)
end;

end;
if opcaografico==3
titulo=['Biplot'];
if opcaofimpca==2,titulo=['Gráfico de Biplot-Varimax'];end;
fonte=x_choose(labfont,'Escolha o tamanho da Fonte');
opcaonomegraf=x_choose(['Sim';'Nao'],'Deseja inserir nomes no gráfico');
if opcaonomegraf==1
biplot(t,p,labx,laby,titulo,fonte)
else
biplot(t,p,labx_aux,laby,titulo,fonte)
end;

end;
if opcaografico==4
titulo=['Gráfico de Escores'];
if opcaofimpca==2,titulo=['Gráfico de Escores-Varimax'];end;
fonte=x_choose(labfont,'Escolha o tamanho da Fonte');
escores3d(t,labx_aux,titulo,fonte)

end;
if opcaografico==5
titulo=['Loadings'];
if opcaofimpca==2,titulo=['Gráfico de Loadings-Varimax'];end;
fonte=x_choose(labfont,'Escolha o tamanho da Fonte');
loadings3d(p,laby_aux,titulo,fonte)

end;
end;

lab_fimpca=['Fazer novo PCA';'Varimax';'FIM'];
opcaofimpca=x_choose(lab_fimpca,'Continuar - PCA -');
end; //opcaofimpca
Vf=resume(Var(1:numpc,:));

function [Mcm]=mncn(X);

// Centra a matriz X pela média das colunas
//
//
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

// Dimensões de X

[m,n]=size(X);

// Média das colunas de X

med=[];
for i=1:n
med(1,i)=mean(X(:,i));
end;

// Centrar na média
Med=[];
Med=[ones(m,1)*med];

Mcm=[];
Mcm=X-Med;
Mcm=resume(Mcm);

function [Mae]=auto(X);

// Autoescalar a matriz X centrando na média das colunas e escalando pelo
// desvio padrão das colunas.
//
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

// Dimensões de X

[m,n]=size(X);

// Média e desvios padrão das colunas de X
Med=[];
Std=[];
for i=1:n
Med(1,i)=mean(X(:,i));
Std(1,i)=st_deviation(X(:,i));
end;
// Centrar na média
Mae=[];
Mae=[X-[ones(m,1)*Med]]./(ones(m,1)*Std);
Mae=resume(Mae);

function numcp(X);

// X- matriz de dados
// numpc - número de componetes principais através de cross validation e PRESS
//
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

[m,n]=size(X);

// Calcula os numpc componentes principais

for i=1:min([n m])-1
for j=1:m
ind=find([1:m]'~=j);
Xtmp=X(ind,:);
[u,s,v]=svd(Xtmp);
t=u(:,1:i)*s(1:i,1:i);
p=v(:,1:i);
Xpc=t*p';
tmp(j)=sum([Xpc(:)-Xtmp(:)].^2);
end;
Press(i,1)=sum(tmp);
end;

[u,s,v]=svd(X);
t=u(:,1:min([n m]))*s(1:min([n m]),1:min([n m]));
p=v(:,1:min([n m]));
for i=1:min([n m])
Xp=[t(:,i)*p(:,i)'];
var(i)=(1-[(sum((Xp(:)-X(:)).^2))/(sum(X(:).^2))])*100;
end;

cont_win=xget("window");
xset("window",cont_win+1)
xclear(cont_win+1)
xset("font",3,2)

mtlb_subplot(3,1,1)
plot2d(Press)
xtitle([' '],['CP'],[' PRESS'])

mtlb_subplot(3,1,2)
plot2d(var)
xtitle([' '],['CP'],[' Variância %'])

mtlb_subplot(3,1,3)
plot2d(cumsum(var))
xtitle([' '],['CP'],[' Variância Acumulada %'])

function escores(t,lab,titulo,fonte)
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

[saida,entrada]=argn(0);
[m,n]=size(t);

if entrada==1
tmp=[];
for j=1:m
tmp=[tmp;['Amostra-']+string(j)];
end;
lab=tmp
titulo=['Gráfico de escores'];
end;

if entrada==2
titulo=['Gráfico de escores'];
fonte=5;
end;

if entrada==3
fonte=5;
end;

opcaogr=1;

cont_win=xget("window");
cont_win=cont_win+1;
while opcaogr==1
for i=1:n, labpc(i)=['CP'+string(i)];end;
opcaopcx=x_choose(labpc,' A Componente Principal para o eixo x');
opcaopcy=x_choose(labpc,' A Componente Principal para o eixo y');

t1=t(:,opcaopcx);
t2=t(:,opcaopcy);

xclear(cont_win)
xset("window",cont_win)
xset("mark",2,1)
xset("font",3,fonte)
plot2d1("onn",t1,t2,[-5 -2])

xtitle([titulo],[['CP']+string(opcaopcx)],[['CP']+string(opcaopcy)])
for i=1:m, xstring(t1(i),t2(i),lab(i,:));end;

opcaogr=x_choose(['Novo Gráfico';'Fim'],' ');

cont_win=cont_win+1;
end;

function biplot(t,p,labx,laby,titulo,fonte,seta)
// Gráfico Biplot
//
// t - Matriz de escores
// p - Matriz de loadings
// labx- Designação das amostras
// laby- Designação das variáveis
// titulo - Título do gráfico

// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

[saida,entrada]=argn(0);

[m,n]=size(t);
[mp,np]=size(p);

if entrada==2
tmp=[];
for j=1:mp
tmp=[tmp;['Variável-']+string(j)];
end;
laby=tmp
tmp=[];
for j=1:m
tmp=[tmp;['Amostra-']+string(j)];
end;
labx=tmp;
titulo=['Biplot'];
labcpy=['CP-y'];
labcpx=['CP-x'];
end;

if entrada<6
fonte=5;
seta=.05;

end;
if entrada<7
seta=.05;
end;

opcaogr=1;

cont_win=xget("window");
cont_win=cont_win+1;

while opcaogr==1

for i=1:n, labpc(i)=['CP'+string(i)];end;
cpx=x_choose(labpc,'( A Componente Principal para o eixo x)');
cpy=x_choose(labpc,'( A Componente Principal para o eixo y)');

labcpx=['CP'+string(cpx)];
labcpy=['CP'+string(cpy)];

sx=norm(t(:,cpx));
sy=norm(t(:,cpy));

tbx=[t(:,cpx)./sx].*(sx^.5);
tby=[t(:,cpy)./sy].*(sy^.5);
pbx=[p(:,cpx)].*(sx^.5);
pby=[p(:,cpy)].*(sy^.5);

maxxg=max([tbx;pbx])+[(max([tbx;pbx])).*(.1)*sign(max([tbx;pbx]))];
maxyg=max([tby;pby])+[(max([tby;pby])).*(.1)*sign(max([tby;pby]))];

minxg=min([tbx;pbx])+[(min([tbx;pbx])).*(-.1)*sign(min([tbx;pbx]))];
minyg=min([tby;pby])+[(min([tby;pby])).*(-.1)*sign(min([tby;pby]))];

cont_win=xget("window");
xset("window",cont_win+1)
xset("font",2,fonte)
xset("mark",2,1)
plot2d(tbx,tby,-3,["011"]," ",[minxg,minyg,maxxg,maxyg])

if labx~=[]
for i=1:m, xstring(tbx(i,1),tby(i,1),labx(i,:));end;
end;

xset("use color",0)
for i=1:mp, xarrows([0 pbx(i)],[0 pby(i)],seta); end;

xset("font",5,fonte)
if laby~=[]
for i=1:mp, xstring(pbx(i,1),pby(i,1),laby(i,:));end;
end;
xset("font",3,fonte)
xtitle([ titulo],labcpx,labcpy)
opcaogr=x_choose(['Novo grafico';'Fim'],' ');
cont_win=cont_win+1;
end;

function loadings(p,lab,titulo,fonte)
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

[saida,entrada]=argn(0);
[m,n]=size(p);

if entrada==1
tmp=[];
for j=1:m
tmp=[tmp;['Variável-']+string(j)];
end;
lab=tmp
titulo=['Gráfico de loadings'];
end;
if entrada==2
titulo=['Gráfico de loadings'];
fonte=5;

end;

if entrada==3
fonte=5;
end;

opcaogr=1;

cont_win=xget("window");
cont_win=cont_win+1;
while opcaogr==1

opcaotipo=x_choose(['Loading versus variáveis';'Loadings versus Loadings'],'Escolha o tipo de gráfico');

if opcaotipo==1
for i=1:n, labpc(i)=['CP'+string(i)];end;
opcaopcx=x_choose(labpc,'( A Componente Principal para o eixo x)');
maxp=max(p(:,opcaopcx));
minp=min(p(:,opcaopcx));
xset("window",cont_win)
xset("mark",2,1)
xset("font",3,2)

plot2d3("onn",[-1:m+2]',[minp+minp.*.2;0;p(:,opcaopcx);0;maxp+maxp.*.2])
xpoly([-1 m+2],[0 0],"lines")
xaxis(0,[-1 m+2],[0 0 0],[minp+minp.*.2 maxp+maxp.*.2])
xset("window",cont_win)
xset("mark",2,1)
xset("font",3,2)

xtitle([titulo],['Variáveis'],['Loadings'])
if lab~=[]
for i=1:m, xstring(i,p(i,opcaopcx),lab(i,:));end;
end;
end;

if opcaotipo==2
for i=1:n, labpc(i)=['CP'+string(i)];end;
opcaopcx=x_choose(labpc,'( A Componente Principal para o eixo x)');
opcaopcy=x_choose(labpc,'( A Componente Principal para o eixo y)');
p1=p(:,opcaopcx);
p2=p(:,opcaopcy);
xclear()
xset("window",cont_win)
xset("mark",2,5)
xset("font",5,fonte)
plot2d1("onn",p1,p2,[-5 -2])
xtitle([titulo],[['Loadings-CP']+string(opcaopcx)],[['LoadingsCP']+string(opcaopcy)])
xset("window",cont_win)
for i=1:m, xstring(p1(i),p2(i),lab(i,:));end;

end;
opcaogr=x_choose(['Novo grafico';'Fim'],'selection (click on one item )');
cont_win=cont_win+1;
end;

function escores3d(t,lab,titulo,fonte)
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

[saida,entrada]=argn(0);

[m,n]=size(t);

if entrada==1
tmp=[];
for j=1:m
tmp=[tmp;string(j)];
end;
lab=tmp
titulo=['Gráfico de escores'];
end;
if entrada==2
titulo=['Gráfico de escores'];
end;

opcaogr=1;

cont_win=xget("window");
cont_win=cont_win+1;
while opcaogr==1
for i=1:n, labpc(i)=['CP'+string(i)];end;
opcaopcx=x_choose(labpc,'( A Componente Principal para o eixo x)');
opcaopcy=x_choose(labpc,'( A Componente Principal para o eixo y)');
opcaopcz=x_choose(labpc,'( A Componente Principal para o eixo z)');

t1=t(:,opcaopcx);
t2=t(:,opcaopcy);
t3=t(:,opcaopcz);

xclear()
xset("window",cont_win)
xset("mark",2,1)
xset("font",3,fonte)

maxxg=max([t1])+[(max([t1])).*(.5)*sign(max([t1]))];
maxyg=max([t2])+[(max([t2])).*(.5)*sign(max([t2]))];
maxzg=max([t3])+[(max([t3])).*(.5)*sign(max([t3]))];

minxg=min([t1])+[(min([t1])).*(-.5)*sign(min([t1]))];
minyg=min([t2])+[(min([t2])).*(-.5)*sign(min([t2]))];
minzg=min([t3])+[(min([t3])).*(-.5)*sign(min([t3]))];

labcaixa=['Sem Caixa';'Parte da Caixa';'Caixa sem Valores';'Caixa com Valores']

opcaobox=x_choose(labcaixa,'( Inserir caixa ao redor do Gráfico)');
caixa=opcaobox;

teixx=[minxg:max([t1])/100:max([t1])];
teixy=[minyg:max([t2])/100:max([t2])];
teixz=[minzg:max([t3])/100:max([t3])];

mteix=max(size(teixx));
mteiy=max(size(teixy));
mteiz=max(size(teixz));

t1g12=[t1' zeros(1,mteix) zeros(1,mteiy) zeros(1,mteiz)];
t2g12=[t2' zeros(1,mteix) zeros(1,mteiy) zeros(1,mteiz)];
t3g12=[t3' zeros(1,mteix) zeros(1,mteiy) zeros(1,mteiz)];

t1g13=[teixx zeros(t1') zeros(1,mteiy) zeros(1,mteiz)];
t2g13=[zeros(1,mteix) teixy zeros(t2') zeros(1,mteiz)];
t3g13=[zeros(1,mteix) zeros(1,mteiy) zeros(t3') teixz];

xset("font",3,1)

x_t=[t1g12' t1g13' zeros(t2g13') zeros(t2g13')];
y_t=[t2g12' zeros(t2g13') t2g13' zeros(t2g13')];
z_t=[t3g12' zeros(t2g13') zeros(t2g13') t3g13' ];

param3d1(x_t,y_t,list(z_t,[-1 2 3 5]),[30],[30],[['CP']+string(opcaopcx)+['@CP']+string(opcaopcy)+['@CP']+string(opcaopcz)],[1,1],[minxg,maxxg,minyg,maxyg,minzg,maxzg])

opcaogir=0;
opcaogir=x_choose(['Fim'],' ');

if opcaogir==1
opcaoang=1;
while opcaoang==1

alfa=x_dialog(['Entre com o valor de alpha, mostrado na janela do Gráfico '],'0')
theta=x_dialog(['Entre com o valor de theta, mostrado na janela do Gráfico '],'0')

cont_win=cont_win+1;
xset("window",cont_win)
xset("font",3,fonte)
param3d1(x_t,y_t,list(z_t,[-1 2 3 5]),[sscanf(theta,'%f')],[sscanf(alfa,'%f')],[['CP']+string(opcaopcx)+['@CP']+string(opcaopcy)+['@CP']+string(opcaopcz)],[1,1],[minxg,maxxg,minyg,maxyg,minzg,maxzg])

xset("font",3,fonte)
[x,y]=geom3d(t1,t2,t3);
for i=1:m
xstring(x(i),y(i),lab(i))
end;
xtitle([titulo+[' CP']+string(opcaopcx)+['xCP']+string(opcaopcy)+['xCP']+string(opcaopcz)])
xset("font",3,1)
[x1,y1]=geom3d(min(t1),0,0);
xstring(x1(1).*(1.5),y1(1).*(1.5),[['cp']+string(opcaopcx)])

[x2,y2]=geom3d(0,min(t2),0);
xstring(x2(1).*(1.5),y2(1).*(1.5),[['cp']+string(opcaopcy)])

[x3,y3]=geom3d(0,0,min(t3));
xstring(x3(1).*(1.5),y3(1).*(1.5),[['cp']+string(opcaopcz)])

opcaoang=x_choose(['Novo Ângulo';'Fim'],'Continuar?');

end;

end;

opcaogr=x_choose(['Novo Gráfico';'Fim'],'Continuar?');

cont_win=cont_win+1;
end;

function loadings3d(t,lab,titulo,fonte)
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

[saida,entrada]=argn(0);

[m,n]=size(p);

if entrada==1
tmp=[];
for j=1:m
tmp=[tmp;['Variável-']+string(j)];
end;
lab=tmp
titulo=['Gráfico de loadings'];
end;
if entrada==2
titulo=['Gráfico de loadings'];
end;

opcaogr=1;

cont_win=xget("window");
cont_win=cont_win+1;
while opcaogr==1
for i=1:n, labpc(i)=['CP'+string(i)];end;
opcaopcx=x_choose(labpc,'( A Componente Principal para o eixo x)');
opcaopcy=x_choose(labpc,'( A Componente Principal para o eixo y)');
opcaopcz=x_choose(labpc,'( A Componente Principal para o eixo z)');

t1=t(:,opcaopcx);
t2=t(:,opcaopcy);
t3=t(:,opcaopcz);

xclear()
xset("window",cont_win)
xset("mark",2,1)
xset("font",3,fonte)

maxxg=max([t1])+[(max([t1])).*(.5)*sign(max([t1]))];
maxyg=max([t2])+[(max([t2])).*(.5)*sign(max([t2]))];
maxzg=max([t3])+[(max([t3])).*(.5)*sign(max([t3]))];

minxg=min([t1])+[(min([t1])).*(-.5)*sign(min([t1]))];
minyg=min([t2])+[(min([t2])).*(-.5)*sign(min([t2]))];
minzg=min([t3])+[(min([t3])).*(-.5)*sign(min([t3]))];

labcaixa=['Sem Caixa';'Parte da Caixa';'Caixa sem Valores';'Caixa com Valores']

opcaobox=x_choose(labcaixa,'( Inserir caixa ao redor do Gráfico)');
caixa=opcaobox;

teixx=[minxg:max([t1])/100:max([t1])];
teixy=[minyg:max([t2])/100:max([t2])];
teixz=[minzg:max([t3])/100:max([t3])];

mteix=max(size(teixx));
mteiy=max(size(teixy));
mteiz=max(size(teixz));

t1g12=[t1' zeros(1,mteix) zeros(1,mteiy) zeros(1,mteiz)];
t2g12=[t2' zeros(1,mteix) zeros(1,mteiy) zeros(1,mteiz)];
t3g12=[t3' zeros(1,mteix) zeros(1,mteiy) zeros(1,mteiz)];

t1g13=[teixx zeros(t1') zeros(1,mteiy) zeros(1,mteiz)];
t2g13=[zeros(1,mteix) teixy zeros(t2') zeros(1,mteiz)];
t3g13=[zeros(1,mteix) zeros(1,mteiy) zeros(t3') teixz];

xset("font",3,1)

x_t=[t1g12' t1g13' zeros(t2g13') zeros(t2g13')];
y_t=[t2g12' zeros(t2g13') t2g13' zeros(t2g13')];
z_t=[t3g12' zeros(t2g13') zeros(t2g13') t3g13' ];

param3d1(x_t,y_t,list(z_t,[-1 2 3 5]),[30],[30],[['CP']+string(opcaopcx)+['@CP']+string(opcaopcy)+['@CP']+string(opcaopcz)],[1,1],[minxg,maxxg,minyg,maxyg,minzg,maxzg])

opcaogir=0;
opcaogir=x_choose(['Fim'],' ');

if opcaogir==1
opcaoang=1;
while opcaoang==1

alfa=x_dialog(['Entre com o valor de alpha, mostrado na janela do Gráfico '],'0')
theta=x_dialog(['Entre com o valor de theta, mostrado na janela do Gráfico '],'0')

cont_win=cont_win+1;
xset("window",cont_win)
xset("font",3,fonte)
param3d1(x_t,y_t,list(z_t,[-1 2 3 5]),[sscanf(theta,'%f')],[sscanf(alfa,'%f')],[['CP']+string(opcaopcx)+['@CP']+string(opcaopcy)+['@CP']+string(opcaopcz)],[1,1],[minxg,maxxg,minyg,maxyg,minzg,maxzg])

xset("font",3,fonte)
[x,y]=geom3d(t1,t2,t3);
for i=1:m
xstring(x(i),y(i),lab(i))
end;
xtitle([titulo+[' CP']+string(opcaopcx)+['xCP']+string(opcaopcy)+['xCP']+string(opcaopcz)])
xset("font",3,1)
[x1,y1]=geom3d(min(t1),0,0);
xstring(x1(1).*(1.5),y1(1).*(1.5),[['cp']+string(opcaopcx)])

[x2,y2]=geom3d(0,min(t2),0);
xstring(x2(1).*(1.5),y2(1).*(1.5),[['cp']+string(opcaopcy)])

[x3,y3]=geom3d(0,0,min(t3));
xstring(x3(1).*(1.5),y3(1).*(1.5),[['cp']+string(opcaopcz)])

opcaoang=x_choose(['Novo Ângulo';'Fim'],'Continuar?');

end;

end;

opcaogr=x_choose(['Novo Gráfico';'Fim'],'Continuar?');

cont_win=cont_win+1;

end;

function [tv,pv]=varimax(X,numpc);
// Autor: Marlon Martins dos Reis
// e-mail: marlon@iqm.unicamp.br
// página:http://lqta.iqm.unicamp.br/MARLON.html
// Colaboraçao: Márcia M. C. Ferreira
// e-mail: marcia@iqm.unicamp.br
// página: http://www.iqm.unicamp.br/profs/marcia.html
//
// Laboratório de Quimiometria Teórica e Aplicada - LQTA -
//
// http://lqta.iqm.unicamp.br/

lbd=1;
[n,m]=size(X);
lbd=1/n;
[uvar,svar,vvar]=svd(X);
F=vvar(:,1:numpc);
[m_F,n_f]=size(F);
zold=sum([sum(F.^4)]-[lbd.*(sum(F.^2).^2)]);
z=0;
cont_z=1;
while abs(zold-z)>1e-10
for i=1:n_f-1
for j=i+1:n_f

x=F(:,i);
y=F(:,j);

u=(x.*x)-(y.*y);
v=2.*(x.*y);

u_c=mncn(u);
v_c=mncn(v);

a=2*n*(u_c'*v_c);
b=n*(u_c'*u_c)-n*(v_c'*v_c);
c=(a^2+b^2)^(1/2);

v=-sign(a)*[(b+c)/(2*c)]^(1/2);

seno_teta=(.5-.5*v)^(1/2);
coseno_teta=(.5+.5*v)^(1/2);

if v>=0
T=[
coseno_teta seno_teta
-seno_teta coseno_teta];

else
T=[
seno_teta coseno_teta
coseno_teta -seno_teta];
end;

p=[x,y]*T;
F(:,i)=p(:,1);
F(:,j)=p(:,2);

end;
end;
zold=z;
z=sum([sum(F.^4)]-[lbd.*(sum(F.^2).^2)]);

z_temp(cont_z,1)=z;
cont_z=cont_z+1;
end;

tv=X*F;
pv=F;
tv=resume(tv);
pv=resume(pv);