See my accepted program:

Program P1053;
Const Max=1000;
Type TList=Array[1..Max] of Longint;
Var A:TList;
    n,s,i:Integer;
    r1,r2:longint;

Procedure Sort(l,r:Integer);
Var x,t:Longint;
    i,j:Integer;
Begin
  i:=l; j:=r; x:=A[(i+j) div 2];
  repeat
    while A[i]>x do inc(i);
    while A[j]<x do dec(j);
    if i<=j then begin
                   if i<>j then begin
                                  t:=A[i]; A[i]:=A[j]; A
[j]:=t
                                end;
                   inc(i); dec(j)
                 end
  until i>j;
  if i<r then Sort(i,r);
  if l<j then Sort(l,j)
End;

Function Gcd(A,B:Longint):Longint;
Var C:Longint;
Begin
  while B<>0 do
    begin
      C:=A;
      A:=B;
      B:=C mod B
    end;
  Gcd:=A
End;

Begin
  readln(n);
  for i:=1 to n do read(A[i]);
  Sort(1,n);
  for i:=n-1 downto 1 do A[i]:=Gcd(A[i+1],A[i]);
  writeln(A[1])
End.

If so, could you write it down or post it to me?
Thanks!
My E-mail: yuyuanming163@163.com

For example:
If N=3
   and p1=3; p2=-3; p3=10; What i and j = ?

program ural1016;
const
  top:array[1..6{front},1..6{left}]of byte=
       ((0,4,2,5,3,0),(3,0,6,1,0,4),(5,1,0,0,6,2),
        (2,6,0,0,1,5),(4,0,1,6,0,3),(0,3,5,2,4,0));
var
  side:array[1..6]of integer;{top,front,right,bottom,back,left}
  dist:array['a'..'h',1..8,1..6{front},1..6{left}]of longint;
  q:array[1..10000]of record
    x:char;
    y,f,l:byte;
    pre:integer;
  end;
  sx,tx,x:char;
  sy,ty,y,f,l:byte;
  front,rear,p:integer;
  min:longint;
  route:string;
procedure add(x1:char;y1,f1,l1,cost:byte);
  begin
    if dist[x,y,f,l]+side[cost]>=dist[x1,y1,f1,l1] then exit;

    dist[x1,y1,f1,l1]:=dist[x,y,f,l]+side[cost];
    inc(rear);
    with q[rear] do begin
      x:=x1;y:=y1;f:=f1;l:=l1;pre:=front;
    end;

    if (x1=tx) and (y1=ty) then
      if dist[x1,y1,f1,l1]<min then begin
        min:=dist[x1,y1,f1,l1];
        p:=rear;
      end;
  end;
begin
  for x:='a' to 'h' do
    for y:=1 to 8 do
      for f:=1 to 6 do
        for l:=1 to 6 do
          dist[x,y,f,l]:=maxlongint;
  min:=maxlongint;
  read(sx);read(x);sy:=ord(x)-48;read(x);
  read(tx);read(x);ty:=ord(x)-48;
  readln(side[2],side[5],side[1],side[3],side[6],side[4]);
  dist[sx,sy,2,4]:=side[6];
  front:=0;rear:=1;
  q[1].x:=sx;q[1].y:=sy;q[1].f:=2;q[1].l:=4;
  repeat
    inc(front);
    x:=q[front].x;y:=q[front].y;f:=q[front].f;l:=q[front].l;
    if y<8 then add(x,succ(y),7-top[f,l],l,7-f);{Go up}
    if y>1 then add(x,pred(y),top[f,l],l,f);{Go down}
    if x>'a' then add(pred(x),y,f,top[f,l],l);{Go left}
    if x<'h' then add(succ(x),y,f,7-top[f,l],7-l);{Go right}
  until front=rear;
  write(min);
  route:=' '+q[p].x+chr(48+q[p].y);
  while p>1 do begin
    p:=q[p].pre;
    route:=' '+q[p].x+chr(48+q[p].y)+route;
  end;
  writeln(route);
