Solver Computing the Discriminant

Source code of 'Computing the Discriminant'

This Solver (Computing the Discriminant) was created by by jim_thompson5910(28536)

: View Source, Show, Put on YOUR site
About jim_thompson5910: I charge $2 a problem (for steps shown) or $1 a problem for answers only. Email: jim_thompson5910@hotmail.com Website: http://www.freewebs.com/jimthompson5910/home.html

==section input

This solver finds the discriminant of any quadratic polynomial and with that information it can tell you how what type of solutions you should expect.

Enter the quadratic polynomial in the form of {{{ax^2+bx+c}}}. For example, if we want to find the discriminant of {{{2x^2+3x+5}}} simply enter this:

*[input 30 exp=2x^2+3x+5]

note: let me know of any errors you encounter

==section solution

perl

sub gcf {
  my ($x, $y) = @_;
  ($x, $y) = ($y, $x % $y) while $y;
  return $x;
}

sub lcm {
  return($_[0] * $_[1] / gcf($_[0], $_[1]));
}

sub generate_fraction {
  my $exp=$_[0];
  my @array=split(/\//,$exp);
  $array[1]=1 if @array==1;
  return @array;
}

# reduce fraction of integer numerator/denominator
sub reduce{
 die "Error: no value entered " if @_==0;
 my @a=generate_fraction($_[0]) if @_==1; ## if input arg is a string
 @a=@_ if @_>1; ## if input arg is an array

if(@a>2)
  {die "ERROR: More than 2 input arguments";}

foreach (@a)
   {die "Cannot handle decimal numbers " if $_=~m/\./;}

if($a[1]==0)
   {die "ERROR: Division by zero";}

if($a[0] eq '0')
  {return $a[0];}

my $gcf=gcf($a[0],$a[1]);
 $a[0]/=$gcf;
 $a[1]/=$gcf;

my $answer_string=join("/",@a);
 $answer_string=~s/\/1$//; # remove denominator of 1

## Last few lines allow for overloading return values
  #-- undefined context -- return nothing
  return if ( ! defined wantarray );
  #-- list/array context -- return array
  return @a if ( wantarray );
  #-- neither undefined nor list context, return scalar
  return $answer_string;
}

# invert a/b to get b/a
sub invert_fraction
{die "More than 2 arguments "   if @_>2;

my @fraction=generate_fraction($_[0]) if @_==1;
 @fraction=@_ if @_==2;
 die "Numerator is zero -- cannot invert " if $fraction[0]==0;
 die "Error Division by zero " if $fraction[1]==0; ## optional?
 if($fraction[0]=~m/\-/)
  {$fraction[0]=abs($fraction[0]);
   $fraction[1]="-$fraction[1]";}

## Last few lines allow for overloading return values
  #-- undefined context -- return nothing
  return if ( ! defined wantarray );
  #-- list/array context -- return array
  return reverse(@fraction) if ( wantarray );
  #-- neither undefined nor list context, return scalar
  return join("/",reverse(@fraction));
}

## main subroutine - Enter strings for operands and operator .
## Ex: rational_arithmetic(2,"2/3","+")
## or  rational_arithmetic($num1,"@array","/")

sub rat {
 my $arg_count=@_;
 if($arg_count!=3)
 {die "ERROR: You need to enter 3 arguments";
 return;}
 my $operator=pop; # pull last element off of input array @_
 my @ans;
 for(my $i=0;$i<@_;$i++)
 {my $temp=$_[$i];
 $temp=~s/\///;
 $temp=~s/\-//g;
 $temp=~s/\s//g;
 if($temp=~m/(\D)/)
 {print "TEMP: $temp\n";
 die "ERROR: nonnumerical character \"$1\" ";}
 }

my @a=generate_fraction($_[0]);
 my @b=generate_fraction($_[1]);
 if(($a[1]==0)||($b[1]==0))
   {print "..$a[0]..$a[1]..$b[0]..$b[1]..\n";
    die "ERROR: Division by zero";}
 if($operator eq '+')
   {my $lcm=lcm($a[1],$b[1]);
    $a[0]=($lcm/$a[1])*$a[0];
    $b[0]=($lcm/$b[1])*$b[0];
    $a[1]=$b[1]=$lcm;
    @ans=($a[0]+$b[0],$a[1]);
   }
 elsif($operator eq '-')
   {my $lcm=lcm($a[1],$b[1]);
    $a[0]=($lcm/$a[1])*$a[0];
    $b[0]=($lcm/$b[1])*$b[0];
    $a[1]=$b[1]=$lcm;
    @ans=($a[0]-$b[0],$a[1]);
   }
 elsif($operator eq '*')
   {@ans=($a[0]*$b[0],$a[1]*$b[1]);}
 elsif($operator eq '/')
   {@ans=($a[0]*$b[1],$a[1]*$b[0]);}
 elsif($operator eq '^')
   {if($b[1]==1)
      {@ans=($a[0]**$b[0],$a[1]**$b[0]);}
    elsif(($b[0]==1)&&($b[1]==2))
      {my $temp=sqrt_of_fraction(join("/",@a));
       return $temp}
    else
      {die "ERROR: exponent ".join("/",@b)." is a fraction b_1=$b[1]";
       return;}
   }
 else
 {die "ERROR: \"$operator\" is not a valid operator";}

## Last few lines allow for overloading return values
  #-- undefined context -- return nothing
  return if ( ! defined wantarray );
  #-- list/array context -- return array
  return @ans if ( wantarray );
  #-- neither undefined nor list context, return scalar
  return join("/",@ans);
}

sub univariate_coefficient
{
  my $expression=$_[0];
  $expression=~s/\-/\+\-/g;                      # change each - into +-
  $expression=~s/^\+//;                          # remove first +
  $expression=~s/([a-z])(\+|\-)/$1\^1$2/g;       # replace 5x with 5x^1
  $expression=~s/([a-z])$/$1\^1/g;               # replace 5x with 5x^1
  $expression=~s/(\+|\-)([a-z])/$1 1 $2/g;       # replace +x with +1x
  $expression=~s/^([a-z])/1 $1/g;                # replace +x with +1x
  $expression=~s/\s//g;
  my $degree=$1 if $expression=~m/\^(\d+)/;
  my @terms=split(/\+/,$expression);
  my $inc=0;
  my @coefficients;
  for(my $i=$degree;$i>0;$i--)
   {if($terms[$inc]=~m/^(.*?)[a-z]\^$i$/)
      {push(@coefficients,$1);
       $inc++;}
    else
      {push(@coefficients,0);}
   }
  if($terms[-1]!~m/[a-z]/)
    {push(@coefficients,$terms[-1]);}
  else
    {push(@coefficients,0);}

return @coefficients;
}

###-------------------

sub discriminant
{
 my ($exp,$print)=@_;
 $exp=~s/\s//g;
 $exp=~s/([a-z])(\d+)/$1\^$2/g;
 my ($a,$b,$c)=univariate_coefficient($exp);
 $exp=~s/(\d+)\/(\d+)/$$1\/$2$/g;
 print " From {{{$exp}}} we can see that {{{a=$a}}}, {{{b=$b}}}, and {{{c=$c}}} " if $print==1;
 print " {{{D=b^2-4ac}}} Start with the discriminant formula. " if $print==1;
 print " {{{D=($b)^2-4($a)($c)}}} Plug in {{{a=$a}}}, {{{b=$b}}}, and {{{c=$c}}} " if $print==1;
 my $b_sq=reduce(rat($b,2,"^"));
 print " {{{D=$b_sq-4($a)($c)}}} Square {{{$b}}} to get {{{$b_sq}}} " if $print==1;
 my $ac_temp=reduce(rat(4,$a,"*"));
 my $ac=reduce(rat($ac_temp,$c,"*"));
 print " {{{D=$b_sq-$ac}}} Multiply {{{4($a)($c)}}} to get {{{($ac_temp)($c)=$ac}}} " if $print==1;
 my $discriminant=reduce(rat($b_sq,$ac,"-"));
 if($ac=~m/^\-/)
 {
 $ac=~s/^\-//;
 print " {{{D=$b_sq+$ac}}} Rewrite {{{D=$b_sq--$ac}}} as {{{D=$b_sq+$ac}}} " if $print==1;
 print " {{{D=$discriminant}}} Add {{{$b_sq}}} to {{{$ac}}} to get {{{$discriminant}}} " if $print==1;
 }
 else
 {print " {{{D=$discriminant}}} Subtract {{{$ac}}} from {{{$b_sq}}} to get {{{$discriminant}}} " if $print==1;}
 if($discriminant==0)
 {print " Since the discriminant is equal to zero, this means that there is one real solution. " if $print==1;
 return $discriminant;}
 if($discriminant=~m/^\-/)
 {print " Since the discriminant is less than zero, this means that there are two complex solutions. In other words, there are no real solutions. " if $print==1;}
 else
 {print " Since the discriminant is greater than zero, this means that there are two real solutions. " if $print==1;}
 return $discriminant;
}

#chomp(my $exp=<>);
my $ans=discriminant($exp,1);
#print "\n\nANS:$ans\n\n";

==section output

==section check