var

w:string;

procedure quick1(var z:string;x,y:integer);

var

i,j:integer;b,d:char;

begin

i:=x;j:=y;

b:=z[(x+y)div 2];

while i

字符串的做法

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

program P1024;

var m,n,p,i,j,l,r,k,t,w:longint;

a:array[0..9] of integer;

b:array[1..1000] of int64;

s1,s2,te,s3:string;

se2,se1,se3:int64;

function chick(o:int64):longint;

var ii:longint;

begin

chick:=0;

for ii:=1 to p-1 do

if se1=b[ii] then begin t:=ii; chick:=1; end;

end;

procedure print;

var iii:longint;

begin

for iii:= t to w do

begin

write(b[iii]);

if iiiw then write(' ');

end;

end;

begin

repeat

readln(s1);

fillchar(b,sizeof(b),0);

p:=1;

val(s1,b[p]);

repeat

fillchar(a,sizeof(a),0);

s2:='';

s3:='';

for i:=1 to length(s1) do

begin

val(s1[i],k);

inc(a[k]);

end;

for i:=9 downto 0 do

for j:=a[i] downto 1 do

begin

str(i,te);

insert(te,s2,length(s2)+1);

end;

for i:=0 to 9 do

for j:=a[i] downto 1 do

begin

str(i,te);

insert(te,s3,length(s3)+1);

end;

val(s2,se2);

val(s3,se3);

inc(p);

se1:=se2-se3;

b[p]:=se1;

str(se1,s1);

until chick(se1)=1;

w:=p-1;

print;

writeln;

until eof;

end.

过了，感觉还行，就是不知道为啥用"while not eof do"就过不了，改用"repeat ...... until eof;"就过了

type

t1=array[0..9] of int64;

var

a,b,d,e:array[1..10000] of int64;

v:t1;

c:array[0..100,1..2] of int64;

m,n,i,j,x,jishu:longint;

k:int64;

s:string;

procedure dz(x,y:longint;v:t1;var b:int64);

begin

if x0 do

begin

b:=b*10+i;

dec(v[i]);

end

else

for i:=x downto y do

while v[i]>0 do

begin

b:=b*10+i;

dec(v[i]);

end;

end;

begin

m:=1;

jishu:=2;

repeat

inc(n);

readln(a[n]);

until eof;

d[1]:=a[n];

x:=n;

while n>0 do

repeat

str(d[jishu-1],s);

m:=length(s);

fillchar(v,sizeof(v),0);

k:=0;

for i:=m downto 1 do

begin

j:=ord(s[i])-48;

inc(v[j]);

end;

dz(9,0,v,b[jishu]);

dz(0,9,v,k);

d[jishu]:=b[jishu]-k;

for i:=c[n+1,2]+1 to jishu-1 do

if d[i]=d[jishu] then

begin

c[n,1]:=i;

c[n,2]:=jishu-1;

d[jishu]:=a[n-1];

inc(jishu);

break

end;

if c[n,2]0 then

begin

dec(n);

break;

end

else

inc(jishu);

until false;

for i:=1 to x do

begin

for j:=c to c do

write(d[j],' ');

writeln;

end;

end.

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|--

借鉴talent123前辈的程序~

谢谢你的巧妙明了的算法！！

为学习C语言的同学们提供程序~

关于sprintf的使用：

http://baike.baidu.com/view/1295144.htm

---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|--

源代码如下：

#include

#include

#include

double numble,circle[1000];

double pow1(int n)

{

if(n==0)return 1;

else return pow1(n-1)*10;

}

double confuse(double num)

