免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
12下一页
最近访问板块 发新帖
查看: 5608 | 回复: 14

各位大大能不能给我这个数据展开的脚本 ? [复制链接]

论坛徽章:
0
发表于 2014-02-08 19:18 |显示全部楼层
各位大大好:

1: 一个文本, 每行是由字符 A, B, C, D 字符组成的。如:

A[BC]D[ABC]DA[BC]D
[BCA][ADB]DAA[BC]

2: [AB], [ABCD]..是一组. 在每一组之内, 字符没有重复, 如:

[AAB]   # A 重复
[ABC]   # 没有重复

3: 数据依序扩展

一行比如:  A[BC]D

数据依序扩展为:

ABD
ACD

一行比如: A[BC]D[AC]
数据依序扩展为:

ABDA
ABDC
ACDA
ACDC

4: 行1 输出 file.1, 行2 输出 file.2....

5: 每文本按照 limit 值 输出, (输出行数 <= limit):

一行比如: A[BC]D[AC]

比如: limit = 3, 输出行数 = 3

ABDA
ABDC
ACDA

一行比如: A[BC]
比如: limit = 5, 输出:

AB
AC

测试文件如下:( 假设 limit = 10 )

A[BC]D[ABC]DA[BC]D
[BCA][ADB]DAA[BC]
A[BC]D[AC]


结果:

file.1:
ABDADABD
ABDADACD
ABDBDABD
ABDBDACD
ABDCDABD
ABDCDACD
ACDADABD
ACDADACD
ACDBDABD
ACDBDACD

file.2:
BADAAB
BADAAC
BDDAAB
BDDAAC
BBDAAB
BBDAAC
CADAAB
CADAAC
CDDAAB
CDDAAC

file.3:
ABDA
ABDC
ACDA
ACDC



# 实际的一行数据可能看起来像这样
A[BC]D[AC]DAABACDA[AC]DDACA[BC]D[AC]DAAA[BC]DDDACB[AC]DAABCCD[AC]DCCA[BC]D[AC]DCA[BC]DACDA[BC]D[ABC]DA[BC]D[AC]DABCD[ACB]DA[BC]DACCDABCD[DC]DA[BCA]DDABCCBB

各位大大能不能给我这个数据扩展的脚本 ?

论坛徽章:
8
技术图书徽章
日期:2013-09-30 08:51:28技术图书徽章
日期:2013-12-11 09:26:39白羊座
日期:2013-12-27 15:27:13金牛座
日期:2014-01-06 09:13:05天蝎座
日期:2014-01-21 14:23:28酉鸡
日期:2014-05-09 16:51:12卯兔
日期:2014-08-11 16:49:1515-16赛季CBA联赛之八一
日期:2017-08-14 23:24:57
发表于 2014-02-09 15:38 |显示全部楼层
扩展的时候每个方框里的顺序都必须是从A到D,并且是从后向前扩展嘛?

论坛徽章:
0
发表于 2014-02-09 16:50 |显示全部楼层
回复 2# xiumu2280


    谢谢大大!

每个方框里的顺序是从前向后:
一行比如: C[BA]D
CBD
CAD

每行方框是从后向前扩展:
一行比如: A[BC]D[AC]
数据依序扩展为:

ABDA
ABDC
ACDA
ACDC

# 实际的一行数据可能看起来像这样
  1. A[BC]D[AC]DAABACDA[AC]DDACA[BC]D[AC]DAAA[BC]DDDACB[AC]DAABCCD[AC]DCCA[BC]D[AC]DCA[BC]DACDA[BC]D[ABC]DA[BC]D[AC]DABCD[ACB]DA[BC]DACCDABCD[DC]DA[BCA]DDABCCBB
复制代码

论坛徽章:
6
丑牛
日期:2014-03-21 15:42:04子鼠
日期:2014-04-12 11:50:17处女座
日期:2014-09-01 09:25:1115-16赛季CBA联赛之吉林
日期:2015-12-22 14:01:5215-16赛季CBA联赛之广东
日期:2016-03-08 18:49:422016科比退役纪念章
日期:2016-07-06 12:19:55
发表于 2014-02-09 22:00 |显示全部楼层
本帖最后由 stanley_tam 于 2014-02-09 22:02 编辑

