По условию ki<=100 => можно поддерживать степень каждого простого числа; при включении или отключении опции мы уменьшаем степень или увеличиваем на соотв. число.

В чём обман не знаю. Хотелось бы получить тесты,т.к. на мою фантазию прога работает.

const NMAX=105000;
      MMAX=100;
      LMAX=10;
var
 a,ki:array[1..NMAX] of int64;
 step:array[1..MMAX] of int64;
 step26:array[0..LMAX] of int64;
 p:array[1..MMAX] of longint;
 N,i,j,r,m,t:longint;
 W,H,p0,key,k,res:int64;
 f:boolean;
 s,s1:string;

procedure QSort(L,R:longint);
 var i,j:longint;
     X,Y:int64;
begin
 X:=A[random(r+1-l)+l];
 i:=L; j:=R;
 while i<=j do
  begin
   while A[i]<X do i:=i+1;
   while A[j]>X do j:=j-1;
     if i<=j then
       begin
         y:=A[i]; A[i]:=A[j]; A[j]:=y;
         y:=ki[i]; ki[i]:=ki[j]; ki[j]:=y;
         i:=i+1; j:=j-1;
       end;
  end;
  if L<j then QSort(L,j);
  if i<R then QSort(i,R);
end;


function Hash(s:string):int64;
 var i,len:longint;
     z:int64;
begin
 z:=0;
 len:=length(s);
 for i:=0 to len-1 do inc(z,(ord(s[len-i])-ord('a'))*step26[i]);
 Hash:=z;
end;


function Search(L,R:longint;key:int64):int64;
 var m:longint;
begin
 while(R-L>1) do begin
  m:=(L+R) div 2;
  if(a[m]<=key) then L:=m
  else R:=m;
 end;

 if(a[L]=key) then Search:=ki[L]
 else Search:=ki[R];
end;


procedure Update(x:int64;sgn:longint);
 var i:longint;
begin
 i:=1;
 while(i<=r) do begin
  while(x mod p[i]=0) do begin
   x:=x div p[i];
   inc(step[i],sgn);
  end;
  inc(i);
 end;
end;


BEGIN
 randomize;
 r:=1;
 p[r]:=2;
 for i:=3 to MMAX do begin
  f:=true;
  for j:=2 to i-1 do if(i mod j=0) then f:=false;
  if(f) then begin
   inc(r);
   p[r]:=i;
  end;
 end;

 for i:=1 to r do step[i]:=0;

 step26[0]:=1;
 for i:=1 to LMAX do step26[i]:=step26[i-1]*26;

 readln(N);
 for i:=1 to N do begin
  readln(s);
  t:=pos(' ',s);
  s1:=copy(s,1,t-1);
  delete(s,1,t);
  val(s,ki[i],t);
  a[i]:=Hash(s1);
  Update(ki[i],1);
 end;

 Qsort(1,N);

 readln(W,H,p0);
 readln(m);

 res:=W*H;
 i:=1;
 while(res<=p0)and(i<=r) do begin
  j:=step[i];
  while(j>0)and(res<=p0) do begin res:=res*p[i];dec(j);end;
  inc(i);
 end;

 if(p0<10*res) then writeln('Slideshow');
 if(p0>=10*res)and(p0<60*res) then writeln('So-so');
 if(p0>60*res) then writeln('Perfect');

 for i:=1 to m do begin
  readln(s);
  if(s[2]='n') then begin
   t:=pos(' ',s);
   delete(s,1,t);
   key:=Hash(s);
   k:=Search(1,N,key);
   Update(k,1);
  end;
  if(s[2]='f') then begin
   t:=pos(' ',s);
   delete(s,1,t);
   key:=Hash(s);
   k:=Search(1,N,key);
   Update(k,-1);
  end;
  if(s[1]='R') then begin
   t:=pos(' ',s);
   delete(s,1,t);
   t:=pos(' ',s);
   s1:=copy(s,1,t-1);
   delete(s,1,t);
   val(s1,w,t);
   val(s,h,t);
  end;

  res:=W*H;
  t:=1;
  while(res<=p0)and(t<=r) do begin
   j:=step[t];
   while(j>0)and(res<=p0) do begin res:=res*p[t];dec(j);end;
   inc(t);
  end;

  if(p0<10*res) then writeln('Slideshow');
  if(p0>=10*res)and(p0<60*res) then writeln('So-so');
  if(p0>60*res) then writeln('Perfect');
 end;
END.

Банальное (p0>60*res) -> (p0>=60*res) в двух местах.
Если будет время, напиши мне пожалуйста?

Что именно написать : как я решать пытаюсь, вердикты на попытки или что-то ещё?

На емайл, т. к. есть вопрос по другой задаче.

Сам отвечу себе)))
Ошибка находилась в строках if(s[2]='f') then begin ... и if(s[1]='R') then begin ..., т.к. в первом условии s менялось и могло попасть во второе или третье;

P.S. задачу сдал без хэшей: можно просто отсортировать строки.