/*GOALS A Selection of Algebra Problems Alan Bundy 10.5.79*/ /*TOP LEVEL RUN*/ smallrun :- checklist(stats,[logeqn(A1), expeqn(A2), trigeqn(A3)]). run :- checklist(stats, [logeqn(A1), expeqn(A2), trigeqn(A3), coueqn(A4), simppull(A5), nl4(A6), car(A7), simpeqns(A8), pulltab(A9), tower1(A10), stvineq(A11), conjineq(A12), dome(A13), bloc(A14), train(A15), nastyeqn(A16), loop(A17), tower2(A18)]). /*Run problem with statistics*/ stats(Problem) :- Problem=..[Name,Arg], statistics(runtime,_), call(Problem), !, statistics(runtime,[ _, Time]), trace('\n%t took %t milliseconds and produced answer %e\n\n', [Name,Time,Arg], 0). stats(Problem) :- statistics(runtime,[ _, Time]), trace('\nSorry I could not prove %t and I spent %t not doing it \n\n', [Problem, Time], 0). /*SINGLE EQUATIONS*/ logeqn(Ans) :- solve(log(e,x+1) + log(e,x-1) = 3, x, Ans). expeqn(Ans) :- solve((2^(x^2))^(x^3) = 2, x, Ans). trigeqn(Ans) :- solve(((2^(cos(x)^2)*2^(sin(x)^2))^sin(x))^cos(x) = 2^(1/4), x, Ans). coueqn(Ans) :- solve(cos(x)^2 + b*cos(x) = c, x, Ans). nastyeqn(Ans) :- solve(y=((1+x^2)^(2^(-1))) / x, x, Ans). /*single equation goals*/ coseqn(Ans) :- solve(cos(x-45) = sin(2*x) , x , Ans). sqrteqn(Ans) :- solve(sqrt(5*x - 25) - sqrt(x-1) = 2 , x , Ans). pow2eqn(Ans) :- solve(2^(2*x+8) - 32*2^x + 1 = 0, x , Ans). quarteqn(Ans) :- solve(12*x^4 - 56*x^3 + 89*x^2 - 56*x + 12 = 0, x ,Ans). /*SIMULTANEOUS EQUATIONS*/ /*trivial test equations*/ simpeqns(Ans) :- simsolve( a=b & b=c & c=1 & true , [a,c,b] , Ans). /*simple pulley*/ simppull(Ans) :- simsolve( m1*g*cos(180) + (1*tsn + 0) = m1*(a1*1) & m2*g*1 + (cos(180)*tsn + 0) + 0 = m2*(a1*1) & true , [tsn,a1] , Ans). /*pulley and table with friction*/ pulltab(Ans) :- simsolve( m1*g*cos(270) + (1*tsn + (cos(-270)*reaction1 + 1*mu*reaction1 + 0)) + 0 = m1*(a1*1) & m2*g*1 + (cos(180)*tsn + 0 ) + 0=m2*(a1*1) & m1*g*1 + (cos(270)*tsn + (reaction1 + cos(270)*mu*reaction1 + 0)) + 0 = m1*(a1*cos(270)) & true, [reaction1, tsn, a1] , Ans). /*natural language problem four*/ nl4(Ans) :- simsolve( v^2=0^2 + 5*(60*60)^2 / (1760*3)*2000/1760 & true , [v] , Ans). /*simple car problem*/ car(Ans) :- simsolve( 1760*3*d0=0*60*t + 1/2*a*60*t^2 & v = 0 + a*60*t & true , [t, v] , Ans). /*tower p21 no13 Palmer & Snell*/ tower1(Ans) :- simsolve( v = vel1 + 32*t2 & d2 = vel1*t2 + 1/2*32*t2^2 & true , [vel1, v] , Ans). /*train problem p18 Palmer & Snell*/ train(Ans) :- simsolve( t0 = t1+(t2+(t3+0)) & 45/60 = 0 + 2^(-1)/60^2*t1 & 45/60*t2 = d2 & 0 = 45/60 + (-2)/60^2*t3 & 7 = d1+(d2+(d3+0)) & d1 = 0*t1 + 1/2*2^(-1)/60^2*t1^2 & d3 = 45/60*t3 + 1/2*(-2)/60^2*t3^2 & true , [t0, t1, t2, t3, d2, d1, d3] , Ans). /*tower to determine value of g*/ tower2(Ans) :- simsolve( v = 0 + a0*t0 & vc = 0 + a1*t1 & v = vc +a1*t2 & t0 = t1 + (t2 + 0) & d2 = vc*t2 + 1/2*a1*t2^2 & d1 = 0*t1 + 1/2*a1*t1^2 & true , [v, vc, a1, t0, t1, a0] , Ans). /*INEQUALITIES*/ stvineq(Ans) :- solveineq(x > 1/(1+sin(y)^2), x, Ans). conjineq(Ans) :- solveineq(2*g*h1>0 & 2*g*(h1-h2)>=0 & 2*g*(h1-h2)>0 & 2*g*(h1-h2)>=0 & true, X, Ans). bloc(Val) :- solveineq(sqrt(2*g*h1)>0 & real(sqrt(2*g*(h1-h2))) & sqrt(2*g*(h1-h2))>0 & real(sqrt(2*g*(h1-h2-l1*tan(t)))) & true, X,Val). loop(Minval) :- min(real(sqrt(2*g*h-2*g*r)) & sqrt(2*g*h-2*g*r)>0 & real(sqrt(2*g*h-4*g*r)) & (2*g*h-2*g*r*(1+sin(ang))) >= r*g*sin(ang) & sqrt(2*g*h-4*g*r)>0 & (2*g*h-2*g*r*(1+sin(ang))) >= r*g*sin(ang) & true, h,Minval). dome(Minval) :- min(m*g*(3*sin(d)-2)>=0 & true,d,Minval). /*SEMANTIC INFORMATION*/ quantity(reactionq1). measure(reactionq1,reaction1). quantity(muq). measure(muq,mu). quantity(vcq). measure(vcq,vc). quantity(velq1). measure(velq1,vel1). quantity(tq0). measure(tq0,t0). quantity(tq1). measure(tq1,t1). quantity(tq2). measure(tq2,t2). quantity(tq3). measure(tq3,t3). quantity(dq0). measure(dq0,d0). quantity(dq1). measure(dq1,d1). quantity(dq2). measure(dq2,d2). quantity(dq3). measure(dq3,d3). quantity(aq0). measure(aq0,a0). quantity(aq1). measure(aq1,a1). quantity(aq3). measure(aq3,a3). quantity(vq). measure(vq,v). quantity(hq1). measure(hq1,h1). quantity(hq2). measure(hq2,h2). quantity(hq). measure(hq,h). quantity(rq). measure(rq,r). quantity(tq). measure(tq,t). quantity(aq). measure(aq,a). quantity(angq). measure(angq,ang). quantity(dq). measure(dq,d). quantity(mq). measure(mq,m). quantity(mq1). measure(mq1,m1). quantity(mq2). measure(mq2,m2). quantity(tsnq). measure(tsnq,tsn). quantity(l1q). measure(l1q,l1). quantity(yq). measure(yq,y). incline(s3,tq,cc). slope(s3,right). concavity(s3,stline). incline(s4,yq,bot). slope(s4,right). concavity(s4,stline). angle(tp1,angq,semi). partition(semi,[s1,s2]). slope(s1,left). concavity(s1,right). slope(s2,right). concavity(s2,right). angle(tp2,dq,dome). slope(dome,left). concavity(dome,right). /*unknowns*/ sought(h1). sought(h2). sought(t). sought(v). sought(h). sought(x). sought(a). sought(d). sought(l). intermediate(y). intermediate(ang). intermediate(m). given(r). given(g). given(m1). given(m2). /*CURRENT PROBLEMS*/ pb1(A) :- eval(arcsin(2^(-1)), A). pb2 :- non_zero(0*2^(-1)). pb3( (-t2)^(-1)*(-(1+t1*(-(-t2)^(-1)))^(-1))*t1*a0*(t1+t2)). pb3 :- non_zero(t2^(-1)*d2). pbb(d1+(-1)*1*2^(-1)*(t2*(-2)^(-1)*(t2^(-1)*d2*1)+t2^(-1)*d2*1*(t2*(-2)^(-1)))). pba((-1)*1*2^(-1)*(t2*(-2)^(-1)*(t2*(-2)^(-1)))). pbc((-1)*1*2^(-1)*(t2^(-1)*d2*1*(t2^(-1)*d2*1))).