雑な時間計算機

timecalc.pl

#!/usr/bin/perl --
use strict;
use warnings;
use feature qw(switch say);
use Math::BigFloat;
use Term::ReadLine;
use Getopt::Long;

# usage: ./timecalc.pl -v "9h15m + 10m - 20m * ( 0.5h / 15m ) * 0.5"

my $verbose = 0;
GetOptions(
	"verbose:+" => \$verbose,
) or die("Error in command line arguments\n");

# 計算式のノード
{
	package Node;

	# 生成
	sub new{
		my($class,@remain)=@_;
		return bless{ op=>'', @remain},$class;
	}

	# 文字列化
	sub toString{
		my($self)=(@_);
		if( $self->{type} eq 'end'){
			return "end of expression";
		}elsif( $self->{type} eq 'number'){
			return $self->{number};
		}elsif( $self->{type} eq 'duration' ){
			my $s = "";
			defined($self->{y}) and $s .= "$self->{y}y";
			defined($self->{j}) and $s .= "$self->{j}j";
			defined($self->{d}) and $s .= "$self->{d}d";
			defined($self->{h}) and $s .= "$self->{h}h";
			defined($self->{m}) and $s .= "$self->{m}m";
			defined($self->{s}) and $s .= "$self->{s}s";
			return $s;
		}else{
			# operator
			if( $self->{right} ){
				my $l = $self->{left}->toString();
				my $r = $self->{right}->toString();
				return "($self->{op} $l $r)";
			}elsif( $self->{left} ){
				my $l = $self->{left}->toString();
				return "($self->{op} $l)";
			}else{
				return $self->{op};
			}
		}
	}
	
	# durationとnumberの掛け算
	sub mulNode($$){
		my($l,$r)=@_;
		return Node->new( 
			type=>'duration',
			'y' => ($l->{y}//0)*$r,
			'j' => ($l->{j}//0)*$r,
			'd' => ($l->{d}//0)*$r,
			'h' => ($l->{h}//0)*$r,
			'm' => ($l->{m}//0)*$r,
			's' => ($l->{s}//0)*$r,
		);
	}
	
	# 
	sub durationToSeconds($){
		my($self)=@_;
		return Math::BigFloat->bzero()
			->badd( $self->{s}//0 )
			->badd( ($self->{m}//0)*60 )
			->badd( ($self->{h}//0)*3600 )
			->badd( ($self->{d}//0)*86400 )
			->badd( ($self->{j}//0)*86400*30 )
			->badd( ($self->{y}//0)*86400*365 )
			;
	}
	
	# 式を評価する
	sub invoke{
		my($self)=(@_);
		if( $self->{type} eq 'end' ){
			return $self;
		}elsif( $self->{type} eq 'number'){
			return $self;
		}elsif( $self->{type} eq 'duration' ){
			return $self;
		}else{
			my $l = $self->{left};
			my $r = $self->{right};
			$l and $l = $l->invoke();
			$r and $r = $r->invoke();
			if( $self->{op} eq '+' ){
				if($r){
					if( $l->{type} eq 'number' and $r->{type} eq 'number' ){
						return Node->new( type =>'number', number => $l->{number} + $r->{number} );
					}elsif( $l->{type} eq 'duration' and $r->{type} eq 'duration' ){
						return Node->new( 
							type=>'duration',
							'y' => ($l->{y}//0)+($r->{y}//0),
							'j' => ($l->{j}//0)+($r->{j}//0),
							'd' => ($l->{d}//0)+($r->{d}//0),
							'h' => ($l->{h}//0)+($r->{h}//0),
							'm' => ($l->{m}//0)+($r->{m}//0),
							's' => ($l->{s}//0)+($r->{s}//0),
						);
					}else{
						$l = $l->toString();
						$r = $r->toString();
						die "can't add $l and $r\n";
					}
				}
				return $l;
			}elsif( $self->{op} eq '-' ){
				if($r){
					if( $l->{type} eq 'number' and $r->{type} eq 'number' ){
						return Node->new( type =>'number', number => $l->{number} - $r->{number} );
					}elsif( $l->{type} eq 'duration' and $r->{type} eq 'duration' ){
						return Node->new( 
							type=>'duration',
							'y' => ($l->{y}//0)-($r->{y}//0),
							'j' => ($l->{j}//0)-($r->{j}//0),
							'd' => ($l->{d}//0)-($r->{d}//0),
							'h' => ($l->{h}//0)-($r->{h}//0),
							'm' => ($l->{m}//0)-($r->{m}//0),
							's' => ($l->{s}//0)-($r->{s}//0),
						);
					}else{
						$l = $l->toString();
						$r = $r->toString();
						die "can't add $l and $r\n";
					}
				}
				return mulNode($l,-1);
			}elsif( $self->{op} eq '*' ){
				if( $l->{type} eq 'number' and $r->{type} eq 'number' ){
					return Node->new( type =>'number', number => $l->{number} * $r->{number} );
				}elsif( $l->{type} eq 'duration' and $r->{type} eq 'duration' ){
					$l = $l->toString();
					$r = $r->toString();
					die "can't multiply $l and $r\n";
				}elsif( $l->{type} eq 'duration' ){
					return mulNode($l,$r->{number} );
				}elsif( $r->{type} eq 'duration' ){
					return mulNode($r,$l->{number} );
				}
			}elsif( $self->{op} eq '/' ){
				if( $l->{type} eq 'number' and $r->{type} eq 'number' ){
					return Node->new( type =>'number', number => $l->{number} / $r->{number} );
				}elsif( $l->{type} eq 'duration' and $r->{type} eq 'number' ){
					return mulNode($l,1/$r->{number} );
				}elsif( $l->{type} eq 'duration' and $r->{type} eq 'duration' ){
					$l = $l->durationToSeconds();
					$l->bdiv( $r->durationToSeconds() );
					return Node->new( type =>'number', number => $l );
				}else{
					$l = $l->toString();
					$r = $r->toString();
					die "can't divide $l by $r\n";
				}
			}else{
				my $t = $self->toString();
				die "can't evaluate $t\n";
			}
		}
	}
}

{
	package Parser;

	sub new{
		my($class,$tokens)=@_;
		return bless {
			tokens => $tokens,
			idx => 0,
			end => 0+@$tokens,
		},$class;
	}

	sub isEnd{
		my( $self )=@_;
		return $self->{idx} >= $self->{end};
	}

	sub peek{
		my( $self )=@_;
		if( $self->isEnd() ){
			return Node->new( type=>'end' );
		}else{
			return $self->{tokens}[$self->{idx}];
		}
	}

	sub eat{
		my( $self )=@_;
		++ $self->{idx};
	}

	sub parseValue($){
		my( $self)=@_;
		my $op = $self->peek();
		if( $op->{op} eq '(' ){
			$self->eat();
			my $v = $self->parseAdd();
			$op = $self->peek();
			$op->{op} eq ')' and $self->eat();
			return $v;
		}elsif( $op->{type} eq 'number' or $op->{type} eq 'duration' ){
			$self->eat();
			return $op;
		}else{
			my $text =$op->toString();
			die "unexpected $text.\n";
		}
	}

	sub parseSignedValue{
		my( $self )=@_;
		my $op = $self->peek();
		if( $op->{op} =~ /[+-]/ ){
			$self->eat();
			my $left = $self->parseValue();
			$op->{left} = $left;
			return $op;
		}else{
			return $self->parseValue();
		}
	}

	sub parseMul{
		my( $self )=@_;
		my $left = $self->parseSignedValue();
		for(;;){
			my $op = $self->peek();
			return $left if not $op->{op} =~ /[*\/]/;
			$self->eat();
			my $right = $self->parseSignedValue();
			$op->{left} = $left;
			$op->{right} = $right;
			$left = $op;
		}
	}

	sub parseAdd($){
		my( $self )=@_;
		my $left = $self->parseMul();
		for(;;){
			my $op = $self->peek();
			return $left if not $op->{op} =~ /[+-]/;
			$self->eat();
			my $right = $self->parseMul();
			$op->{left} = $left;
			$op->{right} = $right;
			$left = $op;
		}
	}
}

# 4 h 2 m などが入った配列からdurationノードを組み立てる
sub concatTimeDurations($){
	my($list) = @_;
	if( @$list == 1 ){
		my $number = shift @$list;
		$number =~ /\d+/ or die "'$number' is not valid number.\n";
		return Node->new( type=> 'number', number => $number );
	}
	my $spec = join '',@$list;
	my $td = Node->new( type => 'duration' );
	while( @$list >= 2 ){
		my $number = shift @$list;
		my $unit = shift @$list;
		$number =~ /\d+/ or die "'$number $unit' is not valid time duration.\n";
		$unit =~ /[yjdhms]/ or die "'$number $unit' is not valid time duration.\n";
		defined($td->{$unit}) and die "time unit '$unit' is duplicated in time duration spec '$spec'. (maybe missing operator between timespecs.)\n";
		$td->{$unit} = $number;
	}
	if(@$list){
		my $v = $list->[0];
		die "syntax error: unexpected '$v' in time duration spec '$spec'\n"; 
	}
	return $td;
}


sub parseTimeDurations($){
	my($tokens) = @_;
	my @result;
	my $last;
	for(@$tokens){
		if( $_ =~ /\d/ ){
			$last or $last = [];
			push @$last,0+$_;
		}elsif( $_ =~ /[yjdhms]/i ){
			$last or $last = [];
			push @$last,lc $_;
		}else{
			if($last){
				push @result,concatTimeDurations($last);
				undef $last;
			}
			push @result,Node->new( type=>'op', op=>$_ );
		}
	}
	if($last){
		push @result,concatTimeDurations($last);
		undef $last;
	}
	return @result;
}

sub timecalc($){

	$verbose and say "#input: ",$_[0];

	# 数値、時間単位指定、演算子が並んだ配列
	my @tokens = 
		grep{ length $_} 
		map{ s/\s+//; $_ } 
		split /(|\d+(?:\.\d*)?)/, $_[0];

	$verbose and say "#tokens: ", join ' ', @tokens;

	# 数値や時間量を解釈する
	@tokens = parseTimeDurations(\@tokens);

	$verbose and say "#parseTimeDurations: ", join ' ', map{ $_->toString()} @tokens;

	# 演算子から構文木を組み立てる
	my $p = Parser->new( \@tokens );
	my $root = $p->parseAdd();
	
	$verbose and say "#parseNodes: ", $root->toString();
	
	my $v = $root->invoke();

	if( $v->{type} eq 'number'){
		return $v->{number};
	}elsif( $v->{type} eq 'duration'){
		my $sum = $v->durationToSeconds();

		my $sign = $sum->copy->bsgn();

		my($days,$h,$m,$s);
		$sum->babs();
		($sum,$s) = $sum->bdiv( 60 );
		($sum,$m) = $sum->bdiv( 60 );
		($days,$h) = $sum->bdiv( 24 );

		my @a = (
			[$days->numify,"${days}d"],
			[$h->numify,"${h}h"],
			[$m->numify,"${m}m"],
			[$s->numify,"${s}s"],
		);

		# trim heads
		shift @a while @a >= 2 and $a[0][0]==0;

		# trim tails
		pop @a while @a >= 2 and $a[$#a][0]==0;

		# get strings
		@a = map{ $_->[1]} @a;

		# insert sign if negative
		unshift @a,'-' if $sign < 0;

		return join('',@a);

	}else{
		return $v->toString();
	}
}

if(0){
	my $a = Math::BigFloat->new("42");
	my $b = $a->bdiv("6");
	say "$a,$b"; # it shows 7,7
	$a->bmul("2"); # in_place mul, and returns callee itself
	$b->bmul("3");
	say "$a,$b"; # it shows 42,42. $a and $b points same instance
}

if( @ARGV ){
	say timecalc(join ' ',@ARGV);
}else{
	say "## time calculator";
	say "## example: 9h15m + 10m - 20m * ( 0.5h / 15m ) * 0.5";
	my $term = Term::ReadLine->new('timecalc');
	my $prompt = ">> ";
	my $OUT = $term->OUT || \*STDOUT;
	while ( defined ($_ = $term->readline($prompt)) ) {
		next if not /\S/;
		$term->addhistory($_);

		my $res = eval{ timecalc( $_ ) };
		if($@){
			warn $@;
		}else{
			say $OUT $res;
		}
	}
}

1;
__END__