graph

Unit graph;

interface

const
    Nm = 20;
    Mm = 20;

type
    TInc = array [1..Nm, 1..Mm] of Integer;
    TMas = array [1..Mm] of Integer;

procedure Inp(var A: TInc; var Ew,Vw: TMas; var n,m,v,w,s: byte);
procedure Outp(A: TInc; Ew,Vw: TMas; n,m,v,w,s: byte);
procedure VAdj(A: TInc; n,m,v: byte; var adj: TMas);
function CheckAdj(A: TInc; m,v,w: byte): byte;
function Eweight(A: TInc; Ew: TMas; m,v,w: byte): Integer;
function VAdjToEdge(A: TInc; i,s: byte): byte;

implementation

uses Math;

procedure Inp(var A: TInc; var Ew,Vw: TMas; var n,m,v,w,s: byte);
var
    Finc,Fedg,Fvert: text;
    i,j: byte;
begin
    assign(Finc,'inc_graph.txt');
    assign(Fedg,'Eweight.txt');
    assign(Fvert,'Vweight.txt');
    reset(Finc);
    readln(Finc,n,m);
    for i:=1 to n do
        for j:=1 to m do
            read(Finc,A[i,j]);
    close(Finc);
    reset(Fedg);
    for j:=1 to m do
        read(Fedg,Ew[j]);
    close(Fedg);
    reset(FVert);
    for j:=1 to m do
        read(Fvert,Vw[j]);
    close(Fvert);

    Repeat
        writeln('enter vertexes:_ v,w');
        readln(v,w);
        writeln('enter edge:_ s');
        readln(s);
    Until
        ((v > 0) and (v <=n ) and (w > 0) and (w <= m) and (s > 0) and (s <= m));
    writeln;
end;

procedure Outp(A: TInc; Ew,Vw: TMas; n,m,v,w,s: byte);
var
    i,j,cntr: byte;
    adj,edges: TMas;
begin
    write('вершины ',v,', ',w);
    if ((CheckAdj(A,m,v,w)) <> 0) then
        writeln(' смежны')
    else
        writeln(' не смежны');

    write('вершины, смежные с ',v,':_');
    VAdj(A,n,m,v,adj);
    cntr:=adj[1];
    for j:=2 to cntr do
        write(' ',Abs(adj[j]));
    writeln;

    if (Eweight(A,Ew,m,v,w) <> -32000) then
        writeln('вес ребра (',v,',',w,'):_ ', Eweight(A,Ew,m,v,w));

    writeln('вес вершины ',v,':_ ', Vw[v]);

    write('ребра, инцидентные вершине ',v,':_ ');
    VAdj(A,n,m,v,edges);
    cntr:=edges[1];
    for j:=2 to cntr do
        if (edges[j] < 0) then
            write(' (',v,',',Abs(edges[j]),') ')
        else
            write(' (',edges[j],',',v,') ');
    writeln;

    write('вершины, инцидентные ребру ',s,':_ ');
        for i:=1 to n do
        begin
            cntr:=VAdjToEdge(A,i,s);
            if (cntr <> 0) then
                write(i,' ');
        end;
    writeln;
end;

function CheckAdj(A: TInc; m,v,w: byte): byte;
{returns edge}
var
    j: byte;
begin
    CheckAdj:=0;
    for j:=1 to m do
        if (A[v,j] <> 0) and (A[w,j] <> 0) then
            CheckAdj:=j;
end;

function VAdjToEdge(A: TInc; i,s: byte): byte;
begin
    VAdjToEdge:=A[i,s];
end;

procedure VAdj(A: TInc; n,m,v: byte; var adj: TMas);
var
    i,j,cntr: byte;
begin
    cntr:=0;
    adj[1]:=cntr;
    for j:=1 to m do
    begin
        if (A[v,j] <> 0) then
            for i:=1 to n do
                if (A[i,j] <> 0) and (i <> v) then
                begin
                    inc(cntr);
                    if (A[i,j] = 1) then
                        adj[cntr+1]:=i
                    else
                        adj[cntr+1]:=-i;
                end;
    end;
    adj[1]:=cntr+1;
end;

function Eweight(A: TInc; Ew: TMas; m,v,w: byte): Integer;
var
    edge: byte;
begin
    edge:=CheckAdj(A,m,v,w);
    if (edge <> 0) then
        Eweight:=Ew[edge]
    else
        Eweight:=-32000;
end;

end.