Как не надо писать программы

[Никита Лесников]

[size=59]

Код: Выделить всё


        #include                                           <stdlib.h>
   #include                                                   <stdio.h>
#define                           a                              typedef
a                               long                                  N;
#define                   i =m(p(r,o,v),e,d
N                         G,l,I,C,B,A,W,L,S
,                            R,O,c,k,s                                 =
80,                                                                U=13
,T=169;                                                      a double P;
   #define                                                 F for(
      a P*E; a char*w;                            P sqrt(P); N H(){ F;
            O=scanf(" %[#]%*[^\n]",&O); ); scanf("%ld%*c",&O);
                          #define D return
                               D O; }



#define V                                             =malloc(sizeof(
#define  M                                           M(
#define   X                                         +=
P M N R){ s=                                       s>=k?printf( "%ld%c"
+3*(C<1),s-k,                                     R&7?32:10):s; D R>0?B
/2?H():getchar                                   ():R?.9+.7*M R+1):0; }
P t(N x,P K){ D                                 x?(x>U?0:t(x+2,K)*(x-1)
/x/K)+1/sqrt(K):                                t(2,K*K/U+1)*K; }  N _(N
J,N x){ F*(x?&W:&                              A)=W+J+x; (O=x=W/(J=k*k))
||A<J||(( O=2*W/J)                            &&2*A/J<3); A X A-J+1){ F
J*=x+O; S--*B&&x==O                          ; O=x=!J){ s X x+s; M 0); }
W X W-J;  S X 2; L X                         L-J*k+M S%8==B); } D  1; } E
p(E J,E x,E O){ F R=T;                      R--; )O[R]=J[R]+.8*x[R]; D O;
} P m(E W,E x,P s){ F R         =          U; --R; ){ E A=W+R*U; W[R]X s/
12; *W X s; *A-=*x++; F;        A>W;      ){ *A/=*W; F O=R; O; O--)A[O]-=
W[O]**A;  A-=U; } W X 14;     } D*W; }   int main(int z,w*y){ N K=s,g; Y;
M z); s= B=C=15-H(); s=G=   M 8); s=l=M C); G*=g=C%3?1:3; if(I=s=M 8)){ N
b=G+9,x=b*340+U,J=b*(l+5), * n V N ) * J ),*j=n+5*b; E h V P)*x),q=h+b,e=q+
b; P d=K; F; J--; )n[J]=J<b ? 0: I / 2  ; F; x; )h[--x]=0; s=M x); k=256; C
=4-C; B=C/4;  s=_(_(T,0),0); F ; -- z  ; ){ R=atoi(*++y); c=R>0?K=R,c :-2*R;
} z=G/K+1; z X g>z; I++; c++; F ;  ++ J<l; ){ P u=0,C,y; E H =e+U,o= H+b*T,r
=o-2*T,v=r-T; F; x<G; x++){ p( H , o -T,o); o X T; H X T; q[x]= .7*(q[x-1]+h
                             [x] );
                             } p(H,
                             H,r );
                             F;  x;
                            ) { E S=
                           e ; w  l =
                        " !{   ,;lf6D@"
                      ; j X 1-g; F; *++l;
                     ){ *S++ =*j; j X*l%3*g-
                   g+*l%5*b-3*b; } y =M  x-G);
                 y =M-J)* M-x)+ M-J-1)*y+.01; y=
               sqrt((u+q[--x]+.1)/y ); o-=T; C i)+
              #define Z(x)(t(0,(x-C)/y)-l+1e-6*(x-Q))
            .5; K=M-B); { N f=I,Q=0; F; f-Q>c; ){ P l=0
          ; N H = C+c/2+1; H%=c; H X(f+Q+c-2*H)/2/c*c; l=
        Z(Q); O=(A-W)*Z(H)/Z(f); _(O,R=B?K>= H:L/k>O+W); *(
      R?&Q:&f)=H; } Q X f; *S=*j=Q/=2; s=B?s:Q+k; f=Q+n[x/z];
    n[x/z]=x%z+J%(z*2/g)?f:!putc(x?l[4*g*f/z/z/I-8]:10,stderr);
  H-=U; F O=156; O--; ){ H--; *H=e[O%U]*e[O/U]/y+.8**H; } C-=Q+.5
; y i/.9)-Q-C; p(p(r+T,r,r),H,r); h[x]=.7*h[x]+C*C; u X h[x]; u*=.7
       ; d X C>0?-y:y; } } j X 9; } _(_(x,x),x); } D 0; }



[/size]

Между прочим, это полностью работающий lossless кодек для изображений glicbawls. Тут есть и файловый ввод/вывод, и псевдообращение матриц, и арифметическое кодирование.

Степень сжатия изображений в большинстве случаев значительно лучше, чем у PNG и JPEG-LS. В качестве входного формата воспринимает только PPM.