end.

I'm locked at the problem some long.Could anyone make me know how to save the memory?

{my wrong code}
const
  maxn=600;
type
  link=^re;
  re=record
    num:integer;
    q:link;
  end;
var
  p:link;
  n:longint;
  va:array[1..maxn]of byte;
  g:array[1..maxn]of link;
  max:array[1..maxn,0..1]of longint;
  r:array[1..maxn]of boolean;

  procedure init;
  var
    x,y,i:longint;
  begin
    assign(input,'1039.in'); reset(Input);
    fillchar(r,sizeof(r),false);
    readln(n);
    for i:=1 to n do
      readln(va[i]);
    readln(y,x);
    while (x<>0) or (y<>0) do
    begin
      r[y]:=true;
      new(p);
      p^.num:=y;
      p^.q:=g[x];
      g[x]:=p;
      readln(y,x);
    end;
  end;

  procedure solve(root:longint);
  var
    p:link;
    x,big:longint;
  begin
    new(p); p:=g[root];
    while p<>nil do
    begin
      x:=p^.num;
      solve(x);
      inc(max[root,1],max[x,0]);
      if max[x,0]>max[x,1]
        then big:=max[x,0]
        else big:=max[x,1];
      inc(max[root,0],big);
      p:=p^.q;
    end;
    inc(max[root,1],va[root]);
  end;

  procedure main;
  var
    i:longint;
  begin
    for i:=1 to n do
      if not(r[i])
        then begin
          solve(i);
          if max[i,1]>max[i,0]
            then writeln(max[i,1])
            else writeln(max[i,0]);
          exit;
        end;
  end;

begin
  init;
  main;
end.


The code is wrong at the fourth test.I am pluzzled.
Please give me some tests. Sorry for my fool.

Language Pascal

In puzzle 1221 system said me : "Compilation error"... On my PC program is work.

Which kind of Pascal compilator using for test programs?
Where I could take tests for programs, if it's possible?

#include <cstdio>
#include <cstring>
#include <cmath>
#include <vector>
#include <algorithm>
using namespace std;

const double EPS=1e-8;
const int MAXN=100;
const int MAXM=100;

struct Tnode {
  int x,y;
  double r,c;
};

int n,m;
int s;
double v;
vector<Tnode> c;
double a[MAXN];
int ind[MAXN][2];

inline bool cmp(Tnode p1,Tnode p2)
{
  return(p1.x==p2.x)?(p1.y<p2.y):(p1.x<p2.x);
}

void read()
{
  int i,x,y;
  Tnode tmp;

  scanf("%d%d%d%lf",&n,&m,&s,&v);
  s--;
  c.clear();
  for(i=0;i<m;i++) {
    scanf("%d%d",&x,&y);
    x--,y--;
    tmp.x=x,tmp.y=y;
    scanf("%lf%lf",&tmp.r,&tmp.c);
    c.push_back(tmp);
    tmp.x=y,tmp.y=x;
    scanf("%lf%lf",&tmp.r,&tmp.c);
    c.push_back(tmp);
  }
  sort(c.begin(),c.end(),cmp);

  memset(ind,255,sizeof(ind));
  ind[c[0].x][0]=0;
  for(i=1;i<c.size();i++) {
    if(c[i].x!=c[i-1].x) {
      ind[c[i-1].x][1]=i-1;
      ind[c[i].x][0]=i;
    }
  }
  i=c.size()-1;
  ind[c[i].x][1]=i;
}

bool solve()
{
  int i,j;
  bool done;
  double u;

  for(i=0;i<n;i++) a[i]=-1.;
  a[s]=v;

  do {
    done=1;
    for(i=0;i<n;i++) if(a[i]>EPS) {
      if(ind[i][0]<0) continue;
      for(j=ind[i][0];j<=ind[i][1];j++) if(a[i]>c[j].c+EPS) {
    u=(a[i]-c[j].c)*c[j].r;
    if(a[c[j].y]<-EPS) {
      a[c[j].y]=u;
      done=0;
    }
    else {
      if(u>a[c[j].y]+EPS) return 1;
    }
      }
    }
  } while(!done);
  return 0;
}