来个超慢版本,处理这一行花了5分钟{:3_198:}。。。
  1. #!perl
  2. use strict;

  3. sub transfer;

  4. my $str = 'A[BC]D[AC]DAABACDA[AC]DDACA[BC]D[AC]DAAA[BC]DDDACB[AC]DAABCCD[AC]DCCA[BC]D[AC]DCA[BC]DACDA[BC]D[ABC]DA[BC]D[AC]DABCD[ACB]DA[BC]DACCDABCD[DC]DA[BCA]DDABCCBB';
  5. $str = transfer($str);

  6. my @many = glob $str;
  7. print "$_\n" for @many;

  8. sub transfer {
  9.     my ($str) = @_;
  10.     my @chars = split //, $str;
  11.     my $in_square = 0;
  12.     my $new_str = q{};
  13.     for my $char (@chars){
  14.         if ($char eq '[') {
  15.             $in_square = 1;
  16.         }

  17.         if ($char eq ']') {
  18.             $in_square = 0;
  19.         }

  20.         $new_str .= "$char";

  21.         if ($in_square and $char =~ m{[A-D]}) {
  22.             # body...
  23.             $new_str .= ',';
  24.         }
  25.     }
  26.     $new_str =~ s{ , \] }{]}gx;
  27.     $new_str =~ s{ \[ }{\{}gx;
  28.     $new_str =~ s{ \] }{\}}gx;
  29.     return $new_str;
  30. }
复制代码

论坛徽章:
8
技术图书徽章
日期:2013-09-30 08:51:28技术图书徽章
日期:2013-12-11 09:26:39白羊座
日期:2013-12-27 15:27:13金牛座
日期:2014-01-06 09:13:05天蝎座
日期:2014-01-21 14:23:28酉鸡
日期:2014-05-09 16:51:12卯兔
日期:2014-08-11 16:49:1515-16赛季CBA联赛之八一
日期:2017-08-14 23:24:57
发表于 2014-02-10 08:59 |显示全部楼层
原来glob还有这个用法··真不错····回复 4# stanley_tam


   