Мораль: как важен бывает хороший стиль программирования

[MethroGnome]

И что это пытались изобразить? На голую бабу вроде не похоже...

[Kron]

ну немножко не совсем рабочая :)
в этой строчке есть ошибочка(обратить внимание на необъявленое Y):
W[O]**A; A-=U; } W X 14; } D*W; } int main(int z,w*y){ N K=s,g; Y;

z.c: In function `main':
z.c:34: error: `Y' undeclared (first use in this function)
z.c:34: error: (Each undeclared identifier is reported only once
z.c:34: error: for each function it appears in.)

но стиль программирования впечатляет

[VEG]

MethroGnome, Вроде чье-то лицо
Никита Лесников, А помнишь, как ты рассказывал про кодера, что код в виде девушки оформлял? Дай взглянуть :)

[Никита Лесников]

Это экзампл с IOCCC (не мой код - я не такой извращенец )

насчет Y - под 3-м gcc компайлится, под bcc и ic - нет. Этот самый Y можно просто закомментировать (

Код: Выделить всё

/* Y */

).

И еще. Точность fpu-арифметики желательно понизить до 64 бит (по дефолту 80), чтобы заработало. Под разными компайлерами это делается разными ключами.

[Никита Лесников]

А помнишь, как ты рассказывал про кодера, что код в виде девушки оформлял? Дай взглянуть :)

Во-первых, если ты этого парня назовешь кодером, он с вероятностью 85 % на тебя обидится

Во-вторых, чтобы в левых отступах увидеть девушку, надо иметь воображение

Вот пример (все, что у меня есть, к сожалению) :

Код: Выделить всё

  const maxn = 20010;

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

       rec = record
        id:longint;
        yg:double;
        p:point;
       end;

  var a,b:array[1..maxn] of point;
      c:array[1..3*maxn] of rec;
      p:array[1..maxn] of longint;
      n,m,k:longint;
      min:point;
      tt:rec;

 procedure init;
  var q,w:longint;
   begin
    assign(input,'input.txt');
     reset(input);
      read(n);
      min.y:=0;
      min.x:=0;
      for q := 1 to n do
       begin
        read(a[q].x,a[q].y);
        min.x:=min.x+a[q].x;
        min.y:=min.y+a[q].y;
       end;
      min.x:=min.x/n;
      min.y:=min.y/n;
      read(m);
      for q := 1 to m do  read(b[q].x,b[q].y);
    close(input);
   end;

  function ygol(x1,y1,x2,y2:double):double;
   var ssin,ccos,yg:double;
    begin
     if (x2 = 0) and (y2 = 0) then
      begin
       ygol:=0;
       exit;
      end;
     ssin:=x1*y2-x2*y1;
     ccos:=x1*x2+y1*y2;
     if ccos = 0 then
     begin
      if ssin > 0 then ygol:=pi/2 else ygol:=3*pi/2;
      exit;
     end;
     yg:=arctan(ssin/ccos);
     if ccos < 0 then yg:=yg+pi
     else
      if ssin < 0 then yg:=yg+2*pi;
       ygol:=yg;
        end;

  procedure Sort(l,r:longint);
   var i,j:longint;
       s:double;
    begin
     i:=l;
     j:=r;
     s:=c[(l+r) shr 1].yg;
     while i <= j do
      begin
       while c[i].yg < s do inc(i);
        while s < c[j].yg do dec(j);
         if i <= j then
          begin
           tt:=c[i];
            c[i]:=c[j];
              c[j]:=tt;
            inc(i);
           dec(j);
          end;
      end;
     if i < r then sort(i,r);
     if l < j then sort(l,j);
    end;

  function fun(a,b,c:point):double;
   begin
    fun:=(a.x-b.x)*(c.y-b.y)-(a.y-b.y)*(c.x-b.x);
   end;

  procedure done;
   var q,w,l,r,i,j:longint;
   begin
    k:=0;
     for q := 1 to n do
       begin
         inc(k);
           c[k].id:=-1;
                c[k].yg:=ygol(1,0,a[q].x-min.x,a[q].y-min.y);
           c[k].p:=a[q];
       end;
    for q := 1 to m do
    begin
    inc(k);
    c[k].id:=q;
    c[k].yg:=ygol(1,0,b[q].x-min.x,b[q].y-min.y);
    c[k].p:=b[q];
    end;
    Sort(1,k);
    fillchar(p,sizeof(p),0);
    for q := 1 to k do if c[q].id = -1 then
     begin
     l:=q;
     break;
     end;
     i:=-1;
      j:=q;
      while i <> j do
      begin
      r:=l+1;
       if r > k then r:=1;
       while c[r].id <> -1 do
       begin
       inc(r);
       if r > k then r:=1;
       end;
      q:=l+1;
      if q > k then q:=1;
      while q <> r do
      begin
     if fun(c[q].p,c[l].p,c[r].p) >= 0 then p[c[q].id]:=1;
     inc(q);
     if q > k then q:=1;
     end;
     l:=r;
       i:=l;
            end;
   end;

  procedure print;
   var q:longint;
    begin
     assign(output,'output.txt');
      rewrite(output);
       for q := 1 to m do if p[q] = 1 then writeln('NO') else writeln('YES');
     close(output);
    end;

  begin
   init;
    done;
     print;
  end.