int main()
{
  read();
  if(solve()) printf("YES\n"); else printf("NO\n");
  return 0;
}

8475.009765625 3721.89990234375
3455

my answer is :
17925655.52
2916 539


for
8475.00 3721.89
3455
i have the answer
17925621.65
2916 539

This is my program:
var
  a:array [1..80] of char;
  hand:integer;

procedure work(ch:char);
begin
  if ch='>' then
    begin
      inc(hand);
      if hand>=80 then hand:=1;
    end
    else if ch='<' then
      begin
        dec(hand);
        if hand<=1 then hand:=1;
      end
      else if (ch>='a')and(ch<='z')or(ch>='A')and(ch<='Z') then
        begin
          a[hand]:=ch;
          inc(hand);
          if hand>=80 then hand:=1;
        end
        else
          begin
            a[hand]:=ch;
            inc(hand);
            if hand<1 then hand:=1;
          end;
end;

procedure init;
var
  ch:char;
begin
  hand:=1;
  fillchar(a,sizeof(a),' ');
  repeat
    read(ch);
    work(ch);
  until eof;
end;

procedure print;
var
  i:integer;
begin
  for i:=1 to 80 do
    write(a[i]);
  writeln;
end;

begin
  init;
  print;
end.

This is my program:
var
  a:array [1..80] of char;
  hand:integer;

procedure work(ch:char);
begin
  if ch='>' then
    begin
      inc(hand);
      if hand>=80 then hand:=1;
    end
    else if ch='<' then
      begin
        dec(hand);
        if hand<=1 then hand:=1;
      end
      else if (ch>='a')and(ch<='z')or(ch>='A')and(ch<='Z') then
        begin
          a[hand]:=ch;
          inc(hand);
          if hand>=80 then hand:=1;
        end
        else
          begin
            a[hand]:=ch;
            inc(hand);
            if hand<1 then hand:=1;
          end;
end;

procedure init;
var
  ch:char;
begin
  hand:=1;
  fillchar(a,sizeof(a),' ');
  repeat
    read(ch);
    work(ch);
  until eof;
end;

procedure print;
var
  i:integer;
begin
  for i:=1 to 80 do
    write(a[i]);
  writeln;
end;

begin
  init;
  print;
end.

[code deleted]

Edited by moderator 04.12.2019 21:09

in pascal i used
  lcm := a*b div gcd(a,b);

i got WA

i changed line to
  lcm := trunc(1.0*a*b / gcd(a,b));
and got AC
i think i had arithmetic overflow

problem 1286
I am sure that my program is right, but I get WA on test 16
Help(Do somebody know something interesting?)

How write answer fast?

In my program i get array[1..2, 1..n] - array of rid in graph. And write answer in O(3*N^2) - that very big.

My program:
var a,b : array [1..7501] of word;
    p   : array [1..2, 1..7501] of word;
    ans : array [1..7501] of boolean;
    i,j,k,n,x : longint;

BEGIN
  n := 0;
  while not eof do
  begin
    read(x);
    inc(n); a[n] := x;
    inc(b[x]);
  end;

  for i := 1 to n do
  begin
    j := 1;
    while (b[j] <> 0) do inc(j);

    dec(b[a[i]]); b[j] := 65535;

    p[1, i] := a[i]; p[2, i] := j;
  end;

  for i := 1 to n+1 do
  begin
    fillchar(ans, sizeof(ans), 0);

    for k := 1 to n do
    for j := 1 to 2 do
      if p[j, k] = i then ans[p[3-j, k]] := true;

    write(i,':');
    for j := 1 to n+1 do
      if ans[j] then write(' ',j);
    writeln;
  end;
END.