%**************************************************; %* Olivier Godechot, *; %* V1.2 the 30.05.2010 *; %* V1.1 the 21.08.2008 *; %**************************************************; %* Macro preparing a pajek file *; %* Macro preparing a pajek file *; %**************************************************; %Macro sas2pajek(dataarcs=,orig=,dest=,value=, multiplex=,aperiod=,arcmore=,direction=directed,mode=1, datavertex=,idvertex=,vertlabel=,vertmore=,vert_x_pos=,vert_y_pos=,vshape=,vcolor=,partitions=,vectors=, path=c:\pajek\,pajname=try.paj,form=Yes); %window Welcome #1 @15 "SAS2PAJEK" #2 @1 "This macro produces a pajek file in order to produce nice graphs and to use other practical facilities" #4 @1 "Data must be organized the following way : " #5 @1 "Origin_id Destiny_id value" #6 @1 "a1572 a1759 2" #7 @1 "a1088 a2716 1" #8 @1 "a1863 a2716 1" #10 @1 "Reading : An arc of value 2 is going from vertex a1572 to vertex a1759" #12 @1 "Name of your SAS the dataset containing arcs or edges : (dataarcs=) *" @75 dataarcs 30 attr=rev_video auto=yes #14 @1 "Identification variable of the departure vertex of an arc ? * (orig=)" @75 orig 30 attr=rev_video auto=yes #16 @1 "Identification variable of the arrival vertex of an arc ? *(dest=)" @75 dest 30 attr=rev_video auto=yes #18 @1 "Is the network directed or undirected ? (direction=)" @75 direction 30 attr=rev_video auto=yes #20 @1 "Is it a 1 mode or 2 mode network ? (mode=)" @75 mode 30 attr=rev_video auto=yes #22 @1 "Path of the folder where you want to save the file ? (path=) *" #24 @5 path 100 attr=rev_video auto=yes #26 @1 "Name of the pajek file (pajname=) *" #28 @5 pajname 30 attr=rev_video auto=yes #32 @15 "ADDITIONNAL SETTINGS FOR THE ARCS" #34 @1 "Variable name for the value of the relation ? (value=)" @75 value 30 attr=rev_video auto=yes #36 @1 "Variable name for the type of the relation ? (multiplex=)" @75 multiplex 30 attr=rev_video auto=yes #38 @1 "Variable name for the period of the relation ? (aperiod=)" @75 aperiod 30 attr=rev_video auto=yes #40 @1 "Variable containing additional settings for the arcs ? (arcmore=)" @76 arcmore 30 attr=rev_video auto=yes #42 @15 "ADDITIONNAL SETTINGS FOR THE VERTEX" #44 @1 "Name of an additional SAS dataset which specifies the selected vertex to use, adds isolated" #45 @1 "and categorical and numerical variable describing the vertex ? (datavertex=) [If 2 mode network... describes origin vertex only) " #46 @5 datavertex 30 attr=rev_video auto=yes #50 @1 "Once completed, press Enter " #55 @1 %nrstr("Complete syntax: sas2pajek(dataarcs=,orig=,dest=,value=,") #56 @1 %nrstr("multiplex=,aperiod=,arcmore=,direction=directed,mode=1,") #57 @1 %nrstr("datavertex=,idvertex=,vertlabel=,vertmore=,vert_x_pos=,vert_y_pos=,vshape=,vcolor=,partitions=,vectors=,") #58 @1 %nrstr("path,pajname=,form=Yes);") #59 @1 "(*) Required. NB : Id variables must not contain the character # " #60 @50 "Credits : Olivier GODECHOT. http://olivier.godechot.free.fr/ " ; %window More #1 @15 "ADDITIONAL SETTINGS FOR THE VERTEX (Continued)" #3 @1 "Identification variable of the vertex ? (idvertex=)" @75 idvertex 30 attr=rev_video auto=yes #5 @1 "Label variable of the vertex ? (vertlabel=)" @75 vertlabel 30 attr=rev_video auto=yes #7 @1 "Horizontal position of the vertex ? (vert_x_pos=)" @75 vert_x_pos 30 attr=rev_video auto=yes #9 @1 "Vertical position of the vertex ? (vert_y_pos=)" @75 vert_y_pos 30 attr=rev_video auto=yes #11 @1 "Variable containing additional settings for the vertex? (vertmore=)" @75 vertmore 30 attr=rev_video auto=yes #13 @1 "Categorical variable for the shapes (12 maximum)? (vertshape=) " @75 vshape 30 attr=rev_video auto=yes #15 @1 "Categorical variable for the (9 maximum) black & white colors? (vertcolor=)" @75 vcolor 30 attr=rev_video auto=yes #17 @1 "Categorical variables describing the vertex for partitions ? (partitions=) " #19 @5 partitions 100 attr=rev_video auto=yes #21 @1 "Numerical variables describing the vertex for vectors ? (vectors=)" #23 @5 vectors 100 attr=rev_video auto=yes ; %if &form=Yes %then %display Welcome; %if &form=Yes and &datavertex NE %then %display More; %let myshape=; %let mycolor=; %let dat1=_%substr(%scan(&dataarcs,1),1,5)_1; %let dat2=_%substr(%scan(&dataarcs,1),1,5)_2; %let dat3=_%substr(%scan(&dataarcs,1),1,5)_3; %let dat4=_%substr(%scan(&dataarcs,1),1,5)_4; %let dat5=_%substr(%scan(&dataarcs,1),1,5)_5; %let dat6=_%substr(%scan(&dataarcs,1),1,5)_6; %let dat7=_%substr(%scan(&dataarcs,1),1,5)_7; %let dat8=_%substr(%scan(&dataarcs,1),1,5)_8; %let dat9=_%substr(%scan(&dataarcs,1),1,5)_9; %let point=%str(.); %let pajname2=%substr(&pajname,1,%eval(%index(&pajname,&point)-1)); %let sufpajname=%substr(&pajname,%eval(%index(&pajname,&point)+1),3); %put %str(&sufpajname); %let orig_=%str(&orig)_; %let dest_=%str(&dest)_; %let idvertex_=%str(&idvertex)_; %if &value NE %then %let arcvalu_=%str(&value)_; %* %if &value NE %then %let arcvaren=%str(&arcvalu_)%str(=)%str(); %if &datavertex NE %then %do; %let datv1=_%substr(%scan(&datavertex,1),1,5)_v1; %let datv2=_%substr(%scan(&datavertex,1),1,5)_v2; %let datv3=_%substr(%scan(&datavertex,1),1,5)_v3; %let datv4=_%substr(%scan(&datavertex,1),1,5)_v4; %let datv5=_%substr(%scan(&datavertex,1),1,5)_v5; %let datv6=_%substr(%scan(&datavertex,1),1,5)_v6; %let datv7=_%substr(%scan(&datavertex,1),1,5)_v7; %let datv8=_%substr(%scan(&datavertex,1),1,5)_v8; %let datv9=_%substr(%scan(&datavertex,1),1,5)_v9; *I.2 Sous-programme pour traiter des suites de variables de type V1-V10 et AA--ZZ; %let tiret1=%str( -); %do %while (%index(&partitions,&tiret1)>0); %let long=%index(&partitions,&tiret1); %let partitions=%qsubstr(&partitions,1,&long-1)%str(-)%qsubstr(&partitions,&long+2); %end; %let tiret2=%str(- ); %do %while (%index(&partitions,&tiret2)>0); %let long=%index(&partitions,&tiret2); %let partitions=%qsubstr(&partitions,1,&long-1)%str(-)%qsubstr(&partitions,&long+2); %end; %if %index(&partitions,--)>0 or %index(&vectors,--)>0 %then %do; proc contents data=&datavertex noprint; run; %end; %do %while (%index(&partitions,--)>0); %let i=1; %do %while(%index(%scan(&partitions,&i,%str( )),--)=0); %let i=%eval(&i+1); %end; %let long2=%length(%scan(&partitions,&i,%str( ))); %let Vd=%scan(&partitions,&i); %let long=%index(&partitions,&vd); %let Vf=%scan(&partitions,&i+1); %local z; %local zz; %let z=%sysfunc(open(&data)); %let posd=%sysfunc(varvectors(&z,&vd)); %let posf=%sysfunc(varvectors(&z,&vf)); %let j=%eval(&posd+1); %let blanc=%str( ); %let ttevar=&vd&blanc; %do %while (&j<&posf); %let vj=%sysfunc(varname(&z,&j)); %let ttevar=&ttevar&vj&blanc; %let j=%eval(&j+1); %end; %let ttevar=&ttevar&vf; %let zz=%sysfunc(close(&z)); %let partitions=%qsubstr(&partitions,1,&long-1)%str(&ttevar)%qsubstr(&partitions,&long+&long2); %end; %do %while (%index(&partitions,-)>0); %let i=1; %do %while(%index(%scan(&partitions,&i,%str( )),-)=0); %let i=%eval(&i+1); %end; %let long2=%length(%scan(&partitions,&i,%str( ))); %let Vd=%scan(&partitions,&i); %let long=%index(&partitions,&vd); %let Vf=%scan(&partitions,&i+1); %let k=%length(&Vd); %do %while(%verify(%substr(&vd,&k),0123456789)=0); %let posd=%substr(&vd,&k); %let k=%eval(&k-1); %end; %let k=%length(&Vf); %do %while(%verify(%substr(&vf,&k),0123456789)=0); %let posf=%substr(&vf,&k); %let k=%eval(&k-1); %end; %let j=%eval(&posd+1); %let blanc=%str( ); %let ttevar=&vd&blanc; %do %while (&j<&posf); %let vj=%substr(&vd,1,&k); %let ttevar=&ttevar&vj&j&blanc; %let j=%eval(&j+1); %end; %let ttevar=&ttevar&vf; %let partitions=%qsubstr(&partitions,1,&long-1)%str(&ttevar)%qsubstr(&partitions,&long+&long2); %end; %let nbpartitions=0; %let j=1; %do %while(%scan(&partitions,&j) NE); %let nbpartitions=%eval(&nbpartitions+1); %let j=%eval(&j+1); %end; *I.2 Sous-programme pour traiter des suites de variables de type V1-V10 et AA--ZZ; %let tiret1=%str( -); %do %while (%index(&vectors,&tiret1)>0); %let long=%index(&vectors,&tiret1); %let vectors=%qsubstr(&vectors,1,&long-1)%str(-)%qsubstr(&vectors,&long+2); %end; %let tiret2=%str(- ); %do %while (%index(&vectors,&tiret2)>0); %let long=%index(&vectors,&tiret2); %let vectors=%qsubstr(&vectors,1,&long-1)%str(-)%qsubstr(&vectors,&long+2); %end; %if %index(&vectors,--)>0 or %index(&vectors,--)>0 %then %do; proc contents data=&datavertex noprint; run; %end; %do %while (%index(&vectors,--)>0); %let i=1; %do %while(%index(%scan(&vectors,&i,%str( )),--)=0); %let i=%eval(&i+1); %end; %let long2=%length(%scan(&vectors,&i,%str( ))); %let Vd=%scan(&vectors,&i); %let long=%index(&vectors,&vd); %let Vf=%scan(&vectors,&i+1); %local z; %local zz; %let z=%sysfunc(open(&data)); %let posd=%sysfunc(varvectors(&z,&vd)); %let posf=%sysfunc(varvectors(&z,&vf)); %let j=%eval(&posd+1); %let blanc=%str( ); %let ttevar=&vd&blanc; %do %while (&j<&posf); %let vj=%sysfunc(varname(&z,&j)); %let ttevar=&ttevar&vj&blanc; %let j=%eval(&j+1); %end; %let ttevar=&ttevar&vf; %let zz=%sysfunc(close(&z)); %let vectors=%qsubstr(&vectors,1,&long-1)%str(&ttevar)%qsubstr(&vectors,&long+&long2); %end; %do %while (%index(&vectors,-)>0); %let i=1; %do %while(%index(%scan(&vectors,&i,%str( )),-)=0); %let i=%eval(&i+1); %end; %let long2=%length(%scan(&vectors,&i,%str( ))); %let Vd=%scan(&vectors,&i); %let long=%index(&vectors,&vd); %let Vf=%scan(&vectors,&i+1); %let k=%length(&Vd); %do %while(%verify(%substr(&vd,&k),0123456789)=0); %let posd=%substr(&vd,&k); %let k=%eval(&k-1); %end; %let k=%length(&Vf); %do %while(%verify(%substr(&vf,&k),0123456789)=0); %let posf=%substr(&vf,&k); %let k=%eval(&k-1); %end; %let j=%eval(&posd+1); %let blanc=%str( ); %let ttevar=&vd&blanc; %do %while (&j<&posf); %let vj=%substr(&vd,1,&k); %let ttevar=&ttevar&vj&j&blanc; %let j=%eval(&j+1); %end; %let ttevar=&ttevar&vf; %let vectors=%qsubstr(&vectors,1,&long-1)%str(&ttevar)%qsubstr(&vectors,&long+&long2); %end; %let nbvectors=0; %let j=1; %do %while(%scan(&vectors,&j) NE); %let nbvectors=%eval(&nbvectors+1); %let j=%eval(&j+1); %end; data &datv1; set &datavertex (keep= &idvertex &vertlabel &vertmore &vert_x_pos &vert_y_pos &vshape &vcolor &partitions &vectors rename=(&idvertex=&idvertex_ )); vertex=&idvertex_ !! ""; run; data &datv2; %if &value NE %then %do; set &dataarcs (keep=&orig &dest &value &multiplex &aperiod &arcmore rename=(&orig=&orig_ &dest=&dest_ &value=&arcvalu_)); %put %str(set &dataarcs (keep=&orig &dest &value rename=(&orig=&orig_ &dest=&dest_ &value=&arcvalu_));); %end; %else %do; set &dataarcs (keep=&orig &dest &value &multiplex &aperiod &arcmore rename=(&orig=&orig_ &dest=&dest_ )); %end; orig=&orig_ !! ""; dest=&dest_ !! ""; %if &value= %then %do; value=1; %end; %else %do; value=&arcvalu_*1; %end; keep orig dest value &multiplex &aperiod &arcmore; run; proc sql; create table &datv3(drop=vertex) as select * from &datv2 as aa inner join &datv1 (keep=vertex) as bb on aa.orig=bb.vertex; %if &mode NE 2 %then %do; create table &dat1 (drop=vertex) as select * from &datv3 as aa inner join &datv1 (keep=vertex) as bb on aa.dest=bb.vertex; %end; %else %do; create table &dat1 as select * from &datv3; create table &dat3 as select min(dest) as vertex, count(dest) as indegree from &dat1 group by dest; %end; quit; %if &vshape NE %then %do; proc freq data=&datv1 noprint ; table &vshape /missing out=&datv4; run; %let myshape=myshape; data &datv4; set &datv4; length myshape $35; if _N_=1 then myshape=" box x_fact 4 y_fact 4"; if _N_=2 then myshape=" triangle x_fact 5 y_fact 5"; if _N_=3 then myshape=" diamond x_fact 4 y_fact 4"; if _N_=4 then myshape=" ellipse x_fact 5 y_fact 5"; if _N_=5 then myshape=" box x_fact 8 y_fact 2"; if _N_=6 then myshape=" triangle x_fact 10 y_fact 3"; if _N_=7 then myshape=" diamond x_fact 8 y_fact 2"; if _N_=8 then myshape=" ellipse x_fact 8 y_fact 3"; if _N_=9 then myshape=" box x_fact 2 y_fact 8"; if _N_=10 then myshape=" triangle x_fact 3 y_fact 10"; if _N_=11 then myshape=" diamond x_fact 2 y_fact 8"; if _N_=>12 then myshape=" ellipse x_fact 3 y_fact 8"; run; proc sort data=&datv4; by &vshape; run; proc sort data=&datv1; by &vshape; run; data &datv5; merge &datv1 &datv4 (keep=&vshape myshape); by &vshape; run; data &datv1; set &datv5; run; %end; %if &vcolor NE %then %do; proc freq data=&datv1 noprint order=freq; table &vcolor /missing out=&datv4; run; %let mycolor=mycolor; data &datv4; set &datv4; length mycolor $25; if _N_=1 then mycolor=" ic White bc Black "; if _N_=2 then mycolor=" ic Gray35 bc Black "; if _N_=3 then mycolor=" ic Gray65 bc Black "; if _N_=4 then mycolor=" ic Black bc Black "; if _N_=5 then mycolor=" ic White bc Gray65 "; if _N_=6 then mycolor=" ic Gray35 bc Gray65"; if _N_=7 then mycolor=" ic Gray65 bc Gray65"; if _N_=8 then mycolor=" ic White bc Gray35"; if _N_>=9 then mycolor=" ic Gray35 bc Gray35"; run; proc sort data=&datv4; by &vcolor; run; proc sort data=&datv1; by &vcolor; run; data &datv5; merge &datv1 &datv4 (keep=&vcolor mycolor); by &vcolor; run; data &datv1; set &datv5; run; %end; proc sort data=&datv1; by vertex; run; %if &vert_x_pos= %then %let vert_x_pos2=; %else %let vert_x_pos2=%str(!! &vert_x_pos); %if &vert_y_pos= %then %let vert_y_pos2=; %else %let vert_y_pos2=%str(!! &vert_y_pos); %if &vertmore= %then %let vertmore2=; %else %let vertmore2=%str(!! &vertmore); %if &myshape= %then %let myshape2=; %else %let myshape2=%str(!! &myshape); %if &mycolor= %then %let mycolor2=; %else %let mycolor2=%str(!! &mycolor); data &dat5; set &datv1; idpajek=_N_; %if &vertlabel NE %then %do; vertices=compbl(idpajek !! ' "' !! compbl(&vertlabel) !! '" ' &vert_x_pos2 &vert_y_pos2 &vertmore2 &myshape2 &mycolor2); *&vcolor !! " " !! &vshape; %end; %else %do; vertices=compbl(idpajek !! ' "' !! compbl(vertex) !! '" ' &vert_x_pos2 &vert_y_pos2 &vertmore2 &myshape2 &mycolor2); *!! &vcolor !! " " !! &vshape ; %end; mode=1; run; %if &mode = 2 %then %do; proc sort data=&dat3; by vertex; run; data &dat3; set &dat3; mode=2; run; data &dat5; set &dat5 &dat3; idpajek=_N_; %if &vertlabel NE %then %do; vertices=compbl(idpajek !! ' "' !! compbl(&vertlabel) !! '" ' &vert_x_pos2 &vert_y_pos2 &vertmore2 &myshape2 &mycolor2); %end; %else %do; vertices=compbl(idpajek !! ' "' !! compbl(vertex) !! '" ' &vert_x_pos2 &vert_y_pos2 &vertmore2 &myshape2 &mycolor2); %end; run; %end; %end; %else %do; data &dat1; %if &value NE %then %do; set &dataarcs (keep=&orig &dest &value &multiplex &aperiod &arcmore rename=(&orig=&orig_ &dest=&dest_ &value=&arcvalu_)); %put %str(set &dataarcs (keep=&orig &dest &value rename=(&orig=&orig_ &dest=&dest_ &value=&arcvalu_));); %end; %else %do; set &dataarcs (keep=&orig &dest &value &multiplex &aperiod &arcmore rename=(&orig=&orig_ &dest=&dest_ )); %end; orig=&orig_ !! ""; dest=&dest_ !! ""; %if &value= %then %do; value=1; %end; %else %do; value=&arcvalu_*1; %end; keep orig dest value &multiplex &aperiod &arcmore ; run; proc sql; create table &dat2 as select min(orig) as vertex, count(orig) as outdegree from &dat1 group by orig; create table &dat3 as select min(dest) as vertex, count(dest) as indegree from &dat1 group by dest; %if &mode=1 %then %do; create table &dat4 as select case vertex WHEN "" THEN vertex_ ELSE vertex END as vertex, max(outdegree,0) as outdegree, max(indegree,0) as indegree, max(outdegree,0) + max(indegree,0) as degree from &dat2 as aa full join &dat3 (rename=(vertex=vertex_ )) as bb on aa.vertex=bb.vertex_; quit; proc sort data=&dat4; by vertex; run; data &dat5; set &dat4; idpajek=_N_; vertices=idpajek !! " " !! '"' !! compbl(vertex) !! '"'; mode=1; run; %end; %else %do; proc sort data=&dat2; by vertex; run; data &dat2; set &dat2; mode=1; run; proc sort data=&dat3; by vertex; run; data &dat3; set &dat3; mode=2; run; data &dat5; set &dat2 &dat3 ; idpajek=_N_; vertices=idpajek !! " " !! '"' !! compbl(vertex) !! '"'; run; %end; %end; proc sql; create table &dat6(rename=(idpajek=idpajek_i)) as select * from &dat1 as aa left join &dat5 (keep= idpajek vertex mode where=(mode=1) ) as bb on aa.orig=bb.vertex; %if &mode NE 2 %then %do; create table &dat7(rename=(idpajek=idpajek_j)) as select * from &dat6 as aa left join &dat5 (keep= idpajek vertex mode where=(mode=1) ) as bb on aa.dest=bb.vertex; %end; %else %do; create table &dat7(rename=(idpajek=idpajek_j)) as select * from &dat6 as aa left join &dat5 (keep= idpajek vertex mode where=(mode=2) ) as bb on aa.dest=bb.vertex; %end; quit; %if &multiplex = and &aperiod = %then %do; %let sumclause=; %let sumclause2=; %end; %else %if &multiplex NE and &aperiod = %then %do; %let sumclause=, min(&multiplex) as &multiplex ; %let sumclause2=,&multiplex; %end; %else %if &multiplex = and &aperiod NE %then %do; %let sumclause=, min(&aperiod) as &aperiod ; %let sumclause2=,&aperiod; %end; %else %if &multiplex NE and &aperiod NE %then %do; %let sumclause=, min(&multiplex) as &multiplex, min(&aperiod) as &aperiod ; %let sumclause2=,&multiplex,&aperiod; %end; %if &arcmore NE %then %do; %let sumclause=&sumclause , min(&arcmore) as &arcmore; %end; %if &multiplex NE %then %let summultiplex=, &multiplex; %else %let summultiplex=; %if &aperiod NE %then %let sumaperiod=, &aperiod; %else %let sumaperiod=; %*end; proc sql; create table &dat8 as select min(idpajek_i) as idpajek_i, min(idpajek_j)as idpajek_j, sum(value) as value &sumclause from &dat7 group idpajek_i, idpajek_j &summultiplex &sumaperiod; quit; %if &multiplex NE %then %do; proc sort data=&dat8; by &multiplex; run; %end; %if &datavertex= %then %do; %let z=%sysfunc(open(&dat4)); %let endver=%sysfunc(attrn(&z,nobs)); %let zz=%sysfunc(close(&z)); %put &endver; %if &mode=2 %then %do; %let z=%sysfunc(open(&dat5)); %let endver=%sysfunc(attrn(&z,nobs)); %let zz=%sysfunc(close(&z)); %put &endver; %let z=%sysfunc(open(&dat2)); %let endor=%sysfunc(attrn(&z,nobs)); %let zz=%sysfunc(close(&z)); %put &endor; %end; %end; %else %do; %let z=%sysfunc(open(&datv1)); %let endver=%sysfunc(attrn(&z,nobs)); %let zz=%sysfunc(close(&z)); %put &endver; %if &mode=2 %then %do; %let z=%sysfunc(open(&dat5)); %let endver=%sysfunc(attrn(&z,nobs)); %let zz=%sysfunc(close(&z)); %put &endver; %let z=%sysfunc(open(&datv1)); %let endor=%sysfunc(attrn(&z,nobs)); %let zz=%sysfunc(close(&z)); %put &endor; %end; %end; data vertextitle; set &dat1 (obs=2); length printpaj $100; %if %upcase(&sufpajname) = NET %then %do; %if &mode=1 %then %do; if _N_=1 then printpaj="*Vertices &endver"; %end; %else %do; if _N_=1 then printpaj="*Vertices &endver &endor"; %end; ; %end; %else %do; if _N_=1 then printpaj="*Network &pajname2"; %if &mode=1 %then %do; if _N_=2 then printpaj="*Vertices &endver"; %end; %else %do; if _N_=2 then printpaj="*Vertices &endver &endor"; %end; ; %end; run; /*data arcstitle; set &dat1 (obs=1 keep=orig); length printpaj $100; %if &multiplex= %then %do; %if &direction=Undirected %then %do; if _N_=1 then printpaj="*Edges"; %end; %else %do; if _N_=1 then printpaj="*Arcs"; %end; %end; %if &multiplex NE %then %do; if _N_=1 then printpaj=""; %end; run; */ %let filerec= %str(&path&pajname); %let dat_partitions=; %if &partitions NE %then %do; %let i=1; %do %while (%scan(&partitions,&i) NE) ; proc freq data=&dat5 noprint ; table %scan(&partitions,&i) /missing out=&datv4; run; data &datv4; set &datv4; classpart=_N_; run; proc sort data=&datv4; by %scan(&partitions,&i); run; data &datv5; set &dat5; keep idpajek %scan(&partitions,&i); run; proc sort data=&datv5; by %scan(&partitions,&i); run; data &datv5; merge &datv5 &datv4 (keep=%scan(&partitions,&i) classpart); by %scan(&partitions,&i); run; proc sort data=&datv5; by idpajek; run; %let dat_partitions=dat_partitions; %if &i=1 %then %let dat_partitions2=; %else %if &i>1 %then %let dat_partitions2=dat_partitions; data &dat_partitions; set &datv5 &dat_partitions2; length pajpartitions $100 partitionsname $50; if pajpartitions = "" then do; numpartitions=&i; partitionsname="%scan(&partitions,&i)"; end; pajpartitions=classpart; run; %let i=&i+1; %end; %end; %let dat_vectors=; %if &vectors NE %then %do; %let i=1; %do %while (%scan(&vectors,&i) NE) ; data &datv5; set &dat5; myvector=%scan(&vectors,&i); keep idpajek %scan(&vectors,&i) myvector; run; proc sort data=&datv5; by idpajek; run; %let dat_vectors=dat_vectors; %if &i=1 %then %let dat_vectors2=; %else %if &i>1 %then %let dat_vectors2=dat_vectors; data &dat_vectors; set &datv5 &dat_vectors2; length pajvectors $100 vectorsname $50; if pajvectors = "" then do; numvectors=&i; vectorsname="%scan(&vectors,&i)"; end; pajvectors=myvector; run; %let i=&i+1; %end; %end; data _null_; set vertextitle &dat5 (keep=vertices) &dat8 (keep=idpajek_i idpajek_j value &aperiod &arcmore &multiplex ) &dat_partitions &dat_vectors; file "&filerec" lrecl=30000; length printpaj $100; if vertices NE "" then printpaj=vertices; retain j 0; i=2; %if &multiplex NE %then %do; if idpajek_i NE "" and &multiplex NE lag(&multiplex) then do; %end; %else %do; if idpajek_i NE "" and lag(idpajek_i)="" then do; %end; i=1; j=j+1; %if &direction=Undirected %then %do; %if &multiplex NE %then %do; printpaj=compbl("*Edges:" !! j !! ' "' !! &multiplex !! '"'); %end; %else %do; printpaj=compbl("*Edges"); %end; %end; %else %do; %if &multiplex NE %then %do; printpaj=compbl("*Arcs:" !! j !! ' "' !! &multiplex !! '"'); %end; %else %do; printpaj=compbl("*Arcs"); %end; %end; end; /*if pajpartitions NE "" and numpartitions NE lag(numpartitions) and i=2 then do; end;*/ if pajpartitions NE "" and numpartitions NE lag(numpartitions) then do; i=0; end; if pajvectors NE "" and numvectors NE lag(numvectors) then do; i=0; end; do while (i<=2); if idpajek_i NE "" and i>1 then printpaj=compbl(idpajek_i) !! " " !! compbl(idpajek_j) !! " " !! compbl(value); %if &aperiod NE %then %do; if idpajek_i NE "" and i>1 then printpaj=compbl(printpaj) !! " [" !! compbl(&aperiod) !! "]"; %end; %if &arcmore NE %then %do; if idpajek_i NE "" and i>1 then printpaj=printpaj !! " " !! &arcmore !! ""; %end; if pajpartitions NE "" and i=0 then printpaj="*Partitions " !! partitionsname; else if pajpartitions NE "" and i=1 then printpaj="*Vertices &endver"; else if pajpartitions NE "" then printpaj=pajpartitions; if pajvectors NE "" and i=0 then printpaj="*vectors " !! vectorsname; else if pajvectors NE "" and i=1 then printpaj="*Vertices &endver"; else if pajvectors NE "" then printpaj=pajvectors; if printpaj NE "" then put printpaj; i=i+1; end; %put %nrstr(%sas2pajek); %put (dataarcs=&dataarcs,orig=&orig,dest=&dest,value=&value,; %put multiplex=&multiplex,aperiod=&aperiod,arcmore=&arcmore,direction=&direction,mode=&mode,; %put datavertex=&datavertex,idvertex=&idvertex,vertlabel=&vertlabel,vertmore=&vertmore,vert_x_pos=&vert_x_pos,; %put vert_y_pos=&vert_y_pos,vshape=&vshape,vcolor=&vcolor,partitions=&partitions,vectors=&vectors,; %put path=&path,pajname=&pajname,form=Yes); %put %str(;); run; %MEND;