fork download
copy 
  1. #!/usr/bin/perl
  2. use 5.016;
  3. use warnings;
  4. use List::Util qw(first max reduce);
  5. use Data::Dumper;
  6. local $Data::Dumper::Terse = 1;
  7. local $Data::Dumper::Indent = 0;
  8.  
  9. sub combi {
  10. 	my ($n, $s, $r) = @_;
  11.  
  12. 	($n > 0) or return $r;
  13.  
  14. 	return map{
  15. 		combi($n - 1, [@{$s}[$_ + 1 .. $#{$s}]], [@{$r}, $s->[$_]])
  16. 	} (0 .. $#{$s});
  17. }
  18.  
  19. sub del { [@{$_[0]}[0 .. $_[1] - 1, $_[1] + 1 .. $#{$_[0]}]] }
  20.  
  21. sub find { first{ $_[0]->[$_]->[0] eq $_[1]->[0] } (0 .. $#{$_[0]}) }
  22.  
  23. sub diff {
  24. 	reduce{
  25. 		sub{ defined $_[0] ? del($a, $_[0]) : $a }->(find($a, $b))
  26. 	} $_[0], @{$_[1]}
  27. }
  28.  
  29. sub go_end {
  30. 	my ($s, $e, $t, $r) = @_;
  31.  
  32. 	return map{
  33. 		go_start(
  34. 			diff($s, $_),
  35. 			[@{$e}, @{$_}],
  36. 			$t + max(map{ $_->[1] } @{$_}),
  37. 			[@{$r}, [map{ $_->[0] } @{$_}]]
  38. 		)
  39. 	} combi(2, $s, []);
  40. }
  41.  
  42. sub go_start {
  43. 	my ($s, $e, $t, $r) = @_;
  44.  
  45. 	(@{$s} > 0) or return [$t, $r];
  46.  
  47. 	return map{
  48. 		go_end(
  49. 			[@{$s}, $_],
  50. 			diff($e, [$_]),
  51. 			$t + $_->[1],
  52. 			[@{$r}, $_->[0]]
  53. 		)
  54. 	} @{$e};
  55. }
  56.  
  57. sub f {
  58. 	reduce{$b->[0] < $a->[0] ? $b : $a } go_end([@_], [], 0, [])
  59. }
  60.  
  61. say Dumper(f(['A', 1], ['B', 2], ['C', 5], ['D', 10]));
  62.  
Success #stdin #stdout 0.03s 7476KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
[17,[['A','B'],'A',['C','D'],'B',['A','B']]]
https://ideone.com/xCfEyx
language:
Perl (perl 5.28.1)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!