论坛徽章:
46
15-16赛季CBA联赛之四川
日期:2018-03-27 11:59:132015年亚洲杯之沙特阿拉伯
日期:2015-04-11 17:31:45天蝎座
日期:2015-03-25 16:56:49双鱼座
日期:2015-03-25 16:56:30摩羯座
日期:2015-03-25 16:56:09巳蛇
日期:2015-03-25 16:55:30卯兔
日期:2015-03-25 16:54:29子鼠
日期:2015-03-25 16:53:59申猴
日期:2015-03-25 16:53:29寅虎
日期:2015-03-25 16:52:29羊年新春福章
日期:2015-03-25 16:51:212015亚冠之布里斯班狮吼
日期:2015-07-13 10:44:56
发表于 2014-02-10 09:00 |显示全部楼层
回复 4# stanley_tam


    transfer 可以这么写 $str =~ s<\[(\w+)\]><'{' . join(',', split //, $1) . '}'>eg;   s<><>eg; 和 s///eg; 一样只是避免 split 那里冲突。

论坛徽章:
6
丑牛
日期:2014-03-21 15:42:04子鼠
日期:2014-04-12 11:50:17处女座
日期:2014-09-01 09:25:1115-16赛季CBA联赛之吉林
日期:2015-12-22 14:01:5215-16赛季CBA联赛之广东
日期:2016-03-08 18:49:422016科比退役纪念章
日期:2016-07-06 12:19:55
发表于 2014-02-10 09:59 |显示全部楼层
第二个可以放表达式的啊,学习了。{:3_193:}
回复 6# zhlong8


   

论坛徽章:
8
技术图书徽章
日期:2013-09-30 08:51:28技术图书徽章
日期:2013-12-11 09:26:39白羊座
日期:2013-12-27 15:27:13金牛座
日期:2014-01-06 09:13:05天蝎座
日期:2014-01-21 14:23:28酉鸡
日期:2014-05-09 16:51:12卯兔
日期:2014-08-11 16:49:1515-16赛季CBA联赛之八一
日期:2017-08-14 23:24:57
发表于 2014-02-10 11:26 |显示全部楼层
本帖最后由 xiumu2280 于 2014-02-10 11:34 编辑

这个应该速度还可以
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;

  4. my $limit = 10;
  5. while (<DATA>) {
  6.         chomp;
  7.         my $line = $_;
  8.         my @oper =$line=~/\[[A-D]+\]/g;
  9.         $line=~s/(\[[A-D]+\])/\|/g;
  10.         @oper = map {s/\[|\]//g;[split //]}@oper;
  11.         my @new_oper;
  12.         my $count = 1;
  13.         my $zone = 1;
  14.         map {  #进行limit计数
  15.                 my $num = scalar(@{$oper[$_]});
  16.                 $count *= $num;
  17.                 if ($count <= $limit && $zone == 1) {
  18.                         unshift @new_oper,$oper[$_];
  19.                 }elsif ($count > $limit && $zone == 1){
  20.                         my $recount = $count/$num;
  21.                         my $re = $recount;
  22.                         my $range;
  23.                         my $num_ran = @{$oper[$_]};
  24.                         for (1..$num_ran-1) {
  25.                                 $recount += $re;
  26.                                 $range = $_;
  27.                                 $recount >= $limit && last;
  28.                         }
  29.                         my @nnew_oper = splice (@{$oper[$_]},0,$range+1);
  30.                         unshift @new_oper,[@nnew_oper];
  31.                         $zone++;
  32.                 }elsif ($count > $limit && $zone != 1) {
  33.                         unshift @new_oper,[$oper[$_]->[0]];
  34.                 }
  35.         } reverse 0..$#oper;
  36.         for ($line=~/\|/g) {
  37.                 $line=~s/\|/'{' . join(',',@{shift @new_oper}) . '}'/e;
  38.         }
  39.         my @pr = glob $line;
  40.         print "$_\n" for grep {$_}@pr[0..$limit-1];
  41.         print "~~~~~~~~~~~~\n";
  42. }



  43. __DATA__
  44. A[BC]D[AC]DAABACDA[AC]DDACA[BC]D[AC]DAAA[BC]DDDACB[AC]DAABCCD[AC]DCCA[BC]D[AC]DCA[BC]DACDA[BC]D[ABC]DA[BC]D[AC]DABCD[ACB]DA[BC]DACCDABCD[DC]DA[BCA]DDABCCBB
复制代码

论坛徽章:
5
丑牛
日期:2014-01-21 08:26:26卯兔
日期:2014-03-11 06:37:43天秤座
日期:2014-03-25 08:52:52寅虎
日期:2014-04-19 11:39:48午马
日期:2014-08-06 03:56:58
发表于 2014-02-10 13:49 |显示全部楼层
{:2_172:} 小伙伴们, 这个高端奢华上档次。, 能不能帮忙解释下 ?
{:2_175:} 我不明白
  1. map {  #进行limit计数 } reverse 0 .. $#oper;
复制代码
回复 8# xiumu2280


   

论坛徽章:
145
技术图书徽章
日期:2013-10-01 15:32:13戌狗
日期:2013-10-25 13:31:35金牛座
日期:2013-11-04 16:22:07子鼠
日期:2013-11-18 18:48:57白羊座
日期:2013-11-29 10:09:11狮子座
日期:2013-12-12 09:57:42白羊座
日期:2013-12-24 16:24:46辰龙
日期:2014-01-08 15:26:12技术图书徽章
日期:2014-01-17 13:24:40巳蛇
日期:2014-02-18 14:32:59未羊
日期:2014-02-20 14:12:13白羊座
日期:2014-02-26 12:06:59
发表于 2014-02-10 14:38 |显示全部楼层
回复 1# gr33n

$ cat glob.pl

use strict;
use warnings;

my $sLimit = 10;

my $sGlob_cnt;
sub glob_limit{
  my($raData, $sLimit, $sNow, $sRet) = @_;
  $sNow =  0 if(! defined $sNow);
  $sRet = "" if(! defined $sRet);
  my $sKey = "";
  if(scalar(@{$raData}) == $sNow){
    $sGlob_cnt++;
    return $sRet;
  }
  if($sNow % 2 == 0){
    return glob_limit($raData, $sLimit, $sNow+1, $sRet . $raData->[$sNow]);
  }
  my @aRet = ();
  foreach(split("",$raData->[$sNow])){
    push @aRet, glob_limit($raData, $sLimit, $sNow+1, "$sRet$_");
    return @aRet if($sGlob_cnt >= $sLimit);
  }
  return @aRet;
}

while(<DATA>){
  chomp;
  print "$_\n";
  my @aData = split /[\[\]]/;
  $sGlob_cnt = 0;
  my @aLimit = glob_limit(\@aData, $sLimit);
  print join("\n", @aLimit), "\n";
}

__DATA__
A[BC]D[ABC]DA[BC]D
[BCA][ADB]DAA[BC]
A[BC]D[AC]
A[BC]D[AC]DAABACDA[AC]DDACA[BC]D[AC]DAAA[BC]DDDACB[AC]DAABCCD[AC]DCCA[BC]D[AC]DCA[BC]DACDA[BC]D[ABC]DA[BC]D[AC]DABCD[ACB]DA[BC]DACCDABCD[DC]DA[BCA]DDABCCBB

   
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年举报专区
中国互联网协会会员  联系我们:huangweiwei@itpub.net
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP