以文本方式查看主题

-  趣题之家  (http://www.qthome.org/bbs/index.asp)
--  算法艺术  (http://www.qthome.org/bbs/list.asp?boardid=38)
----  [推荐]做一道题  (http://www.qthome.org/bbs/dispbbs.asp?boardid=38&id=201)

--  作者:gdgzgq
--  发布时间:11/11/2004 10:05:44 PM

--  [推荐]做一道题

产生数
问题描述:给出一个整数 n(n<10^30) 和 k 个变换规则(k<=15)。
规  则:一位数可变换成另一个一位数;规则的右部不为零。
          例如:n=234。有规则(k=2): 2-> 5 ;3-> 6
          上面的整数 234 经过变换后可能产生出的整数为(包括原数):234;534;264;564;共 4 种不同的产生数
问    题:给出一个整数 n 和 k 个规则。求出:经过任意次的变换(0次或多次),能产生出多少个不同整数。仅要求输出个数。


输    入:键盘输人,第一行输入N,第二行输入K,以下K行输入Xi,Yi。
输    出: 屏幕输出,格式为:一个整数(满足条件的个数)。


--  作者:gdgzgq
--  发布时间:11/11/2004 10:06:46 PM

--  

以下是我编的:


{==================================program===================================}
program NoipG3;


var
   n :string;
   i,j,k,l,t,total :byte;
   a,c :array [1..30] of byte;
   b :array [0..9] of 1..10;
   x,y :array [1..15] of 0..9;
   ok,flag :boolean;
   d :array [0..9] of boolean;



procedure Inset;


begin


  fillchar(c,sizeof(c),0);
  c[1]:=1;
  write(\'N= \');
  readln(n);


  for i:=1 to length(n) do
    a:=ord(n)-48;


  write(\'K= \');
  readln(k);


  for i:=1 to k do
    readln(x,y);


end;



procedure Try(temp :byte);


var
   j :byte;


begin


  for j:=1 to k do
  begin


    t:=y[j];


    if d[t] then
      flag:=true
    else
      flag:=false;


    if (x[j]=temp) and flag then
    begin


      d[t]:=false;
      Try(y[j]);
      inc(total);
      d[t]:=true;


    end;


  end;


end;



procedure Main;


begin


  for i:=0 to 9 do
  begin


    fillchar(d,sizeof(d),true);
    d:=false;
    total:=1;
    Try(i);
    b:=total;


  end;


  for i:=length(n) downto 1 do
  begin


    t:=a;


    if b[t]=10 then
    begin


      for j:=29 downto 1 do


        c[j+1]:=c[j];


      c[1]:=0;


    end
    else
    begin


      for j:=1 to 29 do


        c[j]:=c[j]*b[t];


      for j:=1 to 29 do


        if c[j]>=10 then
        begin


          c[j+1]:=c[j+1]+c[j] div 10;
          c[j]:=c[j] mod 10;


        end;


    end;


  end;


end;



procedure Outset;


begin


  ok:=false;


  for i:=30 downto 1 do
  begin


    if c<>0 then ok:=true;


    if ok then write(c);


  end;


  writeln;


end;



begin


  Inset;
  Main;
  Outset;


end.
{==================================program===================================}


--  作者:remlostime
--  发布时间:3/11/2005 6:20:45 PM

--  
floyed+乘法原理
--  作者:licong
--  发布时间:3/21/2005 1:52:27 PM

--  

同意

搂主的程序相当复杂


--  作者:gdgzgq
--  发布时间:10/5/2005 6:01:02 PM

--  
现在看一下1年以前的程序,觉得自己好弱啊。。。。


网上贸易 创造奇迹! 阿里巴巴 Alibaba

Powered By Dvbbs Version 7.1.0
Copyright ©2003 - 2006 QTHome.Org
页面执行时间 00.10938 秒, 2 次数据查询
本论坛采用阿里巴巴支付宝网上银行支付系统,安全、可靠、便捷