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.

This is my programme which I think it's OK,but got WA in Test 7.
I'm glad to thank you if everyone can give some testdatas.

program ural1103;

{$APPTYPE CONSOLE}

const
        maxn=5000;

type
        point=record
                x,y     :extended;
        end;

var
        po      :array[1..maxn]of point;
        n       :integer;

procedure swap(a,b:integer);
var
        t       :point;
begin
t:=po[a];po[a]:=po[b];po[b]:=t;
end;

function min(a,b:integer):boolean;
begin
min:=(po[b].y-po[a].y>1e-10)or
        ((abs(po[b].y-po[a].y)<1e-10)and(po[b].x-po[a].x>1e-10));
end;

function dis(i,j:point):extended;
begin
dis:=sqrt((i.x-j.x)*(i.x-j.x)+(i.y-j.y)*(i.y-j.y));
end;

function cos_(a:point):extended;
begin
cos_:=(dis(a,po[1])*dis(a,po[1])+dis(a,po[2])*dis(a,po[2])
        -dis(po[1],po[2])*dis(po[1],po[2]))/(dis(a,po[1])*dis(a,po[2]));
end;

procedure qsort(p,q:integer);
var
        i,j     :integer;
        x       :point;
begin
if p>=q then exit;
i:=p-1;
j:=q+1;
x:=po[(i+j)div 2];
while(i<j)do
begin
        repeat inc(i);until (cos_(x)-cos_(po[i])>-1e-10);
        repeat dec(j);until (cos_(po[j])-cos_(x)>-1e-10);
        if i<j then swap(i,j);
end;
qsort(p,j);
qsort(j+1,q);
end;

function max(a,b:integer):boolean;
begin
max:=((po[a].x-po[1].x)*(po[b].y-po[1].y)
        -(po[b].x-po[1].x)*(po[a].y-po[1].y))>1e-10;
end;

procedure init;
var
        i       :integer;
begin
read(n);
for i:=1 to n do
        read(po[i].x,po[i].y);
for i:=2 to n do
        if min(i,1) then swap(1,i);
for i:=3 to n do
        if max(i,2) then swap(2,i);
qsort(3,n);
writeln(po[1].x:0:0,' ',po[1].y:0:0);
writeln(po[2].x:0:0,' ',po[2].y:0:0);
writeln(po[(n+3)div 2].x:0:0,' ',po[(n+3)div 2].y:0:0);
end;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  init;
  readln;
//  readln;
end.

DON'T USE EXTENDED!
TEST #9
  20 15 15
CORRECT ANSWER:  10549134770590785600
INCORRECT ANSWER:10549134770590786000

GOOD LUCK^_^

const
  max=500000;
var
  data:array[0..max]of byte;
  n:longint;
  mid,i:longint;
  p:integer;
  a,b,a1,b1:integer;
begin
  fillchar(data,sizeof(data),0);
  read(n);
  mid:=n div 2;
  if odd(n)
    then p:=1
    else p:=0;
  for i:=1 to mid do
    begin
      read(a,b);
      read(a1,b1);
      data[i]:=10*(a+b)+a1+b1;
    end;
  for i:=1 to p do
    begin
      read(a,b);
      data[mid+p]:=a+b;
      inc(data[mid],data[mid+p]div 10);
      data[mid+p]:=data[mid+p]mod 10;
    end;
  for i:=mid downto 1 do
    begin
      inc(data[i-1],data[i]div 100);
      data[i]:=data[i]mod 100;
    end;
  if data[0]<>0
    then write(data[0]);
  for i:=1 to mid do
    if data[i]=0
      then write('00')
      else write(data[i]);
  if p>0
    then write(data[mid+p]);
end.

r:real;
writeln (r:3:3);

IS THIS GOD OR NOT

Help!
Here's my programm:
var s:array [1..100] of char;
r:array [1..100,1..100,1..100] of char;
l:array [1..100,1..100] of byte;
n,i,j,z,k,a,b:integer;
bool:boolean;
function f (i:byte):byte;
begin
 if (i>=10) and (i<100) then f:=4 else if i=100 then f:=5 else f:=3;
end;
begin
 i:=1; fillchar (l,sizeof (l),0);
 while not eoln do begin Read (s[i]); inc (i); end;
 n:=i-1;
 for j:=1 to 4 do
  for i:=1 to n-j+1 do begin
   for z:=i to i+j-1 do r[i,j,z-i+1]:=s[z];
   l[i,j]:=j;
  end;
 for j:=5 to n do
  for i:=1 to n-j+1 do begin
   a:=0;
   for z:=1 to j-1 do
    if (l[i,j]>l[i,z]+l[i+z,j-z]) or (l[i,j]=0) then
     begin
      l[i,j]:=l[i,z]+l[i+z,j-z];
      a:=z;
     end;
   b:=0;
   for z:=2 to j do
    if j mod z=0 then
     begin
      bool:=true;
      for k:=i to i-1+j-j div z do if s[k]<>s[k+j div z] then begin bool:=false; break; end;
      if bool then if l[i,j]>=f(z)+l[i,j div z] then
       begin
        l[i,j]:=f(z)+l[i,j div z];
        b:=z;
       end;
     end;
   if b=0 then
    begin
     for z:=1 to l[i,a] do
     r[i,j,z]:=r[i,a,z];
     for z:=1 to l[i+a,j-a]
     do r[i,j,z+l[i,a]]:=r[i+a,j-a,z];
    end else
    begin
     if b<10 then begin
      r[i,j,1]:=chr (b+ord ('0'));
      r[i,j,2]:='(';
      for z:=1 to l[i,j div b] do r[i,j,z+2]:=r[i,j div b,z];
      r[i,j,l[i,j div b]+3]:=')';
     end else if b<100 then begin
      r[i,j,1]:=chr (b div 10+ord ('0'));
      r[i,j,2]:=chr (b mod 10+ord ('0'));
      r[i,j,3]:='(';
      for z:=1 to l[i,j div b] do r[i,j,z+3]:=r[i,j div b,z];
      r[i,j,l[i,j div b]+4]:=')';
     end else begin
      r[i,j,1]:='1';
      r[i,j,2]:='0';
      r[i,j,3]:='0';
      r[i,j,4]:='(';
      for z:=1 to l[i,j div b] do r[i,j,z+4]:=r[i,j div b,z];
      r[i,j,l[i,j div b]+5]:=')';
     end;
    end;
  end;
  for i:=1 to l[1,n] do write (r[1,n,i]);
end.
It gets ML on test 20.

This is my program:
var
  a,c:array [0..3001] of real;
  n:integer;

procedure init;
var
  i:integer;
begin
  read(n);
  read(a[0],a[n+1]);
  for i:=1 to n do
    read(c[i]);
end;

function work(i:integer):real;
begin
  if i=0 then work:=a[0] else
  if i=n+1 then work:=a[n+1] else
  work:=(work(i-1)+work(i+1))/2-c[i];
end;

procedure print;
begin
  writeln(work(1):0:2);
end;

begin
  init;
  print;
end.