fork download
copy 
  1. #!/usr/bin/perl
  2. use 5.016;
  3. use warnings;
  4.  
  5. package _Stream;
  6.  
  7. sub new {
  8. 	my $class = shift;
  9. 	return bless [ @_ ], $class;
  10. }
  11.  
  12. sub value { $_[0]->[0] }
  13. sub next { ref $_[0]->[1] eq 'CODE' ? $_[0]->[1] = $_[0]->[1]->() : $_[0]->[1] }
  14.  
  15. sub take {
  16. 	my ($f, $n) = @_;
  17.  
  18. 	my @list;
  19. 	while(defined $n ? (--$n >= 0) : defined $f->value){
  20. 		push @list, $f->value;
  21. 		$f = $f->next;
  22. 	}
  23.  
  24. 	return \@list;
  25. }
  26.  
  27. package main;
  28.  
  29. my @dir = ([1, 0], [0, 1], [-1, 0], [0, -1]);
  30.  
  31. sub f_next {
  32. 	my ($x, $y, $length, $c, $s, $d) = @_;
  33.  
  34. 	if ($c < 1){
  35. 		if (--$s < 1){
  36. 			$length++;
  37. 			$s = 2;
  38. 		}
  39. 		$c = $length;
  40. 		$d = ($d + 1) % 4;
  41. 	}
  42.  
  43. 	my ($dx, $dy) = @{$dir[$d]};
  44.  
  45. 	return _Stream->new(
  46. 		[$x, $y],
  47. 		sub{ f_next($x + $dx, $y + $dy, $length, $c - 1, $s, $d) }
  48. 	);
  49. }
  50.  
  51. sub f { f_next(0, 0, 1, 1, 2, 0) }
  52.  
  53. sub g_next {
  54. 	my ($n, $f, $filter) = @_;
  55.  
  56. 	while(($n > 0) and not $filter->(@{$f->value})){
  57. 		$f = $f->next;
  58. 		--$n;
  59. 	}
  60. 	($n > 0) or return _Stream->new(undef, sub{});
  61.  
  62. 	return _Stream->new(
  63. 		$f->value,
  64. 		sub{ g_next($n - 1, $f->next, $filter) },
  65. 	);
  66. }
  67.  
  68. sub g {
  69. 	my ($r) = @_;
  70.  
  71. 	my $n = (2 * $r + 1) ** 2;
  72. 	my $filter = sub{ $_[0] ** 2 + $_[1] ** 2 <= $r ** 2 };
  73. 	return g_next($n, f(), $filter);
  74. }
  75.  
  76. use Data::Dumper;
  77. local $Data::Dumper::Terse = 1;
  78. local $Data::Dumper::Indent = 0;
  79.  
  80. say Dumper(f()->take(15));
  81. say Dumper(g(2)->take);
  82.  
Success #stdin #stdout 0.02s 5188KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
[[0,0],[1,0],[1,1],[0,1],[-1,1],[-1,0],[-1,-1],[0,-1],[1,-1],[2,-1],[2,0],[2,1],[2,2],[1,2],[0,2]]
[[0,0],[1,0],[1,1],[0,1],[-1,1],[-1,0],[-1,-1],[0,-1],[1,-1],[2,0],[0,2],[-2,0],[0,-2]]
https://ideone.com/UTl6rN
language:
Perl (perl 5.28.1)
created:
10 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!