{

char ch[150];

int temp;

double max=0,min=0;

sprintf(ch,"%.0f",num);

int i,j;

for(i=0;i

注意：输入数值可能占循环节第一位！！！

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

program p1024;

var x:array[1..100]of string;

a:array[1..100]of int64;

l:integer;

procedure go(n:string);

var p,i,j,k,h:integer;

n1,n2:string;

ss:char;

bb:boolean;

max,min:int64;

begin

p:=1;

val(n,a[p]);

inc(p);

bb:=true;

while bb do

begin

n1:=n;

for i:=1 to length(n1)-1 do

for j:=i+1 to length(n1) do

if n1[i]n2[j] then begin ss:=n2[i];n2[i]:=n2[j];n2[j]:=ss;end;

val(n2,min);

a[p]:=abs(max-min);

for k:=p-1 downto 1 do

if a[k]=a[p] then

begin

for h:=k to p-1 do write(a[h],' ');

bb:=false;

writeln;

break;

end;

str(a[p],n);

inc(p);

end;

end;

procedure main;

begin

l:=1;

readln(x[l]);

while x[l]''do

begin

fillchar(a,sizeof(a),0);

if length(x[l])=4 then writeln(6174)

else go(x[l]);

inc(l);

readln(x[l]);

end;

end;

begin

main;

end.

圆舞曲题目 简单模拟

本题输入很特别 多组数据

这样注意 用while(cin >> s) 判断结束

还有 每组数据处理完要清空变量，这个很重要！！！！

Program P1024;

var a:array[1..10]of int64;

var s:string;

var i,j,k,code:longint;

var q,p:int64;

var c:char;

var bb:boolean;

begin

while eof do

begin

bb:=true;

readln(a[1]);

for i:=2 to 10 do

if bb then

begin

str(a,s);

for j:=1 to length(s)-1 do

for k:= j+1 to length(s) do

if s[j]>s[k] then

begin

c:=s[j];

s[j]:=s[k];

s[k]:=c;

end;

val(s,p,code);

for j:=1 to length(s)-1 do

for k:= j+1 to length(s) do

if s[j]

Var

s,maxs,mins:String;

sv,maxv,minv,t:int64;

code,l,pp,i:integer;

yw:array [1..50] of int64;

flag:boolean;

function min(s:String):String;

var

t:Char;q:String; i,j:integer;

Begin

q:=s;

For i:=1 to Length(q) -1 do

For j:=i+1 to length(q) do

if q[i] > q[j] then

begin

t:=q[i];

q[i]:=q[j];

q[j]:=t;

end;

min:=q;

end;

function max(s:String):String;

var

t:Char;q:String; i,j:integer;

Begin

q:=s;

For i:=1 to Length(q) -1 do

For j:=i+1 to length(q) do

if q[i] < q[j] then

begin

t:=q[i];

q[i]:=q[j];

q[j]:=t;

end;

max:=q;

end;

Procedure f(t:int64; var flag:boolean;var p:integer);

var k:integer;

begin

flag:=false;

for k:=1 to l - 1 do

if t = yw[k] then begin flag:=true; p:=k; end;

end;

Begin

fillchar(yw,sizeof(yw),0);

While not eof do

begin

readln(s);

if Length(s) = 4 then Writeln('6174')

else

begin

l:=1;

val(s,t,code);

yw[1]:=t;

flag:=false;

while not flag do

begin

inc(l);

maxs:=max(s);

mins:=min(s);

val(maxs,maxv,code);

val(mins,minv,code);

t:=maxv - minv;

f(t,flag,pp);

yw[l]:=t;

str(t,s);

end;

for i:=pp to l - 2 do

write(yw[i],' ');

writeln(yw[l-1]);

end;

end;

end.

下次小弟我靠你们了

怎么全是PASCAL。。咱来点C++

#include

#include

#include

using namespace std;

int qkpass(char a[],int i,int j)

{

char k=a[i];

while(i

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

真惊了，输入数值可能占循环节第一位！！！

太淫荡了！！！

我的AC率啊！！！

N次90分，总是最后一个点WA==

毛病，本机都过正常，这里总有问题。

program kabulieke;

var a:array[1..1000]of string;

i,len,p,k:longint;

s,x,y:string;

procedure sort1(var s1:string);

var lena,i,j:longint;

p:char;

begin

lena:=length(s1);

for i:=1 to (lena-1) do

for j:=i+1 to lena do

if s1[i]s1[j] then begin p:=s1[i];s1[i]:=s1[j];s1[j]:=p;end;

end;

function js(s1,s2:string):string;

var a,b,c:longint; code:integer;

ss:string;

begin

val(s1,a,code);

val(s2,b,code);

c:=a-b;

str(c,ss);

js:=ss;

end;

begin

read(s);

len:=length(s);k:=0;

if len=4 then write('6147') else begin p:=1; a[p]:=s;

while k=0 do begin

inc(p);

sort1(s); x:=s;

sort2(s); y:=s;

s:=js(x,y);

a[p]:=s;

for i:=1 to p-1 do if a[i]=a[p] then k:=i;

end; {while}

end; {else begin}

for i:=k to p do write(a[i],' ');

end.

var x:array[1..1000] of int64;

s:string;

l:longint;

procedure pc(n:int64);

var i,j,u,len:longint;

max,min,p:int64;

ni:string;

o:char;

begin

for i:=1 to l-1 do

if x[i]=n then

begin

for j:=i to l-2 do

write(x[j],' ');

writeln(x[l-1]);

exit;

end;

str(n,ni);

len:=length(ni);

for i:=1 to len-1 do

for j:=i+1 to len do

if ni[i]

偷偷告诉你：这题很简单！

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

用 int64 or 高精度

type

aa=array[0..9]of integer;

var

t:boolean;

a:aa;

tot:array[1..1000]of longint;

kk,j,i,k:integer;

max,min,x,ans:longint;

procedure try(x:longint;k:integer;var a:aa);

var

i,k1:integer;

begin

fillchar(a,sizeof(a),0);

i:=0;

while x>0 do

begin

inc(i);

k1:=x mod 10;

inc(a[k1]);

x:=x div 10;

end;

if k=1 then kk:=i;

end;

procedure max1(a:aa);

var

u:integer;

i:integer;

begin

max:=0;u:=0;

for i:=9 downto 0 do

while a[i]>0 do

begin

max:=max*10+i;

inc(u);

dec(a[i]);

end;

for i:=1 to kk-u do

max:=max*10;

end;

procedure min1(a:aa);

var

i:integer;

begin

min:=0;

for i:=0 to 9 do

while a[i]0 do

begin

min:=min*10+i;

dec(a[i]);

end;

end;

begin

assign(input,'1.in');

reset(input);

t:=true;

while 1>0 do

begin

if t then begin

readln(x); k:=1; fillchar(tot,sizeof(tot),0);

tot[k]:=x;t:=false; end;

try(x,k,a);

max1(a);

min1(a);

ans:=max-min;

for i:=1 to k do

if tot[i]=ans then

begin

for j:=i to k-1 do write(tot[j],' ');

writeln(tot[k]);

if eof then begin close(input);halt;end;

t:=true;

end;

if not t then begin

inc(k);

tot[k]:=ans;

x:=ans;

end;

end;

end.

????????????????

???????????????

?????????????

?????????????

??????????

????????

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

program P1024;

var

a:array[1..1000]of int64;

i,j,k,g,h:integer;

b:array[1..10]of integer;

f:boolean;

num:int64;

begin

while not eof do

begin

fillchar(a,sizeof(a),0);

readln(a[1]);

f:=true;

i:=1;

while f do

begin

inc(i);

num:=a;

j:=0;

while num>0 do

begin

b[j+1]:=num mod 10;

inc(j);

num:=num div 10

end;

for g:=1 to j-1 do

for k:=g+1 to j do

if b[g]>b[k]

then begin

num:=b[g];

b[g]:=b[k];

b[k]:=num

end;

g:=j div 2;

if odd(j) then inc(g);

for k:=1 to g do

begin

b[k]:=b[j-k+1]-b[k];

b[j-k+1]:=0-b[k];

end;

num:=0;

for k:=1 to j do

num:=num*10+b[k];

k:=1;

while (k

靠，我还以为要升序输出……无语。

同志们一定要注意:此提千万不能用longint,不够!要么int64,要么高精度(int64能过不知谁还去用高精度……)。

下面是本人代码，应该还算短小……

program P1024;

var

i,p,x:longint; //p变量:b[i]的指针

n:int64;

b:array[1..1000] of int64; //b[i]:队列

//

function work(a:int64):int64;

var

i,j,code:longint;

t:int64;

st:string;

procedure swap(var a,b:char);

var

c:char;

begin

c:=a;

a:=b;

b:=c;

end;

begin

str(a,st);

for i:=1 to ord(st[0])-1 do

for j:=i+1 to ord(st[0]) do

if st[j]>st[i] then swap(st[j],st[i]);

val(st,work,code);

for i:=1 to ord(st[0])div 2 do

swap(st[i],st[ord(st[0])-i+1]);

val(st,t,code);

dec(work,t);

end;

//

begin

while not eof(input) do begin

readln(n);

p:=1;

b[p]:=n;

x:=0;

while x=0 do begin

inc(p);

b[p]:=work(b[p-1]);

for i:=1 to p-1 do

if b[i]=b[p] then x:=i;

end;

for i:=x to p-2 do

write(b[i],' ');

writeln(b[p-1]);

end;

end.

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

program hly;

const max=30;

type tlist=array[1..max] of longint;

var

n:int64;

a:array[1..max] of longint;

rec:array[1..50000] of int64;

recindex:longint;

function power(x,y:longint):int64;

var

i:longint;

begin

power:=1;

for i:=1 to y do

power:=power*x;

end;

function JUDGE:boolean;

var

i,j,k:longint;

begin

JUDGE:=false;

for i:=1 to recindex-1 do

for j:=i+1 to recindex do

begin

if rec[i]=rec[j] then

begin

JUDGE:=true;

for k:=i to j-1 do

if rec[k]rec[k+j-i] then exit(false);

if JUDGE then

begin

for k:=i to j-2 do

write(rec[k],' ');

writeln(rec[j-1]);

exit(true);

end;

end;

end;

end;

procedure qsort(var a : tlist;len:longint);

procedure sort(l,r: longint);

var

i,j,x,y: longint;

begin

i:=l;

j:=r;

x:=a[(l+r) div 2];

repeat

while a[i]j;

if l1000) and (n