2Автор исходника: Вова, если твои копирайты нарушены, дай
знать

[VEG]

Никита Лесников, А чего он обидется? Вроде не обидное слово то...
А девушки я не вижу в упор... Есть догадка, что здесь она во весь рост. Точнее, ее половина.

[Kron]

я определил тип для Y, но на процессе линковки требовала либы и я не разбирался - забил. (gcc 3.3.4)
что за pascal`евский файл? собраться то он собрался( с помощью fpc - The Free Pascal compiler ) но что в качестве результата должно быть и что за файл на вход подавать? попробовал подать разные цифери/буквы - либо в сигфолт валилось либо в выходном файле NO появлялось. или это код за последние пару часов? :)

[Никита Лесников]

(gcc 3.3.4)

у меня gcc 3.3.1 без проблем, как и bcc 5.5. Если захотеть, скомпайлить можно.

собраться то он собрался( с помощью fpc - The Free Pascal compiler )

Более того - он на fpc и писался Это решение одной из задач республиканской олимпиады 2004 года (на полный балл, кстати ).

А то, что вываливает сигфолт - надо соблюдать формат входных данных

По-простому - этой точке дается описание выпуклого многоугольника и N точек, и она очень быстро определяет, какие точки ему принадлежат, а какие - нет. Причем делает это очень эффективно (за nlogn).

[Никита Лесников]

Безобидная программка - составлялка частотных словарей. На Haskell. Выглядит оригинально, не правда ли?

Код: Выделить всё


-- frequency dictionary creator

module Main where

import IO
import Control.Monad
import Char
import List

rulocase   = "абвгдеёжзийклмнопрстуфхцчшщьыъэюя"
ruhicase   = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ"

oneof [] x   = False
oneof (x:xs) y  = if x == y then True
                            else oneof xs y

fromto [] [] _ = '?'
fromto (x:xs) (y:ys) c = if x == c then y
                                   else fromto xs ys c

myLower   c   = if (oneof rulocase c) then c
                                        else (fromto ruhicase rulocase c)

myAlpha   c   = (oneof rulocase c) || (oneof ruhicase c)

towords      :: String -> [String]
towords []   = []
towords (x:[])   = if myAlpha x then [[x]] else []
towords (x:y:z) = let  rest = towords (y:z)
             hr   = head rest
             tr   = tail rest   
                  in   if not $ myAlpha x
                        then rest
                        else if myAlpha y then (x:hr) : tr
                                          else [[x]] ++ rest

qs      :: Ord a => [a] -> [a]
qs      = List.sort

data   Stats   = S (Int, String) deriving (Eq, Ord)

fstS (S (x,y))  = x
sndS (S (x,y))  = y

freq      :: [String] -> [Stats]
freq []      = []
freq (x:[])   = [S (1, x)]
freq (x:y:zs)   = let whole = freq (y:zs)
                      hs    = head whole
                      ts    = tail whole
                  in  if x == y then [S (fstS hs + 1, sndS hs)] ++ ts
                                else [S (1, x)] ++ whole

spaces      :: Int -> String                               
spaces 0   = []
spaces n   = ' ':(spaces (n-1))

wide      :: Int -> String -> String
wide n []   = spaces n
wide n (x:xs)   = x : wide (n-1) xs

fmt (S (c,s))   = " " ++ wide 32 s ++ show c ++ "\n"

report []   = []
report (x:xs)   = fmt x ++ report xs
        
stats      = report . take 100 . reverse . qs . freq . qs

freqDict   = stats . map (map myLower). concatMap towords . lines

main      = do hSetBuffering stdin  LineBuffering
                hSetBuffering stdout LineBuffering

              putStrLn "Enter textual file name :"; fTxt <- getLine
           putStrLn "Enter report  file name :"; fRpt <- getLine
   
           (freqDict `liftM` readFile fTxt) >>= (writeFile fRpt)


[Kron]

еще одна прикольная програмка на perl`е. запускать не рекомендую :)
cat "test... test... test..." | perl -e '$??s:;s:s;;$?::s;;=]=>%-{<-|}<&|`{;;y; -/:-@[-`{-};`-{/" -;;s;;$_